Index: /branches/FP_AI/build/makefile
===================================================================
--- /branches/FP_AI/build/makefile	(revision 23)
+++ /branches/FP_AI/build/makefile	(revision 23)
@@ -0,0 +1,91 @@
+SHELL = /bin/bash
+MAIN = FP_ecmwf_gfortran
+
+FC       = gfortran
+INCPATH  = /xnilu_wrk/flex_wrk/bin64/grib_api/include
+LIBPATH1 = /xnilu_wrk/flex_wrk/bin64/grib_api/lib
+LIBPATH2 =   /usr/lib/x86_64-linux-gnu/
+FFLAGS   =   -O2 -m64 -mcmodel=medium -fconvert=little-endian -frecord-marker=4 -I$(INCPATH)
+#FFLAGS   =   -fbounds-check -m64 -mcmodel=medium -fconvert=little-endian -frecord-marker=4 -I$(INCPATH)
+LDFLAGS  = $(FFLAGS) -L$(LIBPATH2) -L$(LIBPATH1) -lgrib_api_f90 -lgrib_api -lm -ljasper
+
+
+MODOBJS = \
+../src/par_mod.o    ../src/com_mod.o \
+../src/conv_mod.o              ../src/hanna_mod.o \
+../src/interpol_mod.o          ../src/cmapf_mod.o \
+../src/unc_mod.o               ../src/oh_mod.o \
+../src/xmass_mod.o             ../src/flux_mod.o \
+../src/point_mod.o             ../src/outg_mod.o
+
+OBJECTS = \
+../src/writeheader.o  ../src/writeheader_txt.o   ../src/writeheader_surf.o       ../src/assignland.o\
+../src/calcpar.o               ../src/part0.o \
+../src/caldate.o               ../src/partdep.o \
+../src/coordtrafo.o            ../src/psih.o \
+../src/raerod.o \
+../src/drydepokernel.o         ../src/random.o \
+../src/erf.o                   ../src/readavailable.o \
+../src/ew.o                    ../src/readcommand.o \
+../src/advance.o               ../src/readdepo.o \
+../src/releaseparticles.o      ../src/psim.o     \
+../src/FLEXPART.o              ../src/readlanduse.o \
+../src/getfields.o             ../src/init_domainfill.o\
+../src/interpol_wind.o         ../src/readoutgrid.o \
+../src/interpol_all.o          ../src/readpaths.o \
+../src/getrb.o                 ../src/readreceptors.o \
+../src/getrc.o                 ../src/readreleases.o \
+../src/getvdep.o               ../src/readspecies.o \
+../src/interpol_misslev.o      ../src/readwind.o \
+../src/conccalc.o              ../src/richardson.o \
+../src/concoutput.o  ../src/concoutput_surf.o          ../src/scalev.o \
+../src/pbl_profile.o           ../src/readOHfield.o\
+../src/juldate.o               ../src/timemanager.o \
+../src/interpol_vdep.o         ../src/interpol_rain.o \
+../src/verttransform.o         ../src/partoutput.o \
+../src/hanna.o                 ../src/wetdepokernel.o \
+../src/mean.o                  ../src/wetdepo.o \
+../src/hanna_short.o           ../src/windalign.o \
+../src/obukhov.o               ../src/gridcheck.o \
+../src/hanna1.o                ../src/initialize.o \
+                        ../src/gridcheck_nests.o \
+../src/readwind_nests.o        ../src/calcpar_nests.o \
+../src/verttransform_nests.o   ../src/interpol_all_nests.o \
+../src/interpol_wind_nests.o   ../src/interpol_misslev_nests.o \
+../src/interpol_vdep_nests.o   ../src/interpol_rain_nests.o \
+../src/getvdep_nests.o \
+../src/readageclasses.o        ../src/readpartpositions.o \
+../src/calcfluxes.o            ../src/fluxoutput.o \
+../src/qvsat.o                 ../src/skplin.o \
+../src/convmix.o               ../src/calcmatrix.o \
+../src/convect43c.o               ../src/redist.o \
+../src/sort2.o                 ../src/distance.o \
+../src/centerofmass.o          ../src/plumetraj.o \
+../src/openouttraj.o           ../src/calcpv.o \
+../src/calcpv_nests.o          ../src/distance2.o \
+../src/clustering.o            ../src/interpol_wind_short.o \
+../src/interpol_wind_short_nests.o ../src/shift_field_0.o \
+../src/shift_field.o           ../src/outgrid_init.o \
+../src/openreceptors.o         ../src/boundcond_domainfill.o\
+../src/partoutput_short.o      ../src/readoutgrid_nest.o \
+../src/outgrid_init_nest.o     ../src/writeheader_nest.o ../src/writeheader_nest_surf.o \
+../src/concoutput_nest.o ../src/concoutput_surf_nest.o      ../src/wetdepokernel_nest.o \
+../src/drydepokernel_nest.o    ../src/zenithangle.o \
+../src/ohreaction.o            ../src/getvdep_nests.o \
+../src/initial_cond_calc.o     ../src/initial_cond_output.o \
+../src/dynamic_viscosity.o     ../src/get_settling.o
+
+
+$(MAIN): $(MODOBJS) $(OBJECTS)
+	$(FC) *.o -o $(MAIN) $(LDFLAGS)
+
+$(OBJECTS): $(MODOBJS)
+
+%.o: %.f90
+	$(FC) -c $(FFLAGS) $<
+
+clean:
+	rm *.o *.mod
+
+cleanall:
+	rm *.o *.mod $(MAIN)
Index: /branches/FP_AI/build/makefile.ganglia
===================================================================
--- /branches/FP_AI/build/makefile.ganglia	(revision 23)
+++ /branches/FP_AI/build/makefile.ganglia	(revision 23)
@@ -0,0 +1,88 @@
+SHELL = /bin/bash
+MAIN = FP_ecmwf_gfortran
+
+FC       = gfortran
+INCPATH  = /xnilu_wrk/flex_wrk/bin64/grib_api/include
+LIBPATH1 = /xnilu_wrk/flex_wrk/bin64/grib_api/lib
+LIBPATH2 =   /usr/lib/x86_64-linux-gnu/
+FFLAGS   =   -O2 -m64 -mcmodel=medium -fconvert=little-endian -frecord-marker=4 -I$(INCPATH)
+LDFLAGS  = $(FFLAGS) -L$(LIBPATH2) -L$(LIBPATH1) -lgrib_api_f90 -lgrib_api -lm -ljasper
+
+
+MODOBJS = \
+par_mod.o    com_mod.o \
+conv_mod.o              hanna_mod.o \
+interpol_mod.o          cmapf_mod.o \
+unc_mod.o               oh_mod.o \
+xmass_mod.o             flux_mod.o \
+point_mod.o             outg_mod.o
+
+OBJECTS = \
+writeheader.o  writeheader_txt.o   writeheader_surf.o       assignland.o\
+calcpar.o               part0.o \
+caldate.o               partdep.o \
+coordtrafo.o            psih.o \
+raerod.o \
+drydepokernel.o         random.o \
+erf.o                   readavailable.o \
+ew.o                    readcommand.o \
+advance.o               readdepo.o \
+releaseparticles.o      psim.o     \
+FLEXPART.o              readlanduse.o \
+getfields.o             init_domainfill.o\
+interpol_wind.o         readoutgrid.o \
+interpol_all.o          readpaths.o \
+getrb.o                 readreceptors.o \
+getrc.o                 readreleases.o \
+getvdep.o               readspecies.o \
+interpol_misslev.o      readwind.o \
+conccalc.o              richardson.o \
+concoutput.o  concoutput_surf.o          scalev.o \
+pbl_profile.o           readOHfield.o\
+juldate.o               timemanager.o \
+interpol_vdep.o         interpol_rain.o \
+verttransform.o         partoutput.o \
+hanna.o                 wetdepokernel.o \
+mean.o                  wetdepo.o \
+hanna_short.o           windalign.o \
+obukhov.o               gridcheck.o \
+hanna1.o                initialize.o \
+                        gridcheck_nests.o \
+readwind_nests.o        calcpar_nests.o \
+verttransform_nests.o   interpol_all_nests.o \
+interpol_wind_nests.o   interpol_misslev_nests.o \
+interpol_vdep_nests.o   interpol_rain_nests.o \
+getvdep_nests.o \
+readageclasses.o        readpartpositions.o \
+calcfluxes.o            fluxoutput.o \
+qvsat.o                 skplin.o \
+convmix.o               calcmatrix.o \
+convect43c.o               redist.o \
+sort2.o                 distance.o \
+centerofmass.o          plumetraj.o \
+openouttraj.o           calcpv.o \
+calcpv_nests.o          distance2.o \
+clustering.o            interpol_wind_short.o \
+interpol_wind_short_nests.o shift_field_0.o \
+shift_field.o           outgrid_init.o \
+openreceptors.o         boundcond_domainfill.o\
+partoutput_short.o      readoutgrid_nest.o \
+outgrid_init_nest.o     writeheader_nest.o writeheader_nest_surf.o \
+concoutput_nest.o concoutput_surf_nest.o      wetdepokernel_nest.o \
+drydepokernel_nest.o    zenithangle.o \
+ohreaction.o            getvdep_nests.o \
+initial_cond_calc.o     initial_cond_output.o \
+dynamic_viscosity.o     get_settling.o
+
+
+$(MAIN): $(MODOBJS) $(OBJECTS)
+	$(FC) *.o -o $(MAIN) $(LDFLAGS)
+
+$(OBJECTS): $(MODOBJS)
+
+%.o: %.f90
+	$(FC) -c $(FFLAGS) $<
+
+clean:
+	rm *.o *.mod
+
Index: /branches/FP_AI/build/makefile.gfs
===================================================================
--- /branches/FP_AI/build/makefile.gfs	(revision 23)
+++ /branches/FP_AI/build/makefile.gfs	(revision 23)
@@ -0,0 +1,98 @@
+SHELL = /bin/bash
+MAIN = FLEXPART_GFS_GFORTRAN
+#
+TARGET = other
+
+FC       = gfortran
+INCPATH  = /xnilu_wrk/flex_wrk/bin64/grib_api/include
+LIBPATH1 = /xnilu_wrk/flex_wrk/bin64/grib_api/lib
+LIBPATH2 = /flex_wrk/flexpart/lib64/gfortran/lib/
+FFLAGS   =   -O2 -m64 -mcmodel=medium -fconvert=little-endian -frecord-marker=4 -I$(INCPATH)
+LDFLAGS  = $(FFLAGS) -L$(LIBPATH2) -L$(LIBPATH1) -lgrib_api_f90 -lgrib_api -lm -ljasper
+#
+
+ifeq ($(TARGET),other)	
+  libs_dir=/Users/ignacio/flexpart/libs/
+  INCPATH  = $(libs_dir)/grib_api-1.9.9_dir/include
+  LIBPATH1 = $(libs_dir)/grib_api-1.9.9_dir/lib
+  LIBPATH2 = $(libs_dir)/jasper_dir/lib
+  #MAIN = FLEXPART_laptop
+endif
+
+MODOBJS = \
+par_mod.o               com_mod.o \
+conv_mod.o              hanna_mod.o \
+interpol_mod.o          cmapf_mod.o \
+unc_mod.o               oh_mod.o \
+xmass_mod.o             flux_mod.o \
+point_mod.o             outg_mod.o
+
+OBJECTS = \
+writeheader.o    writeheader_txt.o   writeheader_surf.o       assignland.o\
+calcpar_gfs.o           part0.o \
+caldate.o               partdep.o \
+coordtrafo.o            psih.o \
+raerod.o \
+drydepokernel.o         random.o \
+erf.o                   readavailable.o \
+ew.o                    readcommand.o \
+advance.o               readdepo.o \
+releaseparticles.o      psim.o     \
+FLEXPART.o              readlanduse.o \
+getfields.o             init_domainfill.o\
+interpol_wind.o         readoutgrid.o \
+interpol_all.o          readpaths.o \
+getrb.o                 readreceptors.o \
+getrc.o                 readreleases.o \
+getvdep.o               readspecies.o \
+interpol_misslev.o      readwind_gfs.o \
+conccalc.o              richardson_gfs.o \
+concoutput.o    concoutput_surf.o         scalev.o \
+pbl_profile.o           readOHfield.o\
+juldate.o               timemanager.o \
+interpol_vdep.o         interpol_rain.o \
+verttransform_gfs.o         partoutput.o \
+hanna.o                 wetdepokernel.o \
+mean.o                  wetdepo.o \
+hanna_short.o           windalign.o \
+obukhov_gfs.o           gridcheck_gfs.o \
+hanna1.o                initialize.o \
+                        gridcheck_nests.o \
+readwind_nests.o        calcpar_nests.o \
+verttransform_nests.o   interpol_all_nests.o \
+interpol_wind_nests.o   interpol_misslev_nests.o \
+interpol_vdep_nests.o   interpol_rain_nests.o \
+getvdep_nests.o \
+readageclasses.o        readpartpositions.o \
+calcfluxes.o            fluxoutput.o \
+qvsat.o                 skplin.o \
+convmix_gfs.o               calcmatrix_gfs.o \
+convect43c.o            redist.o \
+sort2.o                 distance.o \
+centerofmass.o          plumetraj.o \
+openouttraj.o           calcpv.o \
+calcpv_nests.o          distance2.o \
+clustering.o            interpol_wind_short.o \
+interpol_wind_short_nests.o shift_field_0.o \
+shift_field.o           outgrid_init.o \
+openreceptors.o         boundcond_domainfill.o\
+partoutput_short.o      readoutgrid_nest.o \
+outgrid_init_nest.o     writeheader_nest.o writeheader_nest_surf.o\
+concoutput_nest.o  concoutput_surf_nest.o     wetdepokernel_nest.o \
+drydepokernel_nest.o    zenithangle.o \
+ohreaction.o            getvdep_nests.o \
+initial_cond_calc.o     initial_cond_output.o \
+dynamic_viscosity.o     get_settling.o
+
+
+$(MAIN): $(MODOBJS) $(OBJECTS)
+	$(FC) *.o -o $(MAIN) $(LDFLAGS)
+
+$(OBJECTS): $(MODOBJS)
+
+%.o: %.f90
+	$(FC) -c $(FFLAGS) $<
+
+clean:
+	rm *.o *.mod
+
Index: /branches/FP_AI/run/pathnames
===================================================================
--- /branches/FP_AI/run/pathnames	(revision 23)
+++ /branches/FP_AI/run/pathnames	(revision 23)
@@ -0,0 +1,6 @@
+/flex_wrk/ast/FLEXPART_TEST/FLEXPART_CLEAN/options/
+./output/
+/
+/flex_wrk/WIND_FIELDS/AVAILABLE_ECMWF_OPER_fields_global
+============================================
+
Index: /branches/FP_AI/src/FLEXPART.f90
===================================================================
--- /branches/FP_AI/src/FLEXPART.f90	(revision 23)
+++ /branches/FP_AI/src/FLEXPART.f90	(revision 23)
@@ -0,0 +1,405 @@
+!**********************************************************************
+! 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
+  character(len=256) :: inline_options  !pathfile, flexversion, arg2
+
+
+  ! 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))
+
+  ! 
+  flexversion='Version 9.1.9  (2014-05-21)'
+  !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 ', 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 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) 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
+  !call readspecies
+
+
+  ! 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
+
+
+
+  ! 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  
+  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
+
+  ! For continuation of previous run, read in particle positions
+  !*************************************************************
+
+  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
+
+
+  ! 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
+  !******************
+
+  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
+  ! 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
+
+
+  ! 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
+    ireleaseend(i)=nint(real(ireleaseend(i))/ &
+         real(lsynctime))*lsynctime
+  end do
+
+
+  ! 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.
+    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
+  !********************************
+
+  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
+
+
+  write(*,*) 'CONGRATULATIONS: YOU HAVE SUCCESSFULLY COMPLETED A FLE&
+       &XPART MODEL RUN!'
+
+end program flexpart
Index: /branches/FP_AI/src/advance.f90
===================================================================
--- /branches/FP_AI/src/advance.f90	(revision 23)
+++ /branches/FP_AI/src/advance.f90	(revision 23)
@@ -0,0 +1,877 @@
+!**********************************************************************
+! 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 advance(itime,nrelpoint,ldt,up,vp,wp, &
+       usigold,vsigold,wsigold,nstop,xt,yt,zt,prob,icbt)
+  !                     i    i  i/oi/oi/o
+  !  i/o     i/o     i/o     o  i/oi/oi/o i/o  i/o
+  !*****************************************************************************
+  !                                                                            *
+  !  Calculation of turbulent particle trajectories utilizing a                *
+  !  zero-acceleration scheme, which is corrected by a numerically more        *
+  !  accurate Petterssen scheme whenever possible.                             *
+  !                                                                            *
+  !  Particle positions are read in, incremented, and returned to the calling  *
+  !  program.                                                                  *
+  !                                                                            *
+  !  In different regions of the atmosphere (PBL vs. free troposphere),        *
+  !  different parameters are needed for advection, parameterizing turbulent   *
+  !  velocities, etc. For efficiency, different interpolation routines have    *
+  !  been written for these different cases, with the disadvantage that there  *
+  !  exist several routines doing almost the same. They all share the          *
+  !  included file 'interpol_mod'. The following                               *
+  !  interpolation routines are used:                                          *
+  !                                                                            *
+  !  interpol_all(_nests)     interpolates everything (called inside the PBL)  *
+  !  interpol_misslev(_nests) if a particle moves vertically in the PBL,       *
+  !                           additional parameters are interpolated if it     *
+  !                           crosses a model level                            *
+  !  interpol_wind(_nests)    interpolates the wind and determines the         *
+  !                           standard deviation of the wind (called outside   *
+  !                           PBL) also interpolates potential vorticity       *
+  !  interpol_wind_short(_nests) only interpolates the wind (needed for the    *
+  !                           Petterssen scheme)                               *
+  !  interpol_vdep(_nests)    interpolates deposition velocities               *
+  !                                                                            *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     16 December 1997                                                       *
+  !                                                                            *
+  !  Changes:                                                                  *
+  !                                                                            *
+  !  8 April 2000: Deep convection parameterization                            *
+  !                                                                            *
+  !  May 2002: Petterssen scheme introduced                                    *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! icbt               1 if particle not transferred to forbidden state,       *
+  !                    else -1                                                 *
+  ! dawsave            accumulated displacement in along-wind direction        *
+  ! dcwsave            accumulated displacement in cross-wind direction        *
+  ! dxsave             accumulated displacement in longitude                   *
+  ! dysave             accumulated displacement in latitude                    *
+  ! h [m]              Mixing height                                           *
+  ! lwindinterv [s]    time interval between two wind fields                   *
+  ! itime [s]          time at which this subroutine is entered                *
+  ! itimec [s]         actual time, which is incremented in this subroutine    *
+  ! href [m]           height for which dry deposition velocity is calculated  *
+  ! ladvance [s]       Total integration time period                           *
+  ! ldirect            1 forward, -1 backward                                  *
+  ! ldt [s]            Time step for the next integration                      *
+  ! lsynctime [s]      Synchronisation interval of FLEXPART                    *
+  ! ngrid              index which grid is to be used                          *
+  ! nrand              index for a variable to be picked from rannumb          *
+  ! nstop              if > 1 particle has left domain and must be stopped     *
+  ! prob               probability of absorption due to dry deposition         *
+  ! rannumb(maxrand)   normally distributed random variables                   *
+  ! rhoa               air density                                             *
+  ! rhograd            vertical gradient of the air density                    *
+  ! up,vp,wp           random velocities due to turbulence (along wind, cross  *
+  !                    wind, vertical wind                                     *
+  ! usig,vsig,wsig     mesoscale wind fluctuations                             *
+  ! usigold,vsigold,wsigold  like usig, etc., but for the last time step       *
+  ! vdepo              Deposition velocities for all species                   *
+  ! xt,yt,zt           Particle position                                       *
+  !                                                                            *
+  !*****************************************************************************
+
+  use point_mod
+  use par_mod
+  use com_mod
+  use interpol_mod
+  use hanna_mod
+  use cmapf_mod
+
+  implicit none
+
+  real(kind=dp) :: xt,yt
+  real :: zt,xts,yts,weight
+  integer :: itime,itimec,nstop,ldt,i,j,k,nrand,loop,memindnext
+  integer :: ngr,nix,njy,ks,nsp,nrelpoint
+  real :: dz,dz1,dz2,xlon,ylat,xpol,ypol,gridsize
+  real :: ru,rv,rw,dt,ux,vy,cosfact,xtn,ytn,tropop
+  real :: prob(maxspec),up,vp,wp,dxsave,dysave,dawsave
+  real :: dcwsave
+  real :: usigold,vsigold,wsigold,r,rs
+  real :: uold,vold,wold,vdepo(maxspec)
+  !real uprof(nzmax),vprof(nzmax),wprof(nzmax)
+  !real usigprof(nzmax),vsigprof(nzmax),wsigprof(nzmax)
+  !real rhoprof(nzmax),rhogradprof(nzmax)
+  real :: rhoa,rhograd,ran3,delz,dtf,rhoaux,dtftlw,uxscale,wpscale
+  integer(kind=2) :: icbt
+  real,parameter :: eps=nxmax/3.e5,eps2=1.e-9
+
+
+  !!! CHANGE: TEST OF THE WELL-MIXED CRITERION
+  !  integer,parameter :: iclass=10
+  !  real(kind=dp) :: zacc,tacc,t(iclass),th(0:iclass),hsave
+  !  logical dump
+  !  save zacc,tacc,t,th,hsave,dump
+  !!! CHANGE
+
+  integer :: idummy = -7
+  real    :: settling = 0.
+
+
+  !!! CHANGE: TEST OF THE WELL-MIXED CRITERION
+  !if (idummy.eq.-7) then
+  !open(550,file='WELLMIXEDTEST')
+  !do 17 i=0,iclass
+  !7      th(i)=real(i)/real(iclass)
+  !endif
+  !!! CHANGE
+
+
+  nstop=0
+  do i=1,nmixz
+    indzindicator(i)=.true.
+  end do
+
+
+  if (DRYDEP) then    ! reset probability for deposition
+    do ks=1,nspec
+      depoindicator(ks)=.true.
+      prob(ks)=0.
+    end do
+  endif
+
+  dxsave=0.           ! reset position displacements
+  dysave=0.           ! due to mean wind
+  dawsave=0.          ! and turbulent wind
+  dcwsave=0.
+
+  itimec=itime
+
+  nrand=int(ran3(idummy)*real(maxrand-1))+1
+
+
+  ! Determine whether lat/long grid or polarstereographic projection
+  ! is to be used
+  ! Furthermore, determine which nesting level to be used
+  !*****************************************************************
+
+  if (nglobal.and.(yt.gt.switchnorthg)) then
+    ngrid=-1
+  else if (sglobal.and.(yt.lt.switchsouthg)) then
+    ngrid=-2
+  else
+    ngrid=0
+    do j=numbnests,1,-1
+      if ((xt.gt.xln(j)+eps).and.(xt.lt.xrn(j)-eps).and. &
+           (yt.gt.yln(j)+eps).and.(yt.lt.yrn(j)-eps)) then
+        ngrid=j
+        goto 23
+      endif
+    end do
+23   continue
+  endif
+
+
+  !***************************
+  ! Interpolate necessary data
+  !***************************
+
+  if (abs(itime-memtime(1)).lt.abs(itime-memtime(2))) then
+    memindnext=1
+  else
+    memindnext=2
+  endif
+
+  ! Determine nested grid coordinates
+  !**********************************
+
+  if (ngrid.gt.0) then
+    xtn=(xt-xln(ngrid))*xresoln(ngrid)
+    ytn=(yt-yln(ngrid))*yresoln(ngrid)
+    ix=int(xtn)
+    jy=int(ytn)
+    nix=nint(xtn)
+    njy=nint(ytn)
+  else
+    ix=int(xt)
+    jy=int(yt)
+    nix=nint(xt)
+    njy=nint(yt)
+  endif
+  ixp=ix+1
+  jyp=jy+1
+
+
+  ! Compute maximum mixing height around particle position
+  !*******************************************************
+
+  h=0.
+  if (ngrid.le.0) then
+    do k=1,2
+      do j=jy,jyp
+        do i=ix,ixp
+          if (hmix(i,j,1,k).gt.h) h=hmix(i,j,1,k)
+        end do
+      end do
+    end do
+    tropop=tropopause(nix,njy,1,1)
+  else
+    do k=1,2
+      do j=jy,jyp
+        do i=ix,ixp
+          if (hmixn(i,j,1,k,ngrid).gt.h) h=hmixn(i,j,1,k,ngrid)
+        end do
+      end do
+    end do
+    tropop=tropopausen(nix,njy,1,1,ngrid)
+  endif
+
+  zeta=zt/h
+
+
+
+  !*************************************************************
+  ! If particle is in the PBL, interpolate once and then make a
+  ! time loop until end of interval is reached
+  !*************************************************************
+
+  if (zeta.le.1.) then
+
+  ! BEGIN TIME LOOP
+  !================
+
+    loop=0
+100   loop=loop+1
+      if (method.eq.1) then
+        ldt=min(ldt,abs(lsynctime-itimec+itime))
+        itimec=itimec+ldt*ldirect
+      else
+        ldt=abs(lsynctime)
+        itimec=itime+lsynctime
+      endif
+      dt=real(ldt)
+
+      zeta=zt/h
+
+
+      if (loop.eq.1) then
+        if (ngrid.le.0) then
+          xts=real(xt)
+          yts=real(yt)
+          call interpol_all(itime,xts,yts,zt)
+        else
+          call interpol_all_nests(itime,xtn,ytn,zt)
+        endif
+
+      else
+
+
+  ! Determine the level below the current position for u,v,rho
+  !***********************************************************
+
+        do i=2,nz
+          if (height(i).gt.zt) then
+            indz=i-1
+            indzp=i
+            goto 6
+          endif
+        end do
+6       continue
+
+  ! If one of the levels necessary is not yet available,
+  ! calculate it
+  !*****************************************************
+
+        do i=indz,indzp
+          if (indzindicator(i)) then
+            if (ngrid.le.0) then
+              call interpol_misslev(i)
+            else
+              call interpol_misslev_nests(i)
+            endif
+          endif
+        end do
+      endif
+
+
+  ! Vertical interpolation of u,v,w,rho and drhodz
+  !***********************************************
+
+  ! Vertical distance to the level below and above current position
+  ! both in terms of (u,v) and (w) fields
+  !****************************************************************
+
+      dz=1./(height(indzp)-height(indz))
+      dz1=(zt-height(indz))*dz
+      dz2=(height(indzp)-zt)*dz
+
+      u=dz1*uprof(indzp)+dz2*uprof(indz)
+      v=dz1*vprof(indzp)+dz2*vprof(indz)
+      w=dz1*wprof(indzp)+dz2*wprof(indz)
+      rhoa=dz1*rhoprof(indzp)+dz2*rhoprof(indz)
+      rhograd=dz1*rhogradprof(indzp)+dz2*rhogradprof(indz)
+
+
+  ! Compute the turbulent disturbances
+  ! Determine the sigmas and the timescales
+  !****************************************
+
+      if (turbswitch) then
+        call hanna(zt)
+      else
+        call hanna1(zt)
+      endif
+
+
+  !*****************************************
+  ! Determine the new diffusivity velocities
+  !*****************************************
+
+  ! Horizontal components
+  !**********************
+
+      if (nrand+1.gt.maxrand) nrand=1
+      if (dt/tlu.lt..5) then
+        up=(1.-dt/tlu)*up+rannumb(nrand)*sigu*sqrt(2.*dt/tlu)
+      else
+        ru=exp(-dt/tlu)
+        up=ru*up+rannumb(nrand)*sigu*sqrt(1.-ru**2)
+      endif
+      if (dt/tlv.lt..5) then
+        vp=(1.-dt/tlv)*vp+rannumb(nrand+1)*sigv*sqrt(2.*dt/tlv)
+      else
+        rv=exp(-dt/tlv)
+        vp=rv*vp+rannumb(nrand+1)*sigv*sqrt(1.-rv**2)
+      endif
+      nrand=nrand+2
+
+
+      if (nrand+ifine.gt.maxrand) nrand=1
+      rhoaux=rhograd/rhoa
+      dtf=dt*fine
+
+      dtftlw=dtf/tlw
+
+  ! Loop over ifine short time steps for vertical component
+  !********************************************************
+
+      do i=1,ifine
+
+  ! Determine the drift velocity and density correction velocity
+  !*************************************************************
+
+        if (turbswitch) then
+          if (dtftlw.lt..5) then
+            wp=((1.-dtftlw)*wp+rannumb(nrand+i)*sqrt(2.*dtftlw) &
+                 +dtf*(dsigwdz+rhoaux*sigw))*real(icbt)
+          else
+            rw=exp(-dtftlw)
+            wp=(rw*wp+rannumb(nrand+i)*sqrt(1.-rw**2) &
+                 +tlw*(1.-rw)*(dsigwdz+rhoaux*sigw))*real(icbt)
+          endif
+          delz=wp*sigw*dtf
+        else
+          rw=exp(-dtftlw)
+          wp=(rw*wp+rannumb(nrand+i)*sqrt(1.-rw**2)*sigw &
+               +tlw*(1.-rw)*(dsigw2dz+rhoaux*sigw**2))*real(icbt)
+          delz=wp*dtf
+        endif
+
+  !****************************************************
+  ! Compute turbulent vertical displacement of particle
+  !****************************************************
+
+        if (abs(delz).gt.h) delz=mod(delz,h)
+
+  ! Determine if particle transfers to a "forbidden state" below the ground
+  ! or above the mixing height
+  !************************************************************************
+
+        if (delz.lt.-zt) then         ! reflection at ground
+          icbt=-1
+          zt=-zt-delz
+        else if (delz.gt.(h-zt)) then ! reflection at h
+          icbt=-1
+          zt=-zt-delz+2.*h
+        else                         ! no reflection
+          icbt=1
+          zt=zt+delz
+        endif
+
+        if (i.ne.ifine) then
+          zeta=zt/h
+          call hanna_short(zt)
+        endif
+
+      end do
+      nrand=nrand+i
+
+  ! Determine time step for next integration
+  !*****************************************
+
+      if (turbswitch) then
+        ldt=int(min(tlw,h/max(2.*abs(wp*sigw),1.e-5), &
+             0.5/abs(dsigwdz))*ctl)
+      else
+        ldt=int(min(tlw,h/max(2.*abs(wp),1.e-5))*ctl)
+      endif
+      ldt=max(ldt,mintime)
+
+
+  ! If particle represents only a single species, add gravitational settling
+  ! velocity. The settling velocity is zero for gases, or if particle
+  ! represents more than one species
+  !*************************************************************************
+
+      if (mdomainfill.eq.0) then
+        do nsp=1,nspec
+          if (xmass(nrelpoint,nsp).gt.eps2) goto 887
+        end do
+887     nsp=min(nsp,nspec)
+!!$        if (density(nsp).gt.0.) &
+!!$             call get_settling(itime,xts,yts,zt,nsp,settling)    !old
+        if (density(nsp).gt.0.) &
+             call get_settling(itime,real(xt),real(yt),zt,nsp,settling)  !bugfix
+        w=w+settling
+      endif
+
+  ! Horizontal displacements during time step dt are small real values compared
+  ! to the position; adding the two, would result in large numerical errors.
+  ! Thus, displacements are accumulated during lsynctime and are added to the
+  ! position at the end
+  !****************************************************************************
+
+      dxsave=dxsave+u*dt
+      dysave=dysave+v*dt
+      dawsave=dawsave+up*dt
+      dcwsave=dcwsave+vp*dt
+      zt=zt+w*dt*real(ldirect)
+
+      if (zt.gt.h) then
+        if (itimec.eq.itime+lsynctime) goto 99
+        goto 700    ! complete the current interval above PBL
+      endif
+
+
+  !!! CHANGE: TEST OF THE WELL-MIXED CRITERION
+  !!! These lines may be switched on to test the well-mixed criterion
+  !if (zt.le.h) then
+  !  zacc=zacc+zt/h*dt
+  !  hsave=hsave+h*dt
+  !  tacc=tacc+dt
+  !  do 67 i=1,iclass
+  !    if ((zt/h.gt.th(i-1)).and.(zt/h.le.th(i)))
+  !    +    t(i)=t(i)+dt
+  !7        continue
+  !endif
+  !if ((mod(itime,10800).eq.0).and.dump) then
+  ! dump=.false.
+  ! write(550,'(i6,12f10.3)') itime,hsave/tacc,zacc/tacc,
+  !    + (t(i)/tacc*real(iclass),i=1,iclass)
+  !  zacc=0.
+  !  tacc=0.
+  !  do 68 i=1,iclass
+  !8        t(i)=0.
+  !  hsave=0.
+  !endif
+  !if (mod(itime,10800).ne.0) dump=.true.
+  !!! CHANGE
+
+
+  ! Determine probability of deposition
+  !************************************
+
+      if ((DRYDEP).and.(zt.lt.2.*href)) then
+        do ks=1,nspec
+          if (DRYDEPSPEC(ks)) then
+            if (depoindicator(ks)) then
+              if (ngrid.le.0) then
+                call interpol_vdep(ks,vdepo(ks))
+              else
+                call interpol_vdep_nests(ks,vdepo(ks))
+              endif
+            endif
+  ! correction by Petra Seibert, 10 April 2001
+  !   this formulation means that prob(n) = 1 - f(0)*...*f(n)
+  !   where f(n) is the exponential term
+               prob(ks)=1.+(prob(ks)-1.)* &
+                    exp(-vdepo(ks)*abs(dt)/(2.*href))
+          endif
+        end do
+      endif
+
+      if (zt.lt.0.) zt=min(h-eps2,-1.*zt)    ! if particle below ground -> reflection
+
+      if (itimec.eq.(itime+lsynctime)) then
+        usig=0.5*(usigprof(indzp)+usigprof(indz))
+        vsig=0.5*(vsigprof(indzp)+vsigprof(indz))
+        wsig=0.5*(wsigprof(indzp)+wsigprof(indz))
+        goto 99  ! finished
+      endif
+      goto 100
+
+  ! END TIME LOOP
+  !==============
+
+
+  endif
+
+
+
+  !**********************************************************
+  ! For all particles that are outside the PBL, make a single
+  ! time step. Only horizontal turbulent disturbances are
+  ! calculated. Vertical disturbances are reset.
+  !**********************************************************
+
+
+  ! Interpolate the wind
+  !*********************
+
+700   continue
+  if (ngrid.le.0) then
+    xts=real(xt)
+    yts=real(yt)
+    call interpol_wind(itime,xts,yts,zt)
+  else
+    call interpol_wind_nests(itime,xtn,ytn,zt)
+  endif
+
+
+  ! Compute everything for above the PBL
+
+  ! Assume constant, uncorrelated, turbulent perturbations
+  ! In the stratosphere, use a small vertical diffusivity d_strat,
+  ! in the troposphere, use a larger horizontal diffusivity d_trop.
+  ! Turbulent velocity scales are determined based on sqrt(d_trop/dt)
+  !******************************************************************
+
+  ldt=abs(lsynctime-itimec+itime)
+  dt=real(ldt)
+
+  if (zt.lt.tropop) then  ! in the troposphere
+    uxscale=sqrt(2.*d_trop/dt)
+    if (nrand+1.gt.maxrand) nrand=1
+    ux=rannumb(nrand)*uxscale
+    vy=rannumb(nrand+1)*uxscale
+    nrand=nrand+2
+    wp=0.
+  else if (zt.lt.tropop+1000.) then     ! just above the tropopause: make transition
+    weight=(zt-tropop)/1000.
+    uxscale=sqrt(2.*d_trop/dt*(1.-weight))
+    if (nrand+2.gt.maxrand) nrand=1
+    ux=rannumb(nrand)*uxscale
+    vy=rannumb(nrand+1)*uxscale
+    wpscale=sqrt(2.*d_strat/dt*weight)
+    wp=rannumb(nrand+2)*wpscale+d_strat/1000.
+    nrand=nrand+3
+  else                 ! in the stratosphere
+    if (nrand.gt.maxrand) nrand=1
+    ux=0.
+    vy=0.
+    wpscale=sqrt(2.*d_strat/dt)
+    wp=rannumb(nrand)*wpscale
+    nrand=nrand+1
+  endif
+
+
+  ! If particle represents only a single species, add gravitational settling
+  ! velocity. The settling velocity is zero for gases
+  !*************************************************************************
+
+
+
+    if (mdomainfill.eq.0) then
+      do nsp=1,nspec
+        if (xmass(nrelpoint,nsp).gt.eps2) goto 888
+      end do
+888   nsp=min(nsp,nspec)
+!!$      if (density(nsp).gt.0.) &
+!!$           call get_settling(itime,xts,yts,zt,nsp,settling)    !old
+      if (density(nsp).gt.0.) &
+           call get_settling(itime,real(xt),real(yt),zt,nsp,settling)  !bugfix
+      w=w+settling
+    endif
+
+  ! Calculate position at time step itime+lsynctime
+  !************************************************
+
+  dxsave=dxsave+(u+ux)*dt
+  dysave=dysave+(v+vy)*dt
+  zt=zt+(w+wp)*dt*real(ldirect)
+  if (zt.lt.0.) zt=min(h-eps2,-1.*zt)    ! if particle below ground -> reflection
+
+99   continue
+
+
+
+  !****************************************************************
+  ! Add mesoscale random disturbances
+  ! This is done only once for the whole lsynctime interval to save
+  ! computation time
+  !****************************************************************
+
+
+  ! Mesoscale wind velocity fluctuations are obtained by scaling
+  ! with the standard deviation of the grid-scale winds surrounding
+  ! the particle location, multiplied by a factor turbmesoscale.
+  ! The autocorrelation time constant is taken as half the
+  ! time interval between wind fields
+  !****************************************************************
+
+  r=exp(-2.*real(abs(lsynctime))/real(lwindinterv))
+  rs=sqrt(1.-r**2)
+  if (nrand+2.gt.maxrand) nrand=1
+  usigold=r*usigold+rs*rannumb(nrand)*usig*turbmesoscale
+  vsigold=r*vsigold+rs*rannumb(nrand+1)*vsig*turbmesoscale
+  wsigold=r*wsigold+rs*rannumb(nrand+2)*wsig*turbmesoscale
+
+  dxsave=dxsave+usigold*real(lsynctime)
+  dysave=dysave+vsigold*real(lsynctime)
+
+  zt=zt+wsigold*real(lsynctime)
+  if (zt.lt.0.) zt=-1.*zt    ! if particle below ground -> refletion
+
+  !*************************************************************
+  ! Transform along and cross wind components to xy coordinates,
+  ! add them to u and v, transform u,v to grid units/second
+  ! and calculate new position
+  !*************************************************************
+
+  call windalign(dxsave,dysave,dawsave,dcwsave,ux,vy)
+  dxsave=dxsave+ux
+  dysave=dysave+vy
+  if (ngrid.ge.0) then
+    cosfact=dxconst/cos((yt*dy+ylat0)*pi180)
+    xt=xt+real(dxsave*cosfact*real(ldirect),kind=dp)
+    yt=yt+real(dysave*dyconst*real(ldirect),kind=dp)
+  else if (ngrid.eq.-1) then      ! around north pole
+    xlon=xlon0+xt*dx
+    ylat=ylat0+yt*dy
+    call cll2xy(northpolemap,ylat,xlon,xpol,ypol)
+    gridsize=1000.*cgszll(northpolemap,ylat,xlon)
+    dxsave=dxsave/gridsize
+    dysave=dysave/gridsize
+    xpol=xpol+dxsave*real(ldirect)
+    ypol=ypol+dysave*real(ldirect)
+    call cxy2ll(northpolemap,xpol,ypol,ylat,xlon)
+    xt=(xlon-xlon0)/dx
+    yt=(ylat-ylat0)/dy
+  else if (ngrid.eq.-2) then    ! around south pole
+    xlon=xlon0+xt*dx
+    ylat=ylat0+yt*dy
+    call cll2xy(southpolemap,ylat,xlon,xpol,ypol)
+    gridsize=1000.*cgszll(southpolemap,ylat,xlon)
+    dxsave=dxsave/gridsize
+    dysave=dysave/gridsize
+    xpol=xpol+dxsave*real(ldirect)
+    ypol=ypol+dysave*real(ldirect)
+    call cxy2ll(southpolemap,xpol,ypol,ylat,xlon)
+    xt=(xlon-xlon0)/dx
+    yt=(ylat-ylat0)/dy
+  endif
+
+
+  ! If global data are available, use cyclic boundary condition
+  !************************************************************
+
+  if (xglobal) then
+    if (xt.ge.real(nxmin1)) xt=xt-real(nxmin1)
+    if (xt.lt.0.) xt=xt+real(nxmin1)
+    if (xt.le.eps) xt=eps
+    if (abs(xt-real(nxmin1)).le.eps) xt=real(nxmin1)-eps
+  endif
+
+
+  ! Check position: If trajectory outside model domain, terminate it
+  !*****************************************************************
+
+  if ((xt.lt.0.).or.(xt.ge.real(nxmin1)).or.(yt.lt.0.).or. &
+       (yt.ge.real(nymin1))) then
+    nstop=3
+    return
+  endif
+
+  ! If particle above highest model level, set it back into the domain
+  !*******************************************************************
+
+  if (zt.ge.height(nz)) zt=height(nz)-100.*eps
+
+
+  !************************************************************************
+  ! Now we could finish, as this was done in FLEXPART versions up to 4.0.
+  ! However, truncation errors of the advection can be significantly
+  ! reduced by doing one iteration of the Petterssen scheme, if this is
+  ! possible.
+  ! Note that this is applied only to the grid-scale winds, not to
+  ! the turbulent winds.
+  !************************************************************************
+
+  ! The Petterssen scheme can only applied with long time steps (only then u
+  ! is the "old" wind as required by the scheme); otherwise do nothing
+  !*************************************************************************
+
+  if (ldt.ne.abs(lsynctime)) return
+
+  ! The Petterssen scheme can only be applied if the ending time of the time step
+  ! (itime+ldt*ldirect) is still between the two wind fields held in memory;
+  ! otherwise do nothing
+  !******************************************************************************
+
+  if (abs(itime+ldt*ldirect).gt.abs(memtime(2))) return
+
+  ! Apply it also only if starting and ending point of current time step are on
+  ! the same grid; otherwise do nothing
+  !*****************************************************************************
+  if (nglobal.and.(yt.gt.switchnorthg)) then
+    ngr=-1
+  else if (sglobal.and.(yt.lt.switchsouthg)) then
+    ngr=-2
+  else
+    ngr=0
+    do j=numbnests,1,-1
+      if ((xt.gt.xln(j)+eps).and.(xt.lt.xrn(j)-eps).and. &
+           (yt.gt.yln(j)+eps).and.(yt.lt.yrn(j)-eps)) then
+        ngr=j
+        goto 43
+      endif
+    end do
+43   continue
+  endif
+
+  if (ngr.ne.ngrid) return
+
+  ! Determine nested grid coordinates
+  !**********************************
+
+  if (ngrid.gt.0) then
+    xtn=(xt-xln(ngrid))*xresoln(ngrid)
+    ytn=(yt-yln(ngrid))*yresoln(ngrid)
+    ix=int(xtn)
+    jy=int(ytn)
+  else
+    ix=int(xt)
+    jy=int(yt)
+  endif
+  ixp=ix+1
+  jyp=jy+1
+
+
+  ! Memorize the old wind
+  !**********************
+
+  uold=u
+  vold=v
+  wold=w
+
+  ! Interpolate wind at new position and time
+  !******************************************
+
+  if (ngrid.le.0) then
+    xts=real(xt)
+    yts=real(yt)
+    call interpol_wind_short(itime+ldt*ldirect,xts,yts,zt)
+  else
+    call interpol_wind_short_nests(itime+ldt*ldirect,xtn,ytn,zt)
+  endif
+
+  if (mdomainfill.eq.0) then
+    do nsp=1,nspec
+      if (xmass(nrelpoint,nsp).gt.eps2) goto 889
+    end do
+889   nsp=min(nsp,nspec)
+!!$    if (density(nsp).gt.0.) &
+!!$         call get_settling(itime+ldt,xts,yts,zt,nsp,settling)    !old
+    if (density(nsp).gt.0.) &
+         call get_settling(itime+ldt,real(xt),real(yt),zt,nsp,settling)  !bugfix
+    w=w+settling
+  endif
+
+
+  ! Determine the difference vector between new and old wind
+  ! (use half of it to correct position according to Petterssen)
+  !*************************************************************
+
+  u=(u-uold)/2.
+  v=(v-vold)/2.
+  w=(w-wold)/2.
+
+
+  ! Finally, correct the old position
+  !**********************************
+
+  zt=zt+w*real(ldt*ldirect)
+  if (zt.lt.0.) zt=min(h-eps2,-1.*zt)    ! if particle below ground -> reflection
+  if (ngrid.ge.0) then
+    cosfact=dxconst/cos((yt*dy+ylat0)*pi180)
+    xt=xt+real(u*cosfact*real(ldt*ldirect),kind=dp)
+    yt=yt+real(v*dyconst*real(ldt*ldirect),kind=dp)
+  else if (ngrid.eq.-1) then      ! around north pole
+    xlon=xlon0+xt*dx
+    ylat=ylat0+yt*dy
+    call cll2xy(northpolemap,ylat,xlon,xpol,ypol)
+    gridsize=1000.*cgszll(northpolemap,ylat,xlon)
+    u=u/gridsize
+    v=v/gridsize
+    xpol=xpol+u*real(ldt*ldirect)
+    ypol=ypol+v*real(ldt*ldirect)
+    call cxy2ll(northpolemap,xpol,ypol,ylat,xlon)
+    xt=(xlon-xlon0)/dx
+    yt=(ylat-ylat0)/dy
+  else if (ngrid.eq.-2) then    ! around south pole
+    xlon=xlon0+xt*dx
+    ylat=ylat0+yt*dy
+    call cll2xy(southpolemap,ylat,xlon,xpol,ypol)
+    gridsize=1000.*cgszll(southpolemap,ylat,xlon)
+    u=u/gridsize
+    v=v/gridsize
+    xpol=xpol+u*real(ldt*ldirect)
+    ypol=ypol+v*real(ldt*ldirect)
+    call cxy2ll(southpolemap,xpol,ypol,ylat,xlon)
+    xt=(xlon-xlon0)/dx
+    yt=(ylat-ylat0)/dy
+  endif
+
+  ! If global data are available, use cyclic boundary condition
+  !************************************************************
+
+  if (xglobal) then
+    if (xt.ge.real(nxmin1)) xt=xt-real(nxmin1)
+    if (xt.lt.0.) xt=xt+real(nxmin1)
+    if (xt.le.eps) xt=eps
+    if (abs(xt-real(nxmin1)).le.eps) xt=real(nxmin1)-eps
+  endif
+
+  ! Check position: If trajectory outside model domain, terminate it
+  !*****************************************************************
+
+  if ((xt.lt.0.).or.(xt.ge.real(nxmin1)).or.(yt.lt.0.).or. &
+       (yt.ge.real(nymin1))) then
+    nstop=3
+    return
+  endif
+
+  ! If particle above highest model level, set it back into the domain
+  !*******************************************************************
+
+  if (zt.ge.height(nz)) zt=height(nz)-100.*eps
+
+
+end subroutine advance
+
Index: /branches/FP_AI/src/assignland.f90
===================================================================
--- /branches/FP_AI/src/assignland.f90	(revision 23)
+++ /branches/FP_AI/src/assignland.f90	(revision 23)
@@ -0,0 +1,239 @@
+!**********************************************************************
+! 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
Index: /branches/FP_AI/src/boundcond_domainfill.f90
===================================================================
--- /branches/FP_AI/src/boundcond_domainfill.f90	(revision 23)
+++ /branches/FP_AI/src/boundcond_domainfill.f90	(revision 23)
@@ -0,0 +1,588 @@
+!**********************************************************************
+! 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 boundcond_domainfill(itime,loutend)
+  !                                  i      i
+  !*****************************************************************************
+  !                                                                            *
+  ! Particles are created by this subroutine continuously throughout the       *
+  ! simulation at the boundaries of the domain-filling box.                    *
+  ! All particles carry the same amount of mass which alltogether comprises the*
+  ! mass of air within the box, which remains (more or less) constant.         *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     16 October 2002                                                        *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  !                                                                            *
+  ! nx_we(2)       grid indices for western and eastern boundary of domain-    *
+  !                filling trajectory calculations                             *
+  ! ny_sn(2)       grid indices for southern and northern boundary of domain-  *
+  !                filling trajectory calculations                             *
+  !                                                                            *
+  !*****************************************************************************
+
+  use point_mod
+  use par_mod
+  use com_mod
+
+  implicit none
+
+  real :: dz,dz1,dz2,ran1,dt1,dt2,dtt,ylat,xm,cosfact,accmasst
+  integer :: itime,in,indz,indzp,i,loutend
+  integer :: j,k,ix,jy,m,indzh,indexh,minpart,ipart,mmass
+  integer :: numactiveparticles
+
+  real :: windl(2),rhol(2)
+  real :: windhl(2),rhohl(2)
+  real :: windx,rhox
+  real :: deltaz,boundarea,fluxofmass
+
+  integer :: ixm,ixp,jym,jyp,indzm,mm
+  real :: pvpart,ddx,ddy,rddx,rddy,p1,p2,p3,p4,y1(2),yh1(2)
+
+  integer :: idummy = -11
+
+
+  ! If domain-filling is global, no boundary conditions are needed
+  !***************************************************************
+
+  if (gdomainfill) return
+
+  accmasst=0.
+  numactiveparticles=0
+
+  ! Terminate trajectories that have left the domain, if domain-filling
+  ! trajectory calculation domain is not global
+  !********************************************************************
+
+  do i=1,numpart
+    if (itra1(i).eq.itime) then
+      if ((ytra1(i).gt.real(ny_sn(2))).or. &
+           (ytra1(i).lt.real(ny_sn(1)))) itra1(i)=-999999999
+      if (((.not.xglobal).or.(nx_we(2).ne.(nx-2))).and. &
+           ((xtra1(i).lt.real(nx_we(1))).or. &
+           (xtra1(i).gt.real(nx_we(2))))) itra1(i)=-999999999
+    endif
+    if (itra1(i).ne.-999999999) numactiveparticles= &
+         numactiveparticles+1
+  end do
+
+
+  ! Determine auxiliary variables for time interpolation
+  !*****************************************************
+
+  dt1=real(itime-memtime(1))
+  dt2=real(memtime(2)-itime)
+  dtt=1./(dt1+dt2)
+
+  ! Initialize auxiliary variable used to search for vacant storage space
+  !**********************************************************************
+
+  minpart=1
+
+  !***************************************
+  ! Western and eastern boundary condition
+  !***************************************
+
+  ! Loop from south to north
+  !*************************
+
+  do jy=ny_sn(1),ny_sn(2)
+
+  ! Loop over western (index 1) and eastern (index 2) boundary
+  !***********************************************************
+
+    do k=1,2
+
+  ! Loop over all release locations in a column
+  !********************************************
+
+      do j=1,numcolumn_we(k,jy)
+
+  ! Determine, for each release location, the area of the corresponding boundary
+  !*****************************************************************************
+
+        if (j.eq.1) then
+          deltaz=(zcolumn_we(k,jy,2)+zcolumn_we(k,jy,1))/2.
+        else if (j.eq.numcolumn_we(k,jy)) then
+  !        deltaz=height(nz)-(zcolumn_we(k,jy,j-1)+
+  !    +        zcolumn_we(k,jy,j))/2.
+  ! In order to avoid taking a very high column for very many particles,
+  ! use the deltaz from one particle below instead
+          deltaz=(zcolumn_we(k,jy,j)-zcolumn_we(k,jy,j-2))/2.
+        else
+          deltaz=(zcolumn_we(k,jy,j+1)-zcolumn_we(k,jy,j-1))/2.
+        endif
+        if ((jy.eq.ny_sn(1)).or.(jy.eq.ny_sn(2))) then
+          boundarea=deltaz*111198.5/2.*dy
+        else
+          boundarea=deltaz*111198.5*dy
+        endif
+
+
+  ! Interpolate the wind velocity and density to the release location
+  !******************************************************************
+
+  ! Determine the model level below the release position
+  !*****************************************************
+
+        do i=2,nz
+          if (height(i).gt.zcolumn_we(k,jy,j)) then
+            indz=i-1
+            indzp=i
+            goto 6
+          endif
+        end do
+6       continue
+
+  ! Vertical distance to the level below and above current position
+  !****************************************************************
+
+        dz1=zcolumn_we(k,jy,j)-height(indz)
+        dz2=height(indzp)-zcolumn_we(k,jy,j)
+        dz=1./(dz1+dz2)
+
+  ! Vertical and temporal interpolation
+  !************************************
+
+        do m=1,2
+          indexh=memind(m)
+          do in=1,2
+            indzh=indz+in-1
+            windl(in)=uu(nx_we(k),jy,indzh,indexh)
+            rhol(in)=rho(nx_we(k),jy,indzh,indexh)
+          end do
+
+          windhl(m)=(dz2*windl(1)+dz1*windl(2))*dz
+          rhohl(m)=(dz2*rhol(1)+dz1*rhol(2))*dz
+        end do
+
+        windx=(windhl(1)*dt2+windhl(2)*dt1)*dtt
+        rhox=(rhohl(1)*dt2+rhohl(2)*dt1)*dtt
+
+  ! Calculate mass flux
+  !********************
+
+        fluxofmass=windx*rhox*boundarea*real(lsynctime)
+
+
+  ! If the mass flux is directed into the domain, add it to previous mass fluxes;
+  ! if it is out of the domain, set accumulated mass flux to zero
+  !******************************************************************************
+
+        if (k.eq.1) then
+          if (fluxofmass.ge.0.) then
+            acc_mass_we(k,jy,j)=acc_mass_we(k,jy,j)+fluxofmass
+          else
+            acc_mass_we(k,jy,j)=0.
+          endif
+        else
+          if (fluxofmass.le.0.) then
+            acc_mass_we(k,jy,j)=acc_mass_we(k,jy,j)+abs(fluxofmass)
+          else
+            acc_mass_we(k,jy,j)=0.
+          endif
+        endif
+        accmasst=accmasst+acc_mass_we(k,jy,j)
+
+  ! If the accumulated mass exceeds half the mass that each particle shall carry,
+  ! one (or more) particle(s) is (are) released and the accumulated mass is
+  ! reduced by the mass of this (these) particle(s)
+  !******************************************************************************
+
+        if (acc_mass_we(k,jy,j).ge.xmassperparticle/2.) then
+          mmass=int((acc_mass_we(k,jy,j)+xmassperparticle/2.)/ &
+               xmassperparticle)
+          acc_mass_we(k,jy,j)=acc_mass_we(k,jy,j)- &
+               real(mmass)*xmassperparticle
+        else
+          mmass=0
+        endif
+
+        do m=1,mmass
+          do ipart=minpart,maxpart
+
+  ! If a vacant storage space is found, attribute everything to this array element
+  !*****************************************************************************
+
+            if (itra1(ipart).ne.itime) then
+
+  ! Assign particle positions
+  !**************************
+
+              xtra1(ipart)=real(nx_we(k))
+              if (jy.eq.ny_sn(1)) then
+                ytra1(ipart)=real(jy)+0.5*ran1(idummy)
+              else if (jy.eq.ny_sn(2)) then
+                ytra1(ipart)=real(jy)-0.5*ran1(idummy)
+              else
+                ytra1(ipart)=real(jy)+(ran1(idummy)-.5)
+              endif
+              if (j.eq.1) then
+                ztra1(ipart)=zcolumn_we(k,jy,1)+(zcolumn_we(k,jy,2)- &
+                     zcolumn_we(k,jy,1))/4.
+              else if (j.eq.numcolumn_we(k,jy)) then
+                ztra1(ipart)=(2.*zcolumn_we(k,jy,j)+ &
+                     zcolumn_we(k,jy,j-1)+height(nz))/4.
+              else
+                ztra1(ipart)=zcolumn_we(k,jy,j-1)+ran1(idummy)* &
+                     (zcolumn_we(k,jy,j+1)-zcolumn_we(k,jy,j-1))
+              endif
+
+  ! Interpolate PV to the particle position
+  !****************************************
+              ixm=int(xtra1(ipart))
+              jym=int(ytra1(ipart))
+              ixp=ixm+1
+              jyp=jym+1
+              ddx=xtra1(ipart)-real(ixm)
+              ddy=ytra1(ipart)-real(jym)
+              rddx=1.-ddx
+              rddy=1.-ddy
+              p1=rddx*rddy
+              p2=ddx*rddy
+              p3=rddx*ddy
+              p4=ddx*ddy
+              do i=2,nz
+                if (height(i).gt.ztra1(ipart)) then
+                  indzm=i-1
+                  indzp=i
+                  goto 26
+                endif
+              end do
+26            continue
+              dz1=ztra1(ipart)-height(indzm)
+              dz2=height(indzp)-ztra1(ipart)
+              dz=1./(dz1+dz2)
+              do mm=1,2
+                indexh=memind(mm)
+                do in=1,2
+                  indzh=indzm+in-1
+                  y1(in)=p1*pv(ixm,jym,indzh,indexh) &
+                       +p2*pv(ixp,jym,indzh,indexh) &
+                       +p3*pv(ixm,jyp,indzh,indexh) &
+                       +p4*pv(ixp,jyp,indzh,indexh)
+                end do
+                yh1(mm)=(dz2*y1(1)+dz1*y1(2))*dz
+              end do
+              pvpart=(yh1(1)*dt2+yh1(2)*dt1)*dtt
+              ylat=ylat0+ytra1(ipart)*dy
+              if (ylat.lt.0.) pvpart=-1.*pvpart
+
+
+  ! For domain-filling option 2 (stratospheric O3), do the rest only in the stratosphere
+  !*****************************************************************************
+
+              if (((ztra1(ipart).gt.3000.).and. &
+                   (pvpart.gt.pvcrit)).or.(mdomainfill.eq.1)) then
+                nclass(ipart)=min(int(ran1(idummy)* &
+                     real(nclassunc))+1,nclassunc)
+                numactiveparticles=numactiveparticles+1
+                numparticlecount=numparticlecount+1
+                npoint(ipart)=numparticlecount
+                idt(ipart)=mintime
+                itra1(ipart)=itime
+                itramem(ipart)=itra1(ipart)
+                itrasplit(ipart)=itra1(ipart)+ldirect*itsplit
+                xmass1(ipart,1)=xmassperparticle
+                if (mdomainfill.eq.2) xmass1(ipart,1)= &
+                     xmass1(ipart,1)*pvpart*48./29.*ozonescale/10.**9
+              else
+                goto 71
+              endif
+
+
+  ! Increase numpart, if necessary
+  !*******************************
+
+              numpart=max(numpart,ipart)
+              goto 73      ! Storage space has been found, stop searching
+            endif
+          end do
+          if (ipart.gt.maxpart) &
+               stop 'boundcond_domainfill.f: too many particles required'
+73        minpart=ipart+1
+71        continue
+        end do
+
+
+      end do
+    end do
+  end do
+
+
+  !*****************************************
+  ! Southern and northern boundary condition
+  !*****************************************
+
+  ! Loop from west to east
+  !***********************
+
+  do ix=nx_we(1),nx_we(2)
+
+  ! Loop over southern (index 1) and northern (index 2) boundary
+  !*************************************************************
+
+    do k=1,2
+      ylat=ylat0+real(ny_sn(k))*dy
+      cosfact=cos(ylat*pi180)
+
+  ! Loop over all release locations in a column
+  !********************************************
+
+      do j=1,numcolumn_sn(k,ix)
+
+  ! Determine, for each release location, the area of the corresponding boundary
+  !*****************************************************************************
+
+        if (j.eq.1) then
+          deltaz=(zcolumn_sn(k,ix,2)+zcolumn_sn(k,ix,1))/2.
+        else if (j.eq.numcolumn_sn(k,ix)) then
+  !        deltaz=height(nz)-(zcolumn_sn(k,ix,j-1)+
+  !    +        zcolumn_sn(k,ix,j))/2.
+  ! In order to avoid taking a very high column for very many particles,
+  ! use the deltaz from one particle below instead
+          deltaz=(zcolumn_sn(k,ix,j)-zcolumn_sn(k,ix,j-2))/2.
+        else
+          deltaz=(zcolumn_sn(k,ix,j+1)-zcolumn_sn(k,ix,j-1))/2.
+        endif
+        if ((ix.eq.nx_we(1)).or.(ix.eq.nx_we(2))) then
+          boundarea=deltaz*111198.5/2.*cosfact*dx
+        else
+          boundarea=deltaz*111198.5*cosfact*dx
+        endif
+
+
+  ! Interpolate the wind velocity and density to the release location
+  !******************************************************************
+
+  ! Determine the model level below the release position
+  !*****************************************************
+
+        do i=2,nz
+          if (height(i).gt.zcolumn_sn(k,ix,j)) then
+            indz=i-1
+            indzp=i
+            goto 16
+          endif
+        end do
+16      continue
+
+  ! Vertical distance to the level below and above current position
+  !****************************************************************
+
+        dz1=zcolumn_sn(k,ix,j)-height(indz)
+        dz2=height(indzp)-zcolumn_sn(k,ix,j)
+        dz=1./(dz1+dz2)
+
+  ! Vertical and temporal interpolation
+  !************************************
+
+        do m=1,2
+          indexh=memind(m)
+          do in=1,2
+            indzh=indz+in-1
+            windl(in)=vv(ix,ny_sn(k),indzh,indexh)
+            rhol(in)=rho(ix,ny_sn(k),indzh,indexh)
+          end do
+
+          windhl(m)=(dz2*windl(1)+dz1*windl(2))*dz
+          rhohl(m)=(dz2*rhol(1)+dz1*rhol(2))*dz
+        end do
+
+        windx=(windhl(1)*dt2+windhl(2)*dt1)*dtt
+        rhox=(rhohl(1)*dt2+rhohl(2)*dt1)*dtt
+
+  ! Calculate mass flux
+  !********************
+
+        fluxofmass=windx*rhox*boundarea*real(lsynctime)
+
+  ! If the mass flux is directed into the domain, add it to previous mass fluxes;
+  ! if it is out of the domain, set accumulated mass flux to zero
+  !******************************************************************************
+
+        if (k.eq.1) then
+          if (fluxofmass.ge.0.) then
+            acc_mass_sn(k,ix,j)=acc_mass_sn(k,ix,j)+fluxofmass
+          else
+            acc_mass_sn(k,ix,j)=0.
+          endif
+        else
+          if (fluxofmass.le.0.) then
+            acc_mass_sn(k,ix,j)=acc_mass_sn(k,ix,j)+abs(fluxofmass)
+          else
+            acc_mass_sn(k,ix,j)=0.
+          endif
+        endif
+        accmasst=accmasst+acc_mass_sn(k,ix,j)
+
+  ! If the accumulated mass exceeds half the mass that each particle shall carry,
+  ! one (or more) particle(s) is (are) released and the accumulated mass is
+  ! reduced by the mass of this (these) particle(s)
+  !******************************************************************************
+
+        if (acc_mass_sn(k,ix,j).ge.xmassperparticle/2.) then
+          mmass=int((acc_mass_sn(k,ix,j)+xmassperparticle/2.)/ &
+               xmassperparticle)
+          acc_mass_sn(k,ix,j)=acc_mass_sn(k,ix,j)- &
+               real(mmass)*xmassperparticle
+        else
+          mmass=0
+        endif
+
+        do m=1,mmass
+          do ipart=minpart,maxpart
+
+  ! If a vacant storage space is found, attribute everything to this array element
+  !*****************************************************************************
+
+            if (itra1(ipart).ne.itime) then
+
+  ! Assign particle positions
+  !**************************
+
+              ytra1(ipart)=real(ny_sn(k))
+              if (ix.eq.nx_we(1)) then
+                xtra1(ipart)=real(ix)+0.5*ran1(idummy)
+              else if (ix.eq.nx_we(2)) then
+                xtra1(ipart)=real(ix)-0.5*ran1(idummy)
+              else
+                xtra1(ipart)=real(ix)+(ran1(idummy)-.5)
+              endif
+              if (j.eq.1) then
+                ztra1(ipart)=zcolumn_sn(k,ix,1)+(zcolumn_sn(k,ix,2)- &
+                     zcolumn_sn(k,ix,1))/4.
+              else if (j.eq.numcolumn_sn(k,ix)) then
+                ztra1(ipart)=(2.*zcolumn_sn(k,ix,j)+ &
+                     zcolumn_sn(k,ix,j-1)+height(nz))/4.
+              else
+                ztra1(ipart)=zcolumn_sn(k,ix,j-1)+ran1(idummy)* &
+                     (zcolumn_sn(k,ix,j+1)-zcolumn_sn(k,ix,j-1))
+              endif
+
+
+  ! Interpolate PV to the particle position
+  !****************************************
+              ixm=int(xtra1(ipart))
+              jym=int(ytra1(ipart))
+              ixp=ixm+1
+              jyp=jym+1
+              ddx=xtra1(ipart)-real(ixm)
+              ddy=ytra1(ipart)-real(jym)
+              rddx=1.-ddx
+              rddy=1.-ddy
+              p1=rddx*rddy
+              p2=ddx*rddy
+              p3=rddx*ddy
+              p4=ddx*ddy
+              do i=2,nz
+                if (height(i).gt.ztra1(ipart)) then
+                  indzm=i-1
+                  indzp=i
+                  goto 126
+                endif
+              end do
+126           continue
+              dz1=ztra1(ipart)-height(indzm)
+              dz2=height(indzp)-ztra1(ipart)
+              dz=1./(dz1+dz2)
+              do mm=1,2
+                indexh=memind(mm)
+                do in=1,2
+                  indzh=indzm+in-1
+                  y1(in)=p1*pv(ixm,jym,indzh,indexh) &
+                       +p2*pv(ixp,jym,indzh,indexh) &
+                       +p3*pv(ixm,jyp,indzh,indexh) &
+                       +p4*pv(ixp,jyp,indzh,indexh)
+                end do
+                yh1(mm)=(dz2*y1(1)+dz1*y1(2))*dz
+              end do
+              pvpart=(yh1(1)*dt2+yh1(2)*dt1)*dtt
+              if (ylat.lt.0.) pvpart=-1.*pvpart
+
+
+  ! For domain-filling option 2 (stratospheric O3), do the rest only in the stratosphere
+  !*****************************************************************************
+
+              if (((ztra1(ipart).gt.3000.).and. &
+                   (pvpart.gt.pvcrit)).or.(mdomainfill.eq.1)) then
+                nclass(ipart)=min(int(ran1(idummy)* &
+                     real(nclassunc))+1,nclassunc)
+                numactiveparticles=numactiveparticles+1
+                numparticlecount=numparticlecount+1
+                npoint(ipart)=numparticlecount
+                idt(ipart)=mintime
+                itra1(ipart)=itime
+                itramem(ipart)=itra1(ipart)
+                itrasplit(ipart)=itra1(ipart)+ldirect*itsplit
+                xmass1(ipart,1)=xmassperparticle
+                if (mdomainfill.eq.2) xmass1(ipart,1)= &
+                     xmass1(ipart,1)*pvpart*48./29.*ozonescale/10.**9
+              else
+                goto 171
+              endif
+
+
+  ! Increase numpart, if necessary
+  !*******************************
+              numpart=max(numpart,ipart)
+              goto 173      ! Storage space has been found, stop searching
+            endif
+          end do
+          if (ipart.gt.maxpart) &
+               stop 'boundcond_domainfill.f: too many particles required'
+173       minpart=ipart+1
+171       continue
+        end do
+
+
+      end do
+    end do
+  end do
+
+
+  xm=0.
+  do i=1,numpart
+    if (itra1(i).eq.itime) xm=xm+xmass1(i,1)
+  end do
+
+  !write(*,*) itime,numactiveparticles,numparticlecount,numpart,
+  !    +xm,accmasst,xm+accmasst
+
+
+  ! If particles shall be dumped, then accumulated masses at the domain boundaries
+  ! must be dumped, too, to be used for later runs
+  !*****************************************************************************
+
+  if ((ipout.gt.0).and.(itime.eq.loutend)) then
+    open(unitboundcond,file=path(2)(1:length(2))//'boundcond.bin', &
+         form='unformatted')
+    write(unitboundcond) numcolumn_we,numcolumn_sn, &
+         zcolumn_we,zcolumn_sn,acc_mass_we,acc_mass_sn
+    close(unitboundcond)
+  endif
+
+end subroutine boundcond_domainfill
Index: /branches/FP_AI/src/calcfluxes.f90
===================================================================
--- /branches/FP_AI/src/calcfluxes.f90	(revision 23)
+++ /branches/FP_AI/src/calcfluxes.f90	(revision 23)
@@ -0,0 +1,187 @@
+!**********************************************************************
+! 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 (xold.gt.xtra1(jpart)) then       ! west-east flux
+          do k=1,nspec
+            flux(1,ixs,jyave,kzave,k,kp,nage)= &
+                 flux(1,ixs,jyave,kzave,k,kp,nage) &
+                 +xmass1(jpart,k)
+          end do
+        else                                 ! east-west flux
+          do k=1,nspec
+            flux(2,ixs,jyave,kzave,k,kp,nage)= &
+                 flux(2,ixs,jyave,kzave,k,kp,nage) &
+                 +xmass1(jpart,k)
+          end do
+        endif
+      endif
+    endif
+  endif
+
+
+  ! Determine south-north fluxes (fluxs) and north-south fluxes (fluxn)
+  !********************************************************************
+
+  if ((kzave.le.numzgrid).and.(ixave.ge.0).and. &
+       (ixave.le.numxgrid-1)) then
+    jy1=int((yold*dy+youtshift)/dyout+0.5)
+    jy2=int((ytra1(jpart)*dy+youtshift)/dyout+0.5)
+
+    do k=1,nspec
+      do jy=jy1,jy2-1
+        if ((jy.ge.0).and.(jy.le.numygrid-1)) then
+          flux(3,ixave,jy,kzave,k,kp,nage)= &
+               flux(3,ixave,jy,kzave,k,kp,nage) &
+               +xmass1(jpart,k)
+        endif
+      end do
+      do jy=jy2,jy1-1
+        if ((jy.ge.0).and.(jy.le.numygrid-1)) then
+          flux(4,ixave,jy,kzave,k,kp,nage)= &
+               flux(4,ixave,jy,kzave,k,kp,nage) &
+               +xmass1(jpart,k)
+        endif
+      end do
+    end do
+  endif
+
+end subroutine calcfluxes
+
Index: /branches/FP_AI/src/calcmatrix.f90
===================================================================
--- /branches/FP_AI/src/calcmatrix.f90	(revision 23)
+++ /branches/FP_AI/src/calcmatrix.f90	(revision 23)
@@ -0,0 +1,142 @@
+!**********************************************************************
+! 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 calcmatrix(lconv,delt,cbmf)
+  !                        o    i    o
+  !*****************************************************************************
+  !                                                                            *
+  !  This subroutine calculates the matrix describing convective               *
+  !  redistribution of mass in a grid column, using the subroutine             *
+  !  convect43c.f provided by Kerry Emanuel.                                   *
+  !                                                                            *
+  !  Petra Seibert, Bernd C. Krueger, 2000-2001                                *
+  !                                                                            *
+  !  changed by C. Forster, November 2003 - February 2004                      *
+  !  array fmassfrac(nconvlevmax,nconvlevmax) represents                       *
+  !  the convective redistribution matrix for the particles                    *
+  !                                                                            *
+  !  lconv        indicates whether there is convection in this cell, or not   *
+  !  delt         time step for convection [s]                                 *
+  !  cbmf         cloud base mass flux                                         *
+  !                                                                            *
+  !*****************************************************************************
+
+  use par_mod
+  use com_mod
+  use conv_mod
+
+  implicit none
+
+  real :: rlevmass,summe
+
+  integer :: iflag, k, kk, kuvz
+
+  !1-d variables for convection
+  !variables for redistribution matrix
+  real :: cbmfold, precip, qprime
+  real :: tprime, wd, f_qvsat
+  real :: delt,cbmf
+  logical :: lconv
+
+  lconv = .false.
+
+
+  ! calculate pressure at eta levels for use in convect
+  ! and assign temp & spec. hum. to 1D workspace
+  ! -------------------------------------------------------
+
+  ! pconv(1) is the pressure at the first level above ground
+  ! phconv(k) is the pressure between levels k-1 and k
+  ! dpr(k) is the pressure difference "around" tconv(k)
+  ! phconv(kmax) must also be defined 1/2 level above pconv(kmax)
+  ! Therefore, we define k = kuvz-1 and let kuvz start from 2
+  ! top layer cannot be used for convection because p at top of this layer is
+  ! not given
+
+
+  phconv(1) = psconv
+  ! Emanuel subroutine needs pressure in hPa, therefore convert all pressures
+  do kuvz = 2,nuvz
+    k = kuvz-1
+    pconv(k) = (akz(kuvz) + bkz(kuvz)*psconv)
+    phconv(kuvz) = (akm(kuvz) + bkm(kuvz)*psconv)
+    dpr(k) = phconv(k) - phconv(kuvz)
+    qsconv(k) = f_qvsat( pconv(k), tconv(k) )
+
+  ! initialize mass fractions
+    do kk=1,nconvlev
+      fmassfrac(k,kk)=0.
+    enddo
+  enddo
+
+
+  !note that Emanuel says it is important
+  !a. to set this =0. every grid point
+  !b. to keep this value in the calling programme in the iteration
+
+  ! CALL CONVECTION
+  !******************
+
+    cbmfold = cbmf
+  ! Convert pressures to hPa, as required by Emanuel scheme
+  !********************************************************
+!!$    do k=1,nconvlev     !old
+    do k=1,nconvlev+1      !bugfix
+      pconv_hpa(k)=pconv(k)/100.
+      phconv_hpa(k)=phconv(k)/100.
+    end do
+    phconv_hpa(nconvlev+1)=phconv(nconvlev+1)/100.
+    call convect(nconvlevmax, nconvlev, delt, iflag, &
+         precip, wd, tprime, qprime, cbmf)
+
+  ! do not update fmassfrac and cloudbase massflux
+  ! if no convection takes place or
+  ! if a CFL criterion is violated in convect43c.f
+   if (iflag .ne. 1 .and. iflag .ne. 4) then
+     cbmf=cbmfold
+     goto 200
+   endif
+
+  ! do not update fmassfrac and cloudbase massflux
+  ! if the old and the new cloud base mass
+  ! fluxes are zero
+   if (cbmf.le.0..and.cbmfold.le.0.) then
+     cbmf=cbmfold
+     goto 200
+   endif
+
+  ! Update fmassfrac
+  ! account for mass displaced from level k to level k
+
+   lconv = .true.
+    do k=1,nconvtop
+      rlevmass = dpr(k)/ga
+      summe = 0.
+      do kk=1,nconvtop
+        fmassfrac(k,kk) = delt*fmass(k,kk)
+        summe = summe + fmassfrac(k,kk)
+      end do
+      fmassfrac(k,k)=fmassfrac(k,k) + rlevmass - summe
+    end do
+
+200   continue
+
+end subroutine calcmatrix
Index: /branches/FP_AI/src/calcmatrix_gfs.f90
===================================================================
--- /branches/FP_AI/src/calcmatrix_gfs.f90	(revision 23)
+++ /branches/FP_AI/src/calcmatrix_gfs.f90	(revision 23)
@@ -0,0 +1,139 @@
+!**********************************************************************
+! 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 calcmatrix(lconv,delt,cbmf)
+  !                        o    i    o
+  !*****************************************************************************
+  !                                                                            *
+  !  This subroutine calculates the matrix describing convective               *
+  !  redistribution of mass in a grid column, using the subroutine             *
+  !  convect43c.f provided by Kerry Emanuel.                                   *
+  !                                                                            *
+  !  Petra Seibert, Bernd C. Krueger, 2000-2001                                *
+  !                                                                            *
+  !  changed by C. Forster, November 2003 - February 2004                      *
+  !  array fmassfrac(nconvlevmax,nconvlevmax) represents                       *
+  !  the convective redistribution matrix for the particles                    *
+  !                                                                            *
+  !  Changes by C. Forster, November 2005, NCEP GFS version                    *
+  !                                                                            *
+  !  lconv        indicates whether there is convection in this cell, or not   *
+  !  delt         time step for convection [s]                                 *
+  !  cbmf         cloud base mass flux                                         *
+  !                                                                            *
+  !*****************************************************************************
+
+  use par_mod
+  use com_mod
+  use conv_mod
+
+  implicit none
+
+  real :: rlevmass,summe
+
+  integer :: iflag, k, kk, kuvz
+
+  !1-d variables for convection
+  !variables for redistribution matrix
+  real :: cbmfold, precip, qprime
+  real :: tprime, wd, f_qvsat
+  real :: delt,cbmf
+  logical :: lconv
+
+  lconv = .false.
+
+
+  ! calculate pressure at eta levels for use in convect
+  ! and assign temp & spec. hum. to 1D workspace
+  ! -------------------------------------------------------
+
+  ! pconv(1) is the pressure at the first level above ground
+  ! phconv(k) is the pressure between levels k-1 and k
+  ! dpr(k) is the pressure difference "around" tconv(k)
+  ! phconv(kmax) must also be defined 1/2 level above pconv(kmax)
+  ! Therefore, we define k = kuvz-1 and let kuvz start from 2
+  ! top layer cannot be used for convection because p at top of this layer is
+  ! not given
+
+  phconv(1) = psconv
+  do kuvz = 2,nuvz
+    k = kuvz-1
+    phconv(kuvz) =  0.5*(pconv(kuvz)+pconv(k))
+    dpr(k) = phconv(k) - phconv(kuvz)
+    qsconv(k) = f_qvsat( pconv(k), tconv(k) )
+  ! initialize mass fractions
+    do kk=1,nconvlev
+      fmassfrac(k,kk)=0.
+    enddo
+  end do
+
+  !note that Emanuel says it is important
+  !a. to set this =0. every grid point
+  !b. to keep this value in the calling programme in the iteration
+
+  ! CALL CONVECTION
+  !******************
+
+    cbmfold = cbmf
+  ! Convert pressures to hPa, as required by Emanuel scheme
+  !********************************************************
+!!$    do k=1,nconvlev     !old
+    do k=1,nconvlev+1      !bugfix
+      pconv_hpa(k)=pconv(k)/100.
+      phconv_hpa(k)=phconv(k)/100.
+    end do
+    phconv_hpa(nconvlev+1)=phconv(nconvlev+1)/100.
+    call convect(nconvlevmax, nconvlev, delt, iflag, &
+         precip, wd, tprime, qprime, cbmf)
+
+  ! do not update fmassfrac and cloudbase massflux
+  ! if no convection takes place or
+  ! if a CFL criterion is violated in convect43c.f
+   if (iflag .ne. 1 .and. iflag .ne. 4) then
+     cbmf=cbmfold
+     goto 200
+   endif
+
+  ! do not update fmassfrac and cloudbase massflux
+  ! if the old and the new cloud base mass
+  ! fluxes are zero
+   if (cbmf.le.0..and.cbmfold.le.0.) then
+     cbmf=cbmfold
+     goto 200
+   endif
+
+  ! Update fmassfrac
+  ! account for mass displaced from level k to level k
+
+   lconv = .true.
+    do k=1,nconvtop
+      rlevmass = dpr(k)/ga
+      summe = 0.
+      do kk=1,nconvtop
+        fmassfrac(k,kk) = delt*fmass(k,kk)
+        summe = summe + fmassfrac(k,kk)
+      end do
+      fmassfrac(k,k)=fmassfrac(k,k) + rlevmass - summe
+    end do
+
+200   continue
+
+end subroutine calcmatrix
Index: /branches/FP_AI/src/calcpar.f90
===================================================================
--- /branches/FP_AI/src/calcpar.f90	(revision 23)
+++ /branches/FP_AI/src/calcpar.f90	(revision 23)
@@ -0,0 +1,238 @@
+!**********************************************************************
+! 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 calcpar(n,uuh,vvh,pvh)
+  !                   i  i   i   o
+  !*****************************************************************************
+  !                                                                            *
+  !     Computation of several boundary layer parameters needed for the        *
+  !     dispersion calculation and calculation of dry deposition velocities.   *
+  !     All parameters are calculated over the entire grid.                    *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     21 May 1995                                                            *
+  !                                                                            *
+  ! ------------------------------------------------------------------         *
+  !     Petra Seibert, Feb 2000:                                               *
+  !     convection scheme:                                                     *
+  !     new variables in call to richardson                                    *
+  !                                                                            *
+  !*****************************************************************************
+  !  Changes, Bernd C. Krueger, Feb. 2001:
+  !   Variables tth and qvh (on eta coordinates) in common block
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! n                  temporal index for meteorological fields (1 to 3)       *
+  !                                                                            *
+  ! Constants:                                                                 *
+  !                                                                            *
+  !                                                                            *
+  ! Functions:                                                                 *
+  ! scalev             computation of ustar                                    *
+  ! obukhov            computatio of Obukhov length                            *
+  !                                                                            *
+  !*****************************************************************************
+
+  use par_mod
+  use com_mod
+
+  implicit none
+
+  integer :: n,ix,jy,i,kz,lz,kzmin
+  real :: ttlev(nuvzmax),qvlev(nuvzmax),obukhov,scalev,ol,hmixplus
+  real :: ulev(nuvzmax),vlev(nuvzmax),ew,rh,vd(maxspec),subsceff,ylat
+  real :: altmin,tvold,pold,zold,pint,tv,zlev(nuvzmax)
+  real :: uuh(0:nxmax-1,0:nymax-1,nuvzmax)
+  real :: vvh(0:nxmax-1,0:nymax-1,nuvzmax)
+  real :: pvh(0:nxmax-1,0:nymax-1,nuvzmax)
+  real,parameter :: const=r_air/ga
+
+  !write(*,*) 'in calcpar writting snowheight'
+  !***********************************
+  ! for test: write out snow depths
+
+  ! open(4,file='slandusetest',form='formatted')
+  ! do 5 ix=0,nxmin1
+  !5       write (4,*) (sd(ix,jy,1,n),jy=0,nymin1)
+  !  close(4)
+
+
+  ! Loop over entire grid
+  !**********************
+
+  do jy=0,nymin1
+
+  ! Set minimum height for tropopause
+  !**********************************
+
+    ylat=ylat0+real(jy)*dy
+    if ((ylat.ge.-20.).and.(ylat.le.20.)) then
+      altmin = 5000.
+    else
+      if ((ylat.gt.20.).and.(ylat.lt.40.)) then
+        altmin=2500.+(40.-ylat)*125.
+      else if ((ylat.gt.-40.).and.(ylat.lt.-20.)) then
+        altmin=2500.+(40.+ylat)*125.
+      else
+        altmin=2500.
+      endif
+    endif
+
+    do ix=0,nxmin1
+
+  ! 1) Calculation of friction velocity
+  !************************************
+
+      ustar(ix,jy,1,n)=scalev(ps(ix,jy,1,n),tt2(ix,jy,1,n), &
+           td2(ix,jy,1,n),surfstr(ix,jy,1,n))
+      if (ustar(ix,jy,1,n).le.1.e-8) ustar(ix,jy,1,n)=1.e-8
+
+  ! 2) Calculation of inverse Obukhov length scale
+  !***********************************************
+
+      ol=obukhov(ps(ix,jy,1,n),tt2(ix,jy,1,n),td2(ix,jy,1,n), &
+           tth(ix,jy,2,n),ustar(ix,jy,1,n),sshf(ix,jy,1,n),akm,bkm)
+      if (ol.ne.0.) then
+        oli(ix,jy,1,n)=1./ol
+      else
+        oli(ix,jy,1,n)=99999.
+      endif
+
+
+  ! 3) Calculation of convective velocity scale and mixing height
+  !**************************************************************
+
+      do i=1,nuvz
+        ulev(i)=uuh(ix,jy,i)
+        vlev(i)=vvh(ix,jy,i)
+        ttlev(i)=tth(ix,jy,i,n)
+        qvlev(i)=qvh(ix,jy,i,n)
+      end do
+
+      call richardson(ps(ix,jy,1,n),ustar(ix,jy,1,n),ttlev,qvlev, &
+           ulev,vlev,nuvz,akz,bkz,sshf(ix,jy,1,n),tt2(ix,jy,1,n), &
+           td2(ix,jy,1,n),hmix(ix,jy,1,n),wstar(ix,jy,1,n),hmixplus)
+
+      if(lsubgrid.eq.1) then
+        subsceff=min(excessoro(ix,jy),hmixplus)
+      else
+        subsceff=0.0
+      endif
+  !
+  ! CALCULATE HMIX EXCESS ACCORDING TO SUBGRIDSCALE VARIABILITY AND STABILITY
+  !
+      hmix(ix,jy,1,n)=hmix(ix,jy,1,n)+subsceff
+      hmix(ix,jy,1,n)=max(hmixmin,hmix(ix,jy,1,n)) ! set minimum PBL height
+      hmix(ix,jy,1,n)=min(hmixmax,hmix(ix,jy,1,n)) ! set maximum PBL height
+
+  ! 4) Calculation of dry deposition velocities
+  !********************************************
+
+      if (DRYDEP) then
+  ! Sabine Eckhardt, Dec 06: use new index for z0 for water depending on
+  ! windspeed
+        z0(7)=0.016*ustar(ix,jy,1,n)*ustar(ix,jy,1,n)/ga
+
+  ! Calculate relative humidity at surface
+  !***************************************
+        rh=ew(td2(ix,jy,1,n))/ew(tt2(ix,jy,1,n))
+
+        call getvdep(n,ix,jy,ustar(ix,jy,1,n), &
+             tt2(ix,jy,1,n),ps(ix,jy,1,n),1./oli(ix,jy,1,n), &
+             ssr(ix,jy,1,n),rh,lsprec(ix,jy,1,n)+convprec(ix,jy,1,n), &
+             sd(ix,jy,1,n),vd)
+
+        do i=1,nspec
+          vdep(ix,jy,i,n)=vd(i)
+        end do
+
+      endif
+
+  !******************************************************
+  ! Calculate height of thermal tropopause (Hoinka, 1997)
+  !******************************************************
+
+  ! 1) Calculate altitudes of ECMWF model levels
+  !*********************************************
+
+      tvold=tt2(ix,jy,1,n)*(1.+0.378*ew(td2(ix,jy,1,n))/ &
+           ps(ix,jy,1,n))
+      pold=ps(ix,jy,1,n)
+      zold=0.
+      do kz=2,nuvz
+        pint=akz(kz)+bkz(kz)*ps(ix,jy,1,n)  ! pressure on model layers
+        tv=tth(ix,jy,kz,n)*(1.+0.608*qvh(ix,jy,kz,n))
+
+        if (abs(tv-tvold).gt.0.2) then
+         zlev(kz)=zold+const*log(pold/pint)*(tv-tvold)/log(tv/tvold)
+        else
+          zlev(kz)=zold+const*log(pold/pint)*tv
+        endif
+        tvold=tv
+        pold=pint
+        zold=zlev(kz)
+      end do
+
+  ! 2) Define a minimum level kzmin, from which upward the tropopause is
+  !    searched for. This is to avoid inversions in the lower troposphere
+  !    to be identified as the tropopause
+  !************************************************************************
+
+      do kz=1,nuvz
+        if (zlev(kz).ge.altmin) then
+          kzmin=kz
+          goto 45
+        endif
+      end do
+45    continue
+
+  ! 3) Search for first stable layer above minimum height that fulfills the
+  !    thermal tropopause criterion
+  !************************************************************************
+
+      do kz=kzmin,nuvz
+        do lz=kz+1,nuvz
+          if ((zlev(lz)-zlev(kz)).gt.2000.) then
+            if (((tth(ix,jy,kz,n)-tth(ix,jy,lz,n))/ &
+                 (zlev(lz)-zlev(kz))).lt.0.002) then
+              tropopause(ix,jy,1,n)=zlev(kz)
+              goto 51
+            endif
+            goto 50
+          endif
+        end do
+50      continue
+      end do
+51    continue
+
+
+    end do
+  end do
+
+  ! Calculation of potential vorticity on 3-d grid
+  !***********************************************
+
+  call calcpv(n,uuh,vvh,pvh)
+
+
+end subroutine calcpar
Index: /branches/FP_AI/src/calcpar_gfs.f90
===================================================================
--- /branches/FP_AI/src/calcpar_gfs.f90	(revision 23)
+++ /branches/FP_AI/src/calcpar_gfs.f90	(revision 23)
@@ -0,0 +1,243 @@
+!**********************************************************************
+! 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 calcpar(n,uuh,vvh,pvh)
+  !                   i  i   i   o
+  !*****************************************************************************
+  !                                                                            *
+  !     Computation of several boundary layer parameters needed for the        *
+  !     dispersion calculation and calculation of dry deposition velocities.   *
+  !     All parameters are calculated over the entire grid.                    *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     21 May 1995                                                            *
+  !                                                                            *
+  ! ------------------------------------------------------------------         *
+  !     Petra Seibert, Feb 2000:                                               *
+  !     convection scheme:                                                     *
+  !     new variables in call to richardson                                    *
+  !                                                                            *
+  !*****************************************************************************
+  !  Changes, Bernd C. Krueger, Feb. 2001:
+  !   Variables tth and qvh (on eta coordinates) in common block
+  !*****************************************************************************
+  !                                                                            *
+  !  CHANGE 17/11/2005 Caroline Forster NCEP GFS version                       *
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! n                  temporal index for meteorological fields (1 to 3)       *
+  !                                                                            *
+  ! Constants:                                                                 *
+  !                                                                            *
+  !                                                                            *
+  ! Functions:                                                                 *
+  ! scalev             computation of ustar                                    *
+  ! obukhov            computatio of Obukhov length                            *
+  !                                                                            *
+  !*****************************************************************************
+
+  use par_mod
+  use com_mod
+
+  implicit none
+
+  integer :: n,ix,jy,i,kz,lz,kzmin,llev
+  real :: ttlev(nuvzmax),qvlev(nuvzmax),obukhov,scalev,ol,hmixplus
+  real :: ulev(nuvzmax),vlev(nuvzmax),ew,rh,vd(maxspec),subsceff,ylat
+  real :: altmin,tvold,pold,zold,pint,tv,zlev(nuvzmax),hmixdummy
+  real :: uuh(0:nxmax-1,0:nymax-1,nuvzmax)
+  real :: vvh(0:nxmax-1,0:nymax-1,nuvzmax)
+  real :: pvh(0:nxmax-1,0:nymax-1,nuvzmax)
+  real,parameter :: const=r_air/ga
+
+
+  ! Loop over entire grid
+  !**********************
+
+  do jy=0,nymin1
+
+  ! Set minimum height for tropopause
+  !**********************************
+
+    ylat=ylat0+real(jy)*dy
+    if ((ylat.ge.-20.).and.(ylat.le.20.)) then
+      altmin = 5000.
+    else
+      if ((ylat.gt.20.).and.(ylat.lt.40.)) then
+        altmin=2500.+(40.-ylat)*125.
+      else if ((ylat.gt.-40.).and.(ylat.lt.-20.)) then
+        altmin=2500.+(40.+ylat)*125.
+      else
+        altmin=2500.
+      endif
+    endif
+
+    do ix=0,nxmin1
+
+  ! 1) Calculation of friction velocity
+  !************************************
+
+      ustar(ix,jy,1,n)=scalev(ps(ix,jy,1,n),tt2(ix,jy,1,n), &
+           td2(ix,jy,1,n),surfstr(ix,jy,1,n))
+      if (ustar(ix,jy,1,n).le.1.e-8) ustar(ix,jy,1,n)=1.e-8
+
+  ! 2) Calculation of inverse Obukhov length scale
+  !***********************************************
+
+  ! NCEP version: find first level above ground
+      llev = 0
+      do i=1,nuvz
+       if (ps(ix,jy,1,n).lt.akz(i)) llev=i
+      end do
+       llev = llev+1
+       if (llev.gt.nuvz) llev = nuvz-1
+  ! NCEP version
+
+  ! calculate inverse Obukhov length scale with tth(llev)
+      ol=obukhov(ps(ix,jy,1,n),tt2(ix,jy,1,n),td2(ix,jy,1,n), &
+           tth(ix,jy,llev,n),ustar(ix,jy,1,n),sshf(ix,jy,1,n),akz(llev))
+      if (ol.ne.0.) then
+        oli(ix,jy,1,n)=1./ol
+      else
+        oli(ix,jy,1,n)=99999.
+      endif
+
+
+  ! 3) Calculation of convective velocity scale and mixing height
+  !**************************************************************
+
+      do i=1,nuvz
+        ulev(i)=uuh(ix,jy,i)
+        vlev(i)=vvh(ix,jy,i)
+        ttlev(i)=tth(ix,jy,i,n)
+        qvlev(i)=qvh(ix,jy,i,n)
+      end do
+
+  ! NCEP version hmix has been read in in readwind.f, is therefore not calculated here
+      call richardson(ps(ix,jy,1,n),ustar(ix,jy,1,n),ttlev,qvlev, &
+           ulev,vlev,nuvz,akz,bkz,sshf(ix,jy,1,n),tt2(ix,jy,1,n), &
+           td2(ix,jy,1,n),hmixdummy,wstar(ix,jy,1,n),hmixplus)
+
+      if(lsubgrid.eq.1) then
+        subsceff=min(excessoro(ix,jy),hmixplus)
+      else
+        subsceff=0
+      endif
+  !
+  ! CALCULATE HMIX EXCESS ACCORDING TO SUBGRIDSCALE VARIABILITY AND STABILITY
+  !
+      hmix(ix,jy,1,n)=hmix(ix,jy,1,n)+subsceff
+      hmix(ix,jy,1,n)=max(hmixmin,hmix(ix,jy,1,n)) ! set minimum PBL height
+      hmix(ix,jy,1,n)=min(hmixmax,hmix(ix,jy,1,n)) ! set maximum PBL height
+
+  ! 4) Calculation of dry deposition velocities
+  !********************************************
+
+      if (DRYDEP) then
+  ! Sabine Eckhardt, Dec 06: use new index for z0 for water depending on
+  ! windspeed
+        z0(7)=0.016*ustar(ix,jy,1,n)*ustar(ix,jy,1,n)/ga
+
+  ! Calculate relative humidity at surface
+  !***************************************
+        rh=ew(td2(ix,jy,1,n))/ew(tt2(ix,jy,1,n))
+
+        call getvdep(n,ix,jy,ustar(ix,jy,1,n), &
+             tt2(ix,jy,1,n),ps(ix,jy,1,n),1./oli(ix,jy,1,n), &
+             ssr(ix,jy,1,n),rh,lsprec(ix,jy,1,n)+convprec(ix,jy,1,n), &
+             sd(ix,jy,1,n),vd)
+
+        do i=1,nspec
+          vdep(ix,jy,i,n)=vd(i)
+        end do
+
+      endif
+
+  !******************************************************
+  ! Calculate height of thermal tropopause (Hoinka, 1997)
+  !******************************************************
+
+  ! 1) Calculate altitudes of NCEP model levels
+  !*********************************************
+
+      tvold=tt2(ix,jy,1,n)*(1.+0.378*ew(td2(ix,jy,1,n))/ &
+           ps(ix,jy,1,n))
+      pold=ps(ix,jy,1,n)
+      zold=0.
+      do kz=llev,nuvz
+        pint=akz(kz)+bkz(kz)*ps(ix,jy,1,n)  ! pressure on model layers
+        tv=tth(ix,jy,kz,n)*(1.+0.608*qvh(ix,jy,kz,n))
+
+        if (abs(tv-tvold).gt.0.2) then
+         zlev(kz)=zold+const*log(pold/pint)*(tv-tvold)/log(tv/tvold)
+        else
+          zlev(kz)=zold+const*log(pold/pint)*tv
+        endif
+        tvold=tv
+        pold=pint
+        zold=zlev(kz)
+      end do
+
+  ! 2) Define a minimum level kzmin, from which upward the tropopause is
+  !    searched for. This is to avoid inversions in the lower troposphere
+  !    to be identified as the tropopause
+  !************************************************************************
+
+      do kz=llev,nuvz
+        if (zlev(kz).ge.altmin) then
+          kzmin=kz
+          goto 45
+        endif
+      end do
+45    continue
+
+  ! 3) Search for first stable layer above minimum height that fulfills the
+  !    thermal tropopause criterion
+  !************************************************************************
+
+      do kz=kzmin,nuvz
+        do lz=kz+1,nuvz
+          if ((zlev(lz)-zlev(kz)).gt.2000.) then
+            if (((tth(ix,jy,kz,n)-tth(ix,jy,lz,n))/ &
+                 (zlev(lz)-zlev(kz))).lt.0.002) then
+              tropopause(ix,jy,1,n)=zlev(kz)
+              goto 51
+            endif
+            goto 50
+          endif
+        end do
+50      continue
+      end do
+51    continue
+
+
+    end do
+  end do
+
+
+  ! Calculation of potential vorticity on 3-d grid
+  !***********************************************
+
+  call calcpv(n,uuh,vvh,pvh)
+
+
+end subroutine calcpar
Index: /branches/FP_AI/src/calcpar_nests.f90
===================================================================
--- /branches/FP_AI/src/calcpar_nests.f90	(revision 23)
+++ /branches/FP_AI/src/calcpar_nests.f90	(revision 23)
@@ -0,0 +1,236 @@
+!**********************************************************************
+! 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 calcpar_nests(n,uuhn,vvhn,pvhn)
+  !                         i  i    i    o
+  !*****************************************************************************
+  !                                                                            *
+  !     Computation of several boundary layer parameters needed for the        *
+  !     dispersion calculation and calculation of dry deposition velocities.   *
+  !     All parameters are calculated over the entire grid.                    *
+  !     This routine is similar to calcpar, but is used for the nested grids.  *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     8 February 1999                                                        *
+  !                                                                            *
+  ! ------------------------------------------------------------------         *
+  !     Petra Seibert, Feb 2000:                                               *
+  !     convection scheme:                                                     *
+  !     new variables in call to richardson                                    *
+  !                                                                            *
+  !*****************************************************************************
+  !  Changes, Bernd C. Krueger, Feb. 2001:
+  !   Variables tth and qvh (on eta coordinates) in common block
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! n                  temporal index for meteorological fields (1 to 3)       *
+  !                                                                            *
+  ! Constants:                                                                 *
+  !                                                                            *
+  !                                                                            *
+  ! Functions:                                                                 *
+  ! scalev             computation of ustar                                    *
+  ! obukhov            computatio of Obukhov length                            *
+  !                                                                            *
+  !*****************************************************************************
+
+  use par_mod
+  use com_mod
+
+  implicit none
+
+  integer :: n,ix,jy,i,l,kz,lz,kzmin
+  real :: ttlev(nuvzmax),qvlev(nuvzmax),obukhov,scalev,ol,hmixplus
+  real :: ulev(nuvzmax),vlev(nuvzmax),ew,rh,vd(maxspec),subsceff,ylat
+  real :: altmin,tvold,pold,zold,pint,tv,zlev(nuvzmax)
+  real :: uuhn(0:nxmaxn-1,0:nymaxn-1,nuvzmax,maxnests)
+  real :: vvhn(0:nxmaxn-1,0:nymaxn-1,nuvzmax,maxnests)
+  real :: pvhn(0:nxmaxn-1,0:nymaxn-1,nuvzmax,maxnests)
+  real,parameter :: const=r_air/ga
+
+
+  ! Loop over all nests
+  !********************
+
+  do l=1,numbnests
+
+  ! Loop over entire grid
+  !**********************
+
+  do jy=0,nyn(l)-1
+
+  ! Set minimum height for tropopause
+  !**********************************
+
+    ylat=ylat0n(l)+real(jy)*dyn(l)
+    if ((ylat.ge.-20.).and.(ylat.le.20.)) then
+      altmin = 5000.
+    else
+      if ((ylat.gt.20.).and.(ylat.lt.40.)) then
+        altmin=2500.+(40.-ylat)*125.
+      else if ((ylat.gt.-40.).and.(ylat.lt.-20.)) then
+        altmin=2500.+(40.+ylat)*125.
+      else
+        altmin=2500.
+      endif
+    endif
+
+    do ix=0,nxn(l)-1
+
+  ! 1) Calculation of friction velocity
+  !************************************
+
+      ustarn(ix,jy,1,n,l)=scalev(psn(ix,jy,1,n,l),tt2n(ix,jy,1,n,l), &
+           td2n(ix,jy,1,n,l),surfstrn(ix,jy,1,n,l))
+
+  ! 2) Calculation of inverse Obukhov length scale
+  !***********************************************
+
+      ol=obukhov(psn(ix,jy,1,n,l),tt2n(ix,jy,1,n,l), &
+           td2n(ix,jy,1,n,l),tthn(ix,jy,2,n,l),ustarn(ix,jy,1,n,l), &
+           sshfn(ix,jy,1,n,l),akm,bkm)
+      if (ol.ne.0.) then
+        olin(ix,jy,1,n,l)=1./ol
+      else
+        olin(ix,jy,1,n,l)=99999.
+      endif
+
+
+  ! 3) Calculation of convective velocity scale and mixing height
+  !**************************************************************
+
+      do i=1,nuvz
+        ulev(i)=uuhn(ix,jy,i,l)
+        vlev(i)=vvhn(ix,jy,i,l)
+        ttlev(i)=tthn(ix,jy,i,n,l)
+        qvlev(i)=qvhn(ix,jy,i,n,l)
+      end do
+
+      call richardson(psn(ix,jy,1,n,l),ustarn(ix,jy,1,n,l),ttlev, &
+           qvlev,ulev,vlev,nuvz,akz,bkz,sshfn(ix,jy,1,n,l), &
+           tt2n(ix,jy,1,n,l),td2n(ix,jy,1,n,l),hmixn(ix,jy,1,n,l), &
+           wstarn(ix,jy,1,n,l),hmixplus)
+
+      if(lsubgrid.eq.1) then
+        subsceff=min(excessoron(ix,jy,l),hmixplus)
+      else
+        subsceff=0
+      endif
+  !
+  ! CALCULATE HMIX EXCESS ACCORDING TO SUBGRIDSCALE VARIABILITY AND STABILITY
+  !
+      hmixn(ix,jy,1,n,l)=hmixn(ix,jy,1,n,l)+subsceff
+      hmixn(ix,jy,1,n,l)=max(hmixmin,hmixn(ix,jy,1,n,l)) ! minim PBL height
+      hmixn(ix,jy,1,n,l)=min(hmixmax,hmixn(ix,jy,1,n,l)) ! maxim PBL height
+
+
+  ! 4) Calculation of dry deposition velocities
+  !********************************************
+
+      if (DRYDEP) then
+        z0(4)=0.016*ustarn(ix,jy,1,n,l)*ustarn(ix,jy,1,n,l)/ga
+        z0(9)=0.016*ustarn(ix,jy,1,n,l)*ustarn(ix,jy,1,n,l)/ga
+
+  ! Calculate relative humidity at surface
+  !***************************************
+        rh=ew(td2n(ix,jy,1,n,l))/ew(tt2n(ix,jy,1,n,l))
+
+        call getvdep_nests(n,ix,jy,ustarn(ix,jy,1,n,l), &
+             tt2n(ix,jy,1,n,l),psn(ix,jy,1,n,l),1./olin(ix,jy,1,n,l), &
+             ssrn(ix,jy,1,n,l),rh,lsprecn(ix,jy,1,n,l)+ &
+             convprecn(ix,jy,1,n,l),sdn(ix,jy,1,n,l),vd,l)
+
+        do i=1,nspec
+          vdepn(ix,jy,i,n,l)=vd(i)
+        end do
+
+      endif
+
+  !******************************************************
+  ! Calculate height of thermal tropopause (Hoinka, 1997)
+  !******************************************************
+
+  ! 1) Calculate altitudes of ECMWF model levels
+  !*********************************************
+
+      tvold=tt2n(ix,jy,1,n,l)*(1.+0.378*ew(td2n(ix,jy,1,n,l))/ &
+           psn(ix,jy,1,n,l))
+      pold=psn(ix,jy,1,n,l)
+      zold=0.
+      do kz=2,nuvz
+        pint=akz(kz)+bkz(kz)*psn(ix,jy,1,n,l)  ! pressure on model layers
+        tv=tthn(ix,jy,kz,n,l)*(1.+0.608*qvhn(ix,jy,kz,n,l))
+
+        if (abs(tv-tvold).gt.0.2) then
+         zlev(kz)=zold+const*log(pold/pint)*(tv-tvold)/log(tv/tvold)
+        else
+          zlev(kz)=zold+const*log(pold/pint)*tv
+        endif
+        tvold=tv
+        pold=pint
+        zold=zlev(kz)
+      end do
+
+  ! 2) Define a minimum level kzmin, from which upward the tropopause is
+  !    searched for. This is to avoid inversions in the lower troposphere
+  !    to be identified as the tropopause
+  !************************************************************************
+
+      do kz=1,nuvz
+        if (zlev(kz).ge.altmin) then
+          kzmin=kz
+          goto 45
+        endif
+      end do
+45    continue
+
+  ! 3) Search for first stable layer above minimum height that fulfills the
+  !    thermal tropopause criterion
+  !************************************************************************
+
+      do kz=kzmin,nuvz
+        do lz=kz+1,nuvz
+          if ((zlev(lz)-zlev(kz)).gt.2000.) then
+            if (((tthn(ix,jy,kz,n,l)-tthn(ix,jy,lz,n,l))/ &
+                 (zlev(lz)-zlev(kz))).lt.0.002) then
+              tropopausen(ix,jy,1,n,l)=zlev(kz)
+              goto 51
+            endif
+            goto 50
+          endif
+        end do
+50      continue
+      end do
+51    continue
+
+
+    end do
+  end do
+
+
+    call calcpv_nests(l,n,uuhn,vvhn,pvhn)
+
+  end do
+
+
+end subroutine calcpar_nests
Index: /branches/FP_AI/src/calcpv.f90
===================================================================
--- /branches/FP_AI/src/calcpv.f90	(revision 23)
+++ /branches/FP_AI/src/calcpv.f90	(revision 23)
@@ -0,0 +1,331 @@
+!**********************************************************************
+! 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 calcpv(n,uuh,vvh,pvh)
+  !               i  i   i   o
+  !*****************************************************************************
+  !                                                                            *
+  !  Calculation of potential vorticity on 3-d grid.                           *
+  !                                                                            *
+  !     Author: P. James                                                       *
+  !     3 February 2000                                                        *
+  !                                                                            *
+  !     Adaptation to FLEXPART, A. Stohl, 1 May 2000                           *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! n                  temporal index for meteorological fields (1 to 2)       *
+  !                                                                            *
+  ! Constants:                                                                 *
+  !                                                                            *
+  !*****************************************************************************
+
+  use par_mod
+  use com_mod
+
+  implicit none
+
+  integer :: n,ix,jy,i,j,k,kl,ii,jj,klvrp,klvrm,klpt,kup,kdn,kch
+  integer :: jyvp,jyvm,ixvp,ixvm,jumpx,jumpy,jux,juy,ivrm,ivrp,ivr
+  integer :: nlck
+  real :: vx(2),uy(2),phi,tanphi,cosphi,dvdx,dudy,f
+  real :: theta,thetap,thetam,dthetadp,dt1,dt2,dt
+  real :: pvavr,ppml(0:nxmax-1,0:nymax-1,nuvzmax),ppmk(0:nxmax-1,0:nymax-1,nuvzmax)
+  real :: thup,thdn
+  real,parameter :: eps=1.e-5, p0=101325
+  real :: uuh(0:nxmax-1,0:nymax-1,nuvzmax)
+  real :: vvh(0:nxmax-1,0:nymax-1,nuvzmax)
+  real :: pvh(0:nxmax-1,0:nymax-1,nuvzmax)
+
+  ! Set number of levels to check for adjacent theta
+  nlck=nuvz/3
+  !
+  ! Loop over entire grid
+  !**********************
+  do kl=1,nuvz
+    do jy=0,nymin1
+      do ix=0,nxmin1
+         ppml(ix,jy,kl)=akz(kl)+bkz(kl)*ps(ix,jy,1,n)
+      enddo
+    enddo
+  enddo
+  ppmk=(100000./ppml)**kappa
+
+  do jy=0,nymin1
+    if (sglobal.and.jy.eq.0) goto 10
+    if (nglobal.and.jy.eq.nymin1) goto 10
+    phi = (ylat0 + jy * dy) * pi / 180.
+    f = 0.00014585 * sin(phi)
+    tanphi = tan(phi)
+    cosphi = cos(phi)
+  ! Provide a virtual jy+1 and jy-1 in case we are on domain edge (Lat)
+      jyvp=jy+1
+      jyvm=jy-1
+      if (jy.eq.0) jyvm=0
+      if (jy.eq.nymin1) jyvp=nymin1
+  ! Define absolute gap length
+      jumpy=2
+      if (jy.eq.0.or.jy.eq.nymin1) jumpy=1
+      if (sglobal.and.jy.eq.1) then
+         jyvm=1
+         jumpy=1
+      end if
+      if (nglobal.and.jy.eq.ny-2) then
+         jyvp=ny-2
+         jumpy=1
+      end if
+      juy=jumpy
+  !
+    do ix=0,nxmin1
+  ! Provide a virtual ix+1 and ix-1 in case we are on domain edge (Long)
+      ixvp=ix+1
+      ixvm=ix-1
+      jumpx=2
+      if (xglobal) then
+         ivrp=ixvp
+         ivrm=ixvm
+         if (ixvm.lt.0) ivrm=ixvm+nxmin1
+         if (ixvp.ge.nx) ivrp=ixvp-nx+1
+      else
+        if (ix.eq.0) ixvm=0
+        if (ix.eq.nxmin1) ixvp=nxmin1
+        ivrp=ixvp
+        ivrm=ixvm
+  ! Define absolute gap length
+        if (ix.eq.0.or.ix.eq.nxmin1) jumpx=1
+      end if
+      jux=jumpx
+  !
+  ! Loop over the vertical
+  !***********************
+
+      do kl=1,nuvz
+        theta=tth(ix,jy,kl,n)*ppmk(ix,jy,kl)
+        klvrp=kl+1
+        klvrm=kl-1
+        klpt=kl
+  ! If top or bottom level, dthetadp is evaluated between the current
+  ! level and the level inside, otherwise between level+1 and level-1
+  !
+        if (klvrp.gt.nuvz) klvrp=nuvz
+        if (klvrm.lt.1) klvrm=1
+        thetap=tth(ix,jy,klvrp,n)*ppmk(ix,jy,klvrp)
+        thetam=tth(ix,jy,klvrm,n)*ppmk(ix,jy,klvrm)
+        dthetadp=(thetap-thetam)/(ppml(ix,jy,klvrp)-ppml(ix,jy,klvrm))
+
+  ! Compute vertical position at pot. temperature surface on subgrid
+  ! and the wind at that position
+  !*****************************************************************
+  ! a) in x direction
+        ii=0
+        do i=ixvm,ixvp,jumpx
+          ivr=i
+          if (xglobal) then
+             if (i.lt.0) ivr=ivr+nxmin1
+             if (i.ge.nx) ivr=ivr-nx+1
+          end if
+          ii=ii+1
+  ! Search adjacent levels for current theta value
+  ! Spiral out from current level for efficiency
+          kup=klpt-1
+          kdn=klpt
+          kch=0
+40        continue
+  ! Upward branch
+          kup=kup+1
+          if (kch.ge.nlck) goto 21     ! No more levels to check,
+  !                                       ! and no values found
+          if (kup.ge.nuvz) goto 41
+          kch=kch+1
+          k=kup
+          thdn=tth(ivr,jy,k,n)*ppmk(ivr,jy,k)
+          thup=tth(ivr,jy,k+1,n)*ppmk(ivr,jy,k+1)
+
+
+          if (((thdn.ge.theta).and.(thup.le.theta)).or. &
+          ((thdn.le.theta).and.(thup.ge.theta))) then
+            dt1=abs(theta-thdn)
+            dt2=abs(theta-thup)
+            dt=dt1+dt2
+            if (dt.lt.eps) then   ! Avoid division by zero error
+              dt1=0.5             ! G.W., 10.4.1996
+              dt2=0.5
+              dt=1.0
+            endif
+            vx(ii)=(vvh(ivr,jy,k)*dt2+vvh(ivr,jy,k+1)*dt1)/dt
+            goto 20
+          endif
+41        continue
+  ! Downward branch
+          kdn=kdn-1
+          if (kdn.lt.1) goto 40
+          kch=kch+1
+          k=kdn
+          thdn=tth(ivr,jy,k,n)*ppmk(ivr,jy,k)
+          thup=tth(ivr,jy,k+1,n)*ppmk(ivr,jy,k+1)
+
+          if (((thdn.ge.theta).and.(thup.le.theta)).or. &
+          ((thdn.le.theta).and.(thup.ge.theta))) then
+            dt1=abs(theta-thdn)
+            dt2=abs(theta-thup)
+            dt=dt1+dt2
+            if (dt.lt.eps) then   ! Avoid division by zero error
+              dt1=0.5             ! G.W., 10.4.1996
+              dt2=0.5
+              dt=1.0
+            endif
+            vx(ii)=(vvh(ivr,jy,k)*dt2+vvh(ivr,jy,k+1)*dt1)/dt
+            goto 20
+          endif
+          goto 40
+  ! This section used when no values were found
+21      continue
+  ! Must use vv at current level and long. jux becomes smaller by 1
+        vx(ii)=vvh(ix,jy,kl)
+        jux=jux-1
+  ! Otherwise OK
+20        continue
+        end do
+      if (jux.gt.0) then
+      dvdx=(vx(2)-vx(1))/real(jux)/(dx*pi/180.)
+      else
+      dvdx=vvh(ivrp,jy,kl)-vvh(ivrm,jy,kl)
+      dvdx=dvdx/real(jumpx)/(dx*pi/180.)
+  ! Only happens if no equivalent theta value
+  ! can be found on either side, hence must use values
+  ! from either side, same pressure level.
+      end if
+
+  ! b) in y direction
+
+        jj=0
+        do j=jyvm,jyvp,jumpy
+          jj=jj+1
+  ! Search adjacent levels for current theta value
+  ! Spiral out from current level for efficiency
+          kup=klpt-1
+          kdn=klpt
+          kch=0
+70        continue
+  ! Upward branch
+          kup=kup+1
+          if (kch.ge.nlck) goto 51     ! No more levels to check,
+  !                                     ! and no values found
+          if (kup.ge.nuvz) goto 71
+          kch=kch+1
+          k=kup
+          thdn=tth(ix,j,k,n)*ppmk(ix,j,k)
+          thup=tth(ix,j,k+1,n)*ppmk(ix,j,k+1)
+          if (((thdn.ge.theta).and.(thup.le.theta)).or. &
+          ((thdn.le.theta).and.(thup.ge.theta))) then
+            dt1=abs(theta-thdn)
+            dt2=abs(theta-thup)
+            dt=dt1+dt2
+            if (dt.lt.eps) then   ! Avoid division by zero error
+              dt1=0.5             ! G.W., 10.4.1996
+              dt2=0.5
+              dt=1.0
+            endif
+            uy(jj)=(uuh(ix,j,k)*dt2+uuh(ix,j,k+1)*dt1)/dt
+            goto 50
+          endif
+71        continue
+  ! Downward branch
+          kdn=kdn-1
+          if (kdn.lt.1) goto 70
+          kch=kch+1
+          k=kdn
+          thdn=tth(ix,j,k,n)*ppmk(ix,j,k)
+          thup=tth(ix,j,k+1,n)*ppmk(ix,j,k+1)
+          if (((thdn.ge.theta).and.(thup.le.theta)).or. &
+          ((thdn.le.theta).and.(thup.ge.theta))) then
+            dt1=abs(theta-thdn)
+            dt2=abs(theta-thup)
+            dt=dt1+dt2
+            if (dt.lt.eps) then   ! Avoid division by zero error
+              dt1=0.5             ! G.W., 10.4.1996
+              dt2=0.5
+              dt=1.0
+            endif
+            uy(jj)=(uuh(ix,j,k)*dt2+uuh(ix,j,k+1)*dt1)/dt
+            goto 50
+          endif
+          goto 70
+  ! This section used when no values were found
+51      continue
+  ! Must use uu at current level and lat. juy becomes smaller by 1
+          uy(jj)=uuh(ix,jy,kl)
+          juy=juy-1
+  ! Otherwise OK
+50        continue
+        end do
+      if (juy.gt.0) then
+      dudy=(uy(2)-uy(1))/real(juy)/(dy*pi/180.)
+      else
+      dudy=uuh(ix,jyvp,kl)-uuh(ix,jyvm,kl)
+      dudy=dudy/real(jumpy)/(dy*pi/180.)
+      end if
+  !
+      pvh(ix,jy,kl)=dthetadp*(f+(dvdx/cosphi-dudy &
+           +uuh(ix,jy,kl)*tanphi)/r_earth)*(-1.e6)*9.81
+
+
+  !
+  ! Resest jux and juy
+      jux=jumpx
+      juy=jumpy
+      end do
+    end do
+10  continue
+  end do
+  !
+  ! Fill in missing PV values on poles, if present
+  ! Use mean PV of surrounding latitude ring
+  !
+      if (sglobal) then
+         do kl=1,nuvz
+            pvavr=0.
+            do ix=0,nxmin1
+               pvavr=pvavr+pvh(ix,1,kl)
+            end do
+            pvavr=pvavr/real(nx)
+            jy=0
+            do ix=0,nxmin1
+               pvh(ix,jy,kl)=pvavr
+            end do
+         end do
+      end if
+      if (nglobal) then
+         do kl=1,nuvz
+            pvavr=0.
+            do ix=0,nxmin1
+               pvavr=pvavr+pvh(ix,ny-2,kl)
+            end do
+            pvavr=pvavr/real(nx)
+            jy=nymin1
+            do ix=0,nxmin1
+               pvh(ix,jy,kl)=pvavr
+            end do
+         end do
+      end if
+
+end subroutine calcpv
Index: /branches/FP_AI/src/calcpv_nests.f90
===================================================================
--- /branches/FP_AI/src/calcpv_nests.f90	(revision 23)
+++ /branches/FP_AI/src/calcpv_nests.f90	(revision 23)
@@ -0,0 +1,275 @@
+!**********************************************************************
+! 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 calcpv_nests(l,n,uuhn,vvhn,pvhn)
+  !                     i i  i    i    o
+  !*****************************************************************************
+  !                                                                            *
+  !  Calculation of potential vorticity on 3-d nested grid                     *
+  !                                                                            *
+  !     Author: P. James                                                       *
+  !     22 February 2000                                                       *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! n                  temporal index for meteorological fields (1 to 2)       *
+  ! l                  index of current nest                                   *
+  !                                                                            *
+  ! Constants:                                                                 *
+  !                                                                            *
+  !*****************************************************************************
+
+  use par_mod
+  use com_mod
+
+  implicit none
+
+  integer :: n,ix,jy,i,j,k,kl,ii,jj,klvrp,klvrm,klpt,kup,kdn,kch
+  integer :: jyvp,jyvm,ixvp,ixvm,jumpx,jumpy,jux,juy,ivrm,ivrp,ivr
+  integer :: nlck,l
+  real :: vx(2),uy(2),phi,tanphi,cosphi,dvdx,dudy,f
+  real :: theta,thetap,thetam,dthetadp,dt1,dt2,dt
+  real :: ppml(0:nxmaxn-1,0:nymaxn-1,nuvzmax),ppmk(0:nxmaxn-1,0:nymaxn-1,nuvzmax)
+  real :: thup,thdn
+  real,parameter :: eps=1.e-5,p0=101325
+  real :: uuhn(0:nxmaxn-1,0:nymaxn-1,nuvzmax,maxnests)
+  real :: vvhn(0:nxmaxn-1,0:nymaxn-1,nuvzmax,maxnests)
+  real :: pvhn(0:nxmaxn-1,0:nymaxn-1,nuvzmax,maxnests)
+
+  ! Set number of levels to check for adjacent theta
+  nlck=nuvz/3
+  !
+  ! Loop over entire grid
+  !**********************
+  do kl=1,nuvz
+    do jy=0,nyn(l)-1
+      do ix=0,nxn(l)-1
+         ppml(ix,jy,kl)=akz(kl)+bkz(kl)*psn(ix,jy,1,n,l)
+      enddo
+    enddo
+  enddo
+  ppmk=(100000./ppml)**kappa
+
+  do jy=0,nyn(l)-1
+    phi = (ylat0n(l) + jy * dyn(l)) * pi / 180.
+    f = 0.00014585 * sin(phi)
+    tanphi = tan(phi)
+    cosphi = cos(phi)
+  ! Provide a virtual jy+1 and jy-1 in case we are on domain edge (Lat)
+      jyvp=jy+1
+      jyvm=jy-1
+      if (jy.eq.0) jyvm=0
+      if (jy.eq.nyn(l)-1) jyvp=nyn(l)-1
+  ! Define absolute gap length
+      jumpy=2
+      if (jy.eq.0.or.jy.eq.nyn(l)-1) jumpy=1
+      juy=jumpy
+  !
+    do ix=0,nxn(l)-1
+  ! Provide a virtual ix+1 and ix-1 in case we are on domain edge (Long)
+      ixvp=ix+1
+      ixvm=ix-1
+      jumpx=2
+      if (ix.eq.0) ixvm=0
+      if (ix.eq.nxn(l)-1) ixvp=nxn(l)-1
+      ivrp=ixvp
+      ivrm=ixvm
+  ! Define absolute gap length
+      if (ix.eq.0.or.ix.eq.nxn(l)-1) jumpx=1
+      jux=jumpx
+  !
+  ! Loop over the vertical
+  !***********************
+
+      do kl=1,nuvz
+        theta=tthn(ix,jy,kl,n,l)*ppmk(ix,jy,kl)
+        klvrp=kl+1
+        klvrm=kl-1
+        klpt=kl
+  ! If top or bottom level, dthetadp is evaluated between the current
+  ! level and the level inside, otherwise between level+1 and level-1
+  !
+        if (klvrp.gt.nuvz) klvrp=nuvz
+        if (klvrm.lt.1) klvrm=1
+        thetap=tthn(ix,jy,klvrp,n,l)*ppmk(ix,jy,klvrp)
+        thetam=tthn(ix,jy,klvrm,n,l)*ppmk(ix,jy,klvrm)
+        dthetadp=(thetap-thetam)/(ppml(ix,jy,klvrp)-ppml(ix,jy,klvrm))
+
+  ! Compute vertical position at pot. temperature surface on subgrid
+  ! and the wind at that position
+  !*****************************************************************
+  ! a) in x direction
+        ii=0
+        do i=ixvm,ixvp,jumpx
+          ivr=i
+          ii=ii+1
+  ! Search adjacent levels for current theta value
+  ! Spiral out from current level for efficiency
+          kup=klpt-1
+          kdn=klpt
+          kch=0
+40        continue
+  ! Upward branch
+          kup=kup+1
+          if (kch.ge.nlck) goto 21     ! No more levels to check,
+  !                                       ! and no values found
+          if (kup.ge.nuvz) goto 41
+          kch=kch+1
+          k=kup
+          thdn=tthn(ivr,jy,k,n,l)*ppmk(ivr,jy,k)
+          thup=tthn(ivr,jy,k+1,n,l)*ppmk(ivr,jy,k+1)
+
+      if (((thdn.ge.theta).and.(thup.le.theta)).or. &
+           ((thdn.le.theta).and.(thup.ge.theta))) then
+              dt1=abs(theta-thdn)
+              dt2=abs(theta-thup)
+              dt=dt1+dt2
+              if (dt.lt.eps) then   ! Avoid division by zero error
+                dt1=0.5             ! G.W., 10.4.1996
+                dt2=0.5
+                dt=1.0
+              endif
+    vx(ii)=(vvhn(ivr,jy,k,l)*dt2+vvhn(ivr,jy,k+1,l)*dt1)/dt
+              goto 20
+            endif
+41        continue
+  ! Downward branch
+          kdn=kdn-1
+          if (kdn.lt.1) goto 40
+          kch=kch+1
+          k=kdn
+          thdn=tthn(ivr,jy,k,n,l)*ppmk(ivr,jy,k)
+          thup=tthn(ivr,jy,k+1,n,l)*ppmk(ivr,jy,k+1)
+      if (((thdn.ge.theta).and.(thup.le.theta)).or. &
+           ((thdn.le.theta).and.(thup.ge.theta))) then
+              dt1=abs(theta-thdn)
+              dt2=abs(theta-thup)
+              dt=dt1+dt2
+              if (dt.lt.eps) then   ! Avoid division by zero error
+                dt1=0.5             ! G.W., 10.4.1996
+                dt2=0.5
+                dt=1.0
+              endif
+    vx(ii)=(vvhn(ivr,jy,k,l)*dt2+vvhn(ivr,jy,k+1,l)*dt1)/dt
+              goto 20
+            endif
+            goto 40
+  ! This section used when no values were found
+21      continue
+  ! Must use vv at current level and long. jux becomes smaller by 1
+        vx(ii)=vvhn(ix,jy,kl,l)
+        jux=jux-1
+  ! Otherwise OK
+20        continue
+        end do
+      if (jux.gt.0) then
+      dvdx=(vx(2)-vx(1))/real(jux)/(dxn(l)*pi/180.)
+      else
+      dvdx=vvhn(ivrp,jy,kl,l)-vvhn(ivrm,jy,kl,l)
+      dvdx=dvdx/real(jumpx)/(dxn(l)*pi/180.)
+  ! Only happens if no equivalent theta value
+  ! can be found on either side, hence must use values
+  ! from either side, same pressure level.
+      end if
+
+  ! b) in y direction
+
+        jj=0
+        do j=jyvm,jyvp,jumpy
+          jj=jj+1
+  ! Search adjacent levels for current theta value
+  ! Spiral out from current level for efficiency
+          kup=klpt-1
+          kdn=klpt
+          kch=0
+70        continue
+  ! Upward branch
+          kup=kup+1
+          if (kch.ge.nlck) goto 51     ! No more levels to check,
+  !                                     ! and no values found
+          if (kup.ge.nuvz) goto 71
+          kch=kch+1
+          k=kup
+          thdn=tthn(ix,j,k,n,l)*ppmk(ix,j,k)
+          thup=tthn(ix,j,k+1,n,l)*ppmk(ix,j,k+1)
+      if (((thdn.ge.theta).and.(thup.le.theta)).or. &
+           ((thdn.le.theta).and.(thup.ge.theta))) then
+              dt1=abs(theta-thdn)
+              dt2=abs(theta-thup)
+              dt=dt1+dt2
+              if (dt.lt.eps) then   ! Avoid division by zero error
+                dt1=0.5             ! G.W., 10.4.1996
+                dt2=0.5
+                dt=1.0
+              endif
+        uy(jj)=(uuhn(ix,j,k,l)*dt2+uuhn(ix,j,k+1,l)*dt1)/dt
+              goto 50
+            endif
+71        continue
+  ! Downward branch
+          kdn=kdn-1
+          if (kdn.lt.1) goto 70
+          kch=kch+1
+          k=kdn
+          thdn=tthn(ix,j,k,n,l)*ppmk(ix,j,k)
+          thup=tthn(ix,j,k+1,n,l)*ppmk(ix,j,k+1)
+      if (((thdn.ge.theta).and.(thup.le.theta)).or. &
+           ((thdn.le.theta).and.(thup.ge.theta))) then
+              dt1=abs(theta-thdn)
+              dt2=abs(theta-thup)
+              dt=dt1+dt2
+              if (dt.lt.eps) then   ! Avoid division by zero error
+                dt1=0.5             ! G.W., 10.4.1996
+                dt2=0.5
+                dt=1.0
+              endif
+        uy(jj)=(uuhn(ix,j,k,l)*dt2+uuhn(ix,j,k+1,l)*dt1)/dt
+              goto 50
+            endif
+            goto 70
+  ! This section used when no values were found
+51      continue
+  ! Must use uu at current level and lat. juy becomes smaller by 1
+        uy(jj)=uuhn(ix,jy,kl,l)
+        juy=juy-1
+  ! Otherwise OK
+50        continue
+        end do
+      if (juy.gt.0) then
+      dudy=(uy(2)-uy(1))/real(juy)/(dyn(l)*pi/180.)
+      else
+      dudy=uuhn(ix,jyvp,kl,l)-uuhn(ix,jyvm,kl,l)
+      dudy=dudy/real(jumpy)/(dyn(l)*pi/180.)
+      end if
+  !
+      pvhn(ix,jy,kl,l)=dthetadp*(f+(dvdx/cosphi-dudy &
+           +uuhn(ix,jy,kl,l)*tanphi)/r_earth)*(-1.e6)*9.81
+
+  !
+  ! Resest jux and juy
+      jux=jumpx
+      juy=jumpy
+      end do
+    end do
+  end do
+  !
+end subroutine calcpv_nests
Index: /branches/FP_AI/src/caldate.f90
===================================================================
--- /branches/FP_AI/src/caldate.f90	(revision 23)
+++ /branches/FP_AI/src/caldate.f90	(revision 23)
@@ -0,0 +1,91 @@
+!**********************************************************************
+! 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 caldate(juldate,yyyymmdd,hhmiss)
+  !                      i       o       o
+  !*****************************************************************************
+  !                                                                            *
+  !     Calculates the Gregorian date from the Julian date                     *
+  !                                                                            *
+  !     AUTHOR: Andreas Stohl (21 January 1994), adapted from Numerical Recipes*
+  !                                                                            *
+  !     Variables:                                                             *
+  !     dd             Day                                                     *
+  !     hh             Hour                                                    *
+  !     hhmiss         Hour, Minute, Second                                    *
+  !     ja,jb,jc,jd,je help variables                                          *
+  !     jalpha         help variable                                           *
+  !     juldate        Julian Date                                             *
+  !     julday         help variable                                           *
+  !     mi             Minute                                                  *
+  !     mm             Month                                                   *
+  !     ss             Seconds                                                 *
+  !     yyyy           Year                                                    *
+  !     yyyymmdd       Year, Month, Day                                        *
+  !                                                                            *
+  !     Constants:                                                             *
+  !     igreg          help constant                                           *
+  !                                                                            *
+  !*****************************************************************************
+
+  use par_mod, only: dp
+
+  implicit none
+
+  integer           :: yyyymmdd,yyyy,mm,dd,hhmiss,hh,mi,ss
+  integer           :: julday,ja,jb,jc,jd,je,jalpha
+  real(kind=dp)     :: juldate
+  integer,parameter :: igreg=2299161
+
+  julday=int(juldate)
+  if(julday.ge.igreg)then
+    jalpha=int(((julday-1867216)-0.25)/36524.25)
+    ja=julday+1+jalpha-int(0.25*jalpha)
+  else
+    ja=julday
+  endif
+  jb=ja+1524
+  jc=int(6680.+((jb-2439870)-122.1)/365.25)
+  jd=365*jc+int(0.25*jc)
+  je=int((jb-jd)/30.6001)
+  dd=jb-jd-int(30.6001*je)
+  mm=je-1
+  if (mm.gt.12) mm=mm-12
+  yyyy=jc-4715
+  if (mm.gt.2) yyyy=yyyy-1
+  if (yyyy.le.0) yyyy=yyyy-1
+
+  yyyymmdd=10000*yyyy+100*mm+dd
+  hh=int(24._dp*(juldate-real(julday,kind=dp)))
+  mi=int(1440._dp*(juldate-real(julday,kind=dp))-60._dp*real(hh,kind=dp))
+  ss=nint(86400._dp*(juldate-real(julday,kind=dp))-3600._dp*real(hh,kind=dp)- &
+       60._dp*real(mi,kind=dp))
+  if (ss.eq.60) then  ! 60 seconds = 1 minute
+    ss=0
+    mi=mi+1
+  endif
+  if (mi.eq.60) then
+    mi=0
+    hh=hh+1
+  endif
+  hhmiss=10000*hh+100*mi+ss
+
+end subroutine caldate
Index: /branches/FP_AI/src/centerofmass.f90
===================================================================
--- /branches/FP_AI/src/centerofmass.f90	(revision 23)
+++ /branches/FP_AI/src/centerofmass.f90	(revision 23)
@@ -0,0 +1,89 @@
+!**********************************************************************
+! 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 centerofmass(xl,yl,n,xcenter,ycenter)
+  !                        i  i  i    o       o
+  !*****************************************************************************
+  !                                                                            *
+  !   This routine calculates the center of mass of n points on the Earth.     *
+  !   Input are the longitudes (xl) and latitudes (yl) of the individual       *
+  !   points, output is the longitude and latitude of the centre of mass.      *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     24 January 2002                                                        *
+  !                                                                            *
+  !*****************************************************************************
+
+  use par_mod
+
+  implicit none
+
+  integer :: n,l
+  real :: xl(n),yl(n),xll,yll,xav,yav,zav,x,y,z,xcenter,ycenter
+
+
+  xav=0.
+  yav=0.
+  zav=0.
+
+  do l=1,n
+
+  ! Convert longitude and latitude from degrees to radians
+  !*******************************************************
+
+    xll=xl(l)*pi180
+    yll=yl(l)*pi180
+
+  ! Calculate 3D coordinates from longitude and latitude
+  !*****************************************************
+
+    x = cos(yll)*sin(xll)
+    y = -1.*cos(yll)*cos(xll)
+    z = sin(yll)
+
+
+  ! Find the mean location in Cartesian coordinates
+  !************************************************
+
+    xav=xav+x
+    yav=yav+y
+    zav=zav+z
+  end do
+
+  xav=xav/real(n)
+  yav=yav/real(n)
+  zav=zav/real(n)
+
+
+  ! Project the point back onto Earth's surface
+  !********************************************
+
+  xcenter=atan2(xav,-1.*yav)
+  ycenter=atan2(zav,sqrt(xav*xav+yav*yav))
+
+  ! Convert back to degrees
+  !************************
+
+  xcenter=xcenter/pi180
+  ycenter=ycenter/pi180
+
+end subroutine centerofmass
Index: /branches/FP_AI/src/clustering.f90
===================================================================
--- /branches/FP_AI/src/clustering.f90	(revision 23)
+++ /branches/FP_AI/src/clustering.f90	(revision 23)
@@ -0,0 +1,210 @@
+!**********************************************************************
+! 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 clustering(xl,yl,zl,n,xclust,yclust,zclust,fclust,rms, &
+       rmsclust,zrms)
+  !                      i  i  i  i   o      o      o      o     o
+  !   o      o
+  !*****************************************************************************
+  !                                                                            *
+  !   This routine clusters the particle position into ncluster custers.       *
+  !   Input are the longitudes (xl) and latitudes (yl) of the individual       *
+  !   points, output are the cluster mean positions (xclust,yclust).           *
+  !   Vertical positions are not directly used for the clustering.             *
+  !                                                                            *
+  !   For clustering, the procedure described in Dorling et al. (1992) is used.*
+  !                                                                            *
+  !   Dorling, S.R., Davies, T.D. and Pierce, C.E. (1992):                     *
+  !   Cluster analysis: a technique for estimating the synoptic meteorological *
+  !   controls on air and precipitation chemistry - method and applications.   *
+  !   Atmospheric Environment 26A, 2575-2581.                                  *
+  !                                                                            *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     1 February 2002                                                        *
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! fclust          fraction of particles belonging to each cluster            *
+  ! ncluster        number of clusters to be used                              *
+  ! rms             total horizontal rms distance after clustering             *
+  ! rmsclust        horizontal rms distance for each individual cluster        *
+  ! zrms            total vertical rms distance after clustering               *
+  ! xclust,yclust,  Cluster centroid positions                                 *
+  ! zclust                                                                     *
+  ! xl,yl,zl        particle positions                                         *
+  !                                                                            *
+  !*****************************************************************************
+
+  use par_mod
+
+  implicit none
+
+  integer :: n,i,j,l,nclust(maxpart),numb(ncluster),ncl
+  real :: xl(n),yl(n),zl(n),xclust(ncluster),yclust(ncluster),x,y,z
+  real :: zclust(ncluster),distance2,distances,distancemin,rms,rmsold
+  real :: xav(ncluster),yav(ncluster),zav(ncluster),fclust(ncluster)
+  real :: rmsclust(ncluster)
+  real :: zdist,zrms
+
+
+
+  if (n.lt.ncluster) return
+  rmsold=-5.
+
+  ! Convert longitude and latitude from degrees to radians
+  !*******************************************************
+
+  do i=1,n
+    nclust(i)=i
+    xl(i)=xl(i)*pi180
+    yl(i)=yl(i)*pi180
+  end do
+
+
+  ! Generate a seed for each cluster
+  !*********************************
+
+  do j=1,ncluster
+    zclust(j)=0.
+    xclust(j)=xl(j*n/ncluster)
+    yclust(j)=yl(j*n/ncluster)
+  end do
+
+
+  ! Iterative loop to compute the cluster means
+  !********************************************
+
+  do l=1,100
+
+  ! Assign each particle to a cluster: criterion minimum distance to the
+  ! cluster mean position
+  !*********************************************************************
+
+
+    do i=1,n
+      distancemin=10.**10.
+      do j=1,ncluster
+        distances=distance2(yl(i),xl(i),yclust(j),xclust(j))
+        if (distances.lt.distancemin) then
+          distancemin=distances
+          ncl=j
+        endif
+      end do
+      nclust(i)=ncl
+    end do
+
+
+  ! Recalculate the cluster centroid position: convert to 3D Cartesian coordinates,
+  ! calculate mean position, and re-project this point onto the Earth's surface
+  !*****************************************************************************
+
+    do j=1,ncluster
+      xav(j)=0.
+      yav(j)=0.
+      zav(j)=0.
+      rmsclust(j)=0.
+      numb(j)=0
+    end do
+    rms=0.
+
+    do i=1,n
+      numb(nclust(i))=numb(nclust(i))+1
+      distances=distance2(yl(i),xl(i), &
+           yclust(nclust(i)),xclust(nclust(i)))
+
+  ! rms is the total rms of all particles
+  ! rmsclust is the rms for a particular cluster
+  !*********************************************
+
+      rms=rms+distances*distances
+      rmsclust(nclust(i))=rmsclust(nclust(i))+distances*distances
+
+  ! Calculate Cartesian 3D coordinates from longitude and latitude
+  !***************************************************************
+
+      x = cos(yl(i))*sin(xl(i))
+      y = -1.*cos(yl(i))*cos(xl(i))
+      z = sin(yl(i))
+      xav(nclust(i))=xav(nclust(i))+x
+      yav(nclust(i))=yav(nclust(i))+y
+      zav(nclust(i))=zav(nclust(i))+z
+    end do
+
+    rms=sqrt(rms/real(n))
+
+
+  ! Find the mean location in Cartesian coordinates
+  !************************************************
+
+    do j=1,ncluster
+      if (numb(j).gt.0) then
+        rmsclust(j)=sqrt(rmsclust(j)/real(numb(j)))
+        xav(j)=xav(j)/real(numb(j))
+        yav(j)=yav(j)/real(numb(j))
+        zav(j)=zav(j)/real(numb(j))
+
+  ! Project the point back onto Earth's surface
+  !********************************************
+
+        xclust(j)=atan2(xav(j),-1.*yav(j))
+        yclust(j)=atan2(zav(j),sqrt(xav(j)*xav(j)+yav(j)*yav(j)))
+      endif
+    end do
+
+
+  ! Leave the loop if the RMS distance decreases only slightly between 2 iterations
+  !*****************************************************************************
+
+    if ((l.gt.1).and.(abs(rms-rmsold)/rmsold.lt.0.005)) goto 99
+    rmsold=rms
+
+  end do
+
+99   continue
+
+  ! Convert longitude and latitude from radians to degrees
+  !*******************************************************
+
+  do i=1,n
+    xl(i)=xl(i)/pi180
+    yl(i)=yl(i)/pi180
+    zclust(nclust(i))=zclust(nclust(i))+zl(i)
+  end do
+
+  do j=1,ncluster
+    xclust(j)=xclust(j)/pi180
+    yclust(j)=yclust(j)/pi180
+    if (numb(j).gt.0) zclust(j)=zclust(j)/real(numb(j))
+    fclust(j)=100.*real(numb(j))/real(n)
+  end do
+
+  ! Determine total vertical RMS deviation
+  !***************************************
+
+  zrms=0.
+  do i=1,n
+    zdist=zl(i)-zclust(nclust(i))
+    zrms=zrms+zdist*zdist
+  end do
+  if (zrms.gt.0.) zrms=sqrt(zrms/real(n))
+
+end subroutine clustering
Index: /branches/FP_AI/src/cmapf_mod.f90
===================================================================
--- /branches/FP_AI/src/cmapf_mod.f90	(revision 23)
+++ /branches/FP_AI/src/cmapf_mod.f90	(revision 23)
@@ -0,0 +1,834 @@
+!**********************************************************************
+! 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/>.   *
+!**********************************************************************
+
+! Changes to the routines by A. Stohl
+! xi,xi0,eta,eta0 are double precision variables to avoid problems
+! at poles
+
+module cmapf_mod
+
+  use par_mod, only: dp
+
+  implicit none
+  private
+
+  public :: cc2gll, cll2xy, cgszll, cxy2ll, stlmbr, stcm2p
+
+  real,parameter :: rearth=6371.2, almst1=.9999999
+
+  real,parameter :: pi=3.14159265358979
+  real,parameter :: radpdg=pi/180., dgprad=180./pi
+
+contains
+
+subroutine cc2gll (strcmp, xlat,xlong, ue,vn, ug,vg)
+  !*  Written on 3/31/94 by Dr. Albion Taylor  NOAA / OAR / ARL
+
+  use par_mod, only: dp
+
+  implicit none
+
+  real :: strcmp(9), xlat, xlong, ue, vn, ug, vg
+
+  real(kind=dp) :: xpolg,ypolg,along,slong,clong,rot
+
+  along = cspanf( xlong - strcmp(2), -180., 180.)
+  if (xlat.gt.89.985) then
+  !*  North polar meteorological orientation: "north" along prime meridian
+    rot = - strcmp(1) * along + xlong - 180.
+  elseif (xlat.lt.-89.985) then
+  !*  South polar meteorological orientation: "north" along prime meridian
+    rot = - strcmp(1) * along - xlong
+  else
+    rot = - strcmp(1) * along
+  endif
+  slong = sin( radpdg * rot )
+  clong = cos( radpdg * rot )
+  xpolg = slong * strcmp(5) + clong * strcmp(6)
+  ypolg = clong * strcmp(5) - slong * strcmp(6)
+  ug = ypolg * ue + xpolg * vn
+  vg = ypolg * vn - xpolg * ue
+  return
+end subroutine cc2gll
+
+subroutine ccrvll (strcmp, xlat,xlong, gx,gy)
+  !*  Written on 9/20/94 by Dr. Albion Taylor  NOAA / OAR / ARL
+
+  use par_mod, only: dp
+
+  implicit none
+
+  real(kind=dp) :: xpolg,ypolg,temp,along,slong,clong,ctemp, curv
+  real :: strcmp(9), xlat, xlong, gx, gy
+
+  along = cspanf( xlong - strcmp(2), -180., 180.)
+  slong = sin( radpdg * strcmp(1) * along)
+  clong = cos( radpdg * strcmp(1) * along)
+  xpolg = - slong * strcmp(5) + clong * strcmp(6)
+  ypolg = clong * strcmp(5) + slong * strcmp(6)
+  temp = sin(radpdg * xlat)
+  ctemp = cos(radpdg * xlat)
+  curv = (strcmp(1) - temp) / ctemp / rearth
+  gx = curv * xpolg
+  gy = curv * ypolg
+  return
+end subroutine ccrvll
+
+subroutine ccrvxy (strcmp, x,y, gx,gy)
+  !*  Written on 9/20/94 by Dr. Albion Taylor  NOAA / OAR / ARL
+
+  use par_mod, only: dp
+
+  implicit none
+
+  real :: strcmp(9), x, y, gx, gy
+  real(kind=dp) :: xpolg,ypolg,temp,ymerc,efact,curv
+
+  temp = strcmp(1) * strcmp(7) /rearth
+  xpolg = strcmp(6) + temp * (strcmp(3) - x)
+  ypolg = strcmp(5) + temp * (strcmp(4) - y)
+  temp = sqrt ( xpolg ** 2 + ypolg ** 2 )
+  if (temp.gt.0.) then
+    ymerc = - log( temp) /strcmp(1)
+    efact = exp(ymerc)
+    curv = ( (strcmp(1) - 1.d0) * efact + &
+         (strcmp(1) + 1.d0) / efact ) &
+         * .5d0 / rearth
+    gx = xpolg * curv / temp
+    gy = ypolg * curv / temp
+  else
+    if (abs(strcmp(1)) .eq. 1.) then
+      gx = 0.
+      gy = 0.
+    else
+      gx = 1./rearth
+      gy = 1./rearth
+    endif
+  endif
+  return
+end subroutine ccrvxy
+
+subroutine cg2cll (strcmp, xlat,xlong, ug,vg, ue,vn)
+  !*  Written on 3/31/94 by Dr. Albion Taylor  NOAA / OAR / ARL
+
+  use par_mod, only: dp
+
+  implicit none
+
+  real(kind=dp) :: xpolg,ypolg,along,slong,clong,rot
+  real :: strcmp(9), xlat, xlong, ug, vg, ue, vn
+
+  along = cspanf( xlong - strcmp(2), -180., 180.)
+  if (xlat.gt.89.985) then
+  !*  North polar meteorological orientation: "north" along prime meridian
+    rot = - strcmp(1) * along + xlong - 180.
+  elseif (xlat.lt.-89.985) then
+  !*  South polar meteorological orientation: "north" along prime meridian
+    rot = - strcmp(1) * along - xlong
+  else
+    rot = - strcmp(1) * along
+  endif
+  slong = sin( radpdg * rot )
+  clong = cos( radpdg * rot )
+  xpolg = slong * strcmp(5) + clong * strcmp(6)
+  ypolg = clong * strcmp(5) - slong * strcmp(6)
+  ue = ypolg * ug - xpolg * vg
+  vn = ypolg * vg + xpolg * ug
+  return
+end subroutine cg2cll
+
+subroutine cg2cxy (strcmp, x,y, ug,vg, ue,vn)
+  !*  Written on 3/31/94 by Dr. Albion Taylor  NOAA / OAR / ARL
+
+  use par_mod, only: dp
+
+  implicit none
+
+  real :: strcmp(9) , x, y, ug, vg, ue, vn
+
+  real :: clong, radial, rot, slong, xlat, xlong
+  real(kind=dp) :: xpolg,ypolg,temp,xi0,eta0,xi,eta
+
+  xi0 = ( x - strcmp(3) ) * strcmp(7) / rearth
+  eta0 = ( y - strcmp(4) ) * strcmp(7) /rearth
+  xi = xi0 * strcmp(5) - eta0 * strcmp(6)
+  eta = eta0 * strcmp(5) + xi0 * strcmp(6)
+  radial = 2. * eta - strcmp(1) * (xi*xi + eta*eta)
+  if (radial.gt.strcmp(8)) then
+  !*  Case north of 89 degrees. Meteorological wind direction definition
+  !*      changes.
+    call cnxyll(strcmp, xi,eta, xlat,xlong)
+  !*  North polar meteorological orientation: "north" along prime meridian
+    rot = strcmp(1) * (xlong - strcmp(2)) - xlong - 180.
+    slong = - sin( radpdg * rot )
+    clong = cos( radpdg * rot )
+    xpolg = slong * strcmp(5) + clong * strcmp(6)
+    ypolg = clong * strcmp(5) - slong * strcmp(6)
+  else if (radial.lt.strcmp(9)) then
+  !*  Case south of -89 degrees. Meteorological wind direction definition
+  !*      changes.
+    call cnxyll(strcmp, xi,eta, xlat,xlong)
+  !*  South polar meteorological orientation: "north" along prime meridian
+    rot = strcmp(1) * (xlong - strcmp(2)) + xlong
+    slong = - sin( radpdg * rot )
+    clong = cos( radpdg * rot )
+    xpolg = slong * strcmp(5) + clong * strcmp(6)
+    ypolg = clong * strcmp(5) - slong * strcmp(6)
+  else
+  !* Normal case. Meteorological direction of wind related to true north.
+    xpolg = strcmp(6) - strcmp(1) * xi0
+    ypolg = strcmp(5) - strcmp(1) * eta0
+    temp = sqrt ( xpolg ** 2 + ypolg ** 2 )
+    xpolg = xpolg / temp
+    ypolg = ypolg / temp
+  end if
+  ue = ( ypolg * ug - xpolg * vg )
+  vn = ( ypolg * vg + xpolg * ug )
+  return
+end subroutine cg2cxy
+
+real function cgszll (strcmp, xlat,xlong)
+  !*  Written on 3/31/94 by Dr. Albion Taylor  NOAA / OAR / ARL
+
+  use par_mod, only: dp
+
+  implicit none
+
+  real :: strcmp(9), xlat, xlong
+
+  real(kind=dp) :: slat,ymerc,efact
+
+  if (xlat .gt. 89.985) then
+  !* Close to north pole
+    if (strcmp(1) .gt. 0.9999) then
+  !* and to gamma == 1.
+      cgszll = 2. * strcmp(7)
+      return
+    endif
+    efact = cos(radpdg * xlat)
+    if (efact .le. 0.) then
+      cgszll = 0.
+      return
+    else
+      ymerc = - log( efact /(1. + sin(radpdg * xlat)))
+    endif
+  else if (xlat .lt. -89.985) then
+  !* Close to south pole
+    if (strcmp(1) .lt. -0.9999) then
+  !* and to gamma == -1.0
+      cgszll = 2. * strcmp(7)
+      return
+    endif
+    efact = cos(radpdg * xlat)
+    if (efact .le. 0.) then
+      cgszll = 0.
+      return
+    else
+      ymerc = log( efact /(1. - sin(radpdg * xlat)))
+    endif
+  else
+  slat = sin(radpdg * xlat)
+  ymerc = log((1. + slat) / (1. - slat))/2.
+  !efact = exp(ymerc)
+  !cgszll = 2. * strcmp(7) * exp (strcmp(1) * ymerc)
+  !c			 / (efact + 1./efact)
+  endif
+  cgszll = strcmp(7) * cos(radpdg * xlat) * exp(strcmp(1) *ymerc)
+  return
+end function cgszll
+
+real function cgszxy (strcmp, x,y)
+  !*  Written on 3/31/94 by Dr. Albion Taylor  NOAA / OAR / ARL
+
+  use par_mod, only: dp
+
+  implicit none
+
+  real :: strcmp(9) , x, y
+  real(kind=dp) :: ymerc,efact, radial, temp
+  real(kind=dp) :: xi0,eta0,xi,eta
+
+
+  xi0 = ( x - strcmp(3) ) * strcmp(7) / rearth
+  eta0 = ( y - strcmp(4) ) * strcmp(7) /rearth
+  xi = xi0 * strcmp(5) - eta0 * strcmp(6)
+  eta = eta0 * strcmp(5) + xi0 * strcmp(6)
+  radial = 2. * eta - strcmp(1) * (xi*xi + eta*eta)
+  efact = strcmp(1) * radial
+  if (efact .gt. almst1) then
+    if (strcmp(1).gt.almst1) then
+      cgszxy = 2. * strcmp(7)
+    else
+      cgszxy = 0.
+    endif
+    return
+  endif
+  if (abs(efact) .lt. 1.e-2) then
+    temp = (efact / (2. - efact) )**2
+    ymerc = radial / (2. - efact) * (1.    + temp * &
+         (1./3. + temp * &
+         (1./5. + temp * &
+         (1./7. ))))
+  else
+    ymerc = - log( 1. - efact ) /2. /strcmp(1)
+  endif
+  if (ymerc .gt. 6.) then
+    if (strcmp(1) .gt. almst1) then
+      cgszxy = 2. * strcmp(7)
+    else
+      cgszxy = 0.
+    endif
+  else if (ymerc .lt. -6.) then
+    if (strcmp(1) .lt. -almst1) then
+      cgszxy = 2. * strcmp(7)
+    else
+      cgszxy = 0.
+    endif
+  else
+    efact = exp(ymerc)
+    cgszxy = 2. * strcmp(7) * exp (strcmp(1) * ymerc) &
+         / (efact + 1./efact)
+  endif
+  return
+end function cgszxy
+
+subroutine cll2xy (strcmp, xlat,xlong, x,y)
+  !*  Written on 3/31/94 by Dr. Albion Taylor  NOAA / OAR / ARL
+
+  implicit none
+
+  real :: strcmp(9) , xlat, xlong, x, y, xi, eta
+
+  call cnllxy(strcmp, xlat,xlong, xi,eta)
+  x = strcmp(3) + rearth/strcmp(7) * &
+       (xi * strcmp(5) + eta * strcmp(6) )
+  y = strcmp(4) + rearth/strcmp(7) * &
+       (eta * strcmp(5) - xi * strcmp(6) )
+  return
+end subroutine cll2xy
+
+subroutine cnllxy (strcmp, xlat,xlong, xi,eta)
+  !*  Written on 3/31/94 by Dr. Albion Taylor  NOAA / OAR / ARL
+  !  main transformation routine from latitude-longitude to
+  !  canonical (equator-centered, radian unit) coordinates
+
+  use par_mod, only: dp
+
+  implicit none
+
+  real :: strcmp(9), xlat, xlong, xi, eta, &
+       gdlong, sndgam, csdgam, rhog1
+  real(kind=dp) :: gamma
+  real(kind=dp) :: dlong,dlat,slat,mercy,gmercy
+
+  gamma = strcmp(1)
+  dlat = xlat
+  dlong = cspanf(xlong - strcmp(2), -180., 180.)
+  dlong = dlong * radpdg
+  gdlong = gamma * dlong
+  if (abs(gdlong) .lt. .01) then
+  !  Code for gamma small or zero.  This avoids round-off error or divide-
+  !  by zero in the case of mercator or near-mercator projections.
+    gdlong = gdlong * gdlong
+    sndgam = dlong * (1. - 1./6. * gdlong * &
+         (1. - 1./20. * gdlong * &
+         (1. - 1./42. * gdlong )))
+    csdgam = dlong * dlong * .5 * &
+         (1. - 1./12. * gdlong * &
+         (1. - 1./30. * gdlong * &
+         (1. - 1./56. * gdlong )))
+  else
+  ! Code for moderate values of gamma
+    sndgam = sin (gdlong) /gamma
+    csdgam = (1. - cos(gdlong) )/gamma /gamma
+  endif
+  slat = sin(radpdg * dlat)
+  if ((slat .ge. almst1) .or. (slat .le. -almst1)) then
+    eta = 1./strcmp(1)
+    xi = 0.
+    return
+  endif
+  mercy = .5 * log( (1. + slat) / (1. - slat) )
+  gmercy = gamma * mercy
+  if (abs(gmercy) .lt. .001) then
+  !  Code for gamma small or zero.  This avoids round-off error or divide-
+  !  by zero in the case of mercator or near-mercator projections.
+    rhog1 = mercy * (1. - .5 * gmercy * &
+         (1. - 1./3. * gmercy * &
+         (1. - 1./4. * gmercy ) ) )
+  else
+  ! Code for moderate values of gamma
+    rhog1 = (1. - exp(-gmercy)) / gamma
+  endif
+  eta = rhog1 + (1. - gamma * rhog1) * gamma * csdgam
+  xi = (1. - gamma * rhog1 ) * sndgam
+end subroutine cnllxy
+
+subroutine cnxyll (strcmp, xi,eta, xlat,xlong)
+  !*  Written on 3/31/94 by Dr. Albion Taylor  NOAA / OAR / ARL
+  !  main transformation routine from canonical (equator-centered,
+  !  radian unit) coordinates
+
+  use par_mod, only: dp
+
+  implicit none
+
+  real :: strcmp(9), xlat, xlong, odist
+  real(kind=dp) :: gamma,temp,arg1,arg2,ymerc,along,gxi,cgeta
+  real(kind=dp) :: xi,eta
+
+  gamma = strcmp(1)
+  !  Calculate equivalent mercator coordinate
+  odist = xi*xi + eta*eta
+  arg2 = 2. * eta - gamma * (xi*xi + eta*eta)
+  arg1 = gamma * arg2
+  ! Change by A. Stohl to avoid problems close to the poles
+  ! if (arg1 .ge. almst1) then
+  !  distance to north (or south) pole is zero (or imaginary ;) )
+  ! xlat = sign(90.,strcmp(1))
+  ! xlong = strcmp(2)
+  ! return
+  ! endif
+  if (abs(arg1) .lt. .01) then
+  !  Code for gamma small or zero.  This avoids round-off error or divide-
+  !  by zero in the case of mercator or near-mercator projections.
+    temp = (arg1 / (2. - arg1) )**2
+    ymerc = arg2 / (2. - arg1) * (1.    + temp * &
+         (1./3. + temp * &
+         (1./5. + temp * &
+         (1./7. ))))
+  else
+  ! Code for moderate values of gamma
+    ymerc = - log ( 1. - arg1 ) /2. / gamma
+  endif
+  ! Convert ymerc to latitude
+  temp = exp( - abs(ymerc) )
+  xlat = sign(atan2((1. - temp) * (1. + temp), 2. * temp), ymerc)
+  ! Find longitudes
+  gxi = gamma*xi
+  cgeta = 1. - gamma * eta
+  if ( abs(gxi) .lt. .01*cgeta ) then
+  !  Code for gamma small or zero.  This avoids round-off error or divide-
+  !  by zero in the case of mercator or near-mercator projections.
+    temp = ( gxi /cgeta )**2
+    along = xi / cgeta * (1.    - temp * &
+         (1./3. - temp * &
+         (1./5. - temp * &
+         (1./7.   ))))
+  else
+  ! Code for moderate values of gamma
+    along = atan2( gxi, cgeta) / gamma
+  endif
+  xlong = sngl(strcmp(2) + dgprad * along)
+  xlat = xlat * dgprad
+  return
+end subroutine cnxyll
+
+subroutine cpolll (strcmp, xlat,xlong, enx,eny,enz)
+  !*  Written on 11/23/94 by Dr. Albion Taylor  NOAA / OAR / ARL
+
+  use par_mod, only: dp
+
+  implicit none
+
+  real(kind=dp) :: xpolg,ypolg,along,slong,clong,rot
+  real :: strcmp(9), xlat, xlong, enx, eny, enz, clat
+
+  along = cspanf( xlong - strcmp(2), -180., 180.)
+  rot = - strcmp(1) * along
+  slong = sin( radpdg * rot )
+  clong = cos( radpdg * rot )
+  xpolg = slong * strcmp(5) + clong * strcmp(6)
+  ypolg = clong * strcmp(5) - slong * strcmp(6)
+  clat = cos(radpdg * xlat)
+  enx = clat * xpolg
+  eny = clat * ypolg
+  enz = sin(radpdg * xlat)
+  return
+end subroutine cpolll
+
+subroutine cpolxy (strcmp, x,y, enx,eny,enz)
+  !*  Written on 11/26/94 by Dr. Albion Taylor  NOAA / OAR / ARL
+
+  use par_mod, only: dp
+
+  implicit none
+
+  real :: strcmp(9) , x, y, enx, eny, enz
+  real(kind=dp) :: xpol,ypol,temp,xi0,eta0,xi,eta,radial
+  real(kind=dp) :: temp2,ymerc,arg,oarg,clat
+
+  xi0 = ( x - strcmp(3) ) * strcmp(7) / rearth
+  eta0 = ( y - strcmp(4) ) * strcmp(7) /rearth
+  xi = xi0 * strcmp(5) - eta0 * strcmp(6)
+  eta = eta0 * strcmp(5) + xi0 * strcmp(6)
+  radial = 2. * eta -  strcmp(1) * (xi*xi + eta*eta)
+  temp = strcmp(1) * radial
+  if (temp .ge. 1.) then
+    enx = 0.
+    eny = 0.
+    enz = sign(1.,strcmp(1))
+    return
+  endif
+  if (abs(temp).lt.1.e-2) then
+    temp2 = (temp / (2. - temp))**2
+    ymerc = radial / (2. - temp) * (1. + temp2 * &
+         (1./3. + temp2 * &
+         (1./5. + temp2 * &
+         (1./7.))))
+  else
+    ymerc = -.5 * log(1. - temp) / strcmp(1)
+  endif
+  arg = exp( ymerc )
+  oarg = 1./arg
+  clat = 2./(arg + oarg)
+  enz = (arg - oarg) * clat /2.
+  temp = clat / sqrt(1. - temp)
+  xpol = - xi * strcmp(1) * temp
+  ypol = (1. - eta * strcmp(1) ) * temp
+  enx = xpol * strcmp(5) + ypol * strcmp(6)
+  eny = ypol * strcmp(5) - xpol * strcmp(6)
+  return
+end subroutine cpolxy
+
+real function cspanf (value, begin, end)
+  !*  Written on 3/31/94 by Dr. Albion Taylor  NOAA / OAR / ARL
+  !* real function cspanf returns a value in the interval (begin,end]
+  !* which is equivalent to value, mod (end - begin).  It is used to
+  !* reduce periodic variables to a standard range.  It adjusts for the
+  !* behavior of the mod function which provides positive results for
+  !* positive input, and negative results for negative input
+  !* input:
+  !*       value - real number to be reduced to the span
+  !*       begin - first value of the span
+  !*       end   - last value of the span
+  !* returns:
+  !*       the reduced value
+  !* examples:
+  !*      along = cspanf(xlong, -180., +180.)
+  !*      dir  = cspanf(angle, 0., 360.)
+
+  implicit none
+
+  real :: first,last, value, begin, end, val
+
+  first = min(begin,end)
+  last = max(begin,end)
+  val = mod( value - first , last - first)
+  if ( val .le. 0.) then
+    cspanf = val + last
+  else
+    cspanf = val + first
+  endif
+  return
+end function cspanf
+
+subroutine cxy2ll (strcmp, x,y, xlat,xlong)
+  !*  Written on 3/31/94 by Dr. Albion Taylor  NOAA / OAR / ARL
+
+  use par_mod, only: dp
+
+  implicit none
+
+  real(kind=dp) :: xi0,eta0,xi,eta
+  real :: strcmp(9), x, y, xlat, xlong
+
+  xi0 = ( x - strcmp(3) ) * strcmp(7) / rearth
+  eta0 = ( y - strcmp(4) ) * strcmp(7) /rearth
+  xi = xi0 * strcmp(5) - eta0 * strcmp(6)
+  eta = eta0 * strcmp(5) + xi0 * strcmp(6)
+  call cnxyll(strcmp, xi,eta, xlat,xlong)
+  xlong = cspanf(xlong, -180., 180.)
+  return
+end subroutine cxy2ll
+
+real function eqvlat (xlat1,xlat2)
+  !*  Written on 3/31/94 by Dr. Albion Taylor  NOAA / OAR / ARL
+
+  implicit none
+
+  real :: xlat1, xlat2, x, ssind, sinl1, sinl2, al1, al2, tau
+
+  ssind(x) = sin (radpdg*x)
+  sinl1 = ssind (xlat1)
+  sinl2 = ssind (xlat2)
+  if (abs(sinl1 - sinl2) .gt. .001) then
+    al1 = log((1. - sinl1)/(1. - sinl2))
+    al2 = log((1. + sinl1)/(1. + sinl2))
+  else
+  !  Case lat1 near or equal to lat2
+    tau = - (sinl1 - sinl2)/(2. - sinl1 - sinl2)
+    tau = tau*tau
+    al1  = 2. / (2. - sinl1 - sinl2) * (1.    + tau * &
+         (1./3. + tau * &
+         (1./5. + tau * &
+         (1./7.))))
+    tau =   (sinl1 - sinl2)/(2. + sinl1 + sinl2)
+    tau = tau*tau
+    al2  = -2. / (2. + sinl1 + sinl2) * (1.    + tau * &
+         (1./3. + tau * &
+         (1./5. + tau * &
+         (1./7.))))
+  endif
+  eqvlat = asin((al1 + al2) / (al1 - al2))/radpdg
+  return
+end function eqvlat
+
+subroutine stcm1p(strcmp, x1,y1, xlat1,xlong1, &
+       xlatg,xlongg, gridsz, orient)
+  !*  Written on 3/31/94 by Dr. Albion Taylor  NOAA / OAR / ARL
+
+  implicit none
+
+  integer :: k
+  real :: strcmp(9), x1, y1, xlat1, xlong1, turn, orient, &
+       xlatg, xlongg, gridsz, x1a, y1a
+
+  do k=3,4
+    strcmp (k) = 0.
+  enddo
+    turn = radpdg * (orient - strcmp(1) * &
+         cspanf(xlongg - strcmp(2), -180., 180.) )
+  strcmp (5) = cos (turn)
+  strcmp (6) = - sin (turn)
+  strcmp (7) = 1.
+  strcmp (7) = gridsz * strcmp(7) &
+       / cgszll(strcmp, xlatg, strcmp(2))
+  call cll2xy (strcmp, xlat1,xlong1, x1a,y1a)
+  strcmp(3) = strcmp(3) + x1 - x1a
+  strcmp(4) = strcmp(4) + y1 - y1a
+  return
+end subroutine stcm1p
+
+subroutine stcm2p(strcmp, x1,y1, xlat1,xlong1, &
+       x2,y2, xlat2,xlong2)
+  !*  Written on 3/31/94 by Dr. Albion Taylor  NOAA / OAR / ARL
+
+  implicit none
+
+  real :: strcmp(9), x1, y1, xlat1, xlong1, &
+       x2, y2, xlat2, xlong2
+
+  integer :: k
+  real    :: x1a, y1a, x2a, y2a, den, dena
+
+  do k=3,6
+    strcmp (k) = 0.
+  enddo
+  strcmp (5) = 1.
+  strcmp (7) = 1.
+  call cll2xy (strcmp, xlat1,xlong1, x1a,y1a)
+  call cll2xy (strcmp, xlat2,xlong2, x2a,y2a)
+  den = sqrt( (x1 - x2)**2 + (y1 - y2)**2 )
+  dena = sqrt( (x1a - x2a)**2 + (y1a - y2a)**2 )
+  strcmp(5) = ((x1a - x2a)*(x1 - x2) + (y1a - y2a) * (y1 - y2)) &
+       /den /dena
+  strcmp(6) = ((y1a - y2a)*(x1 - x2) - (x1a - x2a) * (y1 - y2)) &
+       /den /dena
+  strcmp (7) = strcmp(7) * dena / den
+  call cll2xy (strcmp, xlat1,xlong1, x1a,y1a)
+  strcmp(3) = strcmp(3) + x1 - x1a
+  strcmp(4) = strcmp(4) + y1 - y1a
+  return
+end subroutine stcm2p
+
+!*  General conformal map routines for meteorological modelers
+!*  written on 3/31/94 by
+
+!* Dr. Albion Taylor
+!* NOAA / OAR / ARL                  phone: (301) 713-0295 x 132
+!* rm. 3151, 1315 east-west highway  fax:   (301) 713-0119
+!* silver spring, md 20910           e-mail: adtaylor@arlrisc.ssmc.noaa.gov
+
+!*  subroutine stlmbr (strcmp, tnglat, clong)
+!*    This routine initializes the map structure array strcmp to
+!*    the form of a specific map projection
+!*  inputs:
+!*    tnglat - the latitude at which the projection will be tangent
+!*             to the earth.  +90. For north polar stereographic,
+!*             -90. for south polar stereographic, 0. For mercator,
+!*             and other values for lambert conformal.
+!*             -90 <= tnglat <= 90.
+!*    clong -  a longitude in the region under consideration.  Longitudes
+!*             between clong-180. and clong+180.  Will be mapped in one
+!*             connected region
+!*  outputs:
+!*    strcmp - a 9-value map structure array for use with subsequent
+!*             calls to the coordinate transform routines.
+!*
+!*  real function eqvlat (xlat1,xlat2)
+!*    This function is provided to assist in finding the tangent latitude
+!*    equivalent to the 2-reference latitude specification in the legend
+!*    of most lambert conformal maps.  If the map specifies "scale
+!*    1:xxxxx true at 40n and 60n", then eqvlat(40.,60.) will return the
+!*    equivalent tangent latitude.
+!*  inputs:
+!*    xlat1,xlat2:  the two latitudes specified in the map legend
+!*  returns:
+!*    the equivalent tangent latitude
+!*  example:  call stlmbr(strcmp, eqvlat(40.,60.), 90.)
+
+!*  subroutine stcm2p (strcmp, x1,y1, xlat1,xlong1,
+!*          x2,y2, xlat2,xlong2)
+!*  subroutine stcm1p (strcmp, x1,y1, xlat1,xlong1,
+!*          xlatg,xlongg, gridsz, orient)
+!*    These routines complete the specification of the map structure
+!*    array by conforming the map coordinates to the specifications
+!*    of a particular grid.  Either stcm1p or stcm2p must be called,
+!*    but not both
+!*  inputs:
+!*    strcmp - a 9-value map structure array, set to a particular map
+!*             form by a previous call to stlmbr
+!*    for stcm2p:
+!*      x1,y1, x2,y2 - the map coordinates of two points on the grid
+!*      xlat1,xlong1, xlat2,xlong2 - the geographic coordinates of the
+!*             same two points
+!*    for stcm1p:
+!*      x1,y1 - the map coordinates of one point on the grid
+!*      xlat1,xlong1 - the geographic coordinates of the same point
+!*      xlatg,xlongg - latitude and longitude of reference point for
+!*             gridsz and orientation specification.
+!*      gridsz - the desired grid size in kilometers, at xlatg,xlongg
+!*      orient - the angle, with respect to north, of a y-grid line, at
+!*             the point xlatg,xlongg
+!*  outputs:
+!*    strcmp - a 9-value map structure array, fully set for use by
+!*             other subroutines in this system
+
+!*  subroutine cll2xy (strcmp, xlat,xlong, x,y)
+!*  subroutine cxy2ll (strcmp, x,y, xlat,xlong)
+!*     these routines convert between map coordinates x,y
+!*     and geographic coordinates xlat,xlong
+!*  inputs:
+!*     strcmp(9) - 9-value map structure array
+!*     for cll2xy:  xlat,xlong - geographic coordinates
+!*     for cxy2ll:  x,y - map coordinates
+!*  outputs:
+!*     for cll2xy:  x,y - map coordinates
+!*     for cxy2ll:  xlat,xlong - geographic coordinates
+
+!*  subroutine cc2gxy (strcmp, x,y, ue,vn, ug,vg)
+!*  subroutine cg2cxy (strcmp, x,y, ug,vg, ue,vn)
+!*  subroutine cc2gll (strcmp, xlat,xlong, ue,vn, ug,vg)
+!*  subroutine cg2cll (strcmp, xlat,xlong, ug,vg, ue,vn)
+!*     These subroutines convert vector wind components from
+!*     geographic, or compass, coordinates, to map or
+!*     grid coordinates.  The site of the wind to be
+!*     converted may be given either in geographic or
+!*     map coordinates.  Wind components are all in kilometers
+!*     per hour, whether geographic or map coordinates.
+!*  inputs:
+!*    strcmp(9) - 9-value map structure array
+!*    for cc2gxy and cg2cxy:  x,y        -  map coordinates of site
+!*    for cc2gll and cg2cll:  xlat,xlong -  geographic coordinates of site
+!*    for cc2gxy and cc2gll:  ue,vn - east and north wind components
+!*    for cg2cxy and cg2cll:  ug,vg - x- and y- direction wind components
+!*  outputs:
+!*    for cc2gxy and cc2gll:  ug,vg - x- and y- direction wind components
+!*    for cg2cxy and cg2cll:  ue,vn - east and north wind components
+
+!*  subroutine ccrvxy (strcmp, x, y,       gx,gy)
+!*  subroutine ccrvll (strcmp, xlat,xlong, gx,gy)
+!*    These subroutines return the curvature vector (gx,gy), as referenced
+!*    to map coordinates, induced by the map transformation.  When
+!*    non-linear terms in wind speed are important, a "geodesic" force
+!*    should be included in the vector form [ (u,u) g - (u,g) u ] where the
+!*    inner product (u,g) is defined as ux*gx + uy*gy.
+!*  inputs:
+!*    strcmp(9) - 9-value map structure array
+!*    for ccrvxy:  x,y        -  map coordinates of site
+!*    for ccrvll:  xlat,xlong -  geographic coordinates of site
+!*  outputs:
+!*    gx,gy       - vector coefficients of curvature, in units radians
+!*                  per kilometer
+
+!*  real function cgszll (strcmp, xlat,xlong)
+!*  real function cgszxy (strcmp, x,y)
+!*    These functions return the size, in kilometers, of each unit of
+!*    motion in map coordinates (grid size).  The grid size at any
+!*    location depends on that location; the position may be given in
+!*    either map or geographic coordinates.
+!*  inputs:
+!*    strcmp(9) - 9-value map structure array
+!*    for cgszxy:  x,y        -  map coordinates of site
+!*    for cgszll:  xlat,xlong -  geographic coordinates of site
+!*  returns:
+!*    gridsize in kilometers at given site.
+
+!*  subroutine cpolxy (strcmp, x,y, enx,eny,enz)
+!*  subroutine cpolll (strcmp, xlat,xlong, enx,eny,enz)
+!*    These subroutines provide 3-d vector components of a unit vector
+!*    in the direction of the north polar axis.  When multiplied
+!*    by twice the rotation rate of the earth (2 * pi/24 hr), the
+!*    vertical component yields the coriolis factor.
+!*  inputs:
+!*    strcmp(9) - 9-value map structure array
+!*    for cpolxy:  x,y        -  map coordinates of site
+!*    for cpolll:  xlat,xlong -  geographic coordinates of site
+!*  returns:
+!*    enx,eny,enz the direction cosines of a unit vector in the
+!*    direction of the rotation axis of the earth
+
+!*  subroutine cnllxy (strcmp, xlat,xlong, xi,eta)
+!*  subroutine cnxyll (strcmp, xi,eta, xlat,xlong)
+!*    These subroutines perform the underlying transformations from
+!*    geographic coordinates to and from canonical (equator centered)
+!*    coordinates.  They are called by cxy2ll and cll2xy, but are not
+!*    intended to be called directly
+
+!*  real function cspanf (value, begin, end)
+!*    This function assists other routines in providing a longitude in
+!*    the proper range.  It adds to value whatever multiple of
+!*    (end - begin) is needed to return a number begin < cspanf <= end
+
+subroutine stlmbr(strcmp, tnglat, xlong)
+  !*  Written on 3/31/94 by Dr. Albion Taylor  NOAA / OAR / ARL
+
+  implicit none
+
+  real :: strcmp(9), tnglat, xlong
+
+  real :: eta, xi
+
+  strcmp(1) = sin(radpdg * tnglat)
+  !*  gamma = sine of the tangent latitude
+  strcmp(2) = cspanf( xlong, -180., +180.)
+  !* lambda_0 = reference longitude
+  strcmp(3) = 0.
+  !* x_0 = x- grid coordinate of origin (xi,eta) = (0.,0.)
+  strcmp(4) = 0.
+  !* y_0 = y-grid coordinate of origin (xi,eta) = (0.,0.)
+  strcmp(5) = 1.
+  !* Cosine of rotation angle from xi,eta to x,y
+  strcmp(6) = 0.
+  !* Sine of rotation angle from xi,eta to x,y
+  strcmp(7) = rearth
+  !* Gridsize in kilometers at the equator
+  call cnllxy(strcmp, 89.,xlong, xi,eta)
+  strcmp(8) = 2. * eta - strcmp(1) * eta * eta
+  !* Radial coordinate for 1 degree from north pole
+  call cnllxy(strcmp, -89.,xlong, xi,eta)
+  strcmp(9) = 2. * eta - strcmp(1) * eta * eta
+  !* Radial coordinate for 1 degree from south pole
+  return
+end subroutine stlmbr
+
+end module cmapf_mod
Index: /branches/FP_AI/src/com_mod.f90
===================================================================
--- /branches/FP_AI/src/com_mod.f90	(revision 23)
+++ /branches/FP_AI/src/com_mod.f90	(revision 23)
@@ -0,0 +1,691 @@
+!*******************************************************************************
+!        Include file for particle diffusion model FLEXPART                    *
+!        This file contains a global common block used by FLEXPART             *
+!                                                                              *
+!        Author: A. Stohl                                                      *
+!                                                                              *
+!        June 1996                                                             *
+!                                                                              *
+!        Last update:15 August 2013 IP                                         *
+!                                                                              *
+!*******************************************************************************
+
+module com_mod
+
+  use par_mod, only: dp, numpath, maxnests, maxageclass, maxspec, ni, &
+       numclass, nymax, nxmax, maxcolumn, maxwf, nzmax, nxmaxn, nymaxn, &
+       maxreceptor, maxpart, maxrand, nwzmax, nuvzmax
+
+  implicit none
+
+  !****************************************************************
+  ! Variables defining where FLEXPART input/output files are stored
+  !****************************************************************
+
+  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
+  !********************************************************
+
+  integer :: ibdate,ibtime,iedate,ietime
+  real(kind=dp) :: bdate,edate
+
+
+  ! ibdate                  beginning date (YYYYMMDD)
+  ! ibtime                  beginning time (HHMISS)
+  ! iedate                  ending date (YYYYMMDD)
+  ! ietime                  ending time (HHMISS)
+  ! bdate                   beginning date of simulation (julian date)
+  ! edate                   ending date of simulation (julian date)
+
+
+  integer :: ldirect,ideltas
+
+  ! ldirect                 1 for forward, -1 for backward simulation
+  ! ideltas                 length of trajectory loop from beginning to
+  !                    ending date (s)
+
+  integer :: loutstep,loutaver,loutsample,method,lsynctime
+  real :: outstep
+
+  ! loutstep [s]            gridded concentration output every loutstep seconds
+  ! loutaver [s]            concentration output is an average over [s] seconds
+  ! loutsample [s]          sampling interval of gridded concentration output
+  ! lsynctime [s]           synchronisation time of all particles
+  ! method                  indicator which dispersion method is to be used
+  ! outstep = real(abs(loutstep))
+
+  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,surf_only
+  logical :: turbswitch
+
+  ! ctl      factor, by which time step must be smaller than Lagrangian time scale
+  ! ifine    reduction factor for time step used for vertical wind
+  !     Langevin equation for the vertical wind component
+  ! ioutputforeachrelease Should each release be a seperate output field?
+  ! iflux    flux calculation options: 1 calculation of fluxes, 2 no fluxes
+  ! iout     output options: 1 conc. output (ng/m3), 2 mixing ratio (pptv), 3 both
+  ! ipout    particle dump options: 0 no, 1 every output interval, 2 only at end
+  ! ipin     read in particle positions from dumped file from a previous run
+  ! fine     real(ifine)
+  ! mdomainfill 0: normal run
+  !        1: particles are initialized according to atmospheric mass distribution
+  ! ind_source switches between different units for concentrations at the source
+  !  NOTE that in backward simulations the release of computational particles
+  !  takes place at the "receptor" and the sampling of particles at the "source".
+  !     1= mass units
+  !     2= mass mixing ratio units
+  ! ind_receptor switches between different units for FLEXPART concentration at the receptor
+  !     1= mass units
+  !     2= mass mixing ratio units
+  ! linit_cond  switch on the output of sensitivity to initial conditions for backward runs
+  !     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
+
+  ! ind_rel and ind_samp  are used within the code to change between mass and mass-mix (see readcommand.f)
+
+
+  integer :: mintime,itsplit
+
+  ! mintime                 minimum time step to be used by FLEXPART
+  ! itsplit                 time constant for splitting particles
+
+  integer :: lsubgrid,lconvection,lagespectra
+
+  ! lsubgrid     1 if subgrid topography parameterization switched on, 2 if not
+  ! lconvection  1 if convection parameterization switched on, 0 if not
+  ! lagespectra  1 if age spectra calculation switched on, 2 if not
+
+
+  integer :: nageclass,lage(maxageclass)
+
+  ! nageclass               number of ageclasses for the age spectra calculation
+  ! lage [s]                ageclasses for the age spectra calculation
+
+
+  logical :: gdomainfill
+
+  ! gdomainfill             .T., if domain-filling is global, .F. if not
+
+
+
+  !*********************************************************************
+  ! Variables defining the release locations, released species and their
+  ! properties, etc.
+  !*********************************************************************
+
+  !change Sabine Eckhardt, only save the first 1000 identifier for releasepoints
+  character :: compoint(1001)*45
+  integer :: numpoint
+  !sec, now dynamically allocated:
+  ! ireleasestart(maxpoint),ireleaseend(maxpoint)
+  !      real xpoint1(maxpoint),ypoint1(maxpoint)
+  !real xpoint2(maxpoint),ypoint2(maxpoint)
+  !real zpoint1(maxpoint),zpoint2(maxpoint)
+  !integer*2 kindz(maxpoint)
+  integer :: specnum(maxspec)
+  !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)
+  real :: vset(maxspec,ni),schmi(maxspec,ni),fract(maxspec,ni)
+  real :: ri(5,numclass),rac(5,numclass),rcl(maxspec,5,numclass)
+  real :: rgs(maxspec,5,numclass),rlu(maxspec,5,numclass)
+  real :: rm(maxspec),dryvel(maxspec),kao(maxspec),ohreact(maxspec)
+  ! se  it is possible to associate a species with a second one to make transfer from gas to aerosol
+  integer :: spec_ass(maxspec)
+
+  real :: area_hour(maxspec,24),point_hour(maxspec,24)
+  real :: area_dow(maxspec,7),point_dow(maxspec,7)
+
+  !integer npart(maxpoint)
+  integer :: nspec,maxpointspec_act
+  character(len=10) :: species(maxspec)
+
+
+  ! compoint                comment, also "name" of each starting point
+  ! numpoint                actual number of trajectory starting/ending points
+  ! ireleasestart,ireleaseend [s] starting and ending time of each release
+  ! xmass                   total mass emitted
+  ! xpoint1,ypoint1         lower left coordinates of release area
+  ! xpoint2,ypoint2         upper right coordinates of release area
+  ! zpoint1,zpoint2         min./max. z-coordinates of release points
+  ! kindz                   1: zpoint is in m agl, 2: zpoint is in m asl
+  ! npart                   number of particles per release point
+  ! nspec                   number of different species allowed for one release
+  ! maxpointspec_act        number of releaspoints for which a different output shall be created
+  ! species                 name of species
+  ! decay                   decay constant of radionuclide
+
+  ! WET DEPOSITION
+  ! 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
+  ! henry [M/atm]           Henry constant
+  ! f0                      reactivity relative to that of O3
+  ! ri [s/m]                stomatal resistance
+  ! rcl [s/m]               lower canopy resistance
+  ! rgs [s/m]               ground resistance
+  ! rlu [s/m]               leaf cuticular resistance
+  ! rm [s/m]                mesophyll resistance
+  ! dryvel [m/s]            constant dry deposition velocity
+
+  ! PARTICLE DEPOSITION
+  ! density [kg/m3]         density of particles
+  ! dquer [m]               mean diameter of particles
+  ! dsigma                  dsigma=10 or dsigma=0.1 means that 68% of the
+  !                    mass are between 0.1*dquer and 10*dquer
+
+  ! fract                   mass fraction of each diameter interval
+  ! vset [m/s]              gravitational settling velocity in ni intervals
+  ! cunningham              Cunningham slip correction (strictly valid only near surface)
+  ! vsetaver [m/s]          average gravitational settling velocity
+  ! schmi                   Schmidt number**2/3 of each diameter interval
+  ! weightmolar [g/mol]     molecular weight
+
+  ! TIME VARIATION OF EMISSION
+  ! area_hour, point_hour   daily variation of emission strengths for area and point sources
+  ! area_dow, point_dow     day-of-week variation of emission strengths for area and point sources
+
+
+
+  !**********************************************************
+  ! Variables used for domain-filling trajectory calculations
+  !**********************************************************
+
+  integer :: nx_we(2),ny_sn(2)
+  integer :: numcolumn
+  integer :: numcolumn_we(2,0:nymax-1),numcolumn_sn(2,0:nxmax-1)
+  real :: zcolumn_we(2,0:nymax-1,maxcolumn)
+  real :: zcolumn_sn(2,0:nxmax-1,maxcolumn)
+  real :: xmassperparticle
+  real :: acc_mass_we(2,0:nymax-1,maxcolumn)
+  real :: acc_mass_sn(2,0:nxmax-1,maxcolumn)
+
+  ! nx_we(2)                x indices of western and eastern boundary of domain-filling
+  ! ny_sn(2)                y indices of southern and northern boundary of domain-filling
+  ! numcolumn_we            number of particles to be released within one column
+  !                    at the western and eastern boundary surfaces
+  ! numcolumn_sn            same as numcolumn_we, but for southern and northern domain boundary
+  ! numcolumn               maximum number of particles to be released within a single
+  !                    column
+  ! zcolumn_we              altitudes where particles are to be released
+  !                    at the western and eastern boundary surfaces
+  ! zcolumn_sn              same as zcolumn_we, but for southern and northern domain boundary
+  ! xmassperparticle        air mass per particle in the domain-filling traj. option
+  ! acc_mass_we             mass that has accumulated at the western and eastern boundary;
+  !                    if it exceeds xmassperparticle, a particle is released and
+  !                    acc_mass_we is reduced accordingly
+  ! acc_mass_sn             same as acc_mass_we, but for southern and northern domain boundary
+
+
+
+  !******************************************************************************
+  ! Variables associated with the ECMWF meteorological input data ("wind fields")
+  !******************************************************************************
+
+  integer :: numbwf,wftime(maxwf),lwindinterv
+  character(len=255) :: wfname(maxwf),wfspec(maxwf)
+
+  ! lwindinterv [s]         Interval between wind fields currently in memory
+  ! numbwf                  actual number of wind fields
+  ! wftime(maxwf) [s]       times relative to beginning time of wind fields
+  ! wfname(maxwf)           file names of wind fields
+  ! wfspec(maxwf)           specifications of wind field file, e.g. if on hard
+  !                    disc or on tape
+
+  integer :: memtime(2),memind(2)
+
+  ! memtime [s]             validation times of wind fields in memory
+  ! memind                  pointer to wind field, in order to avoid shuffling
+  !                    of wind fields
+
+
+
+  !****************************************************************************
+  ! Variables defining actual size and geographical location of the wind fields
+  !****************************************************************************
+
+  integer :: nx,ny,nxmin1,nymin1,nxfield,nuvz,nwz,nz,nmixz,nlev_ec
+  real :: dx,dy,xlon0,ylat0,dxconst,dyconst,height(nzmax)
+
+  ! nx,ny,nz                actual dimensions of wind fields in x,y and z
+  !                    direction, respectively
+  ! nxmin1,nymin1           nx-1, ny-1, respectively
+  ! nuvz,nwz                vertical dimension of original ECMWF data
+  ! nxfield                 same as nx for limited area fields,
+  !                    but for global fields nx=nxfield+1
+  ! nmixz                   number of levels up to maximum PBL height (3500 m)
+
+  ! nuvz is used for u,v components
+  ! nwz is used for w components (staggered grid)
+  ! nz is used for the levels in transformed coordinates (terrain-following Cartesian
+  ! coordinates)
+
+  ! nlev_ec  number of levels ECMWF model
+  ! dx                      grid distance in x direction
+  ! dy                      grid distance in y direction
+  ! dxconst,dyconst         auxiliary variables for utransform,vtransform
+  ! height                  heights of all levels
+  ! xlon0                   geographical longitude and
+  ! ylat0                   geographical latitude of lower left grid point
+
+
+
+  !*************************************************
+  ! Variables used for vertical model discretization
+  !*************************************************
+
+  real :: akm(nwzmax),bkm(nwzmax)
+  real :: akz(nuvzmax),bkz(nuvzmax)
+  real :: aknew(nzmax),bknew(nzmax)
+
+  ! akm,bkm: coeffizients which regulate vertical discretization of ecmwf model
+  !     (at the border of model layers)
+  ! akz,bkz: model discretization coeffizients at the centre of the layers
+  ! aknew,bknew model discretization coeffizients at the interpolated levels
+
+
+
+  ! Fixed fields, unchangeable with time
+  !*************************************
+
+  real :: oro(0:nxmax-1,0:nymax-1)
+  real :: excessoro(0:nxmax-1,0:nymax-1)
+  real :: lsm(0:nxmax-1,0:nymax-1)
+  real :: xlanduse(0:nxmax-1,0:nymax-1,numclass)
+
+  ! oro [m]              orography of the ECMWF model
+  ! excessoro            excess orography mother domain
+  ! lsm                  land sea mask of the ECMWF model
+  ! xlanduse [0-1]       area fractions in percent
+
+  ! 3d fields
+  !**********
+
+  real :: uu(0:nxmax-1,0:nymax-1,nzmax,2)
+  real :: vv(0:nxmax-1,0:nymax-1,nzmax,2)
+  real :: uupol(0:nxmax-1,0:nymax-1,nzmax,2)
+  real :: vvpol(0:nxmax-1,0:nymax-1,nzmax,2)
+  real :: ww(0:nxmax-1,0:nymax-1,nzmax,2)
+  real :: tt(0:nxmax-1,0:nymax-1,nzmax,2)
+  real :: qv(0:nxmax-1,0:nymax-1,nzmax,2)
+  real :: pv(0:nxmax-1,0:nymax-1,nzmax,2)
+  real :: rho(0:nxmax-1,0:nymax-1,nzmax,2)
+  real :: drhodz(0:nxmax-1,0:nymax-1,nzmax,2)
+  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)
+  integer(kind=1) :: clouds(0:nxmax-1,0:nymax-1,nzmax,2)
+  integer :: cloudsh(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
+  ! tt [K]               temperature data
+  ! qv                   specific humidity data
+  ! pv (pvu)             potential vorticity
+  ! rho [kg/m3]          air density
+  ! drhodz [kg/m2]       vertical air density gradient
+  ! tth,qvh              tth,qvh on original eta levels
+  ! clouds:   no cloud, no precipitation   0
+  !      cloud, no precipitation      1
+  !      rainout  conv/lsp dominated  2/3
+  !      washout  conv/lsp dominated  4/5
+
+  ! pplev for the GFS version
+
+  ! 2d fields
+  !**********
+
+  real :: ps(0:nxmax-1,0:nymax-1,1,2)
+  real :: sd(0:nxmax-1,0:nymax-1,1,2)
+  real :: msl(0:nxmax-1,0:nymax-1,1,2)
+  real :: tcc(0:nxmax-1,0:nymax-1,1,2)
+  real :: u10(0:nxmax-1,0:nymax-1,1,2)
+  real :: v10(0:nxmax-1,0:nymax-1,1,2)
+  real :: tt2(0:nxmax-1,0:nymax-1,1,2)
+  real :: td2(0:nxmax-1,0:nymax-1,1,2)
+  real :: lsprec(0:nxmax-1,0:nymax-1,1,2)
+  real :: convprec(0:nxmax-1,0:nymax-1,1,2)
+  real :: sshf(0:nxmax-1,0:nymax-1,1,2)
+  real :: ssr(0:nxmax-1,0:nymax-1,1,2)
+  real :: surfstr(0:nxmax-1,0:nymax-1,1,2)
+  real :: ustar(0:nxmax-1,0:nymax-1,1,2)
+  real :: wstar(0:nxmax-1,0:nymax-1,1,2)
+  real :: hmix(0:nxmax-1,0:nymax-1,1,2)
+  real :: tropopause(0:nxmax-1,0:nymax-1,1,2)
+  real :: oli(0:nxmax-1,0:nymax-1,1,2)
+  real :: diffk(0:nxmax-1,0:nymax-1,1,2)
+
+  ! ps                   surface pressure
+  ! sd                   snow depth
+  ! msl                  mean sea level pressure
+  ! tcc                  total cloud cover
+  ! u10                  10 meter u
+  ! v10                  10 meter v
+  ! tt2                  2 meter temperature
+  ! td2                  2 meter dew point
+  ! lsprec [mm/h]        large scale total precipitation
+  ! convprec [mm/h]      convective precipitation
+  ! sshf                 surface sensible heat flux
+  ! ssr                  surface solar radiation
+  ! surfstr              surface stress
+  ! ustar [m/s]          friction velocity
+  ! wstar [m/s]          convective velocity scale
+  ! hmix  [m]            mixing height
+  ! tropopause [m]       altitude of thermal tropopause
+  ! oli [m]              inverse Obukhov length (1/L)
+  ! diffk [m2/s]         diffusion coefficient at reference height
+
+
+  real :: vdep(0:nxmax-1,0:nymax-1,maxspec,2)
+
+  ! vdep [m/s]           deposition velocities
+
+
+  !********************************************************************
+  ! Variables associated with the ECMWF input data (nested wind fields)
+  !********************************************************************
+
+  ! NOTE: all nested variables have the same name as the variables used
+  ! for the mother domain, except with a 'n' appended at the end
+  !********************************************************************
+
+  integer :: numbnests
+
+  ! numbnests    number of nested grids
+
+  character(len=255) :: wfnamen(maxnests,maxwf)
+  character(len=18) :: wfspecn(maxnests,maxwf)
+
+  ! wfnamen      nested wind field names
+  ! wfspecn      specifications of wind field file, e.g. if on hard
+  !         disc or on tape
+
+
+  !*********************************************************************
+  ! Variables characterizing size and location of the nested wind fields
+  !*********************************************************************
+
+  integer :: nxn(maxnests),nyn(maxnests)
+  real :: dxn(maxnests),dyn(maxnests),xlon0n(maxnests),ylat0n(maxnests)
+
+  ! nxn,nyn      actual dimensions of nested wind fields in x and y direction
+  ! dxn,dyn      grid distances in x,y direction for the nested grids
+  ! xlon0n       geographical longitude of lower left grid point of nested wind fields
+  ! ylat0n       geographical latitude of lower left grid point of nested wind fields
+
+
+  ! Nested fields, unchangeable with time
+  !**************************************
+
+  real :: oron(0:nxmaxn-1,0:nymaxn-1,maxnests)
+  real :: excessoron(0:nxmaxn-1,0:nymaxn-1,maxnests)
+  real :: lsmn(0:nxmaxn-1,0:nymaxn-1,maxnests)
+  real :: xlandusen(0:nxmaxn-1,0:nymaxn-1,numclass,maxnests)
+
+
+  ! 3d nested fields
+  !*****************
+
+  real :: uun(0:nxmaxn-1,0:nymaxn-1,nzmax,2,maxnests)
+  real :: vvn(0:nxmaxn-1,0:nymaxn-1,nzmax,2,maxnests)
+  real :: wwn(0:nxmaxn-1,0:nymaxn-1,nzmax,2,maxnests)
+  real :: ttn(0:nxmaxn-1,0:nymaxn-1,nzmax,2,maxnests)
+  real :: qvn(0:nxmaxn-1,0:nymaxn-1,nzmax,2,maxnests)
+  real :: pvn(0:nxmaxn-1,0:nymaxn-1,nzmax,2,maxnests)
+  integer(kind=1) :: cloudsn(0:nxmaxn-1,0:nymaxn-1,0:nzmax,2,maxnests)
+  integer :: cloudsnh(0:nxmaxn-1,0:nymaxn-1,2,maxnests)
+  real :: rhon(0:nxmaxn-1,0:nymaxn-1,nzmax,2,maxnests)
+  real :: drhodzn(0:nxmaxn-1,0:nymaxn-1,nzmax,2,maxnests)
+  real :: tthn(0:nxmaxn-1,0:nymaxn-1,nuvzmax,2,maxnests)
+  real :: qvhn(0:nxmaxn-1,0:nymaxn-1,nuvzmax,2,maxnests)
+
+  ! 2d nested fields
+  !*****************
+
+  real :: psn(0:nxmaxn-1,0:nymaxn-1,1,2,maxnests)
+  real :: sdn(0:nxmaxn-1,0:nymaxn-1,1,2,maxnests)
+  real :: msln(0:nxmaxn-1,0:nymaxn-1,1,2,maxnests)
+  real :: tccn(0:nxmaxn-1,0:nymaxn-1,1,2,maxnests)
+  real :: u10n(0:nxmaxn-1,0:nymaxn-1,1,2,maxnests)
+  real :: v10n(0:nxmaxn-1,0:nymaxn-1,1,2,maxnests)
+  real :: tt2n(0:nxmaxn-1,0:nymaxn-1,1,2,maxnests)
+  real :: td2n(0:nxmaxn-1,0:nymaxn-1,1,2,maxnests)
+  real :: lsprecn(0:nxmaxn-1,0:nymaxn-1,1,2,maxnests)
+  real :: convprecn(0:nxmaxn-1,0:nymaxn-1,1,2,maxnests)
+  real :: sshfn(0:nxmaxn-1,0:nymaxn-1,1,2,maxnests)
+  real :: ssrn(0:nxmaxn-1,0:nymaxn-1,1,2,maxnests)
+  real :: surfstrn(0:nxmaxn-1,0:nymaxn-1,1,2,maxnests)
+  real :: ustarn(0:nxmaxn-1,0:nymaxn-1,1,2,maxnests)
+  real :: wstarn(0:nxmaxn-1,0:nymaxn-1,1,2,maxnests)
+  real :: hmixn(0:nxmaxn-1,0:nymaxn-1,1,2,maxnests)
+  real :: tropopausen(0:nxmaxn-1,0:nymaxn-1,1,2,maxnests)
+  real :: olin(0:nxmaxn-1,0:nymaxn-1,1,2,maxnests)
+  real :: diffkn(0:nxmaxn-1,0:nymaxn-1,1,2,maxnests)
+  real :: vdepn(0:nxmaxn-1,0:nymaxn-1,maxspec,2,maxnests)
+
+
+  !*************************************************
+  ! Certain auxiliary variables needed for the nests
+  !*************************************************
+
+  real :: xresoln(0:maxnests),yresoln(0:maxnests)
+
+  ! xresoln, yresoln   Factors by which the resolutions in the nests
+  !               are enhanced compared to mother grid
+
+  real :: xln(maxnests),yln(maxnests),xrn(maxnests),yrn(maxnests)
+
+  ! xln,yln,xrn,yrn    Corner points of nested grids in grid coordinates
+  !               of mother grid
+
+
+  !******************************************************
+  ! Variables defining the polar stereographic projection
+  !******************************************************
+
+  logical :: xglobal,sglobal,nglobal
+  real :: switchnorthg,switchsouthg
+
+  !xglobal             T for global fields, F for limited area fields
+  !sglobal             T if domain extends towards south pole
+  !nglobal             T if domain extends towards north pole
+  !switchnorthg,switchsouthg   same as parameters switchnorth,
+  !                    switchsouth, but in grid units
+
+  real :: southpolemap(9),northpolemap(9)
+
+  !southpolemap,northpolemap   define stereographic projections
+  !                    at the two poles
+
+
+  !******************
+  ! Landuse inventory
+  ! Sabine Eckhardt Dec 06: change to new landuse inventary - 11 classes, 1200 x 600 global
+  !******************
+
+  integer(kind=1) :: landinvent(1200,600,6)
+  real :: z0(numclass)
+
+  ! landinvent         landuse inventory (numclass=11 classes)
+  ! z0                  roughness length for the landuse classes
+
+
+
+  !**************************************************************************
+  ! Variables characterizing the output grid and containing the model results
+  !**************************************************************************
+
+  integer :: numxgrid,numygrid,numzgrid
+  real :: dxout,dyout,outlon0,outlat0,xoutshift,youtshift
+  integer :: numxgridn,numygridn
+  real :: dxoutn,dyoutn,outlon0n,outlat0n,xoutshiftn,youtshiftn
+  !real outheight(maxzgrid),outheighthalf(maxzgrid)
+  logical :: DEP,DRYDEP,DRYDEPSPEC(maxspec),WETDEP,OHREA,ASSSPEC
+
+  ! numxgrid,numygrid       number of grid points in x,y-direction
+  ! numxgridn,numygridn     number of grid points in x,y-direction for nested output grid
+  ! numzgrid                number of vertical levels of output grid
+  ! dxout,dyout             grid distance of output grid
+  ! dxoutn,dyoutn           grid distance of nested output grid
+  ! outlon0,outlat0         lower left corner of output grid
+  ! outlon0n,outlat0n       lower left corner of nested output grid
+  ! xoutshift,youtshift     xlon0-outlon0, ylat0-outlat0
+  ! xoutshiftn,youtshiftn   xlon0-outlon0n, ylat0-outlat0n
+  ! outheight [m]           upper levels of the output grid
+  ! outheighthalf [m]       half (middle) levels of the output grid cells
+  ! DEP                     .true., if either dry or wet depos. is switched on
+  ! DRYDEP                  .true., if dry deposition is switched on
+  ! DRYDEPSPEC              .true., if dry deposition is switched on for that species
+  ! WETDEP                  .true., if wet deposition is switched on
+  ! OHREA                   .true., if OH reaction is switched on
+  ! ASSSPEC                 .true., if there are two species asscoiated
+  !                    (i.e. transfer of mass between these two occurs
+
+
+
+  !  if output for each releasepoint shall be created maxpointspec=number of releasepoints
+  !  else maxpointspec is 1 -> moved to unc_mod
+  !  the OUTGRID is moved to the module outg_mod
+  !******************************************************************************
+
+  !real gridunc(0:maxxgrid-1,0:maxygrid-1,maxzgrid,maxspec,
+  !    +             maxpointspec_act,nclassunc,maxageclass)
+  !real griduncn(0:maxxgridn-1,0:maxygridn-1,maxzgrid,maxspec,
+  !    +              maxpointspec_act,nclassunc,maxageclass)
+  !real wetgridunc(0:maxxgrid-1,0:maxygrid-1,maxspec,
+  !    +                maxpointspec_act,nclassunc,maxageclass)
+  !real wetgriduncn(0:maxxgridn-1,0:maxygridn-1,maxspec,
+  !    +ct                 maxpointspec,nclassunc,maxageclass)
+  !real drygridunc(0:maxxgrid-1,0:maxygrid-1,maxspec,maxpointspec,
+  !    +                nclassunc,maxageclass)
+  !real drygriduncn(0:maxxgridn-1,0:maxygridn-1,maxspec,
+  !    +                 maxpointspec,nclassunc,maxageclass)
+
+  !real oroout(0:maxxgrid-1,0:maxygrid-1)
+  !real orooutn(0:maxxgridn-1,0:maxygridn-1)
+  !     real area(0:maxxgrid-1,0:maxygrid-1)
+  !real arean(0:maxxgridn-1,0:maxygridn-1)
+  !real volume(0:maxxgrid-1,0:maxygrid-1,maxzgrid)
+  !real volumen(0:maxxgridn-1,0:maxygridn-1,maxzgrid)
+
+  !real areaeast(0:maxxgrid-1,0:maxygrid-1,maxzgrid)
+  !real areanorth(0:maxxgrid-1,0:maxygrid-1,maxzgrid)
+
+
+  ! gridunc,griduncn        uncertainty of outputted concentrations
+  ! wetgridunc,wetgriduncn  uncertainty of accumulated wet deposited mass on output grid
+  ! drygridunc,drygriduncn  uncertainty of accumulated dry deposited mass on output grid
+  ! oroout,orooutn [m]      height of model topography at output grid
+  ! area,arean [m2]         area of each grid cell
+  ! volume,volumen [m3]     volume of each grid cell
+  ! ... field names with n at the end indicate a nested output grid
+
+
+  !***********************************
+  ! Variables defining receptor points
+  !***********************************
+
+  real :: xreceptor(maxreceptor),yreceptor(maxreceptor)
+  real :: receptorarea(maxreceptor)
+  real :: creceptor(maxreceptor,maxspec)
+  character(len=16) :: receptorname(maxreceptor)
+  integer :: numreceptor
+
+  ! xreceptor,yreceptor     receptor position
+  ! creceptor               concentrations at receptor points
+  ! receptorarea            area of 1*1 grid cell at receptor point
+
+
+
+  !***************************************
+  ! Variables characterizing each particle
+  !***************************************
+
+  integer :: numpart,itra1(maxpart)
+  integer :: npoint(maxpart),nclass(maxpart)
+  integer :: idt(maxpart),itramem(maxpart),itrasplit(maxpart)
+  integer :: numparticlecount
+
+  real(kind=dp) :: xtra1(maxpart),ytra1(maxpart)
+  real :: ztra1(maxpart),xmass1(maxpart,maxspec)
+
+  ! numpart                 actual number of particles in memory
+  ! itra1 (maxpart) [s]     temporal positions of the particles
+  ! npoint(maxpart)         indicates the release point of each particle
+  ! nclass (maxpart)        one of nclassunc classes to which the particle is attributed
+  ! itramem (maxpart) [s]   memorized release times of the particles
+  ! itrasplit (maxpart) [s] next time when particle is to be split into two
+  ! idt(maxpart) [s]        time step to be used for next integration
+  ! numparticlecount        counts the total number of particles that have been released
+  ! xtra1,ytra1,ztra1       spatial positions of the particles
+  ! xmass1 [kg]             particle masses
+
+
+
+  !*******************************************************
+  ! Info table on available chemical species/radionuclides
+  !*******************************************************
+
+  !character*10 specname(maxtable)
+  !real decaytime(maxtable),wetscava(maxtable),wetscavb(maxtable)
+  !real drydiff(maxtable),dryhenry(maxtable),dryactiv(maxtable)
+  !real partrho(maxtable),partmean(maxtable),partsig(maxtable)
+  !real dryvelo(maxtable),weightmol(maxtable),ohreact(maxtable)
+
+  ! specname            Name of chemical species/radionuclide
+  ! decaytime           Half time of radionuclides
+  ! wetscava, wetscavb  Parameters for calculating scavenging coefficients
+  ! drydiff             diffusivitiy of species relative to diff. of H2O
+  ! dryhenry [M/atm]    Henry constant
+  ! dryactiv            reactivity relative to that of O3
+  ! partrho [kg/m3]     density of particles
+  ! partmean [m]        mean diameter of particles
+  ! partsig [m]         mean stand. deviation of particle diameter
+  ! dryvelo [cm/s]      constant dry deposition velocity
+  ! weightmol [g/mol]   molecular weight
+  ! ohreact             OH reaction rate
+
+
+  !********************
+  ! Random number field
+  !********************
+
+  real :: rannumb(maxrand)
+
+  ! 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
Index: /branches/FP_AI/src/conccalc.f90
===================================================================
--- /branches/FP_AI/src/conccalc.f90	(revision 23)
+++ /branches/FP_AI/src/conccalc.f90	(revision 23)
@@ -0,0 +1,419 @@
+!**********************************************************************
+! 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 conccalc(itime,weight)
+  !                      i     i
+  !*****************************************************************************
+  !                                                                            *
+  !     Calculation of the concentrations on a regular grid using volume       *
+  !     sampling                                                               *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     24 May 1996                                                            *
+  !                                                                            *
+  !     April 2000: Update to calculate age spectra                            *
+  !                 Bug fix to avoid negative conc. at the domain boundaries,  *
+  !                 as suggested by Petra Seibert                              *
+  !                                                                            *
+  !     2 July 2002: re-order if-statements in order to optimize CPU time      *
+  !                                                                            *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! nspeciesdim     = nspec for forward runs, 1 for backward runs              *
+  !                                                                            *
+  !*****************************************************************************
+
+  use unc_mod
+  use outg_mod
+  use par_mod
+  use com_mod
+
+  implicit none
+
+  integer :: itime,itage,i,ix,jy,ixp,jyp,kz,ks,n,nage
+  integer :: il,ind,indz,indzp,nrelpointer
+  real :: rddx,rddy,p1,p2,p3,p4,dz1,dz2,dz
+  real :: weight,hx,hy,hz,h,xd,yd,zd,xkern,r2,c(maxspec),ddx,ddy
+  real :: rhoprof(2),rhoi
+  real :: xl,yl,wx,wy,w
+  real,parameter :: factor=.596831, hxmax=6.0, hymax=4.0, hzmax=150.
+
+
+  ! For forward simulations, make a loop over the number of species;
+  ! for backward simulations, make an additional loop over the
+  ! releasepoints
+  !***************************************************************************
+
+
+  do i=1,numpart
+    if (itra1(i).ne.itime) goto 20
+
+  ! Determine age class of the particle
+    itage=abs(itra1(i)-itramem(i))
+    do nage=1,nageclass
+      if (itage.lt.lage(nage)) goto 33
+    end do
+33   continue
+
+
+  ! For special runs, interpolate the air density to the particle position
+  !************************************************************************
+  !***********************************************************************
+  !AF IND_SOURCE switches between different units for concentrations at the source
+  !Af    NOTE that in backward simulations the release of particles takes place
+  !Af    at the receptor and the sampling at the source.
+  !Af          1="mass"
+  !Af          2="mass mixing ratio"
+  !Af IND_RECEPTOR switches between different units for concentrations at the receptor
+  !Af          1="mass"
+  !Af          2="mass mixing ratio"
+
+  !Af switches for the conccalcfile:
+  !AF IND_SAMP =  0 : xmass * 1
+  !Af IND_SAMP = -1 : xmass / rho
+
+  !Af ind_samp is defined in readcommand.f
+
+    if ( ind_samp .eq. -1 ) then
+
+      ix=int(xtra1(i))
+      jy=int(ytra1(i))
+      ixp=ix+1
+      jyp=jy+1
+      ddx=xtra1(i)-real(ix)
+      ddy=ytra1(i)-real(jy)
+      rddx=1.-ddx
+      rddy=1.-ddy
+      p1=rddx*rddy
+      p2=ddx*rddy
+      p3=rddx*ddy
+      p4=ddx*ddy
+
+      do il=2,nz
+        if (height(il).gt.ztra1(i)) then
+          indz=il-1
+          indzp=il
+          goto 6
+        endif
+      end do
+6     continue
+
+      dz1=ztra1(i)-height(indz)
+      dz2=height(indzp)-ztra1(i)
+      dz=1./(dz1+dz2)
+
+  ! Take density from 2nd wind field in memory (accurate enough, no time interpolation needed)
+  !*****************************************************************************
+      do ind=indz,indzp
+        rhoprof(ind-indz+1)=p1*rho(ix ,jy ,ind,2) &
+             +p2*rho(ixp,jy ,ind,2) &
+             +p3*rho(ix ,jyp,ind,2) &
+             +p4*rho(ixp,jyp,ind,2)
+      end do
+      rhoi=(dz1*rhoprof(2)+dz2*rhoprof(1))*dz
+   elseif (ind_samp.eq.0) then
+      rhoi = 1.
+   endif
+
+
+  !****************************************************************************
+  ! 1. Evaluate grid concentrations using a uniform kernel of bandwidths dx, dy
+  !****************************************************************************
+
+
+  ! For backward simulations, look from which release point the particle comes from
+  ! For domain-filling trajectory option, npoint contains a consecutive particle
+  ! number, not the release point information. Therefore, nrelpointer is set to 1
+  ! for the domain-filling option.
+  !*****************************************************************************
+
+    if ((ioutputforeachrelease.eq.0).or.(mdomainfill.eq.1)) then
+       nrelpointer=1
+    else
+       nrelpointer=npoint(i)
+    endif
+
+    do kz=1,numzgrid                ! determine height of cell
+      if (outheight(kz).gt.ztra1(i)) goto 21
+    end do
+21   continue
+    if (kz.le.numzgrid) then           ! inside output domain
+
+
+  !********************************
+  ! Do everything for mother domain
+  !********************************
+
+      xl=(xtra1(i)*dx+xoutshift)/dxout
+      yl=(ytra1(i)*dy+youtshift)/dyout
+      ix=int(xl)
+      if (xl.lt.0.) ix=ix-1
+      jy=int(yl)
+      if (yl.lt.0.) jy=jy-1
+
+  ! if (i.eq.10000) write(*,*) itime,xtra1(i),ytra1(i),ztra1(i),xl,yl
+
+
+  ! For particles aged less than 3 hours, attribute particle mass to grid cell
+  ! it resides in rather than use the kernel, in order to avoid its smoothing effect.
+  ! For older particles, use the uniform kernel.
+  ! If a particle is close to the domain boundary, do not use the kernel either.
+  !*****************************************************************************
+
+      if ((itage.lt.10800).or.(xl.lt.0.5).or.(yl.lt.0.5).or. &
+           (xl.gt.real(numxgrid-1)-0.5).or. &
+           (yl.gt.real(numygrid-1)-0.5)) then             ! no kernel, direct attribution to grid cell
+        if ((ix.ge.0).and.(jy.ge.0).and.(ix.le.numxgrid-1).and. &
+             (jy.le.numygrid-1)) then
+          do ks=1,nspec
+            gridunc(ix,jy,kz,ks,nrelpointer,nclass(i),nage)= &
+                 gridunc(ix,jy,kz,ks,nrelpointer,nclass(i),nage)+ &
+                 xmass1(i,ks)/rhoi*weight
+          end do
+        endif
+
+      else                                 ! attribution via uniform kernel
+
+        ddx=xl-real(ix)                   ! distance to left cell border
+        ddy=yl-real(jy)                   ! distance to lower cell border
+        if (ddx.gt.0.5) then
+          ixp=ix+1
+          wx=1.5-ddx
+        else
+          ixp=ix-1
+          wx=0.5+ddx
+        endif
+
+        if (ddy.gt.0.5) then
+          jyp=jy+1
+          wy=1.5-ddy
+        else
+          jyp=jy-1
+          wy=0.5+ddy
+        endif
+
+
+  ! Determine mass fractions for four grid points
+  !**********************************************
+
+        if ((ix.ge.0).and.(ix.le.numxgrid-1)) then
+          if ((jy.ge.0).and.(jy.le.numygrid-1)) then
+            w=wx*wy
+            do ks=1,nspec
+              gridunc(ix,jy,kz,ks,nrelpointer,nclass(i),nage)= &
+                   gridunc(ix,jy,kz,ks,nrelpointer,nclass(i),nage)+ &
+                   xmass1(i,ks)/rhoi*weight*w
+            end do
+          endif
+
+          if ((jyp.ge.0).and.(jyp.le.numygrid-1)) then
+            w=wx*(1.-wy)
+            do ks=1,nspec
+              gridunc(ix,jyp,kz,ks,nrelpointer,nclass(i),nage)= &
+                   gridunc(ix,jyp,kz,ks,nrelpointer,nclass(i),nage)+ &
+                   xmass1(i,ks)/rhoi*weight*w
+            end do
+          endif
+        endif
+
+
+        if ((ixp.ge.0).and.(ixp.le.numxgrid-1)) then
+          if ((jyp.ge.0).and.(jyp.le.numygrid-1)) then
+            w=(1.-wx)*(1.-wy)
+            do ks=1,nspec
+              gridunc(ixp,jyp,kz,ks,nrelpointer,nclass(i),nage)= &
+                   gridunc(ixp,jyp,kz,ks,nrelpointer,nclass(i),nage)+ &
+                   xmass1(i,ks)/rhoi*weight*w
+            end do
+          endif
+
+          if ((jy.ge.0).and.(jy.le.numygrid-1)) then
+            w=(1.-wx)*wy
+            do ks=1,nspec
+              gridunc(ixp,jy,kz,ks,nrelpointer,nclass(i),nage)= &
+                   gridunc(ixp,jy,kz,ks,nrelpointer,nclass(i),nage)+ &
+                   xmass1(i,ks)/rhoi*weight*w
+            end do
+          endif
+        endif
+      endif
+
+
+
+  !************************************
+  ! Do everything for the nested domain
+  !************************************
+
+      if (nested_output.eq.1) then
+        xl=(xtra1(i)*dx+xoutshiftn)/dxoutn
+        yl=(ytra1(i)*dy+youtshiftn)/dyoutn
+        ix=int(xl)
+        if (xl.lt.0.) ix=ix-1
+        jy=int(yl)
+        if (yl.lt.0.) jy=jy-1
+
+
+  ! For particles aged less than 3 hours, attribute particle mass to grid cell
+  ! it resides in rather than use the kernel, in order to avoid its smoothing effect.
+  ! For older particles, use the uniform kernel.
+  ! If a particle is close to the domain boundary, do not use the kernel either.
+  !*****************************************************************************
+
+        if ((itage.lt.10800).or.(xl.lt.0.5).or.(yl.lt.0.5).or. &
+             (xl.gt.real(numxgridn-1)-0.5).or. &
+             (yl.gt.real(numygridn-1)-0.5)) then             ! no kernel, direct attribution to grid cell
+          if ((ix.ge.0).and.(jy.ge.0).and.(ix.le.numxgridn-1).and. &
+               (jy.le.numygridn-1)) then
+            do ks=1,nspec
+              griduncn(ix,jy,kz,ks,nrelpointer,nclass(i),nage)= &
+                   griduncn(ix,jy,kz,ks,nrelpointer,nclass(i),nage)+ &
+                   xmass1(i,ks)/rhoi*weight
+            end do
+          endif
+
+        else                                 ! attribution via uniform kernel
+
+          ddx=xl-real(ix)                   ! distance to left cell border
+          ddy=yl-real(jy)                   ! distance to lower cell border
+          if (ddx.gt.0.5) then
+            ixp=ix+1
+            wx=1.5-ddx
+          else
+            ixp=ix-1
+            wx=0.5+ddx
+          endif
+
+          if (ddy.gt.0.5) then
+            jyp=jy+1
+            wy=1.5-ddy
+          else
+            jyp=jy-1
+            wy=0.5+ddy
+          endif
+
+
+  ! Determine mass fractions for four grid points
+  !**********************************************
+
+          if ((ix.ge.0).and.(ix.le.numxgridn-1)) then
+            if ((jy.ge.0).and.(jy.le.numygridn-1)) then
+              w=wx*wy
+              do ks=1,nspec
+                griduncn(ix,jy,kz,ks,nrelpointer,nclass(i),nage)= &
+                     griduncn(ix,jy,kz,ks,nrelpointer,nclass(i),nage)+ &
+                     xmass1(i,ks)/rhoi*weight*w
+              end do
+            endif
+
+            if ((jyp.ge.0).and.(jyp.le.numygridn-1)) then
+              w=wx*(1.-wy)
+              do ks=1,nspec
+                griduncn(ix,jyp,kz,ks,nrelpointer,nclass(i),nage)= &
+                     griduncn(ix,jyp,kz,ks,nrelpointer,nclass(i),nage)+ &
+                     xmass1(i,ks)/rhoi*weight*w
+              end do
+            endif
+          endif
+
+
+          if ((ixp.ge.0).and.(ixp.le.numxgridn-1)) then
+            if ((jyp.ge.0).and.(jyp.le.numygridn-1)) then
+              w=(1.-wx)*(1.-wy)
+              do ks=1,nspec
+                griduncn(ixp,jyp,kz,ks,nrelpointer,nclass(i),nage)= &
+                     griduncn(ixp,jyp,kz,ks,nrelpointer,nclass(i),nage)+ &
+                     xmass1(i,ks)/rhoi*weight*w
+              end do
+            endif
+
+            if ((jy.ge.0).and.(jy.le.numygridn-1)) then
+              w=(1.-wx)*wy
+              do ks=1,nspec
+                griduncn(ixp,jy,kz,ks,nrelpointer,nclass(i),nage)= &
+                     griduncn(ixp,jy,kz,ks,nrelpointer,nclass(i),nage)+ &
+                     xmass1(i,ks)/rhoi*weight*w
+              end do
+            endif
+          endif
+        endif
+
+      endif
+    endif
+20  continue
+  end do
+
+  !***********************************************************************
+  ! 2. Evaluate concentrations at receptor points, using the kernel method
+  !***********************************************************************
+
+  do n=1,numreceptor
+
+
+  ! Reset concentrations
+  !*********************
+
+    do ks=1,nspec
+      c(ks)=0.
+    end do
+
+
+  ! Estimate concentration at receptor
+  !***********************************
+
+    do i=1,numpart
+
+      if (itra1(i).ne.itime) goto 40
+      itage=abs(itra1(i)-itramem(i))
+
+      hz=min(50.+0.3*sqrt(real(itage)),hzmax)
+      zd=ztra1(i)/hz
+      if (zd.gt.1.) goto 40          ! save computing time, leave loop
+
+      hx=min((0.29+2.222e-3*sqrt(real(itage)))*dx+ &
+           real(itage)*1.2e-5,hxmax)                     ! 80 km/day
+      xd=(xtra1(i)-xreceptor(n))/hx
+      if (xd*xd.gt.1.) goto 40       ! save computing time, leave loop
+
+      hy=min((0.18+1.389e-3*sqrt(real(itage)))*dy+ &
+           real(itage)*7.5e-6,hymax)                     ! 80 km/day
+      yd=(ytra1(i)-yreceptor(n))/hy
+      if (yd*yd.gt.1.) goto 40       ! save computing time, leave loop
+      h=hx*hy*hz
+
+      r2=xd*xd+yd*yd+zd*zd
+      if (r2.lt.1.) then
+        xkern=factor*(1.-r2)
+        do ks=1,nspec
+          c(ks)=c(ks)+xmass1(i,ks)*xkern/h
+        end do
+      endif
+40    continue
+    end do
+
+    do ks=1,nspec
+      creceptor(n,ks)=creceptor(n,ks)+2.*weight*c(ks)/receptorarea(n)
+    end do
+  end do
+
+end subroutine conccalc
Index: /branches/FP_AI/src/concoutput.f90
===================================================================
--- /branches/FP_AI/src/concoutput.f90	(revision 23)
+++ /branches/FP_AI/src/concoutput.f90	(revision 23)
@@ -0,0 +1,610 @@
+!**********************************************************************
+! 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 concoutput(itime,outnum,gridtotalunc,wetgridtotalunc, &
+       drygridtotalunc)
+  !                        i     i          o             o
+  !       o
+  !*****************************************************************************
+  !                                                                            *
+  !     Output of the concentration grid and the receptor concentrations.      *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     24 May 1995                                                            *
+  !                                                                            *
+  !     13 April 1999, Major update: if output size is smaller, dump output    *
+  !                    in sparse matrix format; additional output of           *
+  !                    uncertainty                                             *
+  !                                                                            *
+  !     05 April 2000, Major update: output of age classes; output for backward*
+  !                    runs is time spent in grid cell times total mass of     *
+  !                    species.                                                *
+  !                                                                            *
+  !     17 February 2002, Appropriate dimensions for backward and forward runs *
+  !                       are now specified in file par_mod                    *
+  !                                                                            *
+  !     June 2006, write grid in sparse matrix with a single write command     *
+  !                in order to save disk space                                 *
+  !                                                                            *
+  !     2008 new sparse matrix format                                          *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! outnum          number of samples                                          *
+  ! ncells          number of cells with non-zero concentrations               *
+  ! sparse          .true. if in sparse matrix format, else .false.            *
+  ! tot_mu          1 for forward, initial mass mixing ration for backw. runs  *
+  !                                                                            *
+  !*****************************************************************************
+
+  use unc_mod
+  use point_mod
+  use outg_mod
+  use par_mod
+  use com_mod
+
+  implicit none
+
+  real(kind=dp) :: jul
+  integer :: itime,i,ix,jy,kz,ks,kp,l,iix,jjy,kzz,nage,jjjjmmdd,ihmmss
+  integer :: sp_count_i,sp_count_r
+  real :: sp_fact
+  real :: outnum,densityoutrecept(maxreceptor),xl,yl
+
+  !real densityoutgrid(0:numxgrid-1,0:numygrid-1,numzgrid),
+  !    +grid(0:numxgrid-1,0:numygrid-1,numzgrid,maxspec,maxpointspec_act,
+  !    +    maxageclass)
+  !real wetgrid(0:numxgrid-1,0:numygrid-1,maxspec,maxpointspec_act,
+  !    +       maxageclass)
+  !real drygrid(0:numxgrid-1,0:numygrid-1,maxspec,
+  !    +       maxpointspec_act,maxageclass)
+  !real gridsigma(0:numxgrid-1,0:numygrid-1,numzgrid,maxspec,
+  !    +       maxpointspec_act,maxageclass),
+  !    +     drygridsigma(0:numxgrid-1,0:numygrid-1,maxspec,
+  !    +     maxpointspec_act,maxageclass),
+  !    +     wetgridsigma(0:numxgrid-1,0:numygrid-1,maxspec,
+  !    +     maxpointspec_act,maxageclass)
+  !real factor(0:numxgrid-1,0:numygrid-1,numzgrid)
+  !real sparse_dump_r(numxgrid*numygrid*numzgrid)
+  !integer sparse_dump_i(numxgrid*numygrid*numzgrid)
+
+  !real sparse_dump_u(numxgrid*numygrid*numzgrid)
+  real :: auxgrid(nclassunc),gridtotal,gridsigmatotal,gridtotalunc
+  real :: wetgridtotal,wetgridsigmatotal,wetgridtotalunc
+  real :: drygridtotal,drygridsigmatotal,drygridtotalunc
+  real :: halfheight,dz,dz1,dz2,tot_mu(maxspec,maxpointspec_act)
+  real,parameter :: smallnum = tiny(0.0) ! smallest number that can be handled
+  real,parameter :: weightair=28.97
+  logical :: sp_zer
+  character :: adate*8,atime*6
+  character(len=3) :: anspec
+
+
+  ! Determine current calendar date, needed for the file name
+  !**********************************************************
+
+  jul=bdate+real(itime,kind=dp)/86400._dp
+  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.
+  ! Thus, make loops either about nspec, or about numpoint
+  !*****************************************************************
+
+
+  if (ldirect.eq.1) then
+    do ks=1,nspec
+      do kp=1,maxpointspec_act
+        tot_mu(ks,kp)=1
+      end do
+    end do
+  else
+    do ks=1,nspec
+      do kp=1,maxpointspec_act
+        tot_mu(ks,kp)=xmass(kp,ks)
+      end do
+    end do
+  endif
+
+
+  !*******************************************************************
+  ! Compute air density: sufficiently accurate to take it
+  ! from coarse grid at some time
+  ! Determine center altitude of output layer, and interpolate density
+  ! data to that altitude
+  !*******************************************************************
+
+  do kz=1,numzgrid
+    if (kz.eq.1) then
+      halfheight=outheight(1)/2.
+    else
+      halfheight=(outheight(kz)+outheight(kz-1))/2.
+    endif
+    do kzz=2,nz
+      if ((height(kzz-1).lt.halfheight).and. &
+           (height(kzz).gt.halfheight)) goto 46
+    end do
+46   kzz=max(min(kzz,nz),2)
+    dz1=halfheight-height(kzz-1)
+    dz2=height(kzz)-halfheight
+    dz=dz1+dz2
+    do jy=0,numygrid-1
+      do ix=0,numxgrid-1
+        xl=outlon0+real(ix)*dxout
+        yl=outlat0+real(jy)*dyout
+        xl=(xl-xlon0)/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+ &
+             rho(iix,jjy,kzz-1,2)*dz2)/dz
+      end do
+    end do
+  end do
+
+    do i=1,numreceptor
+      xl=xreceptor(i)
+      yl=yreceptor(i)
+      iix=max(min(nint(xl),nxmin1),0)
+      jjy=max(min(nint(yl),nymin1),0)
+      densityoutrecept(i)=rho(iix,jjy,1,2)
+    end do
+
+
+  ! Output is different for forward and backward simulations
+    do kz=1,numzgrid
+      do jy=0,numygrid-1
+        do ix=0,numxgrid-1
+          if (ldirect.eq.1) then
+            factor3d(ix,jy,kz)=1.e12/volume(ix,jy,kz)/outnum
+          else
+            factor3d(ix,jy,kz)=real(abs(loutaver))/outnum
+          endif
+        end do
+      end do
+    end do
+
+  !*********************************************************************
+  ! Determine the standard deviation of the mean concentration or mixing
+  ! ratio (uncertainty of the output) and the dry and wet deposition
+  !*********************************************************************
+
+  gridtotal=0.
+  gridsigmatotal=0.
+  gridtotalunc=0.
+  wetgridtotal=0.
+  wetgridsigmatotal=0.
+  wetgridtotalunc=0.
+  drygridtotal=0.
+  drygridsigmatotal=0.
+  drygridtotalunc=0.
+
+  do ks=1,nspec
+
+  write(anspec,'(i3.3)') ks
+  if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
+    if (ldirect.eq.1) then
+      open(unitoutgrid,file=path(2)(1:length(2))//'grid_conc_'//adate// &
+           atime//'_'//anspec,form='unformatted')
+    else
+      open(unitoutgrid,file=path(2)(1:length(2))//'grid_time_'//adate// &
+           atime//'_'//anspec,form='unformatted')
+    endif
+     write(unitoutgrid) itime
+   endif
+
+  if ((iout.eq.2).or.(iout.eq.3)) then      ! mixing ratio
+   open(unitoutgridppt,file=path(2)(1:length(2))//'grid_pptv_'//adate// &
+        atime//'_'//anspec,form='unformatted')
+
+    write(unitoutgridppt) itime
+  endif
+
+  do kp=1,maxpointspec_act
+  do nage=1,nageclass
+
+    do jy=0,numygrid-1
+      do ix=0,numxgrid-1
+
+  ! WET DEPOSITION
+        if ((WETDEP).and.(ldirect.gt.0)) then
+            do l=1,nclassunc
+              auxgrid(l)=wetgridunc(ix,jy,ks,kp,l,nage)
+            end do
+            call mean(auxgrid,wetgrid(ix,jy), &
+                 wetgridsigma(ix,jy),nclassunc)
+  ! Multiply by number of classes to get total concentration
+            wetgrid(ix,jy)=wetgrid(ix,jy) &
+                 *nclassunc
+            wetgridtotal=wetgridtotal+wetgrid(ix,jy)
+  ! Calculate standard deviation of the mean
+            wetgridsigma(ix,jy)= &
+                 wetgridsigma(ix,jy)* &
+                 sqrt(real(nclassunc))
+            wetgridsigmatotal=wetgridsigmatotal+ &
+                 wetgridsigma(ix,jy)
+        endif
+
+  ! DRY DEPOSITION
+        if ((DRYDEP).and.(ldirect.gt.0)) then
+            do l=1,nclassunc
+              auxgrid(l)=drygridunc(ix,jy,ks,kp,l,nage)
+            end do
+            call mean(auxgrid,drygrid(ix,jy), &
+                 drygridsigma(ix,jy),nclassunc)
+  ! Multiply by number of classes to get total concentration
+            drygrid(ix,jy)=drygrid(ix,jy)* &
+                 nclassunc
+            drygridtotal=drygridtotal+drygrid(ix,jy)
+  ! Calculate standard deviation of the mean
+            drygridsigma(ix,jy)= &
+                 drygridsigma(ix,jy)* &
+                 sqrt(real(nclassunc))
+125         drygridsigmatotal=drygridsigmatotal+ &
+                 drygridsigma(ix,jy)
+        endif
+
+  ! CONCENTRATION OR MIXING RATIO
+        do kz=1,numzgrid
+            do l=1,nclassunc
+              auxgrid(l)=gridunc(ix,jy,kz,ks,kp,l,nage)
+            end do
+            call mean(auxgrid,grid(ix,jy,kz), &
+                 gridsigma(ix,jy,kz),nclassunc)
+  ! Multiply by number of classes to get total concentration
+            grid(ix,jy,kz)= &
+                 grid(ix,jy,kz)*nclassunc
+            gridtotal=gridtotal+grid(ix,jy,kz)
+  ! Calculate standard deviation of the mean
+            gridsigma(ix,jy,kz)= &
+                 gridsigma(ix,jy,kz)* &
+                 sqrt(real(nclassunc))
+            gridsigmatotal=gridsigmatotal+ &
+                 gridsigma(ix,jy,kz)
+        end do
+      end do
+    end do
+
+
+
+
+  !*******************************************************************
+  ! Generate output: may be in concentration (ng/m3) or in mixing
+  ! ratio (ppt) or both
+  ! Output the position and the values alternated multiplied by
+  ! 1 or -1, first line is number of values, number of positions
+  ! For backward simulations, the unit is seconds, stored in grid_time
+  !*******************************************************************
+
+  ! Concentration output
+  !*********************
+  if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
+
+  ! Wet deposition
+         sp_count_i=0
+         sp_count_r=0
+         sp_fact=-1.
+         sp_zer=.true.
+         if ((ldirect.eq.1).and.(WETDEP)) then
+         do jy=0,numygrid-1
+            do ix=0,numxgrid-1
+  !oncentraion greater zero
+              if (wetgrid(ix,jy).gt.smallnum) then
+                 if (sp_zer.eqv..true.) then ! first non zero value
+                    sp_count_i=sp_count_i+1
+                    sparse_dump_i(sp_count_i)=ix+jy*numxgrid
+                    sp_zer=.false.
+                    sp_fact=sp_fact*(-1.)
+                 endif
+                 sp_count_r=sp_count_r+1
+                 sparse_dump_r(sp_count_r)= &
+                      sp_fact*1.e12*wetgrid(ix,jy)/area(ix,jy)
+  !                sparse_dump_u(sp_count_r)=
+  !+                1.e12*wetgridsigma(ix,jy,ks,kp,nage)/area(ix,jy)
+              else ! concentration is zero
+                  sp_zer=.true.
+              endif
+            end do
+         end do
+         else
+            sp_count_i=0
+            sp_count_r=0
+         endif
+         write(unitoutgrid) sp_count_i
+         write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
+         write(unitoutgrid) sp_count_r
+         write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
+  !       write(unitoutgrid) sp_count_u
+  !       write(unitoutgrid) (sparse_dump_u(i),i=1,sp_count_r)
+
+  ! Dry deposition
+         sp_count_i=0
+         sp_count_r=0
+         sp_fact=-1.
+         sp_zer=.true.
+         if ((ldirect.eq.1).and.(DRYDEP)) then
+          do jy=0,numygrid-1
+            do ix=0,numxgrid-1
+              if (drygrid(ix,jy).gt.smallnum) then
+                 if (sp_zer.eqv..true.) then ! first non zero value
+                    sp_count_i=sp_count_i+1
+                    sparse_dump_i(sp_count_i)=ix+jy*numxgrid
+                    sp_zer=.false.
+                    sp_fact=sp_fact*(-1.)
+                 endif
+                 sp_count_r=sp_count_r+1
+                 sparse_dump_r(sp_count_r)= &
+                      sp_fact* &
+                      1.e12*drygrid(ix,jy)/area(ix,jy)
+  !                sparse_dump_u(sp_count_r)=
+  !+                1.e12*drygridsigma(ix,jy,ks,kp,nage)/area(ix,jy)
+              else ! concentration is zero
+                  sp_zer=.true.
+              endif
+            end do
+          end do
+         else
+            sp_count_i=0
+            sp_count_r=0
+         endif
+         write(unitoutgrid) sp_count_i
+         write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
+         write(unitoutgrid) sp_count_r
+         write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
+  !       write(*,*) sp_count_u
+  !       write(unitoutgrid) (sparse_dump_u(i),i=1,sp_count_r)
+
+
+
+  ! Concentrations
+         sp_count_i=0
+         sp_count_r=0
+         sp_fact=-1.
+         sp_zer=.true.
+          do kz=1,numzgrid
+            do jy=0,numygrid-1
+              do ix=0,numxgrid-1
+                if (grid(ix,jy,kz).gt.smallnum) then
+                  if (sp_zer.eqv..true.) then ! first non zero value
+                    sp_count_i=sp_count_i+1
+                    sparse_dump_i(sp_count_i)= &
+                         ix+jy*numxgrid+kz*numxgrid*numygrid
+                    sp_zer=.false.
+                    sp_fact=sp_fact*(-1.)
+                   endif
+                   sp_count_r=sp_count_r+1
+                   sparse_dump_r(sp_count_r)= &
+                        sp_fact* &
+                        grid(ix,jy,kz)* &
+                        factor3d(ix,jy,kz)/tot_mu(ks,kp)
+  !                 if ((factor(ix,jy,kz)/tot_mu(ks,kp)).eq.0)
+  !    +              write (*,*) factor(ix,jy,kz),tot_mu(ks,kp),ks,kp
+  !                sparse_dump_u(sp_count_r)=
+  !+               ,gridsigma(ix,jy,kz,ks,kp,nage)*
+  !+               factor(ix,jy,kz)/tot_mu(ks,kp)
+              else ! concentration is zero
+                  sp_zer=.true.
+              endif
+              end do
+            end do
+          end do
+         write(unitoutgrid) sp_count_i
+         write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
+         write(unitoutgrid) sp_count_r
+         write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
+  !       write(unitoutgrid) sp_count_u
+  !       write(unitoutgrid) (sparse_dump_u(i),i=1,sp_count_r)
+
+
+
+    endif !  concentration output
+
+  ! Mixing ratio output
+  !********************
+
+  if ((iout.eq.2).or.(iout.eq.3)) then      ! mixing ratio
+
+  ! Wet deposition
+         sp_count_i=0
+         sp_count_r=0
+         sp_fact=-1.
+         sp_zer=.true.
+         if ((ldirect.eq.1).and.(WETDEP)) then
+          do jy=0,numygrid-1
+            do ix=0,numxgrid-1
+                if (wetgrid(ix,jy).gt.smallnum) then
+                  if (sp_zer.eqv..true.) then ! first non zero value
+                    sp_count_i=sp_count_i+1
+                    sparse_dump_i(sp_count_i)= &
+                         ix+jy*numxgrid
+                    sp_zer=.false.
+                    sp_fact=sp_fact*(-1.)
+                 endif
+                 sp_count_r=sp_count_r+1
+                 sparse_dump_r(sp_count_r)= &
+                      sp_fact* &
+                      1.e12*wetgrid(ix,jy)/area(ix,jy)
+  !                sparse_dump_u(sp_count_r)=
+  !    +            ,1.e12*wetgridsigma(ix,jy,ks,kp,nage)/area(ix,jy)
+              else ! concentration is zero
+                  sp_zer=.true.
+              endif
+            end do
+          end do
+         else
+           sp_count_i=0
+           sp_count_r=0
+         endif
+         write(unitoutgridppt) sp_count_i
+         write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
+         write(unitoutgridppt) sp_count_r
+         write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
+  !       write(unitoutgridppt) sp_count_u
+  !       write(unitoutgridppt) (sparse_dump_u(i),i=1,sp_count_r)
+
+
+  ! Dry deposition
+         sp_count_i=0
+         sp_count_r=0
+         sp_fact=-1.
+         sp_zer=.true.
+         if ((ldirect.eq.1).and.(DRYDEP)) then
+          do jy=0,numygrid-1
+            do ix=0,numxgrid-1
+                if (drygrid(ix,jy).gt.smallnum) then
+                  if (sp_zer.eqv..true.) then ! first non zero value
+                    sp_count_i=sp_count_i+1
+                    sparse_dump_i(sp_count_i)= &
+                         ix+jy*numxgrid
+                    sp_zer=.false.
+                    sp_fact=sp_fact*(-1)
+                 endif
+                 sp_count_r=sp_count_r+1
+                 sparse_dump_r(sp_count_r)= &
+                      sp_fact* &
+                      1.e12*drygrid(ix,jy)/area(ix,jy)
+  !                sparse_dump_u(sp_count_r)=
+  !    +            ,1.e12*drygridsigma(ix,jy,ks,kp,nage)/area(ix,jy)
+              else ! concentration is zero
+                  sp_zer=.true.
+              endif
+            end do
+          end do
+         else
+           sp_count_i=0
+           sp_count_r=0
+         endif
+         write(unitoutgridppt) sp_count_i
+         write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
+         write(unitoutgridppt) sp_count_r
+         write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
+  !       write(unitoutgridppt) sp_count_u
+  !       write(unitoutgridppt) (sparse_dump_u(i),i=1,sp_count_r)
+
+
+  ! Mixing ratios
+         sp_count_i=0
+         sp_count_r=0
+         sp_fact=-1.
+         sp_zer=.true.
+          do kz=1,numzgrid
+            do jy=0,numygrid-1
+              do ix=0,numxgrid-1
+                if (grid(ix,jy,kz).gt.smallnum) then
+                  if (sp_zer.eqv..true.) then ! first non zero value
+                    sp_count_i=sp_count_i+1
+                    sparse_dump_i(sp_count_i)= &
+                         ix+jy*numxgrid+kz*numxgrid*numygrid
+                    sp_zer=.false.
+                    sp_fact=sp_fact*(-1.)
+                 endif
+                 sp_count_r=sp_count_r+1
+                 sparse_dump_r(sp_count_r)= &
+                      sp_fact* &
+                      1.e12*grid(ix,jy,kz) &
+                      /volume(ix,jy,kz)/outnum* &
+                      weightair/weightmolar(ks)/densityoutgrid(ix,jy,kz)
+  !                sparse_dump_u(sp_count_r)=
+  !+              ,1.e12*gridsigma(ix,jy,kz,ks,kp,nage)/volume(ix,jy,kz)/
+  !+              outnum*weightair/weightmolar(ks)/
+  !+              densityoutgrid(ix,jy,kz)
+              else ! concentration is zero
+                  sp_zer=.true.
+              endif
+              end do
+            end do
+          end do
+         write(unitoutgridppt) sp_count_i
+         write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
+         write(unitoutgridppt) sp_count_r
+         write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
+  !       write(unitoutgridppt) sp_count_u
+  !       write(unitoutgridppt) (sparse_dump_u(i),i=1,sp_count_r)
+
+      endif ! output for ppt
+
+  end do
+  end do
+
+    close(unitoutgridppt)
+    close(unitoutgrid)
+
+  end do
+
+  if (gridtotal.gt.0.) gridtotalunc=gridsigmatotal/gridtotal
+  if (wetgridtotal.gt.0.) wetgridtotalunc=wetgridsigmatotal/ &
+       wetgridtotal
+  if (drygridtotal.gt.0.) drygridtotalunc=drygridsigmatotal/ &
+       drygridtotal
+
+  ! Dump of receptor concentrations
+
+    if (numreceptor.gt.0 .and. (iout.eq.2 .or. iout.eq.3)  ) then
+      write(unitoutreceptppt) itime
+      do ks=1,nspec
+        write(unitoutreceptppt) (1.e12*creceptor(i,ks)/outnum* &
+             weightair/weightmolar(ks)/densityoutrecept(i),i=1,numreceptor)
+      end do
+    endif
+
+  ! Dump of receptor concentrations
+
+    if (numreceptor.gt.0) then
+      write(unitoutrecept) itime
+      do ks=1,nspec
+        write(unitoutrecept) (1.e12*creceptor(i,ks)/outnum, &
+             i=1,numreceptor)
+      end do
+    endif
+
+
+
+  ! Reinitialization of grid
+  !*************************
+
+  do ks=1,nspec
+  do kp=1,maxpointspec_act
+    do i=1,numreceptor
+      creceptor(i,ks)=0.
+    end do
+    do jy=0,numygrid-1
+      do ix=0,numxgrid-1
+        do l=1,nclassunc
+          do nage=1,nageclass
+            do kz=1,numzgrid
+              gridunc(ix,jy,kz,ks,kp,l,nage)=0.
+            end do
+          end do
+        end do
+      end do
+    end do
+  end do
+  end do
+
+
+end subroutine concoutput
Index: /branches/FP_AI/src/concoutput_nest.f90
===================================================================
--- /branches/FP_AI/src/concoutput_nest.f90	(revision 23)
+++ /branches/FP_AI/src/concoutput_nest.f90	(revision 23)
@@ -0,0 +1,561 @@
+!**********************************************************************
+! 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 concoutput_nest(itime,outnum)
+  !                        i     i
+  !*****************************************************************************
+  !                                                                            *
+  !     Output of the concentration grid and the receptor concentrations.      *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     24 May 1995                                                            *
+  !                                                                            *
+  !     13 April 1999, Major update: if output size is smaller, dump output    *
+  !                    in sparse matrix format; additional output of           *
+  !                    uncertainty                                             *
+  !                                                                            *
+  !     05 April 2000, Major update: output of age classes; output for backward*
+  !                    runs is time spent in grid cell times total mass of     *
+  !                    species.                                                *
+  !                                                                            *
+  !     17 February 2002, Appropriate dimensions for backward and forward runs *
+  !                       are now specified in file par_mod                    *
+  !                                                                            *
+  !     June 2006, write grid in sparse matrix with a single write command     *
+  !                in order to save disk space                                 *
+  !                                                                            *
+  !     2008 new sparse matrix format                                          *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! outnum          number of samples                                          *
+  ! ncells          number of cells with non-zero concentrations               *
+  ! sparse          .true. if in sparse matrix format, else .false.            *
+  ! tot_mu          1 for forward, initial mass mixing ration for backw. runs  *
+  !                                                                            *
+  !*****************************************************************************
+
+  use unc_mod
+  use point_mod
+  use outg_mod
+  use par_mod
+  use com_mod
+
+  implicit none
+
+  real(kind=dp) :: jul
+  integer :: itime,i,ix,jy,kz,ks,kp,l,iix,jjy,kzz,nage,jjjjmmdd,ihmmss
+  integer :: sp_count_i,sp_count_r
+  real :: sp_fact
+  real :: outnum,densityoutrecept(maxreceptor),xl,yl
+
+  !real densityoutgrid(0:numxgrid-1,0:numygrid-1,numzgrid),
+  !    +grid(0:numxgrid-1,0:numygrid-1,numzgrid,maxspec,maxpointspec_act,
+  !    +    maxageclass)
+  !real wetgrid(0:numxgrid-1,0:numygrid-1,maxspec,maxpointspec_act,
+  !    +       maxageclass)
+  !real drygrid(0:numxgrid-1,0:numygrid-1,maxspec,
+  !    +       maxpointspec_act,maxageclass)
+  !real gridsigma(0:numxgrid-1,0:numygrid-1,numzgrid,maxspec,
+  !    +       maxpointspec_act,maxageclass),
+  !    +     drygridsigma(0:numxgrid-1,0:numygrid-1,maxspec,
+  !    +     maxpointspec_act,maxageclass),
+  !    +     wetgridsigma(0:numxgrid-1,0:numygrid-1,maxspec,
+  !    +     maxpointspec_act,maxageclass)
+  !real factor(0:numxgrid-1,0:numygrid-1,numzgrid)
+  !real sparse_dump_r(numxgrid*numygrid*numzgrid)
+  !integer sparse_dump_i(numxgrid*numygrid*numzgrid)
+
+  !real sparse_dump_u(numxgrid*numygrid*numzgrid)
+  real :: auxgrid(nclassunc)
+  real :: halfheight,dz,dz1,dz2,tot_mu(maxspec,maxpointspec_act)
+  real,parameter :: smallnum = tiny(0.0) ! smallest number that can be handled
+  real,parameter :: weightair=28.97
+  logical :: sp_zer
+  character :: adate*8,atime*6
+  character(len=3) :: anspec
+
+
+  ! Determine current calendar date, needed for the file name
+  !**********************************************************
+
+  jul=bdate+real(itime,kind=dp)/86400._dp
+  call caldate(jul,jjjjmmdd,ihmmss)
+  write(adate,'(i8.8)') jjjjmmdd
+  write(atime,'(i6.6)') ihmmss
+
+
+  ! For forward simulations, output fields have dimension MAXSPEC,
+  ! for backward simulations, output fields have dimension MAXPOINT.
+  ! Thus, make loops either about nspec, or about numpoint
+  !*****************************************************************
+
+
+    if (ldirect.eq.1) then
+       do ks=1,nspec
+         do kp=1,maxpointspec_act
+           tot_mu(ks,kp)=1
+         end do
+       end do
+   else
+      do ks=1,nspec
+             do kp=1,maxpointspec_act
+               tot_mu(ks,kp)=xmass(kp,ks)
+             end do
+      end do
+    endif
+
+
+  !*******************************************************************
+  ! Compute air density: sufficiently accurate to take it
+  ! from coarse grid at some time
+  ! Determine center altitude of output layer, and interpolate density
+  ! data to that altitude
+  !*******************************************************************
+
+  do kz=1,numzgrid
+    if (kz.eq.1) then
+      halfheight=outheight(1)/2.
+    else
+      halfheight=(outheight(kz)+outheight(kz-1))/2.
+    endif
+    do kzz=2,nz
+      if ((height(kzz-1).lt.halfheight).and. &
+           (height(kzz).gt.halfheight)) goto 46
+    end do
+46   kzz=max(min(kzz,nz),2)
+    dz1=halfheight-height(kzz-1)
+    dz2=height(kzz)-halfheight
+    dz=dz1+dz2
+    do jy=0,numygridn-1
+      do ix=0,numxgridn-1
+        xl=outlon0n+real(ix)*dxoutn
+        yl=outlat0n+real(jy)*dyoutn
+        xl=(xl-xlon0)/dx
+        yl=(yl-ylat0)/dy
+        iix=max(min(nint(xl),nxmin1),0)
+        jjy=max(min(nint(yl),nymin1),0)
+        densityoutgrid(ix,jy,kz)=(rho(iix,jjy,kzz,2)*dz1+ &
+             rho(iix,jjy,kzz-1,2)*dz2)/dz
+      end do
+    end do
+  end do
+
+    do i=1,numreceptor
+      xl=xreceptor(i)
+      yl=yreceptor(i)
+      iix=max(min(nint(xl),nxmin1),0)
+      jjy=max(min(nint(yl),nymin1),0)
+      densityoutrecept(i)=rho(iix,jjy,1,2)
+    end do
+
+
+  ! Output is different for forward and backward simulations
+    do kz=1,numzgrid
+      do jy=0,numygridn-1
+        do ix=0,numxgridn-1
+          if (ldirect.eq.1) then
+            factor3d(ix,jy,kz)=1.e12/volumen(ix,jy,kz)/outnum
+          else
+            factor3d(ix,jy,kz)=real(abs(loutaver))/outnum
+          endif
+        end do
+      end do
+    end do
+
+  !*********************************************************************
+  ! Determine the standard deviation of the mean concentration or mixing
+  ! ratio (uncertainty of the output) and the dry and wet deposition
+  !*********************************************************************
+
+  do ks=1,nspec
+
+  write(anspec,'(i3.3)') ks
+  if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
+    if (ldirect.eq.1) then
+      open(unitoutgrid,file=path(2)(1:length(2))//'grid_conc_nest_' &
+           //adate// &
+           atime//'_'//anspec,form='unformatted')
+    else
+      open(unitoutgrid,file=path(2)(1:length(2))//'grid_time_nest_' &
+           //adate// &
+           atime//'_'//anspec,form='unformatted')
+    endif
+     write(unitoutgrid) itime
+   endif
+
+  if ((iout.eq.2).or.(iout.eq.3)) then      ! mixing ratio
+   open(unitoutgridppt,file=path(2)(1:length(2))//'grid_pptv_nest_' &
+        //adate// &
+        atime//'_'//anspec,form='unformatted')
+
+    write(unitoutgridppt) itime
+  endif
+
+  do kp=1,maxpointspec_act
+  do nage=1,nageclass
+
+    do jy=0,numygridn-1
+      do ix=0,numxgridn-1
+
+  ! WET DEPOSITION
+        if ((WETDEP).and.(ldirect.gt.0)) then
+            do l=1,nclassunc
+              auxgrid(l)=wetgriduncn(ix,jy,ks,kp,l,nage)
+            end do
+            call mean(auxgrid,wetgrid(ix,jy), &
+                 wetgridsigma(ix,jy),nclassunc)
+  ! Multiply by number of classes to get total concentration
+            wetgrid(ix,jy)=wetgrid(ix,jy) &
+                 *nclassunc
+  ! Calculate standard deviation of the mean
+            wetgridsigma(ix,jy)= &
+                 wetgridsigma(ix,jy)* &
+                 sqrt(real(nclassunc))
+        endif
+
+  ! DRY DEPOSITION
+        if ((DRYDEP).and.(ldirect.gt.0)) then
+            do l=1,nclassunc
+              auxgrid(l)=drygriduncn(ix,jy,ks,kp,l,nage)
+            end do
+            call mean(auxgrid,drygrid(ix,jy), &
+                 drygridsigma(ix,jy),nclassunc)
+  ! Multiply by number of classes to get total concentration
+            drygrid(ix,jy)=drygrid(ix,jy)* &
+                 nclassunc
+  ! Calculate standard deviation of the mean
+            drygridsigma(ix,jy)= &
+                 drygridsigma(ix,jy)* &
+                 sqrt(real(nclassunc))
+        endif
+
+  ! CONCENTRATION OR MIXING RATIO
+        do kz=1,numzgrid
+            do l=1,nclassunc
+              auxgrid(l)=griduncn(ix,jy,kz,ks,kp,l,nage)
+            end do
+            call mean(auxgrid,grid(ix,jy,kz), &
+                 gridsigma(ix,jy,kz),nclassunc)
+  ! Multiply by number of classes to get total concentration
+            grid(ix,jy,kz)= &
+                 grid(ix,jy,kz)*nclassunc
+  ! Calculate standard deviation of the mean
+            gridsigma(ix,jy,kz)= &
+                 gridsigma(ix,jy,kz)* &
+                 sqrt(real(nclassunc))
+        end do
+      end do
+    end do
+
+
+  !*******************************************************************
+  ! Generate output: may be in concentration (ng/m3) or in mixing
+  ! ratio (ppt) or both
+  ! Output the position and the values alternated multiplied by
+  ! 1 or -1, first line is number of values, number of positions
+  ! For backward simulations, the unit is seconds, stored in grid_time
+  !*******************************************************************
+
+  ! Concentration output
+  !*********************
+  if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
+
+  ! Wet deposition
+         sp_count_i=0
+         sp_count_r=0
+         sp_fact=-1.
+         sp_zer=.true.
+         if ((ldirect.eq.1).and.(WETDEP)) then
+         do jy=0,numygridn-1
+            do ix=0,numxgridn-1
+  !oncentraion greater zero
+              if (wetgrid(ix,jy).gt.smallnum) then
+                 if (sp_zer.eqv..true.) then ! first non zero value
+                    sp_count_i=sp_count_i+1
+                    sparse_dump_i(sp_count_i)=ix+jy*numxgridn
+                    sp_zer=.false.
+                    sp_fact=sp_fact*(-1.)
+                 endif
+                 sp_count_r=sp_count_r+1
+                 sparse_dump_r(sp_count_r)= &
+                      sp_fact*1.e12*wetgrid(ix,jy)/arean(ix,jy)
+  !                sparse_dump_u(sp_count_r)=
+  !+                1.e12*wetgridsigma(ix,jy,ks,kp,nage)/area(ix,jy)
+              else ! concentration is zero
+                  sp_zer=.true.
+              endif
+            end do
+         end do
+         else
+            sp_count_i=0
+            sp_count_r=0
+         endif
+         write(unitoutgrid) sp_count_i
+         write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
+         write(unitoutgrid) sp_count_r
+         write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
+  !       write(unitoutgrid) sp_count_u
+  !       write(unitoutgrid) (sparse_dump_u(i),i=1,sp_count_r)
+
+  ! Dry deposition
+         sp_count_i=0
+         sp_count_r=0
+         sp_fact=-1.
+         sp_zer=.true.
+         if ((ldirect.eq.1).and.(DRYDEP)) then
+          do jy=0,numygridn-1
+            do ix=0,numxgridn-1
+              if (drygrid(ix,jy).gt.smallnum) then
+                 if (sp_zer.eqv..true.) then ! first non zero value
+                    sp_count_i=sp_count_i+1
+                    sparse_dump_i(sp_count_i)=ix+jy*numxgridn
+                    sp_zer=.false.
+                    sp_fact=sp_fact*(-1.)
+                 endif
+                 sp_count_r=sp_count_r+1
+                 sparse_dump_r(sp_count_r)= &
+                      sp_fact* &
+                      1.e12*drygrid(ix,jy)/arean(ix,jy)
+  !                sparse_dump_u(sp_count_r)=
+  !+                1.e12*drygridsigma(ix,jy,ks,kp,nage)/area(ix,jy)
+              else ! concentration is zero
+                  sp_zer=.true.
+              endif
+            end do
+          end do
+         else
+            sp_count_i=0
+            sp_count_r=0
+         endif
+         write(unitoutgrid) sp_count_i
+         write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
+         write(unitoutgrid) sp_count_r
+         write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
+  !       write(*,*) sp_count_u
+  !       write(unitoutgrid) (sparse_dump_u(i),i=1,sp_count_r)
+
+
+
+  ! Concentrations
+         sp_count_i=0
+         sp_count_r=0
+         sp_fact=-1.
+         sp_zer=.true.
+          do kz=1,numzgrid
+            do jy=0,numygridn-1
+              do ix=0,numxgridn-1
+                if (grid(ix,jy,kz).gt.smallnum) then
+                  if (sp_zer.eqv..true.) then ! first non zero value
+                    sp_count_i=sp_count_i+1
+                    sparse_dump_i(sp_count_i)= &
+                         ix+jy*numxgridn+kz*numxgridn*numygridn
+                    sp_zer=.false.
+                    sp_fact=sp_fact*(-1.)
+                   endif
+                   sp_count_r=sp_count_r+1
+                   sparse_dump_r(sp_count_r)= &
+                        sp_fact* &
+                        grid(ix,jy,kz)* &
+                        factor3d(ix,jy,kz)/tot_mu(ks,kp)
+  !                 if ((factor(ix,jy,kz)/tot_mu(ks,kp)).eq.0)
+  !    +              write (*,*) factor(ix,jy,kz),tot_mu(ks,kp),ks,kp
+  !                sparse_dump_u(sp_count_r)=
+  !+               ,gridsigma(ix,jy,kz,ks,kp,nage)*
+  !+               factor(ix,jy,kz)/tot_mu(ks,kp)
+              else ! concentration is zero
+                  sp_zer=.true.
+              endif
+              end do
+            end do
+          end do
+         write(unitoutgrid) sp_count_i
+         write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
+         write(unitoutgrid) sp_count_r
+         write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
+  !       write(unitoutgrid) sp_count_u
+  !       write(unitoutgrid) (sparse_dump_u(i),i=1,sp_count_r)
+
+
+
+    endif !  concentration output
+
+  ! Mixing ratio output
+  !********************
+
+  if ((iout.eq.2).or.(iout.eq.3)) then      ! mixing ratio
+
+  ! Wet deposition
+         sp_count_i=0
+         sp_count_r=0
+         sp_fact=-1.
+         sp_zer=.true.
+         if ((ldirect.eq.1).and.(WETDEP)) then
+          do jy=0,numygridn-1
+            do ix=0,numxgridn-1
+                if (wetgrid(ix,jy).gt.smallnum) then
+                  if (sp_zer.eqv..true.) then ! first non zero value
+                    sp_count_i=sp_count_i+1
+                    sparse_dump_i(sp_count_i)= &
+                         ix+jy*numxgridn
+                    sp_zer=.false.
+                    sp_fact=sp_fact*(-1.)
+                 endif
+                 sp_count_r=sp_count_r+1
+                 sparse_dump_r(sp_count_r)= &
+                      sp_fact* &
+                      1.e12*wetgrid(ix,jy)/arean(ix,jy)
+  !                sparse_dump_u(sp_count_r)=
+  !    +            ,1.e12*wetgridsigma(ix,jy,ks,kp,nage)/area(ix,jy)
+              else ! concentration is zero
+                  sp_zer=.true.
+              endif
+            end do
+          end do
+         else
+           sp_count_i=0
+           sp_count_r=0
+         endif
+         write(unitoutgridppt) sp_count_i
+         write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
+         write(unitoutgridppt) sp_count_r
+         write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
+  !       write(unitoutgridppt) sp_count_u
+  !       write(unitoutgridppt) (sparse_dump_u(i),i=1,sp_count_r)
+
+
+  ! Dry deposition
+         sp_count_i=0
+         sp_count_r=0
+         sp_fact=-1.
+         sp_zer=.true.
+         if ((ldirect.eq.1).and.(DRYDEP)) then
+          do jy=0,numygridn-1
+            do ix=0,numxgridn-1
+                if (drygrid(ix,jy).gt.smallnum) then
+                  if (sp_zer.eqv..true.) then ! first non zero value
+                    sp_count_i=sp_count_i+1
+                    sparse_dump_i(sp_count_i)= &
+                         ix+jy*numxgridn
+                    sp_zer=.false.
+                    sp_fact=sp_fact*(-1)
+                 endif
+                 sp_count_r=sp_count_r+1
+                 sparse_dump_r(sp_count_r)= &
+                      sp_fact* &
+                      1.e12*drygrid(ix,jy)/arean(ix,jy)
+  !                sparse_dump_u(sp_count_r)=
+  !    +            ,1.e12*drygridsigma(ix,jy,ks,kp,nage)/area(ix,jy)
+              else ! concentration is zero
+                  sp_zer=.true.
+              endif
+            end do
+          end do
+         else
+           sp_count_i=0
+           sp_count_r=0
+         endif
+         write(unitoutgridppt) sp_count_i
+         write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
+         write(unitoutgridppt) sp_count_r
+         write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
+  !       write(unitoutgridppt) sp_count_u
+  !       write(unitoutgridppt) (sparse_dump_u(i),i=1,sp_count_r)
+
+
+  ! Mixing ratios
+         sp_count_i=0
+         sp_count_r=0
+         sp_fact=-1.
+         sp_zer=.true.
+          do kz=1,numzgrid
+            do jy=0,numygridn-1
+              do ix=0,numxgridn-1
+                if (grid(ix,jy,kz).gt.smallnum) then
+                  if (sp_zer.eqv..true.) then ! first non zero value
+                    sp_count_i=sp_count_i+1
+                    sparse_dump_i(sp_count_i)= &
+                         ix+jy*numxgridn+kz*numxgridn*numygridn
+                    sp_zer=.false.
+                    sp_fact=sp_fact*(-1.)
+                 endif
+                 sp_count_r=sp_count_r+1
+                 sparse_dump_r(sp_count_r)= &
+                      sp_fact* &
+                      1.e12*grid(ix,jy,kz) &
+                      /volumen(ix,jy,kz)/outnum* &
+                      weightair/weightmolar(ks)/densityoutgrid(ix,jy,kz)
+  !                sparse_dump_u(sp_count_r)=
+  !+              ,1.e12*gridsigma(ix,jy,kz,ks,kp,nage)/volume(ix,jy,kz)/
+  !+              outnum*weightair/weightmolar(ks)/
+  !+              densityoutgrid(ix,jy,kz)
+              else ! concentration is zero
+                  sp_zer=.true.
+              endif
+              end do
+            end do
+          end do
+         write(unitoutgridppt) sp_count_i
+         write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
+         write(unitoutgridppt) sp_count_r
+         write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
+  !       write(unitoutgridppt) sp_count_u
+  !       write(unitoutgridppt) (sparse_dump_u(i),i=1,sp_count_r)
+
+      endif ! output for ppt
+
+  end do
+  end do
+
+    close(unitoutgridppt)
+    close(unitoutgrid)
+
+  end do
+
+
+
+  ! Reinitialization of grid
+  !*************************
+
+  do ks=1,nspec
+  do kp=1,maxpointspec_act
+    do i=1,numreceptor
+      creceptor(i,ks)=0.
+    end do
+    do jy=0,numygridn-1
+      do ix=0,numxgridn-1
+        do l=1,nclassunc
+          do nage=1,nageclass
+            do kz=1,numzgrid
+              griduncn(ix,jy,kz,ks,kp,l,nage)=0.
+            end do
+          end do
+        end do
+      end do
+    end do
+  end do
+  end do
+
+
+end subroutine concoutput_nest
+
Index: /branches/FP_AI/src/concoutput_surf.f90
===================================================================
--- /branches/FP_AI/src/concoutput_surf.f90	(revision 23)
+++ /branches/FP_AI/src/concoutput_surf.f90	(revision 23)
@@ -0,0 +1,744 @@
+!**********************************************************************
+! 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 concoutput_surf(itime,outnum,gridtotalunc,wetgridtotalunc, &
+       drygridtotalunc)
+  !                        i     i          o             o
+  !       o
+  !*****************************************************************************
+  !                                                                            *
+  !     Output of the concentration grid and the receptor concentrations.      *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     24 May 1995                                                            *
+  !                                                                            *
+  !     13 April 1999, Major update: if output size is smaller, dump output    *
+  !                    in sparse matrix format; additional output of           *
+  !                    uncertainty                                             *
+  !                                                                            *
+  !     05 April 2000, Major update: output of age classes; output for backward*
+  !                    runs is time spent in grid cell times total mass of     *
+  !                    species.                                                *
+  !                                                                            *
+  !     17 February 2002, Appropriate dimensions for backward and forward runs *
+  !                       are now specified in file par_mod                    *
+  !                                                                            *
+  !     June 2006, write grid in sparse matrix with a single write command     *
+  !                in order to save disk space                                 *
+  !                                                                            *
+  !     2008 new sparse matrix format                                          *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! outnum          number of samples                                          *
+  ! ncells          number of cells with non-zero concentrations               *
+  ! sparse          .true. if in sparse matrix format, else .false.            *
+  ! tot_mu          1 for forward, initial mass mixing ration for backw. runs  *
+  !                                                                            *
+  !*****************************************************************************
+
+  use unc_mod
+  use point_mod
+  use outg_mod
+  use par_mod
+  use com_mod
+
+  implicit none
+
+  real(kind=dp) :: jul
+  integer :: itime,i,ix,jy,kz,ks,kp,l,iix,jjy,kzz,nage,jjjjmmdd,ihmmss
+  integer :: sp_count_i,sp_count_r
+  real :: sp_fact
+  real :: outnum,densityoutrecept(maxreceptor),xl,yl
+
+  !real densityoutgrid(0:numxgrid-1,0:numygrid-1,numzgrid),
+  !    +grid(0:numxgrid-1,0:numygrid-1,numzgrid,maxspec,maxpointspec_act,
+  !    +    maxageclass)
+  !real wetgrid(0:numxgrid-1,0:numygrid-1,maxspec,maxpointspec_act,
+  !    +       maxageclass)
+  !real drygrid(0:numxgrid-1,0:numygrid-1,maxspec,
+  !    +       maxpointspec_act,maxageclass)
+  !real gridsigma(0:numxgrid-1,0:numygrid-1,numzgrid,maxspec,
+  !    +       maxpointspec_act,maxageclass),
+  !    +     drygridsigma(0:numxgrid-1,0:numygrid-1,maxspec,
+  !    +     maxpointspec_act,maxageclass),
+  !    +     wetgridsigma(0:numxgrid-1,0:numygrid-1,maxspec,
+  !    +     maxpointspec_act,maxageclass)
+  !real factor(0:numxgrid-1,0:numygrid-1,numzgrid)
+  !real sparse_dump_r(numxgrid*numygrid*numzgrid)
+  !integer sparse_dump_i(numxgrid*numygrid*numzgrid)
+
+  !real sparse_dump_u(numxgrid*numygrid*numzgrid)
+  real :: auxgrid(nclassunc),gridtotal,gridsigmatotal,gridtotalunc
+  real :: wetgridtotal,wetgridsigmatotal,wetgridtotalunc
+  real :: drygridtotal,drygridsigmatotal,drygridtotalunc
+  real :: halfheight,dz,dz1,dz2,tot_mu(maxspec,maxpointspec_act)
+  real,parameter :: smallnum = tiny(0.0) ! smallest number that can be handled
+  real,parameter :: weightair=28.97
+  logical :: sp_zer
+  character :: adate*8,atime*6
+  character(len=3) :: anspec
+
+
+  if (verbosity.eq.1) then
+     print*,'inside concoutput_surf '
+     CALL SYSTEM_CLOCK(count_clock)
+     WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0   
+  endif
+
+  ! Determine current calendar date, needed for the file name
+  !**********************************************************
+
+  jul=bdate+real(itime,kind=dp)/86400._dp
+  call caldate(jul,jjjjmmdd,ihmmss)
+  write(adate,'(i8.8)') jjjjmmdd
+  write(atime,'(i6.6)') ihmmss
+  !write(unitdates,'(a)') adate//atime
+
+    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.
+  ! Thus, make loops either about nspec, or about numpoint
+  !*****************************************************************
+
+
+  if (ldirect.eq.1) then
+    do ks=1,nspec
+      do kp=1,maxpointspec_act
+        tot_mu(ks,kp)=1
+      end do
+    end do
+  else
+    do ks=1,nspec
+      do kp=1,maxpointspec_act
+        tot_mu(ks,kp)=xmass(kp,ks)
+      end do
+    end do
+  endif
+
+
+  if (verbosity.eq.1) then
+     print*,'concoutput_surf 2'
+     CALL SYSTEM_CLOCK(count_clock)
+     WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0   
+  endif
+
+  !*******************************************************************
+  ! Compute air density: sufficiently accurate to take it
+  ! from coarse grid at some time
+  ! Determine center altitude of output layer, and interpolate density
+  ! data to that altitude
+  !*******************************************************************
+
+  do kz=1,numzgrid
+    if (kz.eq.1) then
+      halfheight=outheight(1)/2.
+    else
+      halfheight=(outheight(kz)+outheight(kz-1))/2.
+    endif
+    do kzz=2,nz
+      if ((height(kzz-1).lt.halfheight).and. &
+           (height(kzz).gt.halfheight)) goto 46
+    end do
+46   kzz=max(min(kzz,nz),2)
+    dz1=halfheight-height(kzz-1)
+    dz2=height(kzz)-halfheight
+    dz=dz1+dz2
+    do jy=0,numygrid-1
+      do ix=0,numxgrid-1
+        xl=outlon0+real(ix)*dxout
+        yl=outlat0+real(jy)*dyout
+        xl=(xl-xlon0)/dx
+        yl=(yl-ylat0)/dx
+        iix=max(min(nint(xl),nxmin1),0)
+        jjy=max(min(nint(yl),nymin1),0)
+        densityoutgrid(ix,jy,kz)=(rho(iix,jjy,kzz,2)*dz1+ &
+             rho(iix,jjy,kzz-1,2)*dz2)/dz
+      end do
+    end do
+  end do
+
+    do i=1,numreceptor
+      xl=xreceptor(i)
+      yl=yreceptor(i)
+      iix=max(min(nint(xl),nxmin1),0)
+      jjy=max(min(nint(yl),nymin1),0)
+      densityoutrecept(i)=rho(iix,jjy,1,2)
+    end do
+
+
+  ! Output is different for forward and backward simulations
+    do kz=1,numzgrid
+      do jy=0,numygrid-1
+        do ix=0,numxgrid-1
+          if (ldirect.eq.1) then
+            factor3d(ix,jy,kz)=1.e12/volume(ix,jy,kz)/outnum
+          else
+            factor3d(ix,jy,kz)=real(abs(loutaver))/outnum
+          endif
+        end do
+      end do
+    end do
+
+  !*********************************************************************
+  ! Determine the standard deviation of the mean concentration or mixing
+  ! ratio (uncertainty of the output) and the dry and wet deposition
+  !*********************************************************************
+
+  if (verbosity.eq.1) then
+     print*,'concoutput_surf 3 (sd)'
+     CALL SYSTEM_CLOCK(count_clock)
+     WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0   
+  endif
+  gridtotal=0.
+  gridsigmatotal=0.
+  gridtotalunc=0.
+  wetgridtotal=0.
+  wetgridsigmatotal=0.
+  wetgridtotalunc=0.
+  drygridtotal=0.
+  drygridsigmatotal=0.
+  drygridtotalunc=0.
+
+  do ks=1,nspec
+
+  write(anspec,'(i3.3)') ks
+  if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
+    if (ldirect.eq.1) then
+      open(unitoutgrid,file=path(2)(1:length(2))//'grid_conc_'//adate// &
+           atime//'_'//anspec,form='unformatted')
+    else
+      open(unitoutgrid,file=path(2)(1:length(2))//'grid_time_'//adate// &
+           atime//'_'//anspec,form='unformatted')
+    endif
+     write(unitoutgrid) itime
+   endif
+
+  if ((iout.eq.2).or.(iout.eq.3)) then      ! mixing ratio
+   open(unitoutgridppt,file=path(2)(1:length(2))//'grid_pptv_'//adate// &
+        atime//'_'//anspec,form='unformatted')
+
+    write(unitoutgridppt) itime
+  endif
+
+  do kp=1,maxpointspec_act
+  do nage=1,nageclass
+
+    do jy=0,numygrid-1
+      do ix=0,numxgrid-1
+
+  ! WET DEPOSITION
+        if ((WETDEP).and.(ldirect.gt.0)) then
+            do l=1,nclassunc
+              auxgrid(l)=wetgridunc(ix,jy,ks,kp,l,nage)
+            end do
+            call mean(auxgrid,wetgrid(ix,jy), &
+                 wetgridsigma(ix,jy),nclassunc)
+  ! Multiply by number of classes to get total concentration
+            wetgrid(ix,jy)=wetgrid(ix,jy) &
+                 *nclassunc
+            wetgridtotal=wetgridtotal+wetgrid(ix,jy)
+  ! Calculate standard deviation of the mean
+            wetgridsigma(ix,jy)= &
+                 wetgridsigma(ix,jy)* &
+                 sqrt(real(nclassunc))
+            wetgridsigmatotal=wetgridsigmatotal+ &
+                 wetgridsigma(ix,jy)
+        endif
+
+  ! DRY DEPOSITION
+        if ((DRYDEP).and.(ldirect.gt.0)) then
+            do l=1,nclassunc
+              auxgrid(l)=drygridunc(ix,jy,ks,kp,l,nage)
+            end do
+            call mean(auxgrid,drygrid(ix,jy), &
+                 drygridsigma(ix,jy),nclassunc)
+  ! Multiply by number of classes to get total concentration
+            drygrid(ix,jy)=drygrid(ix,jy)* &
+                 nclassunc
+            drygridtotal=drygridtotal+drygrid(ix,jy)
+  ! Calculate standard deviation of the mean
+            drygridsigma(ix,jy)= &
+                 drygridsigma(ix,jy)* &
+                 sqrt(real(nclassunc))
+125         drygridsigmatotal=drygridsigmatotal+ &
+                 drygridsigma(ix,jy)
+        endif
+
+  ! CONCENTRATION OR MIXING RATIO
+        do kz=1,numzgrid
+            do l=1,nclassunc
+              auxgrid(l)=gridunc(ix,jy,kz,ks,kp,l,nage)
+            end do
+            call mean(auxgrid,grid(ix,jy,kz), &
+                 gridsigma(ix,jy,kz),nclassunc)
+  ! Multiply by number of classes to get total concentration
+            grid(ix,jy,kz)= &
+                 grid(ix,jy,kz)*nclassunc
+            gridtotal=gridtotal+grid(ix,jy,kz)
+  ! Calculate standard deviation of the mean
+            gridsigma(ix,jy,kz)= &
+                 gridsigma(ix,jy,kz)* &
+                 sqrt(real(nclassunc))
+            gridsigmatotal=gridsigmatotal+ &
+                 gridsigma(ix,jy,kz)
+        end do
+      end do
+    end do
+
+
+
+
+  !*******************************************************************
+  ! Generate output: may be in concentration (ng/m3) or in mixing
+  ! ratio (ppt) or both
+  ! Output the position and the values alternated multiplied by
+  ! 1 or -1, first line is number of values, number of positions
+  ! For backward simulations, the unit is seconds, stored in grid_time
+  !*******************************************************************
+  if (verbosity.eq.1) then
+     print*,'concoutput_surf 4 (output)'
+     CALL SYSTEM_CLOCK(count_clock)
+     WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0   
+  endif
+
+  ! Concentration output
+  !*********************
+  if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
+  if (verbosity.eq.1) then
+     print*,'concoutput_surf (Wet deposition)'
+     CALL SYSTEM_CLOCK(count_clock)
+     WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0   
+  endif
+
+  ! Wet deposition
+         sp_count_i=0
+         sp_count_r=0
+         sp_fact=-1.
+         sp_zer=.true.
+         if ((ldirect.eq.1).and.(WETDEP)) then
+         do jy=0,numygrid-1
+            do ix=0,numxgrid-1
+  !oncentraion greater zero
+              if (wetgrid(ix,jy).gt.smallnum) then
+                 if (sp_zer.eqv..true.) then ! first non zero value
+                    sp_count_i=sp_count_i+1
+                    sparse_dump_i(sp_count_i)=ix+jy*numxgrid
+                    sp_zer=.false.
+                    sp_fact=sp_fact*(-1.)
+                 endif
+                 sp_count_r=sp_count_r+1
+                 sparse_dump_r(sp_count_r)= &
+                      sp_fact*1.e12*wetgrid(ix,jy)/area(ix,jy)
+                 sparse_dump_u(sp_count_r)= &
+                      1.e12*wetgridsigma(ix,jy)/area(ix,jy)
+              else ! concentration is zero
+                  sp_zer=.true.
+              endif
+            end do
+         end do
+         else
+            sp_count_i=0
+            sp_count_r=0
+         endif
+         write(unitoutgrid) sp_count_i
+         write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
+         write(unitoutgrid) sp_count_r
+         write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
+!         write(unitoutgrid) sp_count_r
+         write(unitoutgrid) (sparse_dump_u(i),i=1,sp_count_r)
+
+  if (verbosity.eq.1) then
+     print*,'concoutput_surf (Dry deposition)'
+     CALL SYSTEM_CLOCK(count_clock)
+     WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0   
+  endif
+  ! Dry deposition
+         sp_count_i=0
+         sp_count_r=0
+         sp_fact=-1.
+         sp_zer=.true.
+         if ((ldirect.eq.1).and.(DRYDEP)) then
+          do jy=0,numygrid-1
+            do ix=0,numxgrid-1
+              if (drygrid(ix,jy).gt.smallnum) then
+                 if (sp_zer.eqv..true.) then ! first non zero value
+                    sp_count_i=sp_count_i+1
+                    sparse_dump_i(sp_count_i)=ix+jy*numxgrid
+                    sp_zer=.false.
+                    sp_fact=sp_fact*(-1.)
+                 endif
+                 sp_count_r=sp_count_r+1
+                 sparse_dump_r(sp_count_r)= &
+                      sp_fact* &
+                      1.e12*drygrid(ix,jy)/area(ix,jy)
+                  sparse_dump_u(sp_count_r)= &
+                      1.e12*drygridsigma(ix,jy)/area(ix,jy)
+              else ! concentration is zero
+                  sp_zer=.true.
+              endif
+            end do
+          end do
+         else
+            sp_count_i=0
+            sp_count_r=0
+         endif
+         write(unitoutgrid) sp_count_i
+         write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
+         write(unitoutgrid) sp_count_r
+         write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
+!         write(unitoutgrid) sp_count_r
+         write(unitoutgrid) (sparse_dump_u(i),i=1,sp_count_r)
+
+
+
+  if (verbosity.eq.1) then
+     print*,'concoutput_surf (Concentrations)'
+     CALL SYSTEM_CLOCK(count_clock)
+     WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0   
+  endif
+  ! Concentrations
+
+  ! if surf_only write only 1st layer 
+
+         if(surf_only.eq.1) then
+         sp_count_i=0
+         sp_count_r=0
+         sp_fact=-1.
+         sp_zer=.true.
+          do kz=1,1
+            do jy=0,numygrid-1
+              do ix=0,numxgrid-1
+                if (grid(ix,jy,kz).gt.smallnum) then
+                  if (sp_zer.eqv..true.) then ! first non zero value
+                    sp_count_i=sp_count_i+1
+                    sparse_dump_i(sp_count_i)= &
+                         ix+jy*numxgrid+kz*numxgrid*numygrid
+                    sp_zer=.false.
+                    sp_fact=sp_fact*(-1.)
+                   endif
+                   sp_count_r=sp_count_r+1
+                   sparse_dump_r(sp_count_r)= &
+                        sp_fact* &
+                        grid(ix,jy,kz)* &
+                        factor3d(ix,jy,kz)/tot_mu(ks,kp)
+  !                 if ((factor(ix,jy,kz)/tot_mu(ks,kp)).eq.0)
+  !    +              write (*,*) factor(ix,jy,kz),tot_mu(ks,kp),ks,kp
+                   sparse_dump_u(sp_count_r)= &
+                        gridsigma(ix,jy,kz)* &
+                        factor3d(ix,jy,kz)/tot_mu(ks,kp)
+              else ! concentration is zero
+                  sp_zer=.true.
+              endif
+              end do
+            end do
+          end do
+         write(unitoutgrid) sp_count_i
+         write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
+         write(unitoutgrid) sp_count_r
+         write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
+!         write(unitoutgrid) sp_count_r
+         write(unitoutgrid) (sparse_dump_u(i),i=1,sp_count_r)
+         else
+
+  ! write full vertical resolution
+  if (verbosity.eq.1) then
+     print*,'concoutput_surf (write full vertical resolution)'
+     CALL SYSTEM_CLOCK(count_clock)
+     WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0   
+  endif
+
+         sp_count_i=0
+         sp_count_r=0
+         sp_fact=-1.
+         sp_zer=.true.
+          do kz=1,numzgrid
+            do jy=0,numygrid-1
+              do ix=0,numxgrid-1
+                if (grid(ix,jy,kz).gt.smallnum) then
+                  if (sp_zer.eqv..true.) then ! first non zero value
+                    sp_count_i=sp_count_i+1
+                    sparse_dump_i(sp_count_i)= &
+                         ix+jy*numxgrid+kz*numxgrid*numygrid
+                    sp_zer=.false.
+                    sp_fact=sp_fact*(-1.)
+                   endif
+                   sp_count_r=sp_count_r+1
+                   sparse_dump_r(sp_count_r)= &
+                        sp_fact* &
+                        grid(ix,jy,kz)* &
+                        factor3d(ix,jy,kz)/tot_mu(ks,kp)
+  !                 if ((factor(ix,jy,kz)/tot_mu(ks,kp)).eq.0)
+  !    +              write (*,*) factor(ix,jy,kz),tot_mu(ks,kp),ks,kp
+                   sparse_dump_u(sp_count_r)= &
+                        gridsigma(ix,jy,kz)* &
+                        factor3d(ix,jy,kz)/tot_mu(ks,kp)
+              else ! concentration is zero
+                  sp_zer=.true.
+              endif
+              end do
+            end do
+          end do
+         write(unitoutgrid) sp_count_i
+         write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
+         write(unitoutgrid) sp_count_r
+         write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
+!         write(unitoutgrid) sp_count_r
+         write(unitoutgrid) (sparse_dump_u(i),i=1,sp_count_r)         
+         endif ! surf_only
+
+    endif !  concentration output
+
+  ! Mixing ratio output
+  !********************
+
+  if ((iout.eq.2).or.(iout.eq.3)) then      ! mixing ratio
+
+  ! Wet deposition
+         sp_count_i=0
+         sp_count_r=0
+         sp_fact=-1.
+         sp_zer=.true.
+         if ((ldirect.eq.1).and.(WETDEP)) then
+          do jy=0,numygrid-1
+            do ix=0,numxgrid-1
+                if (wetgrid(ix,jy).gt.smallnum) then
+                  if (sp_zer.eqv..true.) then ! first non zero value
+                    sp_count_i=sp_count_i+1
+                    sparse_dump_i(sp_count_i)= &
+                         ix+jy*numxgrid
+                    sp_zer=.false.
+                    sp_fact=sp_fact*(-1.)
+                 endif
+                 sp_count_r=sp_count_r+1
+                 sparse_dump_r(sp_count_r)= &
+                      sp_fact* &
+                      1.e12*wetgrid(ix,jy)/area(ix,jy)
+                 sparse_dump_u(sp_count_r)= &
+                      1.e12*wetgridsigma(ix,jy)/area(ix,jy)
+              else ! concentration is zero
+                  sp_zer=.true.
+              endif
+            end do
+          end do
+         else
+           sp_count_i=0
+           sp_count_r=0
+         endif
+         write(unitoutgridppt) sp_count_i
+         write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
+         write(unitoutgridppt) sp_count_r
+         write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
+!         write(unitoutgridppt) sp_count_r
+         write(unitoutgridppt) (sparse_dump_u(i),i=1,sp_count_r)
+
+
+  ! Dry deposition
+         sp_count_i=0
+         sp_count_r=0
+         sp_fact=-1.
+         sp_zer=.true.
+         if ((ldirect.eq.1).and.(DRYDEP)) then
+          do jy=0,numygrid-1
+            do ix=0,numxgrid-1
+                if (drygrid(ix,jy).gt.smallnum) then
+                  if (sp_zer.eqv..true.) then ! first non zero value
+                    sp_count_i=sp_count_i+1
+                    sparse_dump_i(sp_count_i)= &
+                         ix+jy*numxgrid
+                    sp_zer=.false.
+                    sp_fact=sp_fact*(-1)
+                 endif
+                 sp_count_r=sp_count_r+1
+                 sparse_dump_r(sp_count_r)= &
+                      sp_fact* &
+                      1.e12*drygrid(ix,jy)/area(ix,jy)
+                 sparse_dump_u(sp_count_r)= &
+                      1.e12*drygridsigma(ix,jy)/area(ix,jy)
+              else ! concentration is zero
+                  sp_zer=.true.
+              endif
+            end do
+          end do
+         else
+           sp_count_i=0
+           sp_count_r=0
+         endif
+         write(unitoutgridppt) sp_count_i
+         write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
+         write(unitoutgridppt) sp_count_r
+         write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
+!         write(unitoutgridppt) sp_count_r
+         write(unitoutgridppt) (sparse_dump_u(i),i=1,sp_count_r)
+
+
+  ! Mixing ratios
+
+  ! if surf_only write only 1st layer 
+
+         if(surf_only.eq.1) then
+         sp_count_i=0
+         sp_count_r=0
+         sp_fact=-1.
+         sp_zer=.true.
+          do kz=1,1
+            do jy=0,numygrid-1
+              do ix=0,numxgrid-1
+                if (grid(ix,jy,kz).gt.smallnum) then
+                  if (sp_zer.eqv..true.) then ! first non zero value
+                    sp_count_i=sp_count_i+1
+                    sparse_dump_i(sp_count_i)= &
+                         ix+jy*numxgrid+kz*numxgrid*numygrid
+                    sp_zer=.false.
+                    sp_fact=sp_fact*(-1.)
+                 endif
+                 sp_count_r=sp_count_r+1
+                 sparse_dump_r(sp_count_r)= &
+                      sp_fact* &
+                      1.e12*grid(ix,jy,kz) &
+                      /volume(ix,jy,kz)/outnum* &
+                      weightair/weightmolar(ks)/densityoutgrid(ix,jy,kz)
+                 sparse_dump_u(sp_count_r)= &
+                      1.e12*gridsigma(ix,jy,kz)/volume(ix,jy,kz)/ &
+                      outnum*weightair/weightmolar(ks)/ &
+                      densityoutgrid(ix,jy,kz)
+              else ! concentration is zero
+                  sp_zer=.true.
+              endif
+              end do
+            end do
+          end do
+         write(unitoutgridppt) sp_count_i
+         write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
+         write(unitoutgridppt) sp_count_r
+         write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
+!         write(unitoutgridppt) sp_count_r
+         write(unitoutgridppt) (sparse_dump_u(i),i=1,sp_count_r)
+         else
+
+  ! write full vertical resolution
+
+         sp_count_i=0
+         sp_count_r=0
+         sp_fact=-1.
+         sp_zer=.true.
+          do kz=1,numzgrid
+            do jy=0,numygrid-1
+              do ix=0,numxgrid-1
+                if (grid(ix,jy,kz).gt.smallnum) then
+                  if (sp_zer.eqv..true.) then ! first non zero value
+                    sp_count_i=sp_count_i+1
+                    sparse_dump_i(sp_count_i)= &
+                         ix+jy*numxgrid+kz*numxgrid*numygrid
+                    sp_zer=.false.
+                    sp_fact=sp_fact*(-1.)
+                 endif
+                 sp_count_r=sp_count_r+1
+                 sparse_dump_r(sp_count_r)= &
+                      sp_fact* &
+                      1.e12*grid(ix,jy,kz) &
+                      /volume(ix,jy,kz)/outnum* &
+                      weightair/weightmolar(ks)/densityoutgrid(ix,jy,kz)
+                 sparse_dump_u(sp_count_r)= &
+                      1.e12*gridsigma(ix,jy,kz)/volume(ix,jy,kz)/ &
+                      outnum*weightair/weightmolar(ks)/ &
+                      densityoutgrid(ix,jy,kz)
+              else ! concentration is zero
+                  sp_zer=.true.
+              endif
+              end do
+            end do
+          end do
+         write(unitoutgridppt) sp_count_i
+         write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
+         write(unitoutgridppt) sp_count_r
+         write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
+!         write(unitoutgridppt) sp_count_r
+         write(unitoutgridppt) (sparse_dump_u(i),i=1,sp_count_r)
+         endif ! surf_only
+
+      endif ! output for ppt
+
+  end do
+  end do
+
+    close(unitoutgridppt)
+    close(unitoutgrid)
+
+  end do
+
+  if (gridtotal.gt.0.) gridtotalunc=gridsigmatotal/gridtotal
+  if (wetgridtotal.gt.0.) wetgridtotalunc=wetgridsigmatotal/ &
+       wetgridtotal
+  if (drygridtotal.gt.0.) drygridtotalunc=drygridsigmatotal/ &
+       drygridtotal
+
+  ! Dump of receptor concentrations
+
+    if (numreceptor.gt.0 .and. (iout.eq.2 .or. iout.eq.3)  ) then
+      write(unitoutreceptppt) itime
+      do ks=1,nspec
+        write(unitoutreceptppt) (1.e12*creceptor(i,ks)/outnum* &
+             weightair/weightmolar(ks)/densityoutrecept(i),i=1,numreceptor)
+      end do
+    endif
+
+  ! Dump of receptor concentrations
+
+    if (numreceptor.gt.0) then
+      write(unitoutrecept) itime
+      do ks=1,nspec
+        write(unitoutrecept) (1.e12*creceptor(i,ks)/outnum, &
+             i=1,numreceptor)
+      end do
+    endif
+
+
+
+  ! Reinitialization of grid
+  !*************************
+
+  do ks=1,nspec
+  do kp=1,maxpointspec_act
+    do i=1,numreceptor
+      creceptor(i,ks)=0.
+    end do
+    do jy=0,numygrid-1
+      do ix=0,numxgrid-1
+        do l=1,nclassunc
+          do nage=1,nageclass
+            do kz=1,numzgrid
+              gridunc(ix,jy,kz,ks,kp,l,nage)=0.
+            end do
+          end do
+        end do
+      end do
+    end do
+  end do
+  end do
+
+
+end subroutine concoutput_surf
Index: /branches/FP_AI/src/concoutput_surf_nest.f90
===================================================================
--- /branches/FP_AI/src/concoutput_surf_nest.f90	(revision 23)
+++ /branches/FP_AI/src/concoutput_surf_nest.f90	(revision 23)
@@ -0,0 +1,652 @@
+!**********************************************************************
+! 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 concoutput_surf_nest(itime,outnum)
+  !                        i     i
+  !*****************************************************************************
+  !                                                                            *
+  !     Output of the concentration grid and the receptor concentrations.      *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     24 May 1995                                                            *
+  !                                                                            *
+  !     13 April 1999, Major update: if output size is smaller, dump output    *
+  !                    in sparse matrix format; additional output of           *
+  !                    uncertainty                                             *
+  !                                                                            *
+  !     05 April 2000, Major update: output of age classes; output for backward*
+  !                    runs is time spent in grid cell times total mass of     *
+  !                    species.                                                *
+  !                                                                            *
+  !     17 February 2002, Appropriate dimensions for backward and forward runs *
+  !                       are now specified in file par_mod                    *
+  !                                                                            *
+  !     June 2006, write grid in sparse matrix with a single write command     *
+  !                in order to save disk space                                 *
+  !                                                                            *
+  !     2008 new sparse matrix format                                          *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! outnum          number of samples                                          *
+  ! ncells          number of cells with non-zero concentrations               *
+  ! sparse          .true. if in sparse matrix format, else .false.            *
+  ! tot_mu          1 for forward, initial mass mixing ration for backw. runs  *
+  !                                                                            *
+  !*****************************************************************************
+
+  use unc_mod
+  use point_mod
+  use outg_mod
+  use par_mod
+  use com_mod
+
+  implicit none
+
+  real(kind=dp) :: jul
+  integer :: itime,i,ix,jy,kz,ks,kp,l,iix,jjy,kzz,nage,jjjjmmdd,ihmmss
+  integer :: sp_count_i,sp_count_r
+  real :: sp_fact
+  real :: outnum,densityoutrecept(maxreceptor),xl,yl
+
+  !real densityoutgrid(0:numxgrid-1,0:numygrid-1,numzgrid),
+  !    +grid(0:numxgrid-1,0:numygrid-1,numzgrid,maxspec,maxpointspec_act,
+  !    +    maxageclass)
+  !real wetgrid(0:numxgrid-1,0:numygrid-1,maxspec,maxpointspec_act,
+  !    +       maxageclass)
+  !real drygrid(0:numxgrid-1,0:numygrid-1,maxspec,
+  !    +       maxpointspec_act,maxageclass)
+  !real gridsigma(0:numxgrid-1,0:numygrid-1,numzgrid,maxspec,
+  !    +       maxpointspec_act,maxageclass),
+  !    +     drygridsigma(0:numxgrid-1,0:numygrid-1,maxspec,
+  !    +     maxpointspec_act,maxageclass),
+  !    +     wetgridsigma(0:numxgrid-1,0:numygrid-1,maxspec,
+  !    +     maxpointspec_act,maxageclass)
+  !real factor(0:numxgrid-1,0:numygrid-1,numzgrid)
+  !real sparse_dump_r(numxgrid*numygrid*numzgrid)
+  !integer sparse_dump_i(numxgrid*numygrid*numzgrid)
+
+  !real sparse_dump_u(numxgrid*numygrid*numzgrid)
+  real :: auxgrid(nclassunc)
+  real :: halfheight,dz,dz1,dz2,tot_mu(maxspec,maxpointspec_act)
+  real,parameter :: smallnum = tiny(0.0) ! smallest number that can be handled
+  real,parameter :: weightair=28.97
+  logical :: sp_zer
+  character :: adate*8,atime*6
+  character(len=3) :: anspec
+
+
+  ! Determine current calendar date, needed for the file name
+  !**********************************************************
+
+  jul=bdate+real(itime,kind=dp)/86400._dp
+  call caldate(jul,jjjjmmdd,ihmmss)
+  write(adate,'(i8.8)') jjjjmmdd
+  write(atime,'(i6.6)') ihmmss
+
+
+  ! For forward simulations, output fields have dimension MAXSPEC,
+  ! for backward simulations, output fields have dimension MAXPOINT.
+  ! Thus, make loops either about nspec, or about numpoint
+  !*****************************************************************
+
+
+    if (ldirect.eq.1) then
+       do ks=1,nspec
+         do kp=1,maxpointspec_act
+           tot_mu(ks,kp)=1
+         end do
+       end do
+   else
+      do ks=1,nspec
+             do kp=1,maxpointspec_act
+               tot_mu(ks,kp)=xmass(kp,ks)
+             end do
+      end do
+    endif
+
+
+  !*******************************************************************
+  ! Compute air density: sufficiently accurate to take it
+  ! from coarse grid at some time
+  ! Determine center altitude of output layer, and interpolate density
+  ! data to that altitude
+  !*******************************************************************
+
+  do kz=1,numzgrid
+    if (kz.eq.1) then
+      halfheight=outheight(1)/2.
+    else
+      halfheight=(outheight(kz)+outheight(kz-1))/2.
+    endif
+    do kzz=2,nz
+      if ((height(kzz-1).lt.halfheight).and. &
+           (height(kzz).gt.halfheight)) goto 46
+    end do
+46   kzz=max(min(kzz,nz),2)
+    dz1=halfheight-height(kzz-1)
+    dz2=height(kzz)-halfheight
+    dz=dz1+dz2
+    do jy=0,numygridn-1
+      do ix=0,numxgridn-1
+        xl=outlon0n+real(ix)*dxoutn
+        yl=outlat0n+real(jy)*dyoutn
+        xl=(xl-xlon0)/dx
+        yl=(yl-ylat0)/dy
+        iix=max(min(nint(xl),nxmin1),0)
+        jjy=max(min(nint(yl),nymin1),0)
+        densityoutgrid(ix,jy,kz)=(rho(iix,jjy,kzz,2)*dz1+ &
+             rho(iix,jjy,kzz-1,2)*dz2)/dz
+      end do
+    end do
+  end do
+
+    do i=1,numreceptor
+      xl=xreceptor(i)
+      yl=yreceptor(i)
+      iix=max(min(nint(xl),nxmin1),0)
+      jjy=max(min(nint(yl),nymin1),0)
+      densityoutrecept(i)=rho(iix,jjy,1,2)
+    end do
+
+
+  ! Output is different for forward and backward simulations
+    do kz=1,numzgrid
+      do jy=0,numygridn-1
+        do ix=0,numxgridn-1
+          if (ldirect.eq.1) then
+            factor3d(ix,jy,kz)=1.e12/volumen(ix,jy,kz)/outnum
+          else
+            factor3d(ix,jy,kz)=real(abs(loutaver))/outnum
+          endif
+        end do
+      end do
+    end do
+
+  !*********************************************************************
+  ! Determine the standard deviation of the mean concentration or mixing
+  ! ratio (uncertainty of the output) and the dry and wet deposition
+  !*********************************************************************
+
+  do ks=1,nspec
+
+  write(anspec,'(i3.3)') ks
+  if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
+    if (ldirect.eq.1) then
+      open(unitoutgrid,file=path(2)(1:length(2))//'grid_conc_nest_' &
+           //adate// &
+           atime//'_'//anspec,form='unformatted')
+    else
+      open(unitoutgrid,file=path(2)(1:length(2))//'grid_time_nest_' &
+           //adate// &
+           atime//'_'//anspec,form='unformatted')
+    endif
+     write(unitoutgrid) itime
+   endif
+
+  if ((iout.eq.2).or.(iout.eq.3)) then      ! mixing ratio
+   open(unitoutgridppt,file=path(2)(1:length(2))//'grid_pptv_nest_' &
+        //adate// &
+        atime//'_'//anspec,form='unformatted')
+
+    write(unitoutgridppt) itime
+  endif
+
+  do kp=1,maxpointspec_act
+  do nage=1,nageclass
+
+    do jy=0,numygridn-1
+      do ix=0,numxgridn-1
+
+  ! WET DEPOSITION
+        if ((WETDEP).and.(ldirect.gt.0)) then
+            do l=1,nclassunc
+              auxgrid(l)=wetgriduncn(ix,jy,ks,kp,l,nage)
+            end do
+            call mean(auxgrid,wetgrid(ix,jy), &
+                 wetgridsigma(ix,jy),nclassunc)
+  ! Multiply by number of classes to get total concentration
+            wetgrid(ix,jy)=wetgrid(ix,jy) &
+                 *nclassunc
+  ! Calculate standard deviation of the mean
+            wetgridsigma(ix,jy)= &
+                 wetgridsigma(ix,jy)* &
+                 sqrt(real(nclassunc))
+        endif
+
+  ! DRY DEPOSITION
+        if ((DRYDEP).and.(ldirect.gt.0)) then
+            do l=1,nclassunc
+              auxgrid(l)=drygriduncn(ix,jy,ks,kp,l,nage)
+            end do
+            call mean(auxgrid,drygrid(ix,jy), &
+                 drygridsigma(ix,jy),nclassunc)
+  ! Multiply by number of classes to get total concentration
+            drygrid(ix,jy)=drygrid(ix,jy)* &
+                 nclassunc
+  ! Calculate standard deviation of the mean
+            drygridsigma(ix,jy)= &
+                 drygridsigma(ix,jy)* &
+                 sqrt(real(nclassunc))
+        endif
+
+  ! CONCENTRATION OR MIXING RATIO
+        do kz=1,numzgrid
+            do l=1,nclassunc
+              auxgrid(l)=griduncn(ix,jy,kz,ks,kp,l,nage)
+            end do
+            call mean(auxgrid,grid(ix,jy,kz), &
+                 gridsigma(ix,jy,kz),nclassunc)
+  ! Multiply by number of classes to get total concentration
+            grid(ix,jy,kz)= &
+                 grid(ix,jy,kz)*nclassunc
+  ! Calculate standard deviation of the mean
+            gridsigma(ix,jy,kz)= &
+                 gridsigma(ix,jy,kz)* &
+                 sqrt(real(nclassunc))
+        end do
+      end do
+    end do
+
+
+  !*******************************************************************
+  ! Generate output: may be in concentration (ng/m3) or in mixing
+  ! ratio (ppt) or both
+  ! Output the position and the values alternated multiplied by
+  ! 1 or -1, first line is number of values, number of positions
+  ! For backward simulations, the unit is seconds, stored in grid_time
+  !*******************************************************************
+
+  ! Concentration output
+  !*********************
+  if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
+
+  ! Wet deposition
+         sp_count_i=0
+         sp_count_r=0
+         sp_fact=-1.
+         sp_zer=.true.
+         if ((ldirect.eq.1).and.(WETDEP)) then
+         do jy=0,numygridn-1
+            do ix=0,numxgridn-1
+  !oncentraion greater zero
+              if (wetgrid(ix,jy).gt.smallnum) then
+                 if (sp_zer.eqv..true.) then ! first non zero value
+                    sp_count_i=sp_count_i+1
+                    sparse_dump_i(sp_count_i)=ix+jy*numxgridn
+                    sp_zer=.false.
+                    sp_fact=sp_fact*(-1.)
+                 endif
+                 sp_count_r=sp_count_r+1
+                 sparse_dump_r(sp_count_r)= &
+                      sp_fact*1.e12*wetgrid(ix,jy)/arean(ix,jy)
+                 sparse_dump_u(sp_count_r)= &
+                      1.e12*wetgridsigma(ix,jy)/area(ix,jy)
+              else ! concentration is zero
+                  sp_zer=.true.
+              endif
+            end do
+         end do
+         else
+            sp_count_i=0
+            sp_count_r=0
+         endif
+         write(unitoutgrid) sp_count_i
+         write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
+         write(unitoutgrid) sp_count_r
+         write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
+         write(unitoutgrid) sp_count_r
+         write(unitoutgrid) (sparse_dump_u(i),i=1,sp_count_r)
+
+  ! Dry deposition
+         sp_count_i=0
+         sp_count_r=0
+         sp_fact=-1.
+         sp_zer=.true.
+         if ((ldirect.eq.1).and.(DRYDEP)) then
+          do jy=0,numygridn-1
+            do ix=0,numxgridn-1
+              if (drygrid(ix,jy).gt.smallnum) then
+                 if (sp_zer.eqv..true.) then ! first non zero value
+                    sp_count_i=sp_count_i+1
+                    sparse_dump_i(sp_count_i)=ix+jy*numxgridn
+                    sp_zer=.false.
+                    sp_fact=sp_fact*(-1.)
+                 endif
+                 sp_count_r=sp_count_r+1
+                 sparse_dump_r(sp_count_r)= &
+                      sp_fact* &
+                      1.e12*drygrid(ix,jy)/arean(ix,jy)
+                 sparse_dump_u(sp_count_r)= &
+                      1.e12*drygridsigma(ix,jy)/area(ix,jy)
+              else ! concentration is zero
+                  sp_zer=.true.
+              endif
+            end do
+          end do
+         else
+            sp_count_i=0
+            sp_count_r=0
+         endif
+         write(unitoutgrid) sp_count_i
+         write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
+         write(unitoutgrid) sp_count_r
+         write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
+         write(unitoutgrid) sp_count_r
+         write(unitoutgrid) (sparse_dump_u(i),i=1,sp_count_r)
+
+
+
+  ! Concentrations
+
+  ! if surf_only write only 1st layer 
+
+         if(surf_only.eq.1) then
+         sp_count_i=0
+         sp_count_r=0
+         sp_fact=-1.
+         sp_zer=.true.
+          do kz=1,1
+            do jy=0,numygridn-1
+              do ix=0,numxgridn-1
+                if (grid(ix,jy,kz).gt.smallnum) then
+                  if (sp_zer.eqv..true.) then ! first non zero value
+                    sp_count_i=sp_count_i+1
+                    sparse_dump_i(sp_count_i)= &
+                         ix+jy*numxgridn+kz*numxgridn*numygridn
+                    sp_zer=.false.
+                    sp_fact=sp_fact*(-1.)
+                   endif
+                   sp_count_r=sp_count_r+1
+                   sparse_dump_r(sp_count_r)= &
+                        sp_fact* &
+                        grid(ix,jy,kz)* &
+                        factor3d(ix,jy,kz)/tot_mu(ks,kp)
+  !                 if ((factor(ix,jy,kz)/tot_mu(ks,kp)).eq.0)
+  !    +              write (*,*) factor(ix,jy,kz),tot_mu(ks,kp),ks,kp
+                   sparse_dump_u(sp_count_r)= &
+                        gridsigma(ix,jy,kz)* &
+                        factor3d(ix,jy,kz)/tot_mu(ks,kp)
+              else ! concentration is zero
+                  sp_zer=.true.
+              endif
+              end do
+            end do
+          end do
+         write(unitoutgrid) sp_count_i
+         write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
+         write(unitoutgrid) sp_count_r
+         write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
+         write(unitoutgrid) sp_count_r
+         write(unitoutgrid) (sparse_dump_u(i),i=1,sp_count_r)
+         else
+
+  ! write full vertical resolution
+
+         sp_count_i=0
+         sp_count_r=0
+         sp_fact=-1.
+         sp_zer=.true.
+          do kz=1,numzgrid
+            do jy=0,numygridn-1
+              do ix=0,numxgridn-1
+                if (grid(ix,jy,kz).gt.smallnum) then
+                  if (sp_zer.eqv..true.) then ! first non zero value
+                    sp_count_i=sp_count_i+1
+                    sparse_dump_i(sp_count_i)= &
+                         ix+jy*numxgridn+kz*numxgridn*numygridn
+                    sp_zer=.false.
+                    sp_fact=sp_fact*(-1.)
+                   endif
+                   sp_count_r=sp_count_r+1
+                   sparse_dump_r(sp_count_r)= &
+                        sp_fact* &
+                        grid(ix,jy,kz)* &
+                        factor3d(ix,jy,kz)/tot_mu(ks,kp)
+  !                 if ((factor(ix,jy,kz)/tot_mu(ks,kp)).eq.0)
+  !    +              write (*,*) factor(ix,jy,kz),tot_mu(ks,kp),ks,kp
+                   sparse_dump_u(sp_count_r)= &
+                        gridsigma(ix,jy,kz)* &
+                        factor3d(ix,jy,kz)/tot_mu(ks,kp)
+              else ! concentration is zero
+                  sp_zer=.true.
+              endif
+              end do
+            end do
+          end do
+         write(unitoutgrid) sp_count_i
+         write(unitoutgrid) (sparse_dump_i(i),i=1,sp_count_i)
+         write(unitoutgrid) sp_count_r
+         write(unitoutgrid) (sparse_dump_r(i),i=1,sp_count_r)
+         write(unitoutgrid) sp_count_r
+         write(unitoutgrid) (sparse_dump_u(i),i=1,sp_count_r)
+         endif ! surf_only
+
+
+    endif !  concentration output
+
+  ! Mixing ratio output
+  !********************
+
+  if ((iout.eq.2).or.(iout.eq.3)) then      ! mixing ratio
+
+  ! Wet deposition
+         sp_count_i=0
+         sp_count_r=0
+         sp_fact=-1.
+         sp_zer=.true.
+         if ((ldirect.eq.1).and.(WETDEP)) then
+          do jy=0,numygridn-1
+            do ix=0,numxgridn-1
+                if (wetgrid(ix,jy).gt.smallnum) then
+                  if (sp_zer.eqv..true.) then ! first non zero value
+                    sp_count_i=sp_count_i+1
+                    sparse_dump_i(sp_count_i)= &
+                         ix+jy*numxgridn
+                    sp_zer=.false.
+                    sp_fact=sp_fact*(-1.)
+                 endif
+                 sp_count_r=sp_count_r+1
+                 sparse_dump_r(sp_count_r)= &
+                      sp_fact* &
+                      1.e12*wetgrid(ix,jy)/arean(ix,jy)
+                 sparse_dump_u(sp_count_r)= &
+                      1.e12*wetgridsigma(ix,jy)/area(ix,jy)
+              else ! concentration is zero
+                  sp_zer=.true.
+              endif
+            end do
+          end do
+         else
+           sp_count_i=0
+           sp_count_r=0
+         endif
+         write(unitoutgridppt) sp_count_i
+         write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
+         write(unitoutgridppt) sp_count_r
+         write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
+         write(unitoutgridppt) sp_count_r
+         write(unitoutgridppt) (sparse_dump_u(i),i=1,sp_count_r)
+
+
+  ! Dry deposition
+         sp_count_i=0
+         sp_count_r=0
+         sp_fact=-1.
+         sp_zer=.true.
+         if ((ldirect.eq.1).and.(DRYDEP)) then
+          do jy=0,numygridn-1
+            do ix=0,numxgridn-1
+                if (drygrid(ix,jy).gt.smallnum) then
+                  if (sp_zer.eqv..true.) then ! first non zero value
+                    sp_count_i=sp_count_i+1
+                    sparse_dump_i(sp_count_i)= &
+                         ix+jy*numxgridn
+                    sp_zer=.false.
+                    sp_fact=sp_fact*(-1)
+                 endif
+                 sp_count_r=sp_count_r+1
+                 sparse_dump_r(sp_count_r)= &
+                      sp_fact* &
+                      1.e12*drygrid(ix,jy)/arean(ix,jy)
+                 sparse_dump_u(sp_count_r)= &
+                      1.e12*drygridsigma(ix,jy)/area(ix,jy)
+              else ! concentration is zero
+                  sp_zer=.true.
+              endif
+            end do
+          end do
+         else
+           sp_count_i=0
+           sp_count_r=0
+         endif
+         write(unitoutgridppt) sp_count_i
+         write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
+         write(unitoutgridppt) sp_count_r
+         write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
+         write(unitoutgridppt) sp_count_r
+         write(unitoutgridppt) (sparse_dump_u(i),i=1,sp_count_r)
+
+
+  ! Mixing ratios
+
+    ! if surf_only write only 1st layer 
+
+         if(surf_only.eq.1) then
+         sp_count_i=0
+         sp_count_r=0
+         sp_fact=-1.
+         sp_zer=.true.
+          do kz=1,1
+            do jy=0,numygridn-1
+              do ix=0,numxgridn-1
+                if (grid(ix,jy,kz).gt.smallnum) then
+                  if (sp_zer.eqv..true.) then ! first non zero value
+                    sp_count_i=sp_count_i+1
+                    sparse_dump_i(sp_count_i)= &
+                         ix+jy*numxgridn+kz*numxgridn*numygridn
+                    sp_zer=.false.
+                    sp_fact=sp_fact*(-1.)
+                 endif
+                 sp_count_r=sp_count_r+1
+                 sparse_dump_r(sp_count_r)= &
+                      sp_fact* &
+                      1.e12*grid(ix,jy,kz) &
+                      /volumen(ix,jy,kz)/outnum* &
+                      weightair/weightmolar(ks)/densityoutgrid(ix,jy,kz)
+                 sparse_dump_u(sp_count_r)= &
+                      1.e12*gridsigma(ix,jy,kz)/volumen(ix,jy,kz)/ &
+                      outnum*weightair/weightmolar(ks)/ &
+                      densityoutgrid(ix,jy,kz)
+              else ! concentration is zero
+                  sp_zer=.true.
+              endif
+              end do
+            end do
+          end do
+         write(unitoutgridppt) sp_count_i
+         write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
+         write(unitoutgridppt) sp_count_r
+         write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
+         write(unitoutgridppt) sp_count_r
+         write(unitoutgridppt) (sparse_dump_u(i),i=1,sp_count_r)
+         else
+
+  ! write full vertical resolution
+
+         sp_count_i=0
+         sp_count_r=0
+         sp_fact=-1.
+         sp_zer=.true.
+          do kz=1,numzgrid
+            do jy=0,numygridn-1
+              do ix=0,numxgridn-1
+                if (grid(ix,jy,kz).gt.smallnum) then
+                  if (sp_zer.eqv..true.) then ! first non zero value
+                    sp_count_i=sp_count_i+1
+                    sparse_dump_i(sp_count_i)= &
+                         ix+jy*numxgridn+kz*numxgridn*numygridn
+                    sp_zer=.false.
+                    sp_fact=sp_fact*(-1.)
+                 endif
+                 sp_count_r=sp_count_r+1
+                 sparse_dump_r(sp_count_r)= &
+                      sp_fact* &
+                      1.e12*grid(ix,jy,kz) &
+                      /volumen(ix,jy,kz)/outnum* &
+                      weightair/weightmolar(ks)/densityoutgrid(ix,jy,kz)
+                 sparse_dump_u(sp_count_r)= &
+                      1.e12*gridsigma(ix,jy,kz)/volumen(ix,jy,kz)/ &
+                      outnum*weightair/weightmolar(ks)/ &
+                      densityoutgrid(ix,jy,kz)
+              else ! concentration is zero
+                  sp_zer=.true.
+              endif
+              end do
+            end do
+          end do
+         write(unitoutgridppt) sp_count_i
+         write(unitoutgridppt) (sparse_dump_i(i),i=1,sp_count_i)
+         write(unitoutgridppt) sp_count_r
+         write(unitoutgridppt) (sparse_dump_r(i),i=1,sp_count_r)
+         write(unitoutgridppt) sp_count_r
+         write(unitoutgridppt) (sparse_dump_u(i),i=1,sp_count_r)
+         endif ! surf_only
+
+      endif ! output for ppt
+
+  end do
+  end do
+
+    close(unitoutgridppt)
+    close(unitoutgrid)
+
+  end do
+
+
+
+  ! Reinitialization of grid
+  !*************************
+
+  do ks=1,nspec
+  do kp=1,maxpointspec_act
+    do i=1,numreceptor
+      creceptor(i,ks)=0.
+    end do
+    do jy=0,numygridn-1
+      do ix=0,numxgridn-1
+        do l=1,nclassunc
+          do nage=1,nageclass
+            do kz=1,numzgrid
+              griduncn(ix,jy,kz,ks,kp,l,nage)=0.
+            end do
+          end do
+        end do
+      end do
+    end do
+  end do
+  end do
+
+
+end subroutine concoutput_surf_nest
+
Index: /branches/FP_AI/src/conv_mod.f90
===================================================================
--- /branches/FP_AI/src/conv_mod.f90	(revision 23)
+++ /branches/FP_AI/src/conv_mod.f90	(revision 23)
@@ -0,0 +1,34 @@
+!*******************************************************************************
+!   Include file for convection
+!   This file contains a global common block used by convect
+!   and other subroutines
+!   Author: P. Ferstl
+!
+!   Feb 2001
+!
+!*******************************************************************************
+
+module conv_mod
+
+  use par_mod, only: nconvlevmax, na, nxmax, nymax, nxmaxn, nymaxn, maxnests
+
+  implicit none
+
+  !integer,parameter :: nconvlevmax = nuvzmax-1, &
+  !                     na = nconvlevmax+1
+  !these parameters are defined in par_mod now!
+
+  real :: pconv(nconvlevmax),phconv(na),dpr(nconvlevmax)
+  real :: pconv_hpa(nconvlevmax),phconv_hpa(na)
+
+  real :: ft(nconvlevmax), fq(nconvlevmax)
+  real :: fmass(nconvlevmax,nconvlevmax),sub(nconvlevmax)
+  real :: fmassfrac(nconvlevmax,nconvlevmax)
+  real :: cbaseflux(0:nxmax-1,0:nymax-1)
+  real :: cbasefluxn(0:nxmaxn-1,0:nymaxn-1,maxnests)
+  real :: tconv(na),qconv(na),qsconv(na)
+  real :: psconv,tt2conv,td2conv
+
+  integer :: nconvlev,nconvtop
+
+end module conv_mod
Index: /branches/FP_AI/src/convect43c.f90
===================================================================
--- /branches/FP_AI/src/convect43c.f90	(revision 23)
+++ /branches/FP_AI/src/convect43c.f90	(revision 23)
@@ -0,0 +1,1110 @@
+!**********************************************************************
+! 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 CONVECT                        *****
+!****                          VERSION 4.3c                           *****
+!****                          20 May, 2002                           *****
+!****                          Kerry Emanuel                          *****
+!**************************************************************************
+!
+  SUBROUTINE CONVECT &
+         (ND,  NL,   DELT, IFLAG, &
+         PRECIP, WD,   TPRIME, QPRIME, CBMF    )
+  !
+  !-cv *************************************************************************
+  !-cv C. Forster, November 2003 - May 2004:
+  !-cv
+  !-cv The subroutine has been downloaded from Kerry Emanuel's homepage,
+  !-cv where further infos on the convection scheme can be found
+  !-cv http://www-paoc.mit.edu/~emanuel/home.html
+  !-cv
+  !-cv The following changes have been made to integrate this subroutine
+  !-cv into FLEXPART
+  !-cv
+  !-cv Putting most of the variables in a new common block
+  !-cv renaming eps to eps0 because there is some eps already in includepar
+  !-cv
+  !-cv removing the arrays U,V,TRA and related arrays
+  !-cv
+  !-cv renaming the original arrays T,Q,QS,P,PH to
+  !-cv TCONV,QCONV,QSCONV,PCONV_HPA,PHCONV_HPA
+  !-cv
+  !-cv Initialization of variables has been put into parameter statements
+  !-cv instead of assignment of values at each call, in order to save 
+  !-cv computation time.
+  !***************************************************************************
+  !
+  !-----------------------------------------------------------------------------
+  !    *** On input:      ***
+  !
+  !T:   Array of absolute temperature (K) of dimension ND, with first
+  !      index corresponding to lowest model level. Note that this array
+  !      will be altered by the subroutine if dry convective adjustment
+  !      occurs and if IPBL is not equal to 0.
+  !
+  !Q:   Array of specific humidity (gm/gm) of dimension ND, with first
+  !       index corresponding to lowest model level. Must be defined
+  !       at same grid levels as T. Note that this array will be altered
+  !       if dry convective adjustment occurs and if IPBL is not equal to 0.
+  !
+  !QS:  Array of saturation specific humidity of dimension ND, with first
+  !       index corresponding to lowest model level. Must be defined
+  !       at same grid levels as T. Note that this array will be altered
+  !       if dry convective adjustment occurs and if IPBL is not equal to 0.
+  !
+  !U:   Array of zonal wind velocity (m/s) of dimension ND, witth first
+  !       index corresponding with the lowest model level. Defined at
+  !       same levels as T. Note that this array will be altered if
+  !       dry convective adjustment occurs and if IPBL is not equal to 0.
+  !
+  !V:   Same as U but for meridional velocity.
+  !
+  !TRA: Array of passive tracer mixing ratio, of dimensions (ND,NTRA),
+  !       where NTRA is the number of different tracers. If no
+  !       convective tracer transport is needed, define a dummy
+  !       input array of dimension (ND,1). Tracers are defined at
+  !       same vertical levels as T. Note that this array will be altered
+  !       if dry convective adjustment occurs and if IPBL is not equal to 0.
+  !
+  !P:   Array of pressure (mb) of dimension ND, with first
+  !       index corresponding to lowest model level. Must be defined
+  !       at same grid levels as T.
+  !
+  !PH:  Array of pressure (mb) of dimension ND+1, with first index
+  !       corresponding to lowest level. These pressures are defined at
+  !       levels intermediate between those of P, T, Q and QS. The first
+  !       value of PH should be greater than (i.e. at a lower level than)
+  !       the first value of the array P.
+  !
+  !ND:  The dimension of the arrays T,Q,QS,P,PH,FT and FQ
+  !
+  !NL:  The maximum number of levels to which convection can
+  !       penetrate, plus 1.
+  !       NL MUST be less than or equal to ND-1.
+  !
+  !NTRA:The number of different tracers. If no tracer transport
+  !       is needed, set this equal to 1. (On most compilers, setting
+  !       NTRA to 0 will bypass tracer calculation, saving some CPU.)
+  !
+  !DELT: The model time step (sec) between calls to CONVECT
+  !
+  !----------------------------------------------------------------------------
+  !    ***   On Output:         ***
+  !
+  !IFLAG: An output integer whose value denotes the following:
+  !
+  !           VALUE                        INTERPRETATION
+  !           -----                        --------------
+  !             0               No moist convection; atmosphere is not
+  !                             unstable, or surface temperature is less
+  !                             than 250 K or surface specific humidity
+  !                             is non-positive.
+  !
+  !             1               Moist convection occurs.
+  !
+  !             2               No moist convection: lifted condensation
+  !                             level is above the 200 mb level.
+  !
+  !             3               No moist convection: cloud base is higher
+  !                             then the level NL-1.
+  !
+  !             4               Moist convection occurs, but a CFL condition
+  !                             on the subsidence warming is violated. This
+  !                             does not cause the scheme to terminate.
+  !
+  !FT:   Array of temperature tendency (K/s) of dimension ND, defined at same
+  !        grid levels as T, Q, QS and P.
+  !
+  !FQ:   Array of specific humidity tendencies ((gm/gm)/s) of dimension ND,
+  !        defined at same grid levels as T, Q, QS and P.
+  !
+  !FU:   Array of forcing of zonal velocity (m/s^2) of dimension ND,
+  !        defined at same grid levels as T.
+  !
+  !FV:   Same as FU, but for forcing of meridional velocity.
+  !
+  !FTRA: Array of forcing of tracer content, in tracer mixing ratio per
+  !        second, defined at same levels as T. Dimensioned (ND,NTRA).
+  !
+  !PRECIP: Scalar convective precipitation rate (mm/day).
+  !
+  !WD:    A convective downdraft velocity scale. For use in surface
+  !        flux parameterizations. See convect.ps file for details.
+  !
+  !TPRIME: A convective downdraft temperature perturbation scale (K).
+  !         For use in surface flux parameterizations. See convect.ps
+  !         file for details.
+  !
+  !QPRIME: A convective downdraft specific humidity
+  !         perturbation scale (gm/gm).
+  !         For use in surface flux parameterizations. See convect.ps
+  !         file for details.
+  !
+  !CBMF:   The cloud base mass flux ((kg/m**2)/s). THIS SCALAR VALUE MUST
+  !         BE STORED BY THE CALLING PROGRAM AND RETURNED TO CONVECT AT
+  !         ITS NEXT CALL. That is, the value of CBMF must be "remembered"
+  !         by the calling program between calls to CONVECT.
+  !
+  !-----------------------------------------------------------------------------
+  !
+  !    ***  THE PARAMETER NA SHOULD IN GENERAL BE GREATER THAN   ***
+  !    ***                OR EQUAL TO  ND + 1                    ***
+  !
+  !
+  use par_mod
+  use conv_mod
+
+  implicit none
+  !
+  !-cv====>Begin Module CONVECT    File convect.f      Undeclared variables
+  !
+  !Argument variables
+  !
+  integer :: iflag, nd, nl
+  !
+  real :: cbmf, delt, precip, qprime, tprime, wd
+  !
+  !Local variables
+  !
+  integer :: i, icb, ihmin, inb, inb1, j, jtt, k
+  integer :: nk
+  !
+  real :: ad, afac, ahmax, ahmin, alt, altem
+  real :: am, amp1, anum, asij, awat, b6, bf2, bsum, by
+  real :: byp, c6, cape, capem, cbmfold, chi, coeff
+  real :: cpinv, cwat, damps, dbo, dbosum
+  real :: defrac, dei, delm, delp, delt0, delti, denom, dhdp
+  real :: dpinv, dtma, dtmin, dtpbl, elacrit, ents
+  real :: epmax, fac, fqold, frac, ftold
+  real :: plcl, qp1, qsm, qstm, qti, rat
+  real :: rdcp, revap, rh, scrit, sigt, sjmax
+  real :: sjmin, smid, smin, stemp, tca
+  real :: tvaplcl, tvpplcl, tvx, tvy, wdtrain
+
+  !integer jc,jn
+  !real alvnew,a2,ahm,alv,rm,sum,qnew,dphinv,tc,thbar,tnew,x
+
+  real :: FUP(NA),FDOWN(NA)
+  !
+  !-cv====>End Module   CONVECT    File convect.f
+
+  INTEGER :: NENT(NA)
+  REAL :: M(NA),MP(NA),MENT(NA,NA),QENT(NA,NA),ELIJ(NA,NA)
+  REAL :: SIJ(NA,NA),TVP(NA),TV(NA),WATER(NA)
+  REAL :: QP(NA),EP(NA),TH(NA),WT(NA),EVAP(NA),CLW(NA)
+  REAL :: SIGP(NA),TP(NA),CPN(NA)
+  REAL :: LV(NA),LVCP(NA),H(NA),HP(NA),GZ(NA),HM(NA)
+  !REAL TOLD(NA)
+  !
+  ! -----------------------------------------------------------------------
+  !
+  !   ***                     Specify Switches                         ***
+  !
+  !   ***   IPBL: Set to zero to bypass dry adiabatic adjustment       ***
+  !   ***    Any other value results in dry adiabatic adjustment       ***
+  !   ***     (Zero value recommended for use in models with           ***
+  !   ***                   boundary layer schemes)                    ***
+  !
+  !   ***   MINORIG: Lowest level from which convection may originate  ***
+  !   ***     (Should be first model level at which T is defined       ***
+  !   ***      for models using bulk PBL schemes; otherwise, it should ***
+  !   ***      be the first model level at which T is defined above    ***
+  !   ***                      the surface layer)                      ***
+  !
+    INTEGER,PARAMETER :: IPBL=0
+    INTEGER,PARAMETER :: MINORIG=1
+  !
+  !------------------------------------------------------------------------------
+  !
+  !   ***                    SPECIFY PARAMETERS                        ***
+  !
+  !   *** ELCRIT IS THE AUTOCONVERSION THERSHOLD WATER CONTENT (gm/gm) ***
+  !   ***  TLCRIT IS CRITICAL TEMPERATURE BELOW WHICH THE AUTO-        ***
+  !   ***       CONVERSION THRESHOLD IS ASSUMED TO BE ZERO             ***
+  !   ***     (THE AUTOCONVERSION THRESHOLD VARIES LINEARLY            ***
+  !   ***               BETWEEN 0 C AND TLCRIT)                        ***
+  !   ***   ENTP IS THE COEFFICIENT OF MIXING IN THE ENTRAINMENT       ***
+  !   ***                       FORMULATION                            ***
+  !   ***  SIGD IS THE FRACTIONAL AREA COVERED BY UNSATURATED DNDRAFT  ***
+  !   ***  SIGS IS THE FRACTION OF PRECIPITATION FALLING OUTSIDE       ***
+  !   ***                        OF CLOUD                              ***
+  !   ***        OMTRAIN IS THE ASSUMED FALL SPEED (P/s) OF RAIN       ***
+  !   ***     OMTSNOW IS THE ASSUMED FALL SPEED (P/s) OF SNOW          ***
+  !   ***  COEFFR IS A COEFFICIENT GOVERNING THE RATE OF EVAPORATION   ***
+  !   ***                          OF RAIN                             ***
+  !   ***  COEFFS IS A COEFFICIENT GOVERNING THE RATE OF EVAPORATION   ***
+  !   ***                          OF SNOW                             ***
+  !   ***     CU IS THE COEFFICIENT GOVERNING CONVECTIVE MOMENTUM      ***
+  !   ***                         TRANSPORT                            ***
+  !   ***    DTMAX IS THE MAXIMUM NEGATIVE TEMPERATURE PERTURBATION    ***
+  !   ***        A LIFTED PARCEL IS ALLOWED TO HAVE BELOW ITS LFC      ***
+  !   ***    ALPHA AND DAMP ARE PARAMETERS THAT CONTROL THE RATE OF    ***
+  !   ***                 APPROACH TO QUASI-EQUILIBRIUM                ***
+  !   ***   (THEIR STANDARD VALUES ARE  0.20 AND 0.1, RESPECTIVELY)    ***
+  !   ***                   (DAMP MUST BE LESS THAN 1)                 ***
+  !
+    REAL,PARAMETER :: ELCRIT=.0011
+    REAL,PARAMETER :: TLCRIT=-55.0
+    REAL,PARAMETER :: ENTP=1.5
+    REAL,PARAMETER :: SIGD=0.05
+    REAL,PARAMETER :: SIGS=0.12
+    REAL,PARAMETER :: OMTRAIN=50.0
+    REAL,PARAMETER :: OMTSNOW=5.5
+    REAL,PARAMETER :: COEFFR=1.0
+    REAL,PARAMETER :: COEFFS=0.8
+    REAL,PARAMETER :: CU=0.7
+    REAL,PARAMETER :: BETA=10.0
+    REAL,PARAMETER :: DTMAX=0.9
+    REAL,PARAMETER :: ALPHA=0.025  !original 0.2
+    REAL,PARAMETER :: DAMP=0.1
+  !
+  !   ***        ASSIGN VALUES OF THERMODYNAMIC CONSTANTS,        ***
+  !   ***            GRAVITY, AND LIQUID WATER DENSITY.           ***
+  !   ***             THESE SHOULD BE CONSISTENT WITH             ***
+  !   ***              THOSE USED IN CALLING PROGRAM              ***
+  !   ***     NOTE: THESE ARE ALSO SPECIFIED IN SUBROUTINE TLIFT  ***
+  !
+  REAL,PARAMETER :: CPD=1005.7
+  REAL,PARAMETER :: CPV=1870.0
+  REAL,PARAMETER :: CL=2500.0
+  REAL,PARAMETER :: RV=461.5
+  REAL,PARAMETER :: RD=287.04
+  REAL,PARAMETER :: LV0=2.501E6
+  REAL,PARAMETER :: G=9.81
+  REAL,PARAMETER :: ROWL=1000.0
+  !
+  REAL,PARAMETER :: CPVMCL=CL-CPV
+  REAL,PARAMETER :: EPS0=RD/RV
+  REAL,PARAMETER :: EPSI=1./EPS0
+  REAL,PARAMETER :: GINV=1.0/G
+  REAL,PARAMETER :: EPSILON=1.e-20
+
+  ! EPSILON IS A SMALL NUMBER USED TO EXCLUDE MASS FLUXES OF ZERO
+  !
+  DELTI=1.0/DELT
+  !
+  !      ***  INITIALIZE OUTPUT ARRAYS AND PARAMETERS  ***
+  !
+
+    DO I=1,NL+1
+     FT(I)=0.0
+     FQ(I)=0.0
+     FDOWN(I)=0.0
+     SUB(I)=0.0
+     FUP(I)=0.0
+     M(I)=0.0
+     MP(I)=0.0
+    DO J=1,NL+1
+     FMASS(I,J)=0.0
+     MENT(I,J)=0.0
+    END DO
+    END DO
+    DO I=1,NL+1
+     RDCP=(RD*(1.-QCONV(I))+QCONV(I)*RV)/ &
+          (CPD*(1.-QCONV(I))+QCONV(I)*CPV)
+     TH(I)=TCONV(I)*(1000.0/PCONV_HPA(I))**RDCP
+    END DO
+    PRECIP=0.0
+    WD=0.0
+    TPRIME=0.0
+    QPRIME=0.0
+    IFLAG=0
+  !
+  !  IF(IPBL.NE.0)THEN
+  !
+  !***            PERFORM DRY ADIABATIC ADJUSTMENT            ***
+  !
+  !  JC=0
+  !  DO 30 I=NL-1,1,-1
+  !   JN=0
+  !    SUM=TH(I)*(1.+QCONV(I)*EPSI-QCONV(I))
+  !   DO 10 J=I+1,NL
+  !    SUM=SUM+TH(J)*(1.+QCONV(J)*EPSI-QCONV(J))
+  !    THBAR=SUM/REAL(J+1-I)
+  !    IF((TH(J)*(1.+QCONV(J)*EPSI-QCONV(J))).LT.THBAR)JN=J
+  !  10    CONTINUE
+  !   IF(I.EQ.1)JN=MAX(JN,2)
+  !   IF(JN.EQ.0)GOTO 30
+  !  12    CONTINUE
+  !   AHM=0.0
+  !   RM=0.0
+  !   DO 15 J=I,JN
+  !    AHM=AHM+(CPD*(1.-QCONV(J))+QCONV(J)*CPV)*TCONV(J)*
+  !    +   (PHCONV_HPA(J)-PHCONV_HPA(J+1))
+  !    RM=RM+QCONV(J)*(PHCONV_HPA(J)-PHCONV_HPA(J+1))
+  !  15    CONTINUE
+  !   DPHINV=1./(PHCONV_HPA(I)-PHCONV_HPA(JN+1))
+  !   RM=RM*DPHINV
+  !   A2=0.0
+  !   DO 20 J=I,JN
+  !    QCONV(J)=RM
+  !    RDCP=(RD*(1.-QCONV(J))+QCONV(J)*RV)/
+  !    1     (CPD*(1.-QCONV(J))+QCONV(J)*CPV)
+  !    X=(0.001*PCONV_HPA(J))**RDCP
+  !    TOLD(J)=TCONV(J)
+  !    TCONV(J)=X
+  !    A2=A2+(CPD*(1.-QCONV(J))+QCONV(J)*CPV)*X*
+  !    1    (PHCONV_HPA(J)-PHCONV_HPA(J+1))
+  !  20    CONTINUE
+  !   DO 25 J=I,JN
+  !    TH(J)=AHM/A2
+  !    TCONV(J)=TCONV(J)*TH(J)
+  !    TC=TOLD(J)-273.15
+  !    ALV=LV0-CPVMCL*TC
+  !    QSCONV(J)=QSCONV(J)+QSCONV(J)*(1.+QSCONV(J)*(EPSI-1.))*ALV*
+  !    1    (TCONV(J)- TOLD(J))/(RV*TOLD(J)*TOLD(J))
+  ! if (qslev(j) .lt. 0.) then
+  !   write(*,*) 'qslev.lt.0 ',j,qslev
+  ! endif
+  !  25    CONTINUE
+  !   IF((TH(JN+1)*(1.+QCONV(JN+1)*EPSI-QCONV(JN+1))).LT.
+  !    1    (TH(JN)*(1.+QCONV(JN)*EPSI-QCONV(JN))))THEN
+  !    JN=JN+1
+  !    GOTO 12
+  !   END IF
+  !   IF(I.EQ.1)JC=JN
+  !  30   CONTINUE
+  !
+  !   ***   Remove any supersaturation that results from adjustment ***
+  !
+  !IF(JC.GT.1)THEN
+  ! DO 38 J=1,JC
+  !    IF(QSCONV(J).LT.QCONV(J))THEN
+  !     ALV=LV0-CPVMCL*(TCONV(J)-273.15)
+  !     TNEW=TCONV(J)+ALV*(QCONV(J)-QSCONV(J))/(CPD*(1.-QCONV(J))+
+  !    1      CL*QCONV(J)+QSCONV(J)*(CPV-CL+ALV*ALV/(RV*TCONV(J)*TCONV(J))))
+  !     ALVNEW=LV0-CPVMCL*(TNEW-273.15)
+  !     QNEW=(ALV*QCONV(J)-(TNEW-TCONV(J))*(CPD*(1.-QCONV(J))
+  !    1     +CL*QCONV(J)))/ALVNEW
+  !     PRECIP=PRECIP+24.*3600.*1.0E5*(PHCONV_HPA(J)-PHCONV_HPA(J+1))*
+  !    1      (QCONV(J)-QNEW)/(G*DELT*ROWL)
+  !     TCONV(J)=TNEW
+  !     QCONV(J)=QNEW
+  !     QSCONV(J)=QNEW
+  !    END IF
+  !  38  CONTINUE
+  !END IF
+  !
+  !END IF
+  !
+  !  *** CALCULATE ARRAYS OF GEOPOTENTIAL, HEAT CAPACITY AND STATIC ENERGY
+  !
+    GZ(1)=0.0
+    CPN(1)=CPD*(1.-QCONV(1))+QCONV(1)*CPV
+    H(1)=TCONV(1)*CPN(1)
+    LV(1)=LV0-CPVMCL*(TCONV(1)-273.15)
+    HM(1)=LV(1)*QCONV(1)
+    TV(1)=TCONV(1)*(1.+QCONV(1)*EPSI-QCONV(1))
+    AHMIN=1.0E12
+    IHMIN=NL
+    DO I=2,NL+1
+      TVX=TCONV(I)*(1.+QCONV(I)*EPSI-QCONV(I))
+      TVY=TCONV(I-1)*(1.+QCONV(I-1)*EPSI-QCONV(I-1))
+      GZ(I)=GZ(I-1)+0.5*RD*(TVX+TVY)*(PCONV_HPA(I-1)-PCONV_HPA(I))/ &
+           PHCONV_HPA(I)
+      CPN(I)=CPD*(1.-QCONV(I))+CPV*QCONV(I)
+      H(I)=TCONV(I)*CPN(I)+GZ(I)
+      LV(I)=LV0-CPVMCL*(TCONV(I)-273.15)
+      HM(I)=(CPD*(1.-QCONV(I))+CL*QCONV(I))*(TCONV(I)-TCONV(1))+ &
+           LV(I)*QCONV(I)+GZ(I)
+      TV(I)=TCONV(I)*(1.+QCONV(I)*EPSI-QCONV(I))
+  !
+  !  ***  Find level of minimum moist static energy    ***
+  !
+      IF(I.GE.MINORIG.AND.HM(I).LT.AHMIN.AND.HM(I).LT.HM(I-1))THEN
+       AHMIN=HM(I)
+       IHMIN=I
+      END IF
+    END DO
+    IHMIN=MIN(IHMIN, NL-1)
+  !
+  !  ***     Find that model level below the level of minimum moist       ***
+  !  ***  static energy that has the maximum value of moist static energy ***
+  !
+    AHMAX=0.0
+  !  ***  bug fixed: need to assign an initial value to NK
+  !  HSO, 05.08.2009
+    NK=MINORIG
+    DO I=MINORIG,IHMIN
+     IF(HM(I).GT.AHMAX)THEN
+      NK=I
+      AHMAX=HM(I)
+     END IF
+    END DO
+  !
+  !  ***  CHECK WHETHER PARCEL LEVEL TEMPERATURE AND SPECIFIC HUMIDITY   ***
+  !  ***                          ARE REASONABLE                         ***
+  !  ***      Skip convection if HM increases monotonically upward       ***
+  !
+    IF(TCONV(NK).LT.250.0.OR.QCONV(NK).LE.0.0.OR.IHMIN.EQ.(NL-1)) &
+         THEN
+     IFLAG=0
+     CBMF=0.0
+     RETURN
+    END IF
+  !
+  !   ***  CALCULATE LIFTED CONDENSATION LEVEL OF AIR AT PARCEL ORIGIN LEVEL ***
+  !   ***       (WITHIN 0.2% OF FORMULA OF BOLTON, MON. WEA. REV.,1980)      ***
+  !
+    RH=QCONV(NK)/QSCONV(NK)
+    CHI=TCONV(NK)/(1669.0-122.0*RH-TCONV(NK))
+    PLCL=PCONV_HPA(NK)*(RH**CHI)
+    IF(PLCL.LT.200.0.OR.PLCL.GE.2000.0)THEN
+     IFLAG=2
+     CBMF=0.0
+     RETURN
+    END IF
+  !
+  !   ***  CALCULATE FIRST LEVEL ABOVE LCL (=ICB)  ***
+  !
+    ICB=NL-1
+    DO I=NK+1,NL
+     IF(PCONV_HPA(I).LT.PLCL)THEN
+      ICB=MIN(ICB,I)
+     END IF
+    END DO
+    IF(ICB.GE.(NL-1))THEN
+     IFLAG=3
+     CBMF=0.0
+     RETURN
+    END IF
+  !
+  !   *** FIND TEMPERATURE UP THROUGH ICB AND TEST FOR INSTABILITY           ***
+  !
+  !   *** SUBROUTINE TLIFT CALCULATES PART OF THE LIFTED PARCEL VIRTUAL      ***
+  !   ***  TEMPERATURE, THE ACTUAL TEMPERATURE AND THE ADIABATIC             ***
+  !   ***                   LIQUID WATER CONTENT                             ***
+  !
+    CALL TLIFT(GZ,ICB,NK,TVP,TP,CLW,ND,NL,1)
+    DO I=NK,ICB
+     TVP(I)=TVP(I)-TP(I)*QCONV(NK)
+    END DO
+  !
+  !   ***  If there was no convection at last time step and parcel    ***
+  !   ***       is stable at ICB then skip rest of calculation        ***
+  !
+    IF(CBMF.EQ.0.0.AND.TVP(ICB).LE.(TV(ICB)-DTMAX))THEN
+     IFLAG=0
+     RETURN
+    END IF
+  !
+  !   ***  IF THIS POINT IS REACHED, MOIST CONVECTIVE ADJUSTMENT IS NECESSARY ***
+  !
+    IF(IFLAG.NE.4)IFLAG=1
+  !
+  !   ***  FIND THE REST OF THE LIFTED PARCEL TEMPERATURES          ***
+  !
+    CALL TLIFT(GZ,ICB,NK,TVP,TP,CLW,ND,NL,2)
+  !
+  !   ***  SET THE PRECIPITATION EFFICIENCIES AND THE FRACTION OF   ***
+  !   ***          PRECIPITATION FALLING OUTSIDE OF CLOUD           ***
+  !   ***      THESE MAY BE FUNCTIONS OF TP(I), PCONV_HPA(I) AND CLW(I)     ***
+  !
+    DO I=1,NK
+     EP(I)=0.0
+     SIGP(I)=SIGS
+    END DO
+    DO I=NK+1,NL
+     TCA=TP(I)-273.15
+     IF(TCA.GE.0.0)THEN
+      ELACRIT=ELCRIT
+     ELSE
+      ELACRIT=ELCRIT*(1.0-TCA/TLCRIT)
+     END IF
+     ELACRIT=MAX(ELACRIT,0.0)
+     EPMAX=0.999
+     EP(I)=EPMAX*(1.0-ELACRIT/MAX(CLW(I),1.0E-8))
+     EP(I)=MAX(EP(I),0.0)
+     EP(I)=MIN(EP(I),EPMAX)
+     SIGP(I)=SIGS
+    END DO
+  !
+  !   ***       CALCULATE VIRTUAL TEMPERATURE AND LIFTED PARCEL     ***
+  !   ***                    VIRTUAL TEMPERATURE                    ***
+  !
+    DO I=ICB+1,NL
+     TVP(I)=TVP(I)-TP(I)*QCONV(NK)
+    END DO
+    TVP(NL+1)=TVP(NL)-(GZ(NL+1)-GZ(NL))/CPD
+  !
+  !   ***        NOW INITIALIZE VARIOUS ARRAYS USED IN THE COMPUTATIONS       ***
+  !
+    DO I=1,NL+1
+     HP(I)=H(I)
+     NENT(I)=0
+     WATER(I)=0.0
+     EVAP(I)=0.0
+     WT(I)=OMTSNOW
+     LVCP(I)=LV(I)/CPN(I)
+     DO J=1,NL+1
+      QENT(I,J)=QCONV(J)
+      ELIJ(I,J)=0.0
+      SIJ(I,J)=0.0
+     END DO
+    END DO
+    QP(1)=QCONV(1)
+    DO I=2,NL+1
+     QP(I)=QCONV(I-1)
+    END DO
+  !
+  !  ***  FIND THE FIRST MODEL LEVEL (INB1) ABOVE THE PARCEL'S      ***
+  !  ***          HIGHEST LEVEL OF NEUTRAL BUOYANCY                 ***
+  !  ***     AND THE HIGHEST LEVEL OF POSITIVE CAPE (INB)           ***
+  !
+    CAPE=0.0
+    CAPEM=0.0
+    INB=ICB+1
+    INB1=INB
+    BYP=0.0
+    DO I=ICB+1,NL-1
+     BY=(TVP(I)-TV(I))*(PHCONV_HPA(I)-PHCONV_HPA(I+1))/PCONV_HPA(I)
+     CAPE=CAPE+BY
+     IF(BY.GE.0.0)INB1=I+1
+     IF(CAPE.GT.0.0)THEN
+      INB=I+1
+      BYP=(TVP(I+1)-TV(I+1))*(PHCONV_HPA(I+1)-PHCONV_HPA(I+2))/ &
+           PCONV_HPA(I+1)
+      CAPEM=CAPE
+     END IF
+    END DO
+    INB=MAX(INB,INB1)
+    CAPE=CAPEM+BYP
+    DEFRAC=CAPEM-CAPE
+    DEFRAC=MAX(DEFRAC,0.001)
+    FRAC=-CAPE/DEFRAC
+    FRAC=MIN(FRAC,1.0)
+    FRAC=MAX(FRAC,0.0)
+  !
+  !   ***   CALCULATE LIQUID WATER STATIC ENERGY OF LIFTED PARCEL   ***
+  !
+    DO I=ICB,INB
+     HP(I)=H(NK)+(LV(I)+(CPD-CPV)*TCONV(I))*EP(I)*CLW(I)
+    END DO
+  !
+  !   ***  CALCULATE CLOUD BASE MASS FLUX AND RATES OF MIXING, M(I),  ***
+  !   ***                   AT EACH MODEL LEVEL                       ***
+  !
+    DBOSUM=0.0
+  !
+  !   ***     INTERPOLATE DIFFERENCE BETWEEN LIFTED PARCEL AND      ***
+  !   ***  ENVIRONMENTAL TEMPERATURES TO LIFTED CONDENSATION LEVEL  ***
+  !
+    TVPPLCL=TVP(ICB-1)-RD*TVP(ICB-1)*(PCONV_HPA(ICB-1)-PLCL)/ &
+         (CPN(ICB-1)*PCONV_HPA(ICB-1))
+    TVAPLCL=TV(ICB)+(TVP(ICB)-TVP(ICB+1))*(PLCL-PCONV_HPA(ICB))/ &
+         (PCONV_HPA(ICB)-PCONV_HPA(ICB+1))
+    DTPBL=0.0
+    DO I=NK,ICB-1
+     DTPBL=DTPBL+(TVP(I)-TV(I))*(PHCONV_HPA(I)-PHCONV_HPA(I+1))
+    END DO
+    DTPBL=DTPBL/(PHCONV_HPA(NK)-PHCONV_HPA(ICB))
+    DTMIN=TVPPLCL-TVAPLCL+DTMAX+DTPBL
+    DTMA=DTMIN
+  !
+  !   ***  ADJUST CLOUD BASE MASS FLUX   ***
+  !
+  CBMFOLD=CBMF
+  ! *** C. Forster: adjustment of CBMF is not allowed to depend on FLEXPART timestep
+  DELT0=DELT/3.
+  DAMPS=DAMP*DELT/DELT0
+  CBMF=(1.-DAMPS)*CBMF+0.1*ALPHA*DTMA
+  CBMF=MAX(CBMF,0.0)
+  !
+  !   *** If cloud base mass flux is zero, skip rest of calculation  ***
+  !
+  IF(CBMF.EQ.0.0.AND.CBMFOLD.EQ.0.0)THEN
+   RETURN
+  END IF
+
+  !
+  !   ***   CALCULATE RATES OF MIXING,  M(I)   ***
+  !
+  M(ICB)=0.0
+  DO I=ICB+1,INB
+   K=MIN(I,INB1)
+   DBO=ABS(TV(K)-TVP(K))+ &
+        ENTP*0.02*(PHCONV_HPA(K)-PHCONV_HPA(K+1))
+   DBOSUM=DBOSUM+DBO
+   M(I)=CBMF*DBO
+  END DO
+  DO I=ICB+1,INB
+   M(I)=M(I)/DBOSUM
+  END DO
+  !
+  !   ***  CALCULATE ENTRAINED AIR MASS FLUX (MENT), TOTAL WATER MIXING  ***
+  !   ***     RATIO (QENT), TOTAL CONDENSED WATER (ELIJ), AND MIXING     ***
+  !   ***                        FRACTION (SIJ)                          ***
+  !
+    DO I=ICB+1,INB
+     QTI=QCONV(NK)-EP(I)*CLW(I)
+     DO J=ICB,INB
+      BF2=1.+LV(J)*LV(J)*QSCONV(J)/(RV*TCONV(J)*TCONV(J)*CPD)
+      ANUM=H(J)-HP(I)+(CPV-CPD)*TCONV(J)*(QTI-QCONV(J))
+      DENOM=H(I)-HP(I)+(CPD-CPV)*(QCONV(I)-QTI)*TCONV(J)
+      DEI=DENOM
+      IF(ABS(DEI).LT.0.01)DEI=0.01
+      SIJ(I,J)=ANUM/DEI
+      SIJ(I,I)=1.0
+      ALTEM=SIJ(I,J)*QCONV(I)+(1.-SIJ(I,J))*QTI-QSCONV(J)
+      ALTEM=ALTEM/BF2
+      CWAT=CLW(J)*(1.-EP(J))
+      STEMP=SIJ(I,J)
+      IF((STEMP.LT.0.0.OR.STEMP.GT.1.0.OR. &
+           ALTEM.GT.CWAT).AND.J.GT.I)THEN
+       ANUM=ANUM-LV(J)*(QTI-QSCONV(J)-CWAT*BF2)
+       DENOM=DENOM+LV(J)*(QCONV(I)-QTI)
+       IF(ABS(DENOM).LT.0.01)DENOM=0.01
+       SIJ(I,J)=ANUM/DENOM
+       ALTEM=SIJ(I,J)*QCONV(I)+(1.-SIJ(I,J))*QTI-QSCONV(J)
+       ALTEM=ALTEM-(BF2-1.)*CWAT
+      END IF
+      IF(SIJ(I,J).GT.0.0.AND.SIJ(I,J).LT.0.9)THEN
+       QENT(I,J)=SIJ(I,J)*QCONV(I)+(1.-SIJ(I,J))*QTI
+       ELIJ(I,J)=ALTEM
+       ELIJ(I,J)=MAX(0.0,ELIJ(I,J))
+       MENT(I,J)=M(I)/(1.-SIJ(I,J))
+       NENT(I)=NENT(I)+1
+      END IF
+      SIJ(I,J)=MAX(0.0,SIJ(I,J))
+      SIJ(I,J)=MIN(1.0,SIJ(I,J))
+     END DO
+  !
+  !   ***   IF NO AIR CAN ENTRAIN AT LEVEL I ASSUME THAT UPDRAFT DETRAINS  ***
+  !   ***   AT THAT LEVEL AND CALCULATE DETRAINED AIR FLUX AND PROPERTIES  ***
+  !
+     IF(NENT(I).EQ.0)THEN
+      MENT(I,I)=M(I)
+      QENT(I,I)=QCONV(NK)-EP(I)*CLW(I)
+      ELIJ(I,I)=CLW(I)
+      SIJ(I,I)=1.0
+     END IF
+    END DO
+    SIJ(INB,INB)=1.0
+  !
+  !   ***  NORMALIZE ENTRAINED AIR MASS FLUXES TO REPRESENT EQUAL  ***
+  !   ***              PROBABILITIES OF MIXING                     ***
+  !
+    DO I=ICB+1,INB
+    IF(NENT(I).NE.0)THEN
+     QP1=QCONV(NK)-EP(I)*CLW(I)
+     ANUM=H(I)-HP(I)-LV(I)*(QP1-QSCONV(I))
+     DENOM=H(I)-HP(I)+LV(I)*(QCONV(I)-QP1)
+     IF(ABS(DENOM).LT.0.01)DENOM=0.01
+     SCRIT=ANUM/DENOM
+     ALT=QP1-QSCONV(I)+SCRIT*(QCONV(I)-QP1)
+     IF(ALT.LT.0.0)SCRIT=1.0
+     SCRIT=MAX(SCRIT,0.0)
+     ASIJ=0.0
+     SMIN=1.0
+     DO J=ICB,INB
+      IF(SIJ(I,J).GT.0.0.AND.SIJ(I,J).LT.0.9)THEN
+       IF(J.GT.I)THEN
+        SMID=MIN(SIJ(I,J),SCRIT)
+        SJMAX=SMID
+        SJMIN=SMID
+        IF(SMID.LT.SMIN.AND.SIJ(I,J+1).LT.SMID)THEN
+         SMIN=SMID
+         SJMAX=MIN(SIJ(I,J+1),SIJ(I,J),SCRIT)
+         SJMIN=MAX(SIJ(I,J-1),SIJ(I,J))
+         SJMIN=MIN(SJMIN,SCRIT)
+        END IF
+       ELSE
+        SJMAX=MAX(SIJ(I,J+1),SCRIT)
+        SMID=MAX(SIJ(I,J),SCRIT)
+        SJMIN=0.0
+        IF(J.GT.1)SJMIN=SIJ(I,J-1)
+        SJMIN=MAX(SJMIN,SCRIT)
+       END IF
+       DELP=ABS(SJMAX-SMID)
+       DELM=ABS(SJMIN-SMID)
+       ASIJ=ASIJ+(DELP+DELM)*(PHCONV_HPA(J)-PHCONV_HPA(J+1))
+       MENT(I,J)=MENT(I,J)*(DELP+DELM)* &
+            (PHCONV_HPA(J)-PHCONV_HPA(J+1))
+      END IF
+     END DO
+     ASIJ=MAX(1.0E-21,ASIJ)
+     ASIJ=1.0/ASIJ
+     DO J=ICB,INB
+      MENT(I,J)=MENT(I,J)*ASIJ
+     END DO
+     BSUM=0.0
+     DO J=ICB,INB
+      BSUM=BSUM+MENT(I,J)
+     END DO
+     IF(BSUM.LT.1.0E-18)THEN
+      NENT(I)=0
+      MENT(I,I)=M(I)
+      QENT(I,I)=QCONV(NK)-EP(I)*CLW(I)
+      ELIJ(I,I)=CLW(I)
+      SIJ(I,I)=1.0
+     END IF
+    END IF
+    END DO
+  !
+  !   ***  CHECK WHETHER EP(INB)=0, IF SO, SKIP PRECIPITATING    ***
+  !   ***             DOWNDRAFT CALCULATION                      ***
+  !
+    IF(EP(INB).LT.0.0001)GOTO 405
+  !
+  !   ***  INTEGRATE LIQUID WATER EQUATION TO FIND CONDENSED WATER   ***
+  !   ***                AND CONDENSED WATER FLUX                    ***
+  !
+    JTT=2
+  !
+  !    ***                    BEGIN DOWNDRAFT LOOP                    ***
+  !
+    DO I=INB,1,-1
+  !
+  !    ***              CALCULATE DETRAINED PRECIPITATION             ***
+  !
+    WDTRAIN=G*EP(I)*M(I)*CLW(I)
+    IF(I.GT.1)THEN
+     DO J=1,I-1
+     AWAT=ELIJ(J,I)-(1.-EP(I))*CLW(I)
+     AWAT=MAX(0.0,AWAT)
+       WDTRAIN=WDTRAIN+G*AWAT*MENT(J,I)
+     END DO
+    END IF
+  !
+  !    ***    FIND RAIN WATER AND EVAPORATION USING PROVISIONAL   ***
+  !    ***              ESTIMATES OF QP(I)AND QP(I-1)             ***
+  !
+  !
+  !  ***  Value of terminal velocity and coefficient of evaporation for snow   ***
+  !
+    COEFF=COEFFS
+    WT(I)=OMTSNOW
+  !
+  !  ***  Value of terminal velocity and coefficient of evaporation for rain   ***
+  !
+    IF(TCONV(I).GT.273.0)THEN
+     COEFF=COEFFR
+     WT(I)=OMTRAIN
+    END IF
+    QSM=0.5*(QCONV(I)+QP(I+1))
+    AFAC=COEFF*PHCONV_HPA(I)*(QSCONV(I)-QSM)/ &
+         (1.0E4+2.0E3*PHCONV_HPA(I)*QSCONV(I))
+    AFAC=MAX(AFAC,0.0)
+    SIGT=SIGP(I)
+    SIGT=MAX(0.0,SIGT)
+    SIGT=MIN(1.0,SIGT)
+    B6=100.*(PHCONV_HPA(I)-PHCONV_HPA(I+1))*SIGT*AFAC/WT(I)
+    C6=(WATER(I+1)*WT(I+1)+WDTRAIN/SIGD)/WT(I)
+    REVAP=0.5*(-B6+SQRT(B6*B6+4.*C6))
+    EVAP(I)=SIGT*AFAC*REVAP
+    WATER(I)=REVAP*REVAP
+  !
+  !    ***  CALCULATE PRECIPITATING DOWNDRAFT MASS FLUX UNDER     ***
+  !    ***              HYDROSTATIC APPROXIMATION                 ***
+  !
+    IF(I.EQ.1)GOTO 360
+    DHDP=(H(I)-H(I-1))/(PCONV_HPA(I-1)-PCONV_HPA(I))
+    DHDP=MAX(DHDP,10.0)
+    MP(I)=100.*GINV*LV(I)*SIGD*EVAP(I)/DHDP
+    MP(I)=MAX(MP(I),0.0)
+  !
+  !   ***   ADD SMALL AMOUNT OF INERTIA TO DOWNDRAFT              ***
+  !
+    FAC=20.0/(PHCONV_HPA(I-1)-PHCONV_HPA(I))
+    MP(I)=(FAC*MP(I+1)+MP(I))/(1.+FAC)
+  !
+  !    ***      FORCE MP TO DECREASE LINEARLY TO ZERO                 ***
+  !    ***      BETWEEN ABOUT 950 MB AND THE SURFACE                  ***
+  !
+      IF(PCONV_HPA(I).GT.(0.949*PCONV_HPA(1)))THEN
+       JTT=MAX(JTT,I)
+       MP(I)=MP(JTT)*(PCONV_HPA(1)-PCONV_HPA(I))/(PCONV_HPA(1)- &
+            PCONV_HPA(JTT))
+      END IF
+  360   CONTINUE
+  !
+  !    ***       FIND MIXING RATIO OF PRECIPITATING DOWNDRAFT     ***
+  !
+    IF(I.EQ.INB)GOTO 400
+    IF(I.EQ.1)THEN
+     QSTM=QSCONV(1)
+    ELSE
+     QSTM=QSCONV(I-1)
+    END IF
+    IF(MP(I).GT.MP(I+1))THEN
+      RAT=MP(I+1)/MP(I)
+      QP(I)=QP(I+1)*RAT+QCONV(I)*(1.0-RAT)+100.*GINV* &
+           SIGD*(PHCONV_HPA(I)-PHCONV_HPA(I+1))*(EVAP(I)/MP(I))
+     ELSE
+      IF(MP(I+1).GT.0.0)THEN
+        QP(I)=(GZ(I+1)-GZ(I)+QP(I+1)*(LV(I+1)+TCONV(I+1)*(CL-CPD))+ &
+             CPD*(TCONV(I+1)-TCONV(I)))/(LV(I)+TCONV(I)*(CL-CPD))
+      END IF
+    END IF
+    QP(I)=MIN(QP(I),QSTM)
+    QP(I)=MAX(QP(I),0.0)
+400 CONTINUE
+    END DO
+  !
+  !   ***  CALCULATE SURFACE PRECIPITATION IN MM/DAY     ***
+  !
+    PRECIP=PRECIP+WT(1)*SIGD*WATER(1)*3600.*24000./(ROWL*G)
+  !
+  405   CONTINUE
+  !
+  !   ***  CALCULATE DOWNDRAFT VELOCITY SCALE AND SURFACE TEMPERATURE AND  ***
+  !   ***                    WATER VAPOR FLUCTUATIONS                      ***
+  !
+  WD=BETA*ABS(MP(ICB))*0.01*RD*TCONV(ICB)/(SIGD*PCONV_HPA(ICB))
+  QPRIME=0.5*(QP(1)-QCONV(1))
+  TPRIME=LV0*QPRIME/CPD
+  !
+  !   ***  CALCULATE TENDENCIES OF LOWEST LEVEL POTENTIAL TEMPERATURE  ***
+  !   ***                      AND MIXING RATIO                        ***
+  !
+    DPINV=0.01/(PHCONV_HPA(1)-PHCONV_HPA(2))
+    AM=0.0
+    IF(NK.EQ.1)THEN
+     DO K=2,INB
+       AM=AM+M(K)
+     END DO
+    END IF
+  ! save saturated upward mass flux for first level
+    FUP(1)=AM
+    IF((2.*G*DPINV*AM).GE.DELTI)IFLAG=4
+    FT(1)=FT(1)+G*DPINV*AM*(TCONV(2)-TCONV(1)+(GZ(2)-GZ(1))/CPN(1))
+    FT(1)=FT(1)-LVCP(1)*SIGD*EVAP(1)
+    FT(1)=FT(1)+SIGD*WT(2)*(CL-CPD)*WATER(2)*(TCONV(2)- &
+         TCONV(1))*DPINV/CPN(1)
+    FQ(1)=FQ(1)+G*MP(2)*(QP(2)-QCONV(1))* &
+         DPINV+SIGD*EVAP(1)
+    FQ(1)=FQ(1)+G*AM*(QCONV(2)-QCONV(1))*DPINV
+    DO J=2,INB
+     FQ(1)=FQ(1)+G*DPINV*MENT(J,1)*(QENT(J,1)-QCONV(1))
+    END DO
+  !
+  !   ***  CALCULATE TENDENCIES OF POTENTIAL TEMPERATURE AND MIXING RATIO  ***
+  !   ***               AT LEVELS ABOVE THE LOWEST LEVEL                   ***
+  !
+  !   ***  FIRST FIND THE NET SATURATED UPDRAFT AND DOWNDRAFT MASS FLUXES  ***
+  !   ***                      THROUGH EACH LEVEL                          ***
+  !
+    DO I=2,INB
+    DPINV=0.01/(PHCONV_HPA(I)-PHCONV_HPA(I+1))
+    CPINV=1.0/CPN(I)
+    AMP1=0.0
+    AD=0.0
+    IF(I.GE.NK)THEN
+     DO K=I+1,INB+1
+       AMP1=AMP1+M(K)
+     END DO
+    END IF
+    DO K=1,I
+    DO J=I+1,INB+1
+     AMP1=AMP1+MENT(K,J)
+    END DO
+    END DO
+  ! save saturated upward mass flux
+    FUP(I)=AMP1
+    IF((2.*G*DPINV*AMP1).GE.DELTI)IFLAG=4
+    DO K=1,I-1
+    DO J=I,INB
+     AD=AD+MENT(J,K)
+    END DO
+    END DO
+  ! save saturated downward mass flux
+    FDOWN(I)=AD
+    FT(I)=FT(I)+G*DPINV*(AMP1*(TCONV(I+1)-TCONV(I)+(GZ(I+1)-GZ(I))* &
+         CPINV)-AD*(TCONV(I)-TCONV(I-1)+(GZ(I)-GZ(I-1))*CPINV)) &
+         -SIGD*LVCP(I)*EVAP(I)
+    FT(I)=FT(I)+G*DPINV*MENT(I,I)*(HP(I)-H(I)+ &
+         TCONV(I)*(CPV-CPD)*(QCONV(I)-QENT(I,I)))*CPINV
+    FT(I)=FT(I)+SIGD*WT(I+1)*(CL-CPD)*WATER(I+1)* &
+         (TCONV(I+1)-TCONV(I))*DPINV*CPINV
+    FQ(I)=FQ(I)+G*DPINV*(AMP1*(QCONV(I+1)-QCONV(I))- &
+         AD*(QCONV(I)-QCONV(I-1)))
+    DO K=1,I-1
+     AWAT=ELIJ(K,I)-(1.-EP(I))*CLW(I)
+     AWAT=MAX(AWAT,0.0)
+     FQ(I)=FQ(I)+G*DPINV*MENT(K,I)*(QENT(K,I)-AWAT-QCONV(I))
+    END DO
+    DO K=I,INB
+     FQ(I)=FQ(I)+G*DPINV*MENT(K,I)*(QENT(K,I)-QCONV(I))
+    END DO
+    FQ(I)=FQ(I)+SIGD*EVAP(I)+G*(MP(I+1)* &
+         (QP(I+1)-QCONV(I))-MP(I)*(QP(I)-QCONV(I-1)))*DPINV
+    END DO
+  !
+  !   *** Adjust tendencies at top of convection layer to reflect  ***
+  !   ***       actual position of the level zero CAPE             ***
+  !
+    FQOLD=FQ(INB)
+    FQ(INB)=FQ(INB)*(1.-FRAC)
+    FQ(INB-1)=FQ(INB-1)+FRAC*FQOLD*((PHCONV_HPA(INB)- &
+         PHCONV_HPA(INB+1))/ &
+         (PHCONV_HPA(INB-1)-PHCONV_HPA(INB)))*LV(INB)/LV(INB-1)
+    FTOLD=FT(INB)
+    FT(INB)=FT(INB)*(1.-FRAC)
+    FT(INB-1)=FT(INB-1)+FRAC*FTOLD*((PHCONV_HPA(INB)- &
+         PHCONV_HPA(INB+1))/ &
+         (PHCONV_HPA(INB-1)-PHCONV_HPA(INB)))*CPN(INB)/CPN(INB-1)
+  !
+  !   ***   Very slightly adjust tendencies to force exact   ***
+  !   ***     enthalpy, momentum and tracer conservation     ***
+  !
+    ENTS=0.0
+    DO I=1,INB
+     ENTS=ENTS+(CPN(I)*FT(I)+LV(I)*FQ(I))* &
+          (PHCONV_HPA(I)-PHCONV_HPA(I+1))	
+    END DO
+    ENTS=ENTS/(PHCONV_HPA(1)-PHCONV_HPA(INB+1))
+    DO I=1,INB
+     FT(I)=FT(I)-ENTS/CPN(I)
+    END DO
+
+  ! ************************************************
+  ! **** DETERMINE MASS DISPLACEMENT MATRIX
+  ! ***** AND COMPENSATING SUBSIDENCE
+  ! ************************************************
+
+  ! mass displacement matrix due to saturated up-and downdrafts
+  ! inside the cloud and determine compensating subsidence
+  ! FUP(I) (saturated updrafts), FDOWN(I) (saturated downdrafts) are assumed to be
+  ! balanced by  compensating subsidence (SUB(I))
+  ! FDOWN(I) and SUB(I) defined positive downwards
+
+  ! NCONVTOP IS THE TOP LEVEL AT WHICH CONVECTIVE MASS FLUXES ARE DIAGNOSED
+  ! EPSILON IS A SMALL NUMBER
+
+   SUB(1)=0.
+   NCONVTOP=1
+   do i=1,INB+1
+   do j=1,INB+1
+    if (j.eq.NK) then
+     FMASS(j,i)=FMASS(j,i)+M(i)
+    endif
+     FMASS(j,i)=FMASS(j,i)+MENT(j,i)
+     IF (FMASS(J,I).GT.EPSILON) NCONVTOP=MAX(NCONVTOP,I,J)
+   end do
+   if (i.gt.1) then
+    SUB(i)=FUP(i-1)-FDOWN(i)
+   endif
+   end do
+   NCONVTOP=NCONVTOP+1
+
+    RETURN
+  !
+END SUBROUTINE CONVECT
+!
+! ---------------------------------------------------------------------------
+!
+SUBROUTINE TLIFT(GZ,ICB,NK,TVP,TPK,CLW,ND,NL,KK)
+  !
+  !-cv
+  use par_mod
+  use conv_mod
+
+  implicit none
+  !-cv
+  !====>Begin Module TLIFT      File convect.f      Undeclared variables
+  !
+  !Argument variables
+  !
+  integer :: icb, kk, nd, nk, nl
+  !
+  !Local variables
+  !
+  integer :: i, j, nsb, nst
+  !
+  real :: ah0, ahg, alv, cpinv, cpp, denom
+  real :: es, qg, rg, s, tc, tg
+  !
+  !====>End Module   TLIFT      File convect.f
+
+    REAL :: GZ(ND),TPK(ND),CLW(ND)
+    REAL :: TVP(ND)
+  !
+  !   ***   ASSIGN VALUES OF THERMODYNAMIC CONSTANTS     ***
+  !
+    REAL,PARAMETER :: CPD=1005.7
+    REAL,PARAMETER :: CPV=1870.0
+    REAL,PARAMETER :: CL=2500.0
+    REAL,PARAMETER :: RV=461.5
+    REAL,PARAMETER :: RD=287.04
+    REAL,PARAMETER :: LV0=2.501E6
+  !
+    REAL,PARAMETER :: CPVMCL=CL-CPV
+    REAL,PARAMETER :: EPS0=RD/RV
+    REAL,PARAMETER :: EPSI=1./EPS0
+  !
+  !   ***  CALCULATE CERTAIN PARCEL QUANTITIES, INCLUDING STATIC ENERGY   ***
+  !
+    AH0=(CPD*(1.-QCONV(NK))+CL*QCONV(NK))*TCONV(NK)+QCONV(NK)* &
+         (LV0-CPVMCL*( &
+         TCONV(NK)-273.15))+GZ(NK)
+    CPP=CPD*(1.-QCONV(NK))+QCONV(NK)*CPV
+    CPINV=1./CPP
+  !
+    IF(KK.EQ.1)THEN
+  !
+  !   ***   CALCULATE LIFTED PARCEL QUANTITIES BELOW CLOUD BASE   ***
+  !
+    DO I=1,ICB-1
+     CLW(I)=0.0
+    END DO
+    DO I=NK,ICB-1
+     TPK(I)=TCONV(NK)-(GZ(I)-GZ(NK))*CPINV
+     TVP(I)=TPK(I)*(1.+QCONV(NK)*EPSI)
+    END DO
+    END IF
+  !
+  !    ***  FIND LIFTED PARCEL QUANTITIES ABOVE CLOUD BASE    ***
+  !
+    NST=ICB
+    NSB=ICB
+    IF(KK.EQ.2)THEN
+     NST=NL
+     NSB=ICB+1
+    END IF
+    DO I=NSB,NST
+     TG=TCONV(I)
+     QG=QSCONV(I)
+     ALV=LV0-CPVMCL*(TCONV(I)-273.15)
+     DO J=1,2
+      S=CPD+ALV*ALV*QG/(RV*TCONV(I)*TCONV(I))
+      S=1./S
+      AHG=CPD*TG+(CL-CPD)*QCONV(NK)*TCONV(I)+ALV*QG+GZ(I)
+      TG=TG+S*(AH0-AHG)
+      TG=MAX(TG,35.0)
+      TC=TG-273.15
+      DENOM=243.5+TC
+      IF(TC.GE.0.0)THEN
+       ES=6.112*EXP(17.67*TC/DENOM)
+      ELSE
+       ES=EXP(23.33086-6111.72784/TG+0.15215*LOG(TG))
+      END IF
+      QG=EPS0*ES/(PCONV_HPA(I)-ES*(1.-EPS0))
+     END DO
+     ALV=LV0-CPVMCL*(TCONV(I)-273.15)
+     TPK(I)=(AH0-(CL-CPD)*QCONV(NK)*TCONV(I)-GZ(I)-ALV*QG)/CPD
+     CLW(I)=QCONV(NK)-QG
+     CLW(I)=MAX(0.0,CLW(I))
+     RG=QG/(1.-QCONV(NK))
+     TVP(I)=TPK(I)*(1.+RG*EPSI)
+    END DO
+    RETURN
+END SUBROUTINE TLIFT
Index: /branches/FP_AI/src/convmix.f90
===================================================================
--- /branches/FP_AI/src/convmix.f90	(revision 23)
+++ /branches/FP_AI/src/convmix.f90	(revision 23)
@@ -0,0 +1,299 @@
+!**********************************************************************
+! 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 convmix(itime)
+  !                     i
+  !**************************************************************
+  !handles all the calculations related to convective mixing
+  !Petra Seibert, Bernd C. Krueger, Feb 2001
+  !nested grids included, Bernd C. Krueger, May 2001
+  !
+  !Changes by Caroline Forster, April 2004 - February 2005:
+  !  convmix called every lsynctime seconds
+  !CHANGES by A. Stohl:
+  !  various run-time optimizations - February 2005
+  !**************************************************************
+
+  use flux_mod
+  use par_mod
+  use com_mod
+  use conv_mod
+
+  implicit none
+
+  integer :: igr,igrold, ipart, itime, ix, j, inest
+  integer :: ipconv
+  integer :: jy, kpart, ktop, ngrid,kz
+  integer :: igrid(maxpart), ipoint(maxpart), igridn(maxpart,maxnests)
+  ! itime [s]                 current time
+  ! igrid(maxpart)            horizontal grid position of each particle
+  ! igridn(maxpart,maxnests)  dto. for nested grids
+  ! ipoint(maxpart)           pointer to access particles according to grid position
+
+  logical :: lconv
+  real :: x, y, xtn,ytn, ztold, delt
+  real :: dt1,dt2,dtt
+  integer :: mind1,mind2
+  ! dt1,dt2,dtt,mind1,mind2       variables used for time interpolation
+  integer :: itage,nage
+  real,parameter :: eps=nxmax/3.e5
+
+
+  !monitoring variables
+  !real sumconv,sumall
+
+
+  ! Calculate auxiliary variables for time interpolation
+  !*****************************************************
+
+  dt1=real(itime-memtime(1))
+  dt2=real(memtime(2)-itime)
+  dtt=1./(dt1+dt2)
+  mind1=memind(1)
+  mind2=memind(2)
+  delt=real(abs(lsynctime))
+
+
+  lconv = .false.
+
+  ! if no particles are present return after initialization
+  !********************************************************
+
+  if (numpart.le.0) return
+
+  ! Assign igrid and igridn, which are pseudo grid numbers indicating particles
+  ! that are outside the part of the grid under consideration
+  ! (e.g. particles near the poles or particles in other nests).
+  ! Do this for all nests but use only the innermost nest; for all others
+  ! igrid shall be -1
+  ! Also, initialize index vector ipoint
+  !************************************************************************
+
+  do ipart=1,numpart
+    igrid(ipart)=-1
+    do j=numbnests,1,-1
+      igridn(ipart,j)=-1
+    end do
+    ipoint(ipart)=ipart
+  ! do not consider particles that are (yet) not part of simulation
+    if (itra1(ipart).ne.itime) goto 20
+    x = xtra1(ipart)
+    y = ytra1(ipart)
+
+  ! Determine which nesting level to be used
+  !**********************************************************
+
+    ngrid=0
+    do j=numbnests,1,-1
+      if ( x.gt.xln(j)+eps .and. x.lt.xrn(j)-eps .and. &
+           y.gt.yln(j)+eps .and. y.lt.yrn(j)-eps ) then
+        ngrid=j
+        goto 23
+      endif
+    end do
+ 23   continue
+
+  ! Determine nested grid coordinates
+  !**********************************
+
+    if (ngrid.gt.0) then
+  ! nested grids
+      xtn=(x-xln(ngrid))*xresoln(ngrid)
+      ytn=(y-yln(ngrid))*yresoln(ngrid)
+      ix=nint(xtn)
+      jy=nint(ytn)
+      igridn(ipart,ngrid) = 1 + jy*nxn(ngrid) + ix
+    else if(ngrid.eq.0) then
+  ! mother grid
+      ix=nint(x)
+      jy=nint(y)
+      igrid(ipart) = 1 + jy*nx + ix
+    endif
+
+ 20 continue
+  end do
+
+  !sumall = 0.
+  !sumconv = 0.
+
+  !*****************************************************************************
+  ! 1. Now, do everything for the mother domain and, later, for all of the nested domains
+  ! While all particles have to be considered for redistribution, the Emanuel convection
+  ! scheme only needs to be called once for every grid column where particles are present.
+  ! Therefore, particles are sorted according to their grid position. Whenever a new grid
+  ! cell is encountered by looping through the sorted particles, the convection scheme is called.
+  !*****************************************************************************
+
+  ! sort particles according to horizontal position and calculate index vector IPOINT
+
+  call sort2(numpart,igrid,ipoint)
+
+  ! Now visit all grid columns where particles are present
+  ! by going through the sorted particles
+
+  igrold = -1
+  do kpart=1,numpart
+    igr = igrid(kpart)
+    if (igr .eq. -1) goto 50
+    ipart = ipoint(kpart)
+  !  sumall = sumall + 1
+    if (igr .ne. igrold) then
+  ! we are in a new grid column
+      jy = (igr-1)/nx
+      ix = igr - jy*nx - 1
+
+  ! Interpolate all meteorological data needed for the convection scheme
+      psconv=(ps(ix,jy,1,mind1)*dt2+ps(ix,jy,1,mind2)*dt1)*dtt
+      tt2conv=(tt2(ix,jy,1,mind1)*dt2+tt2(ix,jy,1,mind2)*dt1)*dtt
+      td2conv=(td2(ix,jy,1,mind1)*dt2+td2(ix,jy,1,mind2)*dt1)*dtt
+!!$      do kz=1,nconvlev+1      !old
+        do kz=1,nuvz-1           !bugfix
+        tconv(kz)=(tth(ix,jy,kz+1,mind1)*dt2+ &
+             tth(ix,jy,kz+1,mind2)*dt1)*dtt
+        qconv(kz)=(qvh(ix,jy,kz+1,mind1)*dt2+ &
+             qvh(ix,jy,kz+1,mind2)*dt1)*dtt
+      end do
+
+  ! Calculate translocation matrix
+      call calcmatrix(lconv,delt,cbaseflux(ix,jy))
+      igrold = igr
+      ktop = 0
+    endif
+
+  ! treat particle only if column has convection
+    if (lconv .eqv. .true.) then
+  ! assign new vertical position to particle
+
+      ztold=ztra1(ipart)
+      call redist(ipart,ktop,ipconv)
+  !    if (ipconv.le.0) sumconv = sumconv+1
+
+  ! Calculate the gross fluxes across layer interfaces
+  !***************************************************
+
+      if (iflux.eq.1) then
+        itage=abs(itra1(ipart)-itramem(ipart))
+        do nage=1,nageclass
+          if (itage.lt.lage(nage)) goto 37
+        end do
+ 37     continue
+
+        if (nage.le.nageclass) &
+             call calcfluxes(nage,ipart,real(xtra1(ipart)), &
+             real(ytra1(ipart)),ztold)
+      endif
+
+    endif   !(lconv .eqv. .true)
+ 50 continue
+  end do
+
+
+  !*****************************************************************************
+  ! 2. Nested domains
+  !*****************************************************************************
+
+  ! sort particles according to horizontal position and calculate index vector IPOINT
+
+  do inest=1,numbnests
+    do ipart=1,numpart
+      ipoint(ipart)=ipart
+      igrid(ipart) = igridn(ipart,inest)
+    enddo
+    call sort2(numpart,igrid,ipoint)
+
+  ! Now visit all grid columns where particles are present
+  ! by going through the sorted particles
+
+    igrold = -1
+    do kpart=1,numpart
+      igr = igrid(kpart)
+      if (igr .eq. -1) goto 60
+      ipart = ipoint(kpart)
+  !    sumall = sumall + 1
+      if (igr .ne. igrold) then
+  ! we are in a new grid column
+        jy = (igr-1)/nxn(inest)
+        ix = igr - jy*nxn(inest) - 1
+
+  ! Interpolate all meteorological data needed for the convection scheme
+        psconv=(psn(ix,jy,1,mind1,inest)*dt2+ &
+             psn(ix,jy,1,mind2,inest)*dt1)*dtt
+        tt2conv=(tt2n(ix,jy,1,mind1,inest)*dt2+ &
+             tt2n(ix,jy,1,mind2,inest)*dt1)*dtt
+        td2conv=(td2n(ix,jy,1,mind1,inest)*dt2+ &
+             td2n(ix,jy,1,mind2,inest)*dt1)*dtt
+!!$        do kz=1,nconvlev+1    !old
+        do kz=1,nuvz-1           !bugfix
+          tconv(kz)=(tthn(ix,jy,kz+1,mind1,inest)*dt2+ &
+               tthn(ix,jy,kz+1,mind2,inest)*dt1)*dtt
+          qconv(kz)=(qvhn(ix,jy,kz+1,mind1,inest)*dt2+ &
+               qvhn(ix,jy,kz+1,mind2,inest)*dt1)*dtt
+        end do
+
+  ! calculate translocation matrix
+  !*******************************
+        call calcmatrix(lconv,delt,cbasefluxn(ix,jy,inest))
+        igrold = igr
+        ktop = 0
+      endif
+
+  ! treat particle only if column has convection
+      if (lconv .eqv. .true.) then
+  ! assign new vertical position to particle
+        ztold=ztra1(ipart)
+        call redist(ipart,ktop,ipconv)
+  !      if (ipconv.le.0) sumconv = sumconv+1
+
+  ! Calculate the gross fluxes across layer interfaces
+  !***************************************************
+
+        if (iflux.eq.1) then
+          itage=abs(itra1(ipart)-itramem(ipart))
+          do nage=1,nageclass
+            if (itage.lt.lage(nage)) goto 47
+          end do
+ 47       continue
+
+          if (nage.le.nageclass) &
+               call calcfluxes(nage,ipart,real(xtra1(ipart)), &
+               real(ytra1(ipart)),ztold)
+        endif
+
+      endif !(lconv .eqv. .true.)
+
+
+60    continue
+    end do
+  end do
+  !--------------------------------------------------------------------------
+  !write(*,*)'############################################'
+  !write(*,*)'TIME=',
+  !    &  itime
+  !write(*,*)'fraction of particles under convection',
+  !    &  sumconv/(sumall+0.001)
+  !write(*,*)'total number of particles',
+  !    &  sumall
+  !write(*,*)'number of particles under convection',
+  !    &  sumconv
+  !write(*,*)'############################################'
+
+  return
+end subroutine convmix
Index: /branches/FP_AI/src/convmix_gfs.f90
===================================================================
--- /branches/FP_AI/src/convmix_gfs.f90	(revision 23)
+++ /branches/FP_AI/src/convmix_gfs.f90	(revision 23)
@@ -0,0 +1,303 @@
+!**********************************************************************
+! 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 convmix(itime)
+  !                     i
+  !**************************************************************
+  !handles all the calculations related to convective mixing
+  !Petra Seibert, Bernd C. Krueger, Feb 2001
+  !nested grids included, Bernd C. Krueger, May 2001
+  !
+  !Changes by Caroline Forster, April 2004 - February 2005:
+  !  convmix called every lsynctime seconds
+  !CHANGES by A. Stohl:
+  !  various run-time optimizations - February 2005
+  !CHANGES by C. Forster, November 2005, NCEP GFS version
+  !      in the ECMWF version convection is calculated on the
+  !      original eta-levels
+  !      in the GFS version convection is calculated on the
+  !      FLEXPART levels
+  !**************************************************************
+
+  use par_mod
+  use com_mod
+  use conv_mod
+
+  implicit none
+
+  integer :: igr,igrold, ipart, itime, ix, j, inest
+  integer :: ipconv
+  integer :: jy, kpart, ktop, ngrid,kz
+  integer :: igrid(maxpart), ipoint(maxpart), igridn(maxpart,maxnests)
+  ! itime [s]                 current time
+  ! igrid(maxpart)            horizontal grid position of each particle
+  ! igridn(maxpart,maxnests)  dto. for nested grids
+  ! ipoint(maxpart)           pointer to access particles according to grid position
+
+  logical :: lconv
+  real :: x, y, xtn,ytn, ztold, delt
+  real :: dt1,dt2,dtt
+  integer :: mind1,mind2
+  ! dt1,dt2,dtt,mind1,mind2       variables used for time interpolation
+  integer :: itage,nage
+
+  !monitoring variables
+  !real sumconv,sumall
+
+
+  ! Calculate auxiliary variables for time interpolation
+  !*****************************************************
+
+  dt1=real(itime-memtime(1))
+  dt2=real(memtime(2)-itime)
+  dtt=1./(dt1+dt2)
+  mind1=memind(1)
+  mind2=memind(2)
+  delt=real(abs(lsynctime))
+
+
+  lconv = .false.
+
+  ! if no particles are present return after initialization
+  !********************************************************
+
+  if (numpart.le.0) return
+
+  ! Assign igrid and igridn, which are pseudo grid numbers indicating particles
+  ! that are outside the part of the grid under consideration
+  ! (e.g. particles near the poles or particles in other nests).
+  ! Do this for all nests but use only the innermost nest; for all others
+  ! igrid shall be -1
+  ! Also, initialize index vector ipoint
+  !************************************************************************
+
+  do ipart=1,numpart
+    igrid(ipart)=-1
+    do j=numbnests,1,-1
+      igridn(ipart,j)=-1
+    end do
+    ipoint(ipart)=ipart
+  ! do not consider particles that are (yet) not part of simulation
+    if (itra1(ipart).ne.itime) goto 20
+    x = xtra1(ipart)
+    y = ytra1(ipart)
+
+  ! Determine which nesting level to be used
+  !**********************************************************
+
+    ngrid=0
+    do j=numbnests,1,-1
+      if ( x.gt.xln(j) .and. x.lt.xrn(j) .and. &
+           y.gt.yln(j) .and. y.lt.yrn(j) ) then
+        ngrid=j
+        goto 23
+      endif
+    end do
+ 23   continue
+
+  ! Determine nested grid coordinates
+  !**********************************
+
+    if (ngrid.gt.0) then
+  ! nested grids
+      xtn=(x-xln(ngrid))*xresoln(ngrid)
+      ytn=(y-yln(ngrid))*yresoln(ngrid)
+      ix=nint(xtn)
+      jy=nint(ytn)
+      igridn(ipart,ngrid) = 1 + jy*nxn(ngrid) + ix
+    else if(ngrid.eq.0) then
+  ! mother grid
+      ix=nint(x)
+      jy=nint(y)
+      igrid(ipart) = 1 + jy*nx + ix
+    endif
+
+ 20 continue
+  end do
+
+  !sumall = 0.
+  !sumconv = 0.
+
+  !*****************************************************************************
+  ! 1. Now, do everything for the mother domain and, later, for all of the nested domains
+  ! While all particles have to be considered for redistribution, the Emanuel convection
+  ! scheme only needs to be called once for every grid column where particles are present.
+  ! Therefore, particles are sorted according to their grid position. Whenever a new grid
+  ! cell is encountered by looping through the sorted particles, the convection scheme is called.
+  !*****************************************************************************
+
+  ! sort particles according to horizontal position and calculate index vector IPOINT
+
+  call sort2(numpart,igrid,ipoint)
+
+  ! Now visit all grid columns where particles are present
+  ! by going through the sorted particles
+
+  igrold = -1
+  do kpart=1,numpart
+    igr = igrid(kpart)
+    if (igr .eq. -1) goto 50
+    ipart = ipoint(kpart)
+  !  sumall = sumall + 1
+    if (igr .ne. igrold) then
+  ! we are in a new grid column
+      jy = (igr-1)/nx
+      ix = igr - jy*nx - 1
+
+  ! Interpolate all meteorological data needed for the convection scheme
+      psconv=(ps(ix,jy,1,mind1)*dt2+ps(ix,jy,1,mind2)*dt1)*dtt
+      tt2conv=(tt2(ix,jy,1,mind1)*dt2+tt2(ix,jy,1,mind2)*dt1)*dtt
+      td2conv=(td2(ix,jy,1,mind1)*dt2+td2(ix,jy,1,mind2)*dt1)*dtt
+!!$      do kz=1,nconvlev+1    !old
+      do kz=1,nuvz-1           !bugfix
+        pconv(kz)=(pplev(ix,jy,kz,mind1)*dt2+ &
+             pplev(ix,jy,kz,mind2)*dt1)*dtt
+        tconv(kz)=(tt(ix,jy,kz,mind1)*dt2+ &
+             tt(ix,jy,kz,mind2)*dt1)*dtt
+        qconv(kz)=(qv(ix,jy,kz,mind1)*dt2+ &
+             qv(ix,jy,kz,mind2)*dt1)*dtt
+      end do
+
+  ! Calculate translocation matrix
+      call calcmatrix(lconv,delt,cbaseflux(ix,jy))
+      igrold = igr
+      ktop = 0
+    endif
+
+  ! treat particle only if column has convection
+    if (lconv .eqv. .true.) then
+  ! assign new vertical position to particle
+
+      ztold=ztra1(ipart)
+      call redist(ipart,ktop,ipconv)
+  !    if (ipconv.le.0) sumconv = sumconv+1
+
+  ! Calculate the gross fluxes across layer interfaces
+  !***************************************************
+
+      if (iflux.eq.1) then
+        itage=abs(itra1(ipart)-itramem(ipart))
+        do nage=1,nageclass
+          if (itage.lt.lage(nage)) goto 37
+        end do
+ 37     continue
+
+        if (nage.le.nageclass) &
+             call calcfluxes(nage,ipart,real(xtra1(ipart)), &
+             real(ytra1(ipart)),ztold)
+      endif
+
+    endif   !(lconv .eqv. .true)
+50  continue
+  end do
+
+
+  !*****************************************************************************
+  ! 2. Nested domains
+  !*****************************************************************************
+
+  ! sort particles according to horizontal position and calculate index vector IPOINT
+
+  do inest=1,numbnests
+    do ipart=1,numpart
+      ipoint(ipart)=ipart
+      igrid(ipart) = igridn(ipart,inest)
+    enddo
+    call sort2(numpart,igrid,ipoint)
+
+  ! Now visit all grid columns where particles are present
+  ! by going through the sorted particles
+
+    igrold = -1
+    do kpart=1,numpart
+      igr = igrid(kpart)
+      if (igr .eq. -1) goto 60
+      ipart = ipoint(kpart)
+  !    sumall = sumall + 1
+      if (igr .ne. igrold) then
+  ! we are in a new grid column
+        jy = (igr-1)/nxn(inest)
+        ix = igr - jy*nxn(inest) - 1
+
+  ! Interpolate all meteorological data needed for the convection scheme
+        psconv=(psn(ix,jy,1,mind1,inest)*dt2+ &
+             psn(ix,jy,1,mind2,inest)*dt1)*dtt
+        tt2conv=(tt2n(ix,jy,1,mind1,inest)*dt2+ &
+             tt2n(ix,jy,1,mind2,inest)*dt1)*dtt
+        td2conv=(td2n(ix,jy,1,mind1,inest)*dt2+ &
+             td2n(ix,jy,1,mind2,inest)*dt1)*dtt
+!!$        do kz=1,nconvlev+1    !old
+        do kz=1,nuvz-1           !bugfix
+          tconv(kz)=(tthn(ix,jy,kz+1,mind1,inest)*dt2+ &
+               tthn(ix,jy,kz+1,mind2,inest)*dt1)*dtt
+          qconv(kz)=(qvhn(ix,jy,kz+1,mind1,inest)*dt2+ &
+               qvhn(ix,jy,kz+1,mind2,inest)*dt1)*dtt
+        end do
+
+  ! calculate translocation matrix
+  !*******************************
+        call calcmatrix(lconv,delt,cbasefluxn(ix,jy,inest))
+        igrold = igr
+        ktop = 0
+      endif
+
+  ! treat particle only if column has convection
+      if (lconv .eqv. .true.) then
+  ! assign new vertical position to particle
+        ztold=ztra1(ipart)
+        call redist(ipart,ktop,ipconv)
+  !      if (ipconv.le.0) sumconv = sumconv+1
+
+  ! Calculate the gross fluxes across layer interfaces
+  !***************************************************
+
+        if (iflux.eq.1) then
+          itage=abs(itra1(ipart)-itramem(ipart))
+          do nage=1,nageclass
+            if (itage.lt.lage(nage)) goto 47
+          end do
+ 47       continue
+
+          if (nage.le.nageclass) &
+               call calcfluxes(nage,ipart,real(xtra1(ipart)), &
+               real(ytra1(ipart)),ztold)
+        endif
+
+      endif !(lconv .eqv. .true.)
+
+
+60    continue
+    end do
+  end do
+  !--------------------------------------------------------------------------
+  !write(*,*)'############################################'
+  !write(*,*)'TIME=',
+  !    &  itime
+  !write(*,*)'fraction of particles under convection',
+  !    &  sumconv/(sumall+0.001)
+  !write(*,*)'total number of particles',
+  !    &  sumall
+  !write(*,*)'number of particles under convection',
+  !    &  sumconv
+  !write(*,*)'############################################'
+
+  return
+end subroutine convmix
Index: /branches/FP_AI/src/coordtrafo.f90
===================================================================
--- /branches/FP_AI/src/coordtrafo.f90	(revision 23)
+++ /branches/FP_AI/src/coordtrafo.f90	(revision 23)
@@ -0,0 +1,114 @@
+!**********************************************************************
+! 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 coordtrafo
+
+  !**********************************************************************
+  !                                                                     *
+  !             FLEXPART MODEL SUBROUTINE COORDTRAFO                    *
+  !                                                                     *
+  !**********************************************************************
+  !                                                                     *
+  !             AUTHOR:      G. WOTAWA                                  *
+  !             DATE:        1994-02-07                                 *
+  !             LAST UPDATE: 1996-05-18   A. STOHL                      *
+  !                                                                     *
+  !**********************************************************************
+  !                                                                     *
+  ! DESCRIPTION: This subroutine transforms x and y coordinates of      *
+  ! particle release points to grid coordinates.                        *
+  !                                                                     *
+  !**********************************************************************
+
+  use point_mod
+  use par_mod
+  use com_mod
+
+  implicit none
+
+  integer :: i,j,k
+
+  if (numpoint.eq.0) goto 30
+
+  ! TRANSFORM X- AND Y- COORDINATES OF STARTING POINTS TO GRID COORDINATES
+  !***********************************************************************
+
+  do i=1,numpoint
+    xpoint1(i)=(xpoint1(i)-xlon0)/dx
+    xpoint2(i)=(xpoint2(i)-xlon0)/dx
+    ypoint1(i)=(ypoint1(i)-ylat0)/dy
+    ypoint2(i)=(ypoint2(i)-ylat0)/dy
+  end do
+
+15   continue
+
+
+  ! CHECK IF RELEASE POINTS ARE WITHIN DOMAIN
+  !******************************************
+
+  do i=1,numpoint
+    if (sglobal.and.(ypoint1(i).lt.1.e-6)) ypoint1(i)=1.e-6
+    if (nglobal.and.(ypoint2(i).gt.real(nymin1)-1.e-5)) &
+         ypoint2(i)=real(nymin1)-1.e-5
+  if ((ypoint1(i).lt.1.e-6).or.(ypoint1(i).ge.real(nymin1)-1.e-6) &
+       .or.(ypoint2(i).lt.1.e-6).or.(ypoint2(i).ge.real(nymin1)-1.e-6) &
+       .or.((.not.xglobal).and.((xpoint1(i).lt.1.e-6).or. &
+       (xpoint1(i).ge.real(nxmin1)-1.e-6).or.(xpoint2(i).lt.1.e-6).or. &
+       (xpoint2(i).ge.real(nxmin1)-1.e-6)))) then
+      write(*,*) ' NOTICE: RELEASE POINT OUT OF DOMAIN DETECTED.'
+      write(*,*) ' IT IS REMOVED NOW ... '
+      if (i.ge.1000) then
+         write(*,*) ' COMMENT: ',compoint(i)
+      else
+         write(*,*) ' COMMENT: ',compoint(1001)
+      endif
+      if (i.lt.numpoint) then
+        do j=i+1,numpoint
+          xpoint1(j-1)=xpoint1(j)
+          ypoint1(j-1)=ypoint1(j)
+          xpoint2(j-1)=xpoint2(j)
+          ypoint2(j-1)=ypoint2(j)
+          zpoint1(j-1)=zpoint1(j)
+          zpoint2(j-1)=zpoint2(j)
+          npart(j-1)=npart(j)
+          kindz(j-1)=kindz(j)
+          ireleasestart(j-1)=ireleasestart(j)
+          ireleaseend(j-1)=ireleaseend(j)
+          if (j.le.1000) compoint(j-1)=compoint(j)
+          do k=1,nspec
+            xmass(j-1,k)=xmass(j,k)
+          end do
+        end do
+      endif
+
+      numpoint=numpoint-1
+      if (numpoint.gt.0) goto 15
+    endif
+  end do
+
+30   if(numpoint.eq.0) then
+    write(*,*) ' FLEXPART MODEL SUBROUTINE COORDTRAFO: ERROR ! '
+    write(*,*) ' NO PARTICLE RELEASES ARE DEFINED!'
+    write(*,*) ' CHECK FILE RELEASES...'
+    stop
+  endif
+
+end subroutine coordtrafo
Index: /branches/FP_AI/src/distance.f90
===================================================================
--- /branches/FP_AI/src/distance.f90	(revision 23)
+++ /branches/FP_AI/src/distance.f90	(revision 23)
@@ -0,0 +1,74 @@
+!**********************************************************************
+! 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/>.   *
+!**********************************************************************
+
+!-----------------------------------------------------------------------
+function distance(rlat1,rlon1,rlat2,rlon2)
+
+  !$$$  SUBPROGRAM DOCUMENTATION BLOCK
+  !
+  ! SUBPROGRAM:  GCDIST     COMPUTE GREAT CIRCLE DISTANCE
+  !   PRGMMR: IREDELL       ORG: W/NMC23       DATE: 96-04-10
+  !
+  ! ABSTRACT: THIS SUBPROGRAM COMPUTES GREAT CIRCLE DISTANCE
+  !      BETWEEN TWO POINTS ON THE EARTH.
+  !
+  ! PROGRAM HISTORY LOG:
+  !   96-04-10  IREDELL
+  !
+  ! USAGE:    ...GCDIST(RLAT1,RLON1,RLAT2,RLON2)
+  !
+  !   INPUT ARGUMENT LIST:
+  !rlat1    - REAL LATITUDE OF POINT 1 IN DEGREES
+  !rlon1    - REAL LONGITUDE OF POINT 1 IN DEGREES
+  !rlat2    - REAL LATITUDE OF POINT 2 IN DEGREES
+  !rlon2    - REAL LONGITUDE OF POINT 2 IN DEGREES
+  !
+  !   OUTPUT ARGUMENT LIST:
+  !distance - REAL GREAT CIRCLE DISTANCE IN KILOMETERS
+  !
+  ! ATTRIBUTES:
+  !   LANGUAGE: Fortran 90
+  !
+  !$$$
+
+  use par_mod, only: dp
+
+  implicit none
+
+  real          :: rlat1,rlon1,rlat2,rlon2,distance
+  real(kind=dp) :: clat1,clat2,slat1,slat2,cdlon,crd
+  real(kind=dp),parameter :: rerth=6.3712e6_dp
+  real(kind=dp),parameter :: pi=3.14159265358979_dp, dpr=180.0_dp/pi
+  ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+  if ((abs(rlat1-rlat2).lt.0.03).and. &
+       (abs(rlon1-rlon2).lt.0.03)) then
+    distance=0.
+  else
+    clat1=cos(real(rlat1,kind=dp)/dpr)
+    slat1=sin(real(rlat1,kind=dp)/dpr)
+    clat2=cos(real(rlat2,kind=dp)/dpr)
+    slat2=sin(real(rlat2,kind=dp)/dpr)
+    cdlon=cos(real((rlon1-rlon2),kind=dp)/dpr)
+    crd=slat1*slat2+clat1*clat2*cdlon
+    distance=real(rerth*acos(crd)/1000.0_dp)
+  endif
+  ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+end function distance
Index: /branches/FP_AI/src/distance2.f90
===================================================================
--- /branches/FP_AI/src/distance2.f90	(revision 23)
+++ /branches/FP_AI/src/distance2.f90	(revision 23)
@@ -0,0 +1,76 @@
+!**********************************************************************
+! 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/>.   *
+!**********************************************************************
+
+!-----------------------------------------------------------------------
+function distance2(rlat1,rlon1,rlat2,rlon2)
+
+  !$$$  SUBPROGRAM DOCUMENTATION BLOCK
+  !
+  ! SUBPROGRAM:  GCDIST     COMPUTE GREAT CIRCLE DISTANCE
+  !   PRGMMR: IREDELL       ORG: W/NMC23       DATE: 96-04-10
+  !
+  ! ABSTRACT: THIS SUBPROGRAM COMPUTES GREAT CIRCLE DISTANCE
+  !      BETWEEN TWO POINTS ON THE EARTH. COORDINATES ARE GIVEN IN RADIANS!
+  !
+  ! PROGRAM HISTORY LOG:
+  !   96-04-10  IREDELL
+  !
+  ! USAGE:    ...GCDIST(RLAT1,RLON1,RLAT2,RLON2)
+  !
+  !   INPUT ARGUMENT LIST:
+  !rlat1    - REAL LATITUDE OF POINT 1 IN RADIANS
+  !rlon1    - REAL LONGITUDE OF POINT 1 IN RADIANS
+  !rlat2    - REAL LATITUDE OF POINT 2 IN RADIANS
+  !rlon2    - REAL LONGITUDE OF POINT 2 IN RADIANS
+  !
+  !   OUTPUT ARGUMENT LIST:
+  !distance2   - REAL GREAT CIRCLE DISTANCE IN KM
+  !
+  ! ATTRIBUTES:
+  !   LANGUAGE: Fortran 90
+  !
+  !$$$
+
+  use par_mod, only: dp
+
+  implicit none
+
+  real                    :: rlat1,rlon1,rlat2,rlon2,distance2
+  real(kind=dp)           :: clat1,clat2,slat1,slat2,cdlon,crd
+  real(kind=dp),parameter :: rerth=6.3712e6_dp
+  real(kind=dp),parameter :: pi=3.14159265358979_dp
+
+  if ((abs(rlat1-rlat2).lt.0.0003).and. &
+       (abs(rlon1-rlon2).lt.0.0003)) then
+    distance2=0.0_dp
+  else
+
+  ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+    clat1=cos(real(rlat1,kind=dp))
+    slat1=sin(real(rlat1,kind=dp))
+    clat2=cos(real(rlat2,kind=dp))
+    slat2=sin(real(rlat2,kind=dp))
+    cdlon=cos(real(rlon1-rlon2,kind=dp))
+    crd=slat1*slat2+clat1*clat2*cdlon
+    distance2=real(rerth*acos(crd)/1000.0_dp)
+  endif
+  ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+end function distance2
Index: /branches/FP_AI/src/drydepokernel.f90
===================================================================
--- /branches/FP_AI/src/drydepokernel.f90	(revision 23)
+++ /branches/FP_AI/src/drydepokernel.f90	(revision 23)
@@ -0,0 +1,116 @@
+!**********************************************************************
+! 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 drydepokernel(nunc,deposit,x,y,nage,kp)
+  !                          i      i    i i  i
+  !*****************************************************************************
+  !                                                                            *
+  !     Attribution of the deposition to the grid using a uniform kernel with  *
+  !     bandwidths dx and dy.                                                  *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     26 December 1996                                                       *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  !                                                                            *
+  ! nunc             uncertainty class of the respective particle              *
+  ! nage             age class of the respective particle                      *
+  ! deposit          amount (kg) to be deposited                               *
+  !                                                                            *
+  !*****************************************************************************
+
+  use unc_mod
+  use par_mod
+  use com_mod
+
+  implicit none
+
+  real :: x,y,deposit(maxspec),ddx,ddy,xl,yl,wx,wy,w
+  integer :: ix,jy,ixp,jyp,ks,nunc,nage,kp
+
+
+  xl=(x*dx+xoutshift)/dxout
+  yl=(y*dy+youtshift)/dyout
+  ix=int(xl)
+  jy=int(yl)
+  ddx=xl-real(ix)                   ! distance to left cell border
+  ddy=yl-real(jy)                   ! distance to lower cell border
+
+  if (ddx.gt.0.5) then
+    ixp=ix+1
+    wx=1.5-ddx
+  else
+    ixp=ix-1
+    wx=0.5+ddx
+  endif
+
+  if (ddy.gt.0.5) then
+    jyp=jy+1
+    wy=1.5-ddy
+  else
+    jyp=jy-1
+    wy=0.5+ddy
+  endif
+
+
+  ! Determine mass fractions for four grid points
+  !**********************************************
+    do ks=1,nspec
+
+    if ((abs(deposit(ks)).gt.0).and.DRYDEPSPEC(ks)) then
+
+   if ((ix.ge.0).and.(jy.ge.0).and.(ix.le.numxgrid-1).and. &
+        (jy.le.numygrid-1)) then
+    w=wx*wy
+      drygridunc(ix,jy,ks,kp,nunc,nage)= &
+           drygridunc(ix,jy,ks,kp,nunc,nage)+deposit(ks)*w
+      continue
+  endif
+
+  if ((ixp.ge.0).and.(jyp.ge.0).and.(ixp.le.numxgrid-1).and. &
+       (jyp.le.numygrid-1)) then
+    w=(1.-wx)*(1.-wy)
+      drygridunc(ixp,jyp,ks,kp,nunc,nage)= &
+           drygridunc(ixp,jyp,ks,kp,nunc,nage)+deposit(ks)*w
+  endif
+
+  if ((ixp.ge.0).and.(jy.ge.0).and.(ixp.le.numxgrid-1).and. &
+       (jy.le.numygrid-1)) then
+    w=(1.-wx)*wy
+      drygridunc(ixp,jy,ks,kp,nunc,nage)= &
+           drygridunc(ixp,jy,ks,kp,nunc,nage)+deposit(ks)*w
+  endif
+
+  if ((ix.ge.0).and.(jyp.ge.0).and.(ix.le.numxgrid-1).and. &
+       (jyp.le.numygrid-1)) then
+    w=wx*(1.-wy)
+      drygridunc(ix,jyp,ks,kp,nunc,nage)= &
+           drygridunc(ix,jyp,ks,kp,nunc,nage)+deposit(ks)*w
+  endif
+
+  endif
+
+    end do
+
+end subroutine drydepokernel
Index: /branches/FP_AI/src/drydepokernel_nest.f90
===================================================================
--- /branches/FP_AI/src/drydepokernel_nest.f90	(revision 23)
+++ /branches/FP_AI/src/drydepokernel_nest.f90	(revision 23)
@@ -0,0 +1,118 @@
+!**********************************************************************
+! 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 drydepokernel_nest(nunc,deposit,x,y,nage,kp)
+  !                               i      i    i i  i
+  !*****************************************************************************
+  !                                                                            *
+  !     Attribution of the deposition from an individual particle to the       *
+  !     nested deposition fields using a uniform kernel with bandwidths        *
+  !     dxoutn and dyoutn.                                                     *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     26 December 1996                                                       *
+  !                                                                            *
+  !      2 September 2004: Adaptation from drydepokernel.                      *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  !                                                                            *
+  ! nunc             uncertainty class of the respective particle              *
+  ! nage             age class of the respective particle                      *
+  ! deposit          amount (kg) to be deposited                               *
+  !                                                                            *
+  !*****************************************************************************
+
+  use unc_mod
+  use par_mod
+  use com_mod
+
+  implicit none
+
+  real :: x,y,deposit(maxspec),ddx,ddy,xl,yl,wx,wy,w
+  integer :: ix,jy,ixp,jyp,ks,kp,nunc,nage
+
+
+
+  xl=(x*dx+xoutshiftn)/dxoutn
+  yl=(y*dy+youtshiftn)/dyoutn
+  ix=int(xl)
+  jy=int(yl)
+  ddx=xl-real(ix)                   ! distance to left cell border
+  ddy=yl-real(jy)                   ! distance to lower cell border
+
+  if (ddx.gt.0.5) then
+    ixp=ix+1
+    wx=1.5-ddx
+  else
+    ixp=ix-1
+    wx=0.5+ddx
+  endif
+
+  if (ddy.gt.0.5) then
+    jyp=jy+1
+    wy=1.5-ddy
+  else
+    jyp=jy-1
+    wy=0.5+ddy
+  endif
+
+
+  ! Determine mass fractions for four grid points
+  !**********************************************
+    do ks=1,nspec
+
+  if (DRYDEPSPEC(ks).and.(abs(deposit(ks)).gt.0)) then
+
+  if ((ix.ge.0).and.(jy.ge.0).and.(ix.le.numxgridn-1).and. &
+       (jy.le.numygridn-1)) then
+    w=wx*wy
+      drygriduncn(ix,jy,ks,kp,nunc,nage)= &
+           drygriduncn(ix,jy,ks,kp,nunc,nage)+deposit(ks)*w
+  endif
+
+  if ((ixp.ge.0).and.(jyp.ge.0).and.(ixp.le.numxgridn-1).and. &
+       (jyp.le.numygridn-1)) then
+    w=(1.-wx)*(1.-wy)
+      drygriduncn(ixp,jyp,ks,kp,nunc,nage)= &
+           drygriduncn(ixp,jyp,ks,kp,nunc,nage)+deposit(ks)*w
+  endif
+
+  if ((ixp.ge.0).and.(jy.ge.0).and.(ixp.le.numxgridn-1).and. &
+       (jy.le.numygridn-1)) then
+    w=(1.-wx)*wy
+      drygriduncn(ixp,jy,ks,kp,nunc,nage)= &
+           drygriduncn(ixp,jy,ks,kp,nunc,nage)+deposit(ks)*w
+  endif
+
+  if ((ix.ge.0).and.(jyp.ge.0).and.(ix.le.numxgridn-1).and. &
+       (jyp.le.numygridn-1)) then
+    w=wx*(1.-wy)
+      drygriduncn(ix,jyp,ks,kp,nunc,nage)= &
+           drygriduncn(ix,jyp,ks,kp,nunc,nage)+deposit(ks)*w
+  endif
+
+  endif
+
+    end do
+end subroutine drydepokernel_nest
Index: /branches/FP_AI/src/dynamic_viscosity.f90
===================================================================
--- /branches/FP_AI/src/dynamic_viscosity.f90	(revision 23)
+++ /branches/FP_AI/src/dynamic_viscosity.f90	(revision 23)
@@ -0,0 +1,36 @@
+!**********************************************************************
+! 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/>.   *
+!**********************************************************************
+
+! Function calculates dynamic viscosity of air (kg/m/s) as function of
+! temperature (K) using Sutherland's formula
+
+real function viscosity(t)
+
+  implicit none
+
+  real :: t
+  real,parameter :: c=120.,t_0=291.15,eta_0=1.827e-5
+
+  viscosity=eta_0*(t_0+c)/(t+c)*(t/t_0)**1.5
+
+  return
+
+end function viscosity
Index: /branches/FP_AI/src/erf.f90
===================================================================
--- /branches/FP_AI/src/erf.f90	(revision 23)
+++ /branches/FP_AI/src/erf.f90	(revision 23)
@@ -0,0 +1,212 @@
+!**********************************************************************
+! 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/>.   *
+!**********************************************************************
+
+! To be used, if the non-standard Fortran function erf does not exist on
+! your machine
+!
+!aus:  Numerical Recipes (FORTRAN) / Chapter 6.
+!
+!6.1  FUNCTION GAMMLN
+!6.2  FUNCTION GAMMP   <6.2:GSER/6.2:GCF/6.1:GAMMLN>
+!6.2  FUNCTION GAMMQ   <6.2:GSER/6.2:GCF/6.1:GAMMLN>
+!6.2  SUBROUTINE GSER    <6.1:GAMMLN>
+!6.2  SUBROUTINE GCF     <6.1:GAMMLN>
+!6.2  FUNCTION ERF     <6.2:GAMMP/6.2:GSER/6.2:GCF/6.1:GAMMLN>
+!6.2  FUNCTION ERFC    <6.2.:GAMMP/6.2:GAMMQ/6.2:GSER/
+!                       6.2:GCF/6.1:GAMMLN>
+!6.2  FUNCTION ERFCC
+
+function gammln(xx)
+
+  use par_mod, only: dp
+
+  implicit none
+
+  integer :: j
+  real :: x,tmp,ser,xx,gammln
+  real :: cof(6) = (/ &
+       76.18009173_dp, -86.50532033_dp, 24.01409822_dp, &
+       -1.231739516_dp, .120858003e-2_dp, -.536382e-5_dp    /)
+  real :: stp = 2.50662827465_dp
+  real :: half = 0.5_dp, one = 1.0_dp, fpf = 5.5_dp
+
+  x=xx-one
+  tmp=x+fpf
+  tmp=(x+half)*log(tmp)-tmp
+  ser=one
+  do j=1,6
+    x=x+one
+    ser=ser+cof(j)/x
+  end do
+  gammln=tmp+log(stp*ser)
+end function gammln
+
+function gammp(a,x)
+
+  implicit none
+
+  real :: a, x, gln, gamser, gammp, gammcf
+
+  if(x .lt. 0. .or. a .le. 0.) then
+     print*, 'gammp'
+     stop
+  end if
+  if(x.lt.a+1.)then
+    call gser(gamser,a,x,gln)
+    gammp=gamser
+  else
+    call gcf(gammcf,a,x,gln)
+    gammp=1.-gammcf
+  endif
+end function gammp
+
+function gammq(a,x)
+
+  implicit none
+
+  real :: a, x, gln, gamser, gammq, gammcf
+
+  if(x.lt.0..or.a.le.0.) then
+     print*, 'gammq'
+     stop
+  end if
+  if(x.lt.a+1.)then
+    call gser(gamser,a,x,gln)
+    gammq=1.-gamser
+  else
+    call gcf(gammcf,a,x,gln)
+    gammq=gammcf
+  endif
+end function gammq
+
+subroutine gser(gamser,a,x,gln)
+
+  implicit none
+
+  integer :: n
+  real :: gamser, a, x, gln, ap, summ, del
+  real, external :: gammln
+
+  integer,parameter :: itmax=100
+  real,parameter    :: eps=3.e-7
+
+  gln=gammln(a)
+  if(x.le.0.)then
+    if(x.lt.0.) then
+       print*, 'gser'
+       stop
+    end if
+    gamser=0.
+    return
+  endif
+  ap=a
+  summ=1./a
+  del=summ
+  do n=1,itmax
+    ap=ap+1.
+    del=del*x/ap
+    summ=summ+del
+    if(abs(del).lt.abs(summ)*eps)go to 1
+  end do
+  print*, 'gser: a too large, itmax too small'
+  stop
+1   gamser=summ*exp(-x+a*log(x)-gln)
+end subroutine gser
+
+subroutine gcf(gammcf,a,x,gln)
+
+  implicit none
+
+  integer :: n
+  real :: gammcf, a, x, gln, gold, a0, a1, b0, b1, fac, an, anf, ana, g
+  real, external :: gammln
+
+  integer,parameter :: itmax=100
+  real,parameter    :: eps=3.e-7
+
+  gln=gammln(a)
+  gold=0.
+  a0=1.
+  a1=x
+  b0=0.
+  b1=1.
+  fac=1.
+  do n=1,itmax
+    an=real(n)
+    ana=an-a
+    a0=(a1+a0*ana)*fac
+    b0=(b1+b0*ana)*fac
+    anf=an*fac
+    a1=x*a0+anf*a1
+    b1=x*b0+anf*b1
+    if(a1.ne.0.)then
+      fac=1./a1
+      g=b1*fac
+      if(abs((g-gold)/g).lt.eps)go to 1
+      gold=g
+    endif
+  end do
+  print*, 'gcf: a too large, itmax too small'
+  stop
+1   gammcf=exp(-x+a*alog(x)-gln)*g
+end subroutine gcf
+
+function erf(x)
+
+  implicit none
+
+  real :: x, erf
+  real, external :: gammp
+
+  if(x.lt.0.)then
+    erf=-gammp(.5,x**2)
+  else
+    erf=gammp(.5,x**2)
+  endif
+end function erf
+
+function erfc(x)
+
+  implicit none
+
+  real :: x, erfc
+  real, external :: gammp, gammq
+
+  if(x.lt.0.)then
+    erfc=1.+gammp(.5,x**2)
+  else
+    erfc=gammq(.5,x**2)
+  endif
+end function erfc
+
+function erfcc(x)
+
+  implicit none
+
+  real :: x, z, t, erfcc
+
+  z=abs(x)
+  t=1./(1.+0.5*z)
+  erfcc=t*exp(-z*z-1.26551223+t*(1.00002368+t*(.37409196+ &
+       t*(.09678418+t*(-.18628806+t*(.27886807+t*(-1.13520398+ &
+       t*(1.48851587+t*(-.82215223+t*.17087277)))))))))
+  if (x.lt.0.) erfcc=2.-erfcc
+end function erfcc
Index: /branches/FP_AI/src/ew.f90
===================================================================
--- /branches/FP_AI/src/ew.f90	(revision 23)
+++ /branches/FP_AI/src/ew.f90	(revision 23)
@@ -0,0 +1,47 @@
+!**********************************************************************
+! 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/>.   *
+!**********************************************************************
+
+real function ew(x)
+
+  !****************************************************************
+  !SAETTIGUNGSDAMPFDRUCK UEBER WASSER IN PA. X IN KELVIN.
+  !NACH DER GOFF-GRATCH-FORMEL.
+  !****************************************************************
+
+  implicit none
+
+  real :: x, y, a, c, d
+
+  ew=0.
+  if(x.le.0.) stop 'sorry: t not in [k]'
+  y=373.16/x
+  a=-7.90298*(y-1.)
+  a=a+(5.02808*0.43429*alog(y))
+  c=(1.-(1./y))*11.344
+  c=-1.+(10.**c)
+  c=-1.3816*c/(10.**7)
+  d=(1.-y)*3.49149
+  d=-1.+(10.**d)
+  d=8.1328*d/(10.**3)
+  y=a+c+d
+  ew=101324.6*(10.**y)       ! Saettigungsdampfdruck in Pa
+
+end function ew
Index: /branches/FP_AI/src/flux_mod.f90
===================================================================
--- /branches/FP_AI/src/flux_mod.f90	(revision 23)
+++ /branches/FP_AI/src/flux_mod.f90	(revision 23)
@@ -0,0 +1,41 @@
+!**********************************************************************
+! 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/>.   *
+!**********************************************************************
+
+module flux_mod
+
+  ! flux eastward, westward, northward, southward, upward and downward
+  ! fluxes of all species and all ageclasses
+  ! areaeast,areanorth [m2] side areas of each grid cell
+
+  implicit none
+
+  real,allocatable, dimension (:,:,:,:,:,:,:) :: flux
+
+  !1 fluxw west - east
+  !2 fluxe east - west
+  !3 fluxs south - north
+  !4 fluxn north - south
+  !5 fluxu upward
+  !6 fluxd downward
+  !real,allocatable, dimension (:,:,:) :: areanorth
+  !real,allocatable, dimension (:,:,:) :: areaeast
+
+end module flux_mod
Index: /branches/FP_AI/src/fluxoutput.f90
===================================================================
--- /branches/FP_AI/src/fluxoutput.f90	(revision 23)
+++ /branches/FP_AI/src/fluxoutput.f90	(revision 23)
@@ -0,0 +1,324 @@
+!**********************************************************************
+! 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 fluxoutput(itime)
+  !                        i
+  !*****************************************************************************
+  !                                                                            *
+  !     Output of the gridded fluxes.                                          *
+  !     Eastward, westward, northward, southward, upward and downward gross    *
+  !     fluxes are written to output file in either sparse matrix or grid dump *
+  !     format, whichever is more efficient.                                   *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     04 April 2000                                                          *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! ncellse         number of cells with non-zero values for eastward fluxes   *
+  ! sparsee         .true. if in sparse matrix format, else .false.            *
+  !                                                                            *
+  !*****************************************************************************
+
+  use flux_mod
+  use outg_mod
+  use par_mod
+  use com_mod
+
+  implicit none
+
+  real(kind=dp) :: jul
+  integer :: itime,ix,jy,kz,k,nage,jjjjmmdd,ihmmss,kp,i
+  integer :: ncellse(maxspec,maxageclass),ncellsw(maxspec,maxageclass)
+  integer :: ncellss(maxspec,maxageclass),ncellsn(maxspec,maxageclass)
+  integer :: ncellsu(maxspec,maxageclass),ncellsd(maxspec,maxageclass)
+  logical :: sparsee(maxspec,maxageclass),sparsew(maxspec,maxageclass)
+  logical :: sparses(maxspec,maxageclass),sparsen(maxspec,maxageclass)
+  logical :: sparseu(maxspec,maxageclass),sparsed(maxspec,maxageclass)
+  character :: adate*8,atime*6
+
+
+  ! Determine current calendar date, needed for the file name
+  !**********************************************************
+
+  jul=bdate+real(itime,kind=dp)/86400._dp
+  call caldate(jul,jjjjmmdd,ihmmss)
+  write(adate,'(i8.8)') jjjjmmdd
+  write(atime,'(i6.6)') ihmmss
+
+
+  open(unitflux,file=path(2)(1:length(2))//'grid_flux_'//adate// &
+       atime,form='unformatted')
+
+  !**************************************************************
+  ! Check, whether output of full grid or sparse matrix format is
+  ! more efficient in terms of storage space. This is checked for
+  ! every species and for every age class
+  !**************************************************************
+
+  do k=1,nspec
+    do nage=1,nageclass
+      ncellse(k,nage)=0
+      ncellsw(k,nage)=0
+      ncellsn(k,nage)=0
+      ncellss(k,nage)=0
+      ncellsu(k,nage)=0
+      ncellsd(k,nage)=0
+    end do
+  end do
+
+  do k=1,nspec
+  do kp=1,maxpointspec_act
+    do nage=1,nageclass
+      do jy=0,numygrid-1
+        do ix=0,numxgrid-1
+          do kz=1,numzgrid
+            if (flux(2,ix,jy,kz,k,kp,nage).gt.0) ncellse(k,nage)= &
+                 ncellse(k,nage)+1
+            if (flux(1,ix,jy,kz,k,kp,nage).gt.0) ncellsw(k,nage)= &
+                 ncellsw(k,nage)+1
+            if (flux(4,ix,jy,kz,k,kp,nage).gt.0) ncellsn(k,nage)= &
+                 ncellsn(k,nage)+1
+            if (flux(3,ix,jy,kz,k,kp,nage).gt.0) ncellss(k,nage)= &
+                 ncellss(k,nage)+1
+            if (flux(5,ix,jy,kz,k,kp,nage).gt.0) ncellsu(k,nage)= &
+                 ncellsu(k,nage)+1
+            if (flux(6,ix,jy,kz,k,kp,nage).gt.0) ncellsd(k,nage)= &
+                 ncellsd(k,nage)+1
+          end do
+        end do
+      end do
+    end do
+  end do
+  end do
+
+  ! Output in sparse matrix format more efficient, if less than
+  ! 2/5 of all cells contains concentrations>0
+  !************************************************************
+
+  do k=1,nspec
+    do nage=1,nageclass
+      if (4*ncellse(k,nage).lt.numxgrid*numygrid*numzgrid) then
+        sparsee(k,nage)=.true.
+      else
+        sparsee(k,nage)=.false.
+      endif
+      if (4*ncellsw(k,nage).lt.numxgrid*numygrid*numzgrid) then
+        sparsew(k,nage)=.true.
+      else
+        sparsew(k,nage)=.false.
+      endif
+      if (4*ncellsn(k,nage).lt.numxgrid*numygrid*numzgrid) then
+        sparsen(k,nage)=.true.
+      else
+        sparsen(k,nage)=.false.
+      endif
+      if (4*ncellss(k,nage).lt.numxgrid*numygrid*numzgrid) then
+        sparses(k,nage)=.true.
+      else
+        sparses(k,nage)=.false.
+      endif
+      if (4*ncellsu(k,nage).lt.numxgrid*numygrid*numzgrid) then
+        sparseu(k,nage)=.true.
+      else
+        sparseu(k,nage)=.false.
+      endif
+      if (4*ncellsd(k,nage).lt.numxgrid*numygrid*numzgrid) then
+        sparsed(k,nage)=.true.
+      else
+        sparsed(k,nage)=.false.
+      endif
+    end do
+  end do
+
+
+
+  ! Flux output: divide by area and time to get flux in ng/m2/s
+  !************************************************************
+
+  write(unitflux) itime
+  do k=1,nspec
+  do kp=1,maxpointspec_act
+    do nage=1,nageclass
+
+      if (sparsee(k,nage)) then
+        write(unitflux) 1
+        do kz=1,numzgrid
+          do jy=0,numygrid-1
+            do ix=0,numxgrid-1
+              if (flux(2,ix,jy,kz,k,kp,nage).gt.0.) write(unitflux) &
+                   ix+jy*numxgrid+kz*numxgrid*numygrid,1.e12* &
+                   flux(2,ix,jy,kz,k,kp,nage)/areaeast(ix,jy,kz)/outstep
+            end do
+          end do
+        end do
+        write(unitflux) -999,999.
+      else
+        write(unitflux) 2
+        do kz=1,numzgrid
+          do ix=0,numxgrid-1
+            write(unitflux) (1.e12*flux(2,ix,jy,kz,k,kp,nage)/ &
+                 areaeast(ix,jy,kz)/outstep,jy=0,numygrid-1)
+          end do
+        end do
+      endif
+
+      if (sparsew(k,nage)) then
+        write(unitflux) 1
+        do kz=1,numzgrid
+          do jy=0,numygrid-1
+            do ix=0,numxgrid-1
+              if (flux(1,ix,jy,kz,k,kp,nage).gt.0.) write(unitflux) &
+                   ix+jy*numxgrid+kz*numxgrid*numygrid,1.e12* &
+                   flux(1,ix,jy,kz,k,kp,nage)/areaeast(ix,jy,kz)/outstep
+            end do
+          end do
+        end do
+        write(unitflux) -999,999.
+      else
+        write(unitflux) 2
+        do kz=1,numzgrid
+          do ix=0,numxgrid-1
+            write(unitflux) (1.e12*flux(1,ix,jy,kz,k,kp,nage)/ &
+                 areaeast(ix,jy,kz)/outstep,jy=0,numygrid-1)
+          end do
+        end do
+      endif
+
+      if (sparses(k,nage)) then
+        write(unitflux) 1
+        do kz=1,numzgrid
+          do jy=0,numygrid-1
+            do ix=0,numxgrid-1
+              if (flux(3,ix,jy,kz,k,kp,nage).gt.0.) write(unitflux) &
+                   ix+jy*numxgrid+kz*numxgrid*numygrid,1.e12* &
+                   flux(3,ix,jy,kz,k,kp,nage)/areanorth(ix,jy,kz)/outstep
+            end do
+          end do
+        end do
+        write(unitflux) -999,999.
+      else
+        write(unitflux) 2
+        do kz=1,numzgrid
+          do ix=0,numxgrid-1
+            write(unitflux) (1.e12*flux(3,ix,jy,kz,k,kp,nage)/ &
+                 areanorth(ix,jy,kz)/outstep,jy=0,numygrid-1)
+          end do
+        end do
+      endif
+
+      if (sparsen(k,nage)) then
+        write(unitflux) 1
+        do kz=1,numzgrid
+          do jy=0,numygrid-1
+            do ix=0,numxgrid-1 ! north
+              if (flux(4,ix,jy,kz,k,kp,nage).gt.0.) write(unitflux) &
+                   ix+jy*numxgrid+kz*numxgrid*numygrid,1.e12* &
+                   flux(4,ix,jy,kz,k,kp,nage)/areanorth(ix,jy,kz)/outstep
+            end do
+          end do
+        end do
+        write(unitflux) -999,999.
+      else
+        write(unitflux) 2
+        do kz=1,numzgrid
+          do ix=0,numxgrid-1
+            write(unitflux) (1.e12*flux(4,ix,jy,kz,k,kp,nage)/ &
+                 areanorth(ix,jy,kz)/outstep,jy=0,numygrid-1)
+          end do
+        end do
+      endif
+
+      if (sparseu(k,nage)) then
+        write(unitflux) 1
+        do kz=1,numzgrid
+          do jy=0,numygrid-1
+            do ix=0,numxgrid-1
+              if (flux(5,ix,jy,kz,k,kp,nage).gt.0.) write(unitflux) &
+                   ix+jy*numxgrid+kz*numxgrid*numygrid,1.e12* &
+                   flux(5,ix,jy,kz,k,kp,nage)/area(ix,jy)/outstep
+            end do
+          end do
+        end do
+        write(unitflux) -999,999.
+      else
+        write(unitflux) 2
+        do kz=1,numzgrid
+          do ix=0,numxgrid-1
+            write(unitflux) (1.e12*flux(5,ix,jy,kz,k,kp,nage)/ &
+                 area(ix,jy)/outstep,jy=0,numygrid-1)
+          end do
+        end do
+      endif
+
+      if (sparsed(k,nage)) then
+        write(unitflux) 1
+        do kz=1,numzgrid
+          do jy=0,numygrid-1
+            do ix=0,numxgrid-1
+              if (flux(6,ix,jy,kz,k,kp,nage).gt.0.) write(unitflux) &
+                   ix+jy*numxgrid+kz*numxgrid*numygrid,1.e12* &
+                   flux(6,ix,jy,kz,k,kp,nage)/area(ix,jy)/outstep
+            end do
+          end do
+        end do
+        write(unitflux) -999,999.
+      else
+        write(unitflux) 2
+        do kz=1,numzgrid
+          do ix=0,numxgrid-1
+            write(unitflux) (1.e12*flux(6,ix,jy,kz,k,kp,nage)/ &
+                 area(ix,jy)/outstep,jy=0,numygrid-1)
+          end do
+        end do
+      endif
+
+    end do
+  end do
+  end do
+
+
+  close(unitflux)
+
+
+  ! Reinitialization of grid
+  !*************************
+
+  do k=1,nspec
+  do kp=1,maxpointspec_act
+    do jy=0,numygrid-1
+      do ix=0,numxgrid-1
+          do kz=1,numzgrid
+            do nage=1,nageclass
+              do i=1,6
+                flux(i,ix,jy,kz,k,kp,nage)=0.
+              end do
+            end do
+          end do
+      end do
+    end do
+  end do
+  end do
+
+
+end subroutine fluxoutput
Index: /branches/FP_AI/src/get_settling.f90
===================================================================
--- /branches/FP_AI/src/get_settling.f90	(revision 23)
+++ /branches/FP_AI/src/get_settling.f90	(revision 23)
@@ -0,0 +1,147 @@
+!**********************************************************************
+! 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 get_settling(itime,xt,yt,zt,nsp,settling)
+  !                          i   i  i  i   i     o
+  !*****************************************************************************
+  !                                                                            *
+  !  This subroutine calculates particle settling velocity.                    *
+  !                                                                            *
+  !    Author: A. Stohl                                                        *
+  !                                                                            *
+  !    May 2010                                                                *
+  !                                                                            *
+  !  Improvement over traditional settling calculation in FLEXPART:            *
+  !  generalize to higher Reynolds numbers and also take into account the      *
+  !  temperature dependence of dynamic viscosity.                              *
+  !                                                                            *
+  !  Based on:                                                                 *
+  !  Naeslund E., and Thaning, L. (1991): On the settling velocity in a        *
+  !  nonstationary atmosphere, Aerosol Science and Technology 14, 247-256.     *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! itime [s]          current temporal position                               *
+  ! xt,yt,zt           coordinates position for which wind data shall be cal-  *
+  !                    culated                                                 *
+  !                                                                            *
+  ! Constants:                                                                 *
+  !                                                                            *
+  !*****************************************************************************
+
+  use par_mod
+  use com_mod
+
+  implicit none
+
+  integer :: itime,indz
+  real :: xt,yt,zt
+
+  ! Auxiliary variables needed for interpolation
+  real :: dz1,dz2,dz
+  real :: rho1(2),tt1(2),temperature,airdens,vis_dyn,vis_kin,viscosity
+  real :: settling,settling_old,reynolds,c_d
+  integer :: i,n,nix,njy,indzh,nsp
+
+
+  !*****************************************************************************
+  ! 1. Interpolate temperature and density: nearest neighbor interpolation sufficient
+  !*****************************************************************************
+
+  nix=int(xt)
+  njy=int(yt)
+
+  ! Determine the level below the current position for u,v
+  !*******************************************************
+
+  do i=2,nz
+    if (height(i).gt.zt) then
+      indz=i-1
+      goto 6
+    endif
+  end do
+6   continue
+
+
+  ! Vertical distance to the level below and above current position
+  !****************************************************************
+
+  dz=1./(height(indz+1)-height(indz))
+  dz1=(zt-height(indz))*dz
+  dz2=(height(indz+1)-zt)*dz
+
+
+  ! Bilinear horizontal interpolation
+  !**********************************
+
+  ! Loop over 2 levels
+  !*******************
+
+  do n=1,2
+    indzh=indz+n-1
+    rho1(n)=rho(nix,njy,indzh,1)
+    tt1(n)=tt(nix,njy,indzh,1)
+  end do
+
+
+  ! Linear vertical interpolation
+  !******************************
+
+  temperature=dz2*tt1(1)+dz1*tt1(2)
+  airdens=dz2*rho1(1)+dz1*rho1(2)
+
+
+  vis_dyn=viscosity(temperature)
+  vis_kin=vis_dyn/airdens
+
+  reynolds=dquer(nsp)/1.e6*abs(vsetaver(nsp))/vis_kin
+
+
+
+  ! Iteration to determine both Reynolds number and settling velocity
+  !******************************************************************
+
+  settling_old=vsetaver(nsp)    ! initialize iteration with Stokes' law, constant viscosity estimate
+
+  do i=1,20    ! do a few iterations
+
+    if (reynolds.lt.1.917) then
+      c_d=24./reynolds
+    else if (reynolds.lt.500.) then
+      c_d=18.5/(reynolds**0.6)
+    else
+      c_d=0.44
+    endif
+
+    settling=-1.* &
+         sqrt(4*ga*dquer(nsp)/1.e6*density(nsp)*cunningham(nsp)/ &
+         (3.*c_d*airdens))
+
+    if (abs((settling-settling_old)/settling).lt.0.01) goto 11  ! stop iteration
+
+    reynolds=dquer(nsp)/1.e6*abs(settling)/vis_kin
+    settling_old=settling
+  end do
+
+11   continue
+
+end subroutine get_settling
Index: /branches/FP_AI/src/getfields.f90
===================================================================
--- /branches/FP_AI/src/getfields.f90	(revision 23)
+++ /branches/FP_AI/src/getfields.f90	(revision 23)
@@ -0,0 +1,177 @@
+!**********************************************************************
+! 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 getfields(itime,nstop)
+  !                       i     o
+  !*****************************************************************************
+  !                                                                            *
+  !  This subroutine manages the 3 data fields to be kept in memory.           *
+  !  During the first time step of petterssen it has to be fulfilled that the  *
+  !  first data field must have |wftime|<itime, i.e. the absolute value of     *
+  !  wftime must be smaller than the absolute value of the current time in [s].*
+  !  The other 2 fields are the next in time after the first one.              *
+  !  Pointers (memind) are used, because otherwise one would have to resort the*
+  !  wind fields, which costs a lot of computing time. Here only the pointers  *
+  !  are resorted.                                                             *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     29 April 1994                                                          *
+  !                                                                            *
+  !*****************************************************************************
+  !  Changes, Bernd C. Krueger, Feb. 2001:
+  !   Variables tth,qvh,tthn,qvhn (on eta coordinates) in common block.
+  !   Function of nstop extended.
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! lwindinterval [s]    time difference between the two wind fields read in   *
+  ! indj                 indicates the number of the wind field to be read in  *
+  ! indmin               remembers the number of wind fields already treated   *
+  ! memind(2)            pointer, on which place the wind fields are stored    *
+  ! memtime(2) [s]       times of the wind fields, which are kept in memory    *
+  ! itime [s]            current time since start date of trajectory calcu-    *
+  !                      lation                                                *
+  ! nstop                > 0, if trajectory has to be terminated               *
+  ! nx,ny,nuvz,nwz       field dimensions in x,y and z direction               *
+  ! uu(0:nxmax,0:nymax,nuvzmax,2)   wind components in x-direction [m/s]       *
+  ! vv(0:nxmax,0:nymax,nuvzmax,2)   wind components in y-direction [m/s]       *
+  ! ww(0:nxmax,0:nymax,nwzmax,2)    wind components in z-direction [deltaeta/s]*
+  ! tt(0:nxmax,0:nymax,nuvzmax,2)   temperature [K]                            *
+  ! ps(0:nxmax,0:nymax,2)           surface pressure [Pa]                      *
+  !                                                                            *
+  ! Constants:                                                                 *
+  ! idiffmax             maximum allowable time difference between 2 wind      *
+  !                      fields                                                *
+  !                                                                            *
+  !*****************************************************************************
+
+  use par_mod
+  use com_mod
+
+  implicit none
+
+  integer :: indj,itime,nstop,memaux
+
+  real :: uuh(0:nxmax-1,0:nymax-1,nuvzmax)
+  real :: vvh(0:nxmax-1,0:nymax-1,nuvzmax)
+  real :: pvh(0:nxmax-1,0:nymax-1,nuvzmax)
+  real :: wwh(0:nxmax-1,0:nymax-1,nwzmax)
+  real :: uuhn(0:nxmaxn-1,0:nymaxn-1,nuvzmax,maxnests)
+  real :: vvhn(0:nxmaxn-1,0:nymaxn-1,nuvzmax,maxnests)
+  real :: pvhn(0:nxmaxn-1,0:nymaxn-1,nuvzmax,maxnests)
+  real :: wwhn(0:nxmaxn-1,0:nymaxn-1,nwzmax,maxnests)
+
+  integer :: indmin = 1
+
+
+  ! Check, if wind fields are available for the current time step
+  !**************************************************************
+
+  nstop=0
+
+  if ((ldirect*wftime(1).gt.ldirect*itime).or. &
+       (ldirect*wftime(numbwf).lt.ldirect*itime)) then
+    write(*,*) 'FLEXPART WARNING: NO WIND FIELDS ARE AVAILABLE.'
+    write(*,*) 'A TRAJECTORY HAS TO BE TERMINATED.'
+    nstop=4
+    return
+  endif
+
+
+  if ((ldirect*memtime(1).le.ldirect*itime).and. &
+       (ldirect*memtime(2).gt.ldirect*itime)) then
+
+  ! The right wind fields are already in memory -> don't do anything
+  !*****************************************************************
+
+    continue
+
+  else if ((ldirect*memtime(2).le.ldirect*itime).and. &
+       (memtime(2).ne.999999999)) then
+
+
+  ! Current time is after 2nd wind field
+  ! -> Resort wind field pointers, so that current time is between 1st and 2nd
+  !***************************************************************************
+
+    memaux=memind(1)
+    memind(1)=memind(2)
+    memind(2)=memaux
+    memtime(1)=memtime(2)
+
+
+  ! Read a new wind field and store it on place memind(2)
+  !******************************************************
+
+    do indj=indmin,numbwf-1
+       if (ldirect*wftime(indj+1).gt.ldirect*itime) then
+          call readwind(indj+1,memind(2),uuh,vvh,wwh)
+          call readwind_nests(indj+1,memind(2),uuhn,vvhn,wwhn)
+          call calcpar(memind(2),uuh,vvh,pvh)
+          call calcpar_nests(memind(2),uuhn,vvhn,pvhn)
+          call verttransform(memind(2),uuh,vvh,wwh,pvh)
+          call verttransform_nests(memind(2),uuhn,vvhn,wwhn,pvhn)
+          memtime(2)=wftime(indj+1)
+          nstop = 1
+          goto 40
+       endif
+    end do
+ 40   indmin=indj
+
+  else
+
+  ! No wind fields, which can be used, are currently in memory
+  ! -> read both wind fields
+  !***********************************************************
+
+     do indj=indmin,numbwf-1
+        if ((ldirect*wftime(indj).le.ldirect*itime).and. &
+             (ldirect*wftime(indj+1).gt.ldirect*itime)) then
+           memind(1)=1
+           call readwind(indj,memind(1),uuh,vvh,wwh)
+           call readwind_nests(indj,memind(1),uuhn,vvhn,wwhn)
+           call calcpar(memind(1),uuh,vvh,pvh)
+           call calcpar_nests(memind(1),uuhn,vvhn,pvhn)
+           call verttransform(memind(1),uuh,vvh,wwh,pvh)
+           call verttransform_nests(memind(1),uuhn,vvhn,wwhn,pvhn)
+           memtime(1)=wftime(indj)
+           memind(2)=2
+           call readwind(indj+1,memind(2),uuh,vvh,wwh)
+           call readwind_nests(indj+1,memind(2),uuhn,vvhn,wwhn)
+           call calcpar(memind(2),uuh,vvh,pvh)
+           call calcpar_nests(memind(2),uuhn,vvhn,pvhn)
+           call verttransform(memind(2),uuh,vvh,wwh,pvh)
+           call verttransform_nests(memind(2),uuhn,vvhn,wwhn,pvhn)
+           memtime(2)=wftime(indj+1)
+           nstop = 1
+           goto 60
+        endif
+     end do
+ 60   indmin=indj
+
+  endif
+
+  lwindinterv=abs(memtime(2)-memtime(1))
+
+  if (lwindinterv.gt.idiffmax) nstop=3
+
+end subroutine getfields
Index: /branches/FP_AI/src/getrb.f90
===================================================================
--- /branches/FP_AI/src/getrb.f90	(revision 23)
+++ /branches/FP_AI/src/getrb.f90	(revision 23)
@@ -0,0 +1,61 @@
+!**********************************************************************
+! 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 getrb(nc,ustar,nyl,diffh2o,reldiff,rb)
+  !                 i    i    i     i       i    o
+  !*****************************************************************************
+  !                                                                            *
+  !  Calculation of the quasilaminar sublayer resistance to dry deposition.    *
+  !                                                                            *
+  !      AUTHOR: Andreas Stohl, 20 May 1995                                    *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! rb(ncmax)       sublayer resistance                                        *
+  ! schmidt         Schmidt number                                             *
+  ! ustar [m/s]     friction velocity                                          *
+  ! diffh20 [m2/s]  diffusivity of water vapor in air                          *
+  ! reldiff         diffusivity relative to H2O                                *
+  !                                                                            *
+  ! Constants:                                                                 *
+  ! karman          von Karman constant                                        *
+  ! pr              Prandtl number                                             *
+  !                                                                            *
+  !*****************************************************************************
+
+  use par_mod
+
+  implicit none
+
+  real :: ustar,diffh2o,rb(maxspec),schmidt,nyl
+  real :: reldiff(maxspec)
+  integer :: ic,nc
+  real,parameter :: pr=0.72
+
+  do ic=1,nc
+    if (reldiff(ic).gt.0.) then
+      schmidt=nyl/diffh2o*reldiff(ic)
+      rb(ic)=2.0*(schmidt/pr)**0.67/(karman*ustar)
+    endif
+  end do
+
+end subroutine getrb
Index: /branches/FP_AI/src/getrc.f90
===================================================================
--- /branches/FP_AI/src/getrc.f90	(revision 23)
+++ /branches/FP_AI/src/getrc.f90	(revision 23)
@@ -0,0 +1,122 @@
+!**********************************************************************
+! 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 getrc(nc,i,j,t,gr,rh,rr,rc)
+  !                 i  i i i i  i  i  o
+  !*****************************************************************************
+  !                                                                            *
+  !  Calculation of the surface resistance according to the procedure given    *
+  !  in:                                                                       *
+  !  Wesely (1989): Parameterization of surface resistances to gaseous         *
+  !  dry deposition in regional-scale numerical models.                        *
+  !  Atmos. Environ. 23, 1293-1304.                                            *
+  !                                                                            *
+  !                                                                            *
+  !      AUTHOR: Andreas Stohl, 19 May 1995                                    *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  !                                                                            *
+  ! reldiff(maxspec)  diffusivity of H2O/diffusivity of component i            *
+  ! gr [W/m2]       global radiation                                           *
+  ! i               index of seasonal category                                 *
+  ! j               index of landuse class                                     *
+  ! ldep(maxspec)          1, if deposition shall be calculated for species i  *
+  ! nc                   actual number of chemical components                  *
+  ! rcl(maxspec,5,8) [s/m] Lower canopy resistance                             *
+  ! rgs(maxspec,5,8) [s/m] Ground resistance                                   *
+  ! rlu(maxspec,5,8) [s/m] Leaf cuticular resistance                           *
+  ! rm(maxspec) [s/m]      Mesophyll resistance                                *
+  ! t [C]           temperature                                                *
+  !                                                                            *
+  !*****************************************************************************
+
+  use par_mod
+  use com_mod
+
+  implicit none
+
+  integer :: i,j,ic,nc
+  real :: gr,rh,rr,t,rs,rsm,corr,rluc,rclc,rgsc,rdc,rluo
+  real :: rc(maxspec)
+
+
+  ! Compute stomatal resistance
+  !****************************
+  ! Sabine Eckhardt, Dec 06: use 1E25 instead of 99999. for infinite res.
+
+  if ((t.gt.0.).and.(t.lt.40.)) then
+    rs=ri(i,j)*(1.+(200./(gr+0.1))**2)*(400./(t*(40.-t)))
+  else
+    rs=1.E25
+  !  rs=99999.
+  endif
+
+
+  ! Correct stomatal resistance for effect of dew and rain
+  !*******************************************************
+
+  if ((rh.gt.0.9).or.(rr.gt.0.)) rs=rs*3.
+
+  ! Compute the lower canopy resistance
+  !************************************
+
+  rdc=100.*(1.+1000./(gr+10.))
+
+
+  corr=1000.*exp(-1.*t-4.)
+  do ic=1,nc
+    if (reldiff(ic).gt.0.) then
+
+  ! Compute combined stomatal and mesophyll resistance
+  !***************************************************
+
+      rsm=rs*reldiff(ic)+rm(ic)
+
+  ! Correct leaf cuticular, lower canopy and ground resistance
+  !***********************************************************
+
+      rluc=rlu(ic,i,j)+corr
+      rclc=rcl(ic,i,j)+corr
+      rgsc=rgs(ic,i,j)+corr
+
+  ! Correct leaf cuticular resistance for effect of dew and rain
+  !*************************************************************
+
+      if (rr.gt.0.) then
+        rluo=1./(1./1000.+1./(3.*rluc))
+        rluc=1./(1./(3.*rluc)+1.e-7*henry(ic)+f0(ic)/rluo)
+      else if (rh.gt.0.9) then
+        rluo=1./(1./3000.+1./(3.*rluc))
+        rluc=1./(1./(3.*rluc)+1.e-7*henry(ic)+f0(ic)/rluo)
+      endif
+
+  ! Combine resistances to give total resistance
+  !*********************************************
+
+      rc(ic)=1./(1./rsm+1./rluc+1./(rdc+rclc)+1./(rac(i,j)+rgsc))
+  ! Sabine Eckhardt, Dec 06: avoid possible excessively high vdep
+      if (rc(ic).lt.10.) rc(ic)=10.
+    endif
+  end do
+
+end subroutine getrc
Index: /branches/FP_AI/src/getvdep.f90
===================================================================
--- /branches/FP_AI/src/getvdep.f90	(revision 23)
+++ /branches/FP_AI/src/getvdep.f90	(revision 23)
@@ -0,0 +1,203 @@
+!**********************************************************************
+! 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 getvdep(n,ix,jy,ust,temp,pa,L,gr,rh,rr,snow,vdepo)
+  !                   i i  i   i   i   i  i i  i  i    i o
+  !*****************************************************************************
+  !                                                                            *
+  !  This routine calculates the dry deposition velocities.                    *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     20 December 1996                                                       *
+  !     Sabine Eckhardt, Jan 07                                                *
+  !     if the latitude is negative: add half a year to the julian day         *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! gr [W/m2]         global radiation                                         *
+  ! L [m]             Obukhov length                                           *
+  ! nyl               kinematic viscosity                                      *
+  ! pa [Pa]           surface air pressure                                     *
+  ! ra [s/m]          aerodynamic resistance                                   *
+  ! raquer [s/m]      average aerodynamic resistance                           *
+  ! rh [0-1]          relative humidity                                        *
+  ! rhoa              density of the air                                       *
+  ! rr [mm/h]         precipitation rate                                       *
+  ! temp [K]          2m temperature                                           *
+  ! tc [C]            2m temperature                                           *
+  ! ust [m/s]         friction velocity                                        *
+  ! snow [m of water equivalent] snow depth                                    *
+  ! xlanduse          fractions of numclasS landuses for each model grid point *
+  !                                                                            *
+  !*****************************************************************************
+
+  use par_mod
+  use com_mod
+
+  implicit none
+
+  integer :: yyyymmdd,hhmmss,yyyy,mmdd,n,lseason,i,j,ix,jy
+  real :: vdepo(maxspec),vd,rb(maxspec),rc(maxspec),raquer,ylat
+  real :: raerod,ra,ust,temp,tc,pa,L,gr,rh,rr,myl,nyl,rhoa,diffh2o,snow
+  real :: slanduse(numclass)
+  real,parameter :: eps=1.e-5
+  real(kind=dp) :: jul
+
+  ! Calculate month and determine the seasonal category
+  !****************************************************
+
+  jul=bdate+real(wftime(n),kind=dp)/86400._dp
+
+  ylat=jy*dy+ylat0
+  if (ylat.lt.0) then
+      jul=jul+365/2
+  endif
+
+
+  call caldate(jul,yyyymmdd,hhmmss)
+  yyyy=yyyymmdd/10000
+  mmdd=yyyymmdd-10000*yyyy
+
+  if ((ylat.gt.-20).and.(ylat.lt.20)) then
+     mmdd=600 ! summer
+  endif
+
+  if ((mmdd.ge.1201).or.(mmdd.le.301)) then
+    lseason=4
+  else if ((mmdd.ge.1101).or.(mmdd.le.331)) then
+    lseason=3
+  else if ((mmdd.ge.401).and.(mmdd.le.515)) then
+    lseason=5
+  else if ((mmdd.ge.516).and.(mmdd.le.915)) then
+    lseason=1
+  else
+    lseason=2
+  endif
+
+  ! Calculate diffusivity of water vapor
+  !************************************
+  diffh2o=2.11e-5*(temp/273.15)**1.94*(101325/pa)
+
+  ! Conversion of temperature from K to C
+  !**************************************
+
+  tc=temp-273.15
+
+  ! Calculate dynamic viscosity
+  !****************************
+
+  if (tc.lt.0) then
+    myl=(1.718+0.0049*tc-1.2e-05*tc**2)*1.e-05
+  else
+    myl=(1.718+0.0049*tc)*1.e-05
+  endif
+
+  ! Calculate kinematic viscosity
+  !******************************
+
+  rhoa=pa/(287.*temp)
+  nyl=myl/rhoa
+
+
+  ! 0. Set all deposition velocities zero
+  !**************************************
+
+  do i=1,nspec
+    vdepo(i)=0.
+  end do
+
+
+  ! 1. Compute surface layer resistances rb
+  !****************************************
+
+  call getrb(nspec,ust,nyl,diffh2o,reldiff,rb)
+
+  ! change for snow
+  do j=1,numclass
+    if (snow.gt.0.001) then ! 10 mm
+       if (j.eq.12) then
+         slanduse(j)=1.
+       else
+         slanduse(j)=0.
+       endif
+    else
+       slanduse(j)=xlanduse(ix,jy,j)
+    endif
+  end do
+
+  raquer=0.
+  do j=1,numclass            ! loop over all landuse classes
+
+    if (slanduse(j).gt.eps)  then
+
+  ! 2. Calculate aerodynamic resistance ra
+  !***************************************
+
+      ra=raerod(L,ust,z0(j))
+      raquer=raquer+ra*slanduse(j)
+
+  ! 3. Calculate surface resistance for gases
+  !******************************************
+
+      call getrc(nspec,lseason,j,tc,gr,rh,rr,rc)
+
+  ! 4. Calculate deposition velocities for gases and ...
+  ! 5. ... sum deposition velocities for all landuse classes
+  !*********************************************************
+
+      do i=1,nspec
+        if (reldiff(i).gt.0.) then
+          if ((ra+rb(i)+rc(i)).gt.0.) then
+            vd=1./(ra+rb(i)+rc(i))
+  ! XXXXXXXXXXXXXXXXXXXXXXXXXX TEST
+  !         vd=1./rc(i)
+  ! XXXXXXXXXXXXXXXXXXXXXXXXXX TEST
+          else
+            vd=9.999
+          endif
+          vdepo(i)=vdepo(i)+vd*slanduse(j)
+        endif
+      end do
+    endif
+  end do
+
+
+  ! 6. Calculate deposition velocities for particles
+  !*************************************************
+
+  call partdep(nspec,density,fract,schmi,vset,raquer,ust,nyl,vdepo)
+
+
+  ! 7. If no detailed parameterization available, take constant deposition
+  !    velocity if that is available
+  !***********************************************************************
+
+  do i=1,nspec
+    if ((reldiff(i).lt.0.).and.(density(i).lt.0.).and. &
+         (dryvel(i).gt.0.)) then
+      vdepo(i)=dryvel(i)
+    endif
+  end do
+
+
+end subroutine getvdep
Index: /branches/FP_AI/src/getvdep_nests.f90
===================================================================
--- /branches/FP_AI/src/getvdep_nests.f90	(revision 23)
+++ /branches/FP_AI/src/getvdep_nests.f90	(revision 23)
@@ -0,0 +1,204 @@
+!**********************************************************************
+! 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 getvdep_nests(n,ix,jy,ust,temp,pa, &
+       L,gr,rh,rr,snow,vdepo,lnest)
+  !                   i i  i   i   i   i  i i  i  i    i o i
+  !*****************************************************************************
+  !                                                                            *
+  !  This routine calculates the dry deposition velocities.                    *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     20 December 1996                                                       *
+  !     Sabine Eckhardt, Jan 07                                                *
+  !     if the latitude is negative: add half a year to the julian day         *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! gr [W/m2]         global radiation                                         *
+  ! L [m]             Obukhov length                                           *
+  ! nyl               kinematic viscosity                                      *
+  ! pa [Pa]           surface air pressure                                     *
+  ! ra [s/m]          aerodynamic resistance                                   *
+  ! raquer [s/m]      average aerodynamic resistance                           *
+  ! rh [0-1]          relative humidity                                        *
+  ! rhoa              density of the air                                       *
+  ! rr [mm/h]         precipitation rate                                       *
+  ! temp [K]          2m temperature                                           *
+  ! tc [C]            2m temperature                                           *
+  ! ust [m/s]         friction velocity                                        *
+  ! snow [m of water equivalent] snow depth                                    *
+  ! xlanduse          fractions of numclasS landuses for each model grid point *
+  !                                                                            *
+  !*****************************************************************************
+
+  use par_mod
+  use com_mod
+
+  implicit none
+
+  integer :: yyyymmdd,hhmmss,yyyy,mmdd,n,lseason,i,j,ix,jy,lnest
+  real :: vdepo(maxspec),vd,rb(maxspec),rc(maxspec),raquer,ylat
+  real :: raerod,ra,ust,temp,tc,pa,L,gr,rh,rr,myl,nyl,rhoa,diffh2o,snow
+  real :: slanduse(numclass)
+  real,parameter :: eps=1.e-5
+  real(kind=dp) :: jul
+
+  ! Calculate month and determine the seasonal category
+  !****************************************************
+
+  jul=bdate+real(wftime(n),kind=dp)/86400._dp
+
+  ylat=jy*dy+ylat0
+  if (ylat.lt.0) then
+      jul=jul+365/2
+  endif
+
+
+  call caldate(jul,yyyymmdd,hhmmss)
+  yyyy=yyyymmdd/10000
+  mmdd=yyyymmdd-10000*yyyy
+
+  if ((ylat.gt.-20).and.(ylat.lt.20)) then
+     mmdd=600 ! summer
+  endif
+
+  if ((mmdd.ge.1201).or.(mmdd.le.301)) then
+    lseason=4
+  else if ((mmdd.ge.1101).or.(mmdd.le.331)) then
+    lseason=3
+  else if ((mmdd.ge.401).and.(mmdd.le.515)) then
+    lseason=5
+  else if ((mmdd.ge.516).and.(mmdd.le.915)) then
+    lseason=1
+  else
+    lseason=2
+  endif
+
+  ! Calculate diffusivity of water vapor
+  !************************************
+  diffh2o=2.11e-5*(temp/273.15)**1.94*(101325/pa)
+
+  ! Conversion of temperature from K to C
+  !**************************************
+
+  tc=temp-273.15
+
+  ! Calculate dynamic viscosity
+  !****************************
+
+  if (tc.lt.0) then
+    myl=(1.718+0.0049*tc-1.2e-05*tc**2)*1.e-05
+  else
+    myl=(1.718+0.0049*tc)*1.e-05
+  endif
+
+  ! Calculate kinematic viscosity
+  !******************************
+
+  rhoa=pa/(287.*temp)
+  nyl=myl/rhoa
+
+
+  ! 0. Set all deposition velocities zero
+  !**************************************
+
+  do i=1,nspec
+    vdepo(i)=0.
+  end do
+
+
+  ! 1. Compute surface layer resistances rb
+  !****************************************
+
+  call getrb(nspec,ust,nyl,diffh2o,reldiff,rb)
+
+  ! change for snow
+  do j=1,numclass
+    if (snow.gt.0.001) then ! 10 mm
+       if (j.eq.12) then
+         slanduse(j)=1.
+       else
+         slanduse(j)=0.
+       endif
+    else
+       slanduse(j)=xlandusen(ix,jy,j,lnest)
+    endif
+  end do
+
+  raquer=0.
+  do j=1,numclass            ! loop over all landuse classes
+
+    if (slanduse(j).gt.eps)  then
+
+  ! 2. Calculate aerodynamic resistance ra
+  !***************************************
+
+      ra=raerod(L,ust,z0(j))
+      raquer=raquer+ra*slanduse(j)
+
+  ! 3. Calculate surface resistance for gases
+  !******************************************
+
+      call getrc(nspec,lseason,j,tc,gr,rh,rr,rc)
+
+  ! 4. Calculate deposition velocities for gases and ...
+  ! 5. ... sum deposition velocities for all landuse classes
+  !*********************************************************
+
+      do i=1,nspec
+        if (reldiff(i).gt.0.) then
+          if ((ra+rb(i)+rc(i)).gt.0.) then
+            vd=1./(ra+rb(i)+rc(i))
+  ! XXXXXXXXXXXXXXXXXXXXXXXXXX TEST
+  !         vd=1./rc(i)
+  ! XXXXXXXXXXXXXXXXXXXXXXXXXX TEST
+          else
+            vd=9.999
+          endif
+          vdepo(i)=vdepo(i)+vd*slanduse(j)
+        endif
+      end do
+    endif
+  end do
+
+
+  ! 6. Calculate deposition velocities for particles
+  !*************************************************
+
+  call partdep(nspec,density,fract,schmi,vset,raquer,ust,nyl,vdepo)
+
+
+  ! 7. If no detailed parameterization available, take constant deposition
+  !    velocity if that is available
+  !***********************************************************************
+
+  do i=1,nspec
+    if ((reldiff(i).lt.0.).and.(density(i).lt.0.).and. &
+         (dryvel(i).gt.0.)) then
+      vdepo(i)=dryvel(i)
+    endif
+  end do
+
+
+end subroutine getvdep_nests
Index: /branches/FP_AI/src/gridcheck.f90
===================================================================
--- /branches/FP_AI/src/gridcheck.f90	(revision 23)
+++ /branches/FP_AI/src/gridcheck.f90	(revision 23)
@@ -0,0 +1,562 @@
+!**********************************************************************
+! 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: 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                *
+  ! UVHEIGHT(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
+  integer :: gotGrid
+  real(kind=4) :: xaux1,xaux2,yaux1,yaux2
+  real(kind=8) :: xaux1in,xaux2in,yaux1in,yaux2in
+  integer :: gribVer,parCat,parNum,typSurf,valSurf,discipl,parID
+  !HSO  end
+  integer :: ix,jy,i,ifn,ifield,j,k,iumax,iwmax,numskip
+  real :: sizesouth,sizenorth,xauxa,pint,conversion_factor
+
+  ! VARIABLES AND ARRAYS NEEDED FOR GRIB DECODING
+
+  ! dimension of isec2 at least (22+n), where n is the number of parallels or
+  ! meridians in a quasi-regular (reduced) Gaussian or lat/long grid
+
+  ! dimension of zsec2 at least (10+nn), where nn is the number of vertical
+  ! coordinate parameters
+
+  integer :: isec1(56),isec2(22+nxmax+nymax)
+  real(kind=4) :: zsec2(60+2*nuvzmax),zsec4(jpunp)
+  character(len=1) :: opt
+
+  !HSO  grib api error messages
+  character(len=24) :: gribErrorMsg = 'Error reading grib file'
+  character(len=20) :: gribFunction = 'gridcheck'
+
+  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
+  !turn on support for multi fields messages
+  !call grib_multi_support_on
+
+  gotGrid=0
+  ifield=0
+10   ifield=ifield+1
+
+  !
+  ! GET NEXT FIELDS
+  !
+  call grib_new_from_file(ifile,igrib,iret)
+  if (iret.eq.GRIB_END_OF_FILE )  then
+    goto 30    ! EOF DETECTED
+  elseif (iret.ne.GRIB_SUCCESS) then
+    goto 999   ! ERROR DETECTED
+  endif
+
+  !first see if we read GRIB1 or GRIB2
+  call grib_get_int(igrib,'editionNumber',gribVer,iret)
+  call grib_check(iret,gribFunction,gribErrorMsg)
+
+  if (gribVer.eq.1) then ! GRIB Edition 1
+
+  !print*,'GRiB Edition 1'
+  !read the grib2 identifiers
+  call grib_get_int(igrib,'indicatorOfParameter',isec1(6),iret)
+  call grib_check(iret,gribFunction,gribErrorMsg)
+  call grib_get_int(igrib,'level',isec1(8),iret)
+  call grib_check(iret,gribFunction,gribErrorMsg)
+
+  !change code for etadot to code for omega
+  if (isec1(6).eq.77) then
+    isec1(6)=135
+  endif
+
+  !print*,isec1(6),isec1(8)
+
+  else
+
+  !print*,'GRiB Edition 2'
+  !read the grib2 identifiers
+  call grib_get_int(igrib,'discipline',discipl,iret)
+  call grib_check(iret,gribFunction,gribErrorMsg)
+  call grib_get_int(igrib,'parameterCategory',parCat,iret)
+  call grib_check(iret,gribFunction,gribErrorMsg)
+  call grib_get_int(igrib,'parameterNumber',parNum,iret)
+  call grib_check(iret,gribFunction,gribErrorMsg)
+  call grib_get_int(igrib,'typeOfFirstFixedSurface',typSurf,iret)
+  call grib_check(iret,gribFunction,gribErrorMsg)
+  call grib_get_int(igrib,'level',valSurf,iret)
+  call grib_check(iret,gribFunction,gribErrorMsg)
+  call grib_get_int(igrib,'paramId',parId,iret)
+  call grib_check(iret,gribFunction,gribErrorMsg)
+
+  !print*,discipl,parCat,parNum,typSurf,valSurf
+
+  !convert to grib1 identifiers
+  isec1(6)=-1
+  isec1(7)=-1
+  isec1(8)=-1
+  isec1(8)=valSurf     ! level
+  if ((parCat.eq.0).and.(parNum.eq.0).and.(typSurf.eq.105)) then ! T
+    isec1(6)=130         ! indicatorOfParameter
+  elseif ((parCat.eq.2).and.(parNum.eq.2).and.(typSurf.eq.105)) then ! U
+    isec1(6)=131         ! indicatorOfParameter
+  elseif ((parCat.eq.2).and.(parNum.eq.3).and.(typSurf.eq.105)) then ! V
+    isec1(6)=132         ! indicatorOfParameter
+  elseif ((parCat.eq.1).and.(parNum.eq.0).and.(typSurf.eq.105)) then ! Q
+    isec1(6)=133         ! indicatorOfParameter
+  elseif ((parCat.eq.3).and.(parNum.eq.0).and.(typSurf.eq.1)) then !SP
+    isec1(6)=134         ! indicatorOfParameter
+  elseif ((parCat.eq.2).and.(parNum.eq.32)) then ! W, actually eta dot
+    isec1(6)=135         ! indicatorOfParameter
+  elseif ((parCat.eq.128).and.(parNum.eq.77)) then ! W, actually eta dot
+    isec1(6)=135         ! indicatorOfParameter
+  elseif ((parCat.eq.3).and.(parNum.eq.0).and.(typSurf.eq.101)) then !SLP
+    isec1(6)=151         ! indicatorOfParameter
+  elseif ((parCat.eq.2).and.(parNum.eq.2).and.(typSurf.eq.103)) then ! 10U
+    isec1(6)=165         ! indicatorOfParameter
+  elseif ((parCat.eq.2).and.(parNum.eq.3).and.(typSurf.eq.103)) then ! 10V
+    isec1(6)=166         ! indicatorOfParameter
+  elseif ((parCat.eq.0).and.(parNum.eq.0).and.(typSurf.eq.103)) then ! 2T
+    isec1(6)=167         ! indicatorOfParameter
+  elseif ((parCat.eq.0).and.(parNum.eq.6).and.(typSurf.eq.103)) then ! 2D
+    isec1(6)=168         ! indicatorOfParameter
+  elseif ((parCat.eq.1).and.(parNum.eq.11).and.(typSurf.eq.1)) then ! SD
+    isec1(6)=141         ! indicatorOfParameter
+  elseif ((parCat.eq.6).and.(parNum.eq.1) .or. parId .eq. 164) then ! CC
+    isec1(6)=164         ! indicatorOfParameter
+  elseif ((parCat.eq.1).and.(parNum.eq.9) .or. parId .eq. 142) then ! LSP
+    isec1(6)=142         ! indicatorOfParameter
+  elseif ((parCat.eq.1).and.(parNum.eq.10)) then ! CP
+    isec1(6)=143         ! indicatorOfParameter
+  elseif ((parCat.eq.0).and.(parNum.eq.11).and.(typSurf.eq.1)) then ! SHF
+    isec1(6)=146         ! indicatorOfParameter
+  elseif ((parCat.eq.4).and.(parNum.eq.9).and.(typSurf.eq.1)) then ! SR
+    isec1(6)=176         ! indicatorOfParameter
+  elseif ((parCat.eq.2).and.(parNum.eq.17) .or. parId .eq. 180) then ! EWSS
+    isec1(6)=180         ! indicatorOfParameter
+  elseif ((parCat.eq.2).and.(parNum.eq.18) .or. parId .eq. 181) then ! NSSS
+    isec1(6)=181         ! indicatorOfParameter
+  elseif ((parCat.eq.3).and.(parNum.eq.4)) then ! ORO
+    isec1(6)=129         ! indicatorOfParameter
+  elseif ((parCat.eq.3).and.(parNum.eq.7) .or. parId .eq. 160) then ! SDO
+    isec1(6)=160         ! indicatorOfParameter
+  elseif ((discipl.eq.2).and.(parCat.eq.0).and.(parNum.eq.0).and. &
+       (typSurf.eq.1)) then ! LSM
+    isec1(6)=172         ! indicatorOfParameter
+  else
+    print*,'***ERROR: undefined GRiB2 message found!',discipl, &
+         parCat,parNum,typSurf
+  endif
+  if(parId .ne. isec1(6) .and. parId .ne. 77) then
+    write(*,*) 'parId',parId, 'isec1(6)',isec1(6)
+!    stop
+  endif
+
+  endif
+
+  !get the size and data of the values array
+  if (isec1(6).ne.-1) then
+    call grib_get_real4_array(igrib,'values',zsec4,iret)
+    call grib_check(iret,gribFunction,gribErrorMsg)
+  endif
+
+  if (ifield.eq.1) then
+
+  !HSO  get the required fields from section 2 in a gribex compatible manner
+    call grib_get_int(igrib,'numberOfPointsAlongAParallel', &
+         isec2(2),iret)
+    call grib_check(iret,gribFunction,gribErrorMsg)
+    call grib_get_int(igrib,'numberOfPointsAlongAMeridian', &
+         isec2(3),iret)
+    call grib_check(iret,gribFunction,gribErrorMsg)
+    call grib_get_real8(igrib,'longitudeOfFirstGridPointInDegrees', &
+         xaux1in,iret)
+    call grib_check(iret,gribFunction,gribErrorMsg)
+    call grib_get_int(igrib,'numberOfVerticalCoordinateValues', &
+         isec2(12),iret)
+    call grib_check(iret,gribFunction,gribErrorMsg)
+
+  !  get the size and data of the vertical coordinate array
+    call grib_get_real4_array(igrib,'pv',zsec2,iret)
+    call grib_check(iret,gribFunction,gribErrorMsg)
+
+    nxfield=isec2(2)
+    ny=isec2(3)
+    nlev_ec=isec2(12)/2-1
+   endif
+
+  !HSO  get the second part of the grid dimensions only from GRiB1 messages
+  if (isec1(6) .eq. 167 .and. (gotGrid.eq.0)) then
+    call grib_get_real8(igrib,'longitudeOfLastGridPointInDegrees', &
+         xaux2in,iret)
+    call grib_check(iret,gribFunction,gribErrorMsg)
+    call grib_get_real8(igrib,'latitudeOfLastGridPointInDegrees', &
+         yaux1in,iret)
+    call grib_check(iret,gribFunction,gribErrorMsg)
+    call grib_get_real8(igrib,'latitudeOfFirstGridPointInDegrees', &
+         yaux2in,iret)
+    call grib_check(iret,gribFunction,gribErrorMsg)
+    xaux1=xaux1in
+    xaux2=xaux2in
+    yaux1=yaux1in
+    yaux2=yaux2in
+    if (xaux1.gt.180.) xaux1=xaux1-360.0
+    if (xaux2.gt.180.) xaux2=xaux2-360.0
+    if (xaux1.lt.-180.) xaux1=xaux1+360.0
+    if (xaux2.lt.-180.) xaux2=xaux2+360.0
+    if (xaux2.lt.xaux1) xaux2=xaux2+360.0
+    xlon0=xaux1
+    ylat0=yaux1
+    dx=(xaux2-xaux1)/real(nxfield-1)
+    dy=(yaux2-yaux1)/real(ny-1)
+    dxconst=180./(dx*r_earth*pi)
+    dyconst=180./(dy*r_earth*pi)
+    gotGrid=1
+  ! Check whether fields are global
+  ! If they contain the poles, specify polar stereographic map
+  ! projections using the stlmbr- and stcm2p-calls
+  !***********************************************************
+
+    xauxa=abs(xaux2+dx-360.-xaux1)
+    if (xauxa.lt.0.001) then
+      nx=nxfield+1                 ! field is cyclic
+      xglobal=.true.
+      if (abs(nxshift).ge.nx) &
+           stop 'nxshift in file par_mod is too large'
+      xlon0=xlon0+real(nxshift)*dx
+    else
+      nx=nxfield
+      xglobal=.false.
+      if (nxshift.ne.0) &
+           stop 'nxshift (par_mod) must be zero for non-global domain'
+    endif
+    nxmin1=nx-1
+    nymin1=ny-1
+    if (xlon0.gt.180.) xlon0=xlon0-360.
+    xauxa=abs(yaux1+90.)
+    if (xglobal.and.xauxa.lt.0.001) then
+      sglobal=.true.               ! field contains south pole
+  ! Enhance the map scale by factor 3 (*2=6) compared to north-south
+  ! map scale
+      sizesouth=6.*(switchsouth+90.)/dy
+      call stlmbr(southpolemap,-90.,0.)
+      call stcm2p(southpolemap,0.,0.,switchsouth,0.,sizesouth, &
+           sizesouth,switchsouth,180.)
+      switchsouthg=(switchsouth-ylat0)/dy
+    else
+      sglobal=.false.
+      switchsouthg=999999.
+    endif
+    xauxa=abs(yaux2-90.)
+    if (xglobal.and.xauxa.lt.0.001) then
+      nglobal=.true.               ! field contains north pole
+  ! Enhance the map scale by factor 3 (*2=6) compared to north-south
+  ! map scale
+      sizenorth=6.*(90.-switchnorth)/dy
+      call stlmbr(northpolemap,90.,0.)
+      call stcm2p(northpolemap,0.,0.,switchnorth,0.,sizenorth, &
+           sizenorth,switchnorth,180.)
+      switchnorthg=(switchnorth-ylat0)/dy
+    else
+      nglobal=.false.
+      switchnorthg=999999.
+    endif
+    if (nxshift.lt.0) &
+         stop 'nxshift (par_mod) must not be negative'
+    if (nxshift.ge.nxfield) stop 'nxshift (par_mod) too large'
+  endif ! gotGrid
+
+  k=isec1(8)
+  if(isec1(6).eq.131) iumax=max(iumax,nlev_ec-k+1)
+  if(isec1(6).eq.135) iwmax=max(iwmax,nlev_ec-k+1)
+
+  if(isec1(6).eq.129) then
+    do jy=0,ny-1
+      do ix=0,nxfield-1
+        oro(ix,jy)=zsec4(nxfield*(ny-jy-1)+ix+1)/ga
+      end do
+    end do
+  endif
+  if(isec1(6).eq.172) then
+    do jy=0,ny-1
+      do ix=0,nxfield-1
+        lsm(ix,jy)=zsec4(nxfield*(ny-jy-1)+ix+1)
+      end do
+    end do
+  endif
+  if(isec1(6).eq.160) then
+    do jy=0,ny-1
+      do ix=0,nxfield-1
+        excessoro(ix,jy)=zsec4(nxfield*(ny-jy-1)+ix+1)
+      end do
+    end do
+  endif
+
+  call grib_release(igrib)
+  goto 10                      !! READ NEXT LEVEL OR PARAMETER
+  !
+  ! CLOSING OF INPUT DATA FILE
+  !
+
+30   call grib_close_file(ifile)
+
+  !error message if no fields found with correct first longitude in it
+  if (gotGrid.eq.0) then
+    print*,'***ERROR: input file needs to contain GRiB1 formatted'// &
+         'messages'
+    stop
+  endif
+
+  nuvz=iumax
+  nwz =iwmax
+  if(nuvz.eq.nlev_ec) nwz=nlev_ec+1
+
+  if (nx.gt.nxmax) then
+   write(*,*) 'FLEXPART error: Too many grid points in x direction.'
+    write(*,*) 'Reduce resolution of wind fields.'
+    write(*,*) 'Or change parameter settings in file par_mod.'
+    write(*,*) nx,nxmax
+    stop
+  endif
+
+  if (ny.gt.nymax) then
+   write(*,*) 'FLEXPART error: Too many grid points in y direction.'
+    write(*,*) 'Reduce resolution of wind fields.'
+    write(*,*) 'Or change parameter settings in file par_mod.'
+    write(*,*) ny,nymax
+    stop
+  endif
+
+  if (nuvz+1.gt.nuvzmax) then
+    write(*,*) 'FLEXPART error: Too many u,v grid points in z '// &
+         'direction.'
+    write(*,*) 'Reduce resolution of wind fields.'
+    write(*,*) 'Or change parameter settings in file par_mod.'
+    write(*,*) nuvz+1,nuvzmax
+    stop
+  endif
+
+  if (nwz.gt.nwzmax) then
+    write(*,*) 'FLEXPART error: Too many w grid points in z '// &
+         'direction.'
+    write(*,*) 'Reduce resolution of wind fields.'
+    write(*,*) 'Or change parameter settings in file par_mod.'
+    write(*,*) nwz,nwzmax
+    stop
+  endif
+
+  ! If desired, shift all grids by nxshift grid cells
+  !**************************************************
+
+  if (xglobal) then
+    call shift_field_0(oro,nxfield,ny)
+    call shift_field_0(lsm,nxfield,ny)
+    call shift_field_0(excessoro,nxfield,ny)
+  endif
+
+  ! Output of grid info
+  !********************
+
+  write(*,*)
+  write(*,*)
+  write(*,'(a,2i7)') '# of vertical levels in ECMWF data: ', &
+       nuvz+1,nwz
+  write(*,*)
+  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: ', &
+       ylat0,' to ',ylat0+(ny-1)*dy,'   Grid distance: ',dy
+  write(*,*)
+
+
+  ! CALCULATE VERTICAL DISCRETIZATION OF ECMWF MODEL
+  ! PARAMETER akm,bkm DESCRIBE THE HYBRID "ETA" COORDINATE SYSTEM
+
+  numskip=nlev_ec-nuvz  ! number of ecmwf model layers not used
+                        ! by trajectory model
+  !do 8940 i=1,244
+  !   write (*,*) 'zsec2:',i,ifield,zsec2(i),numskip
+  !940  continue
+  !   stop
+  ! SEC SEC SEC
+  ! for unknown reason zsec 1 to 10 is filled in this version
+  ! compared to the old one
+  ! SEC SEC SE
+  do i=1,nwz
+    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
+
+  !
+  ! CALCULATION OF AKZ, BKZ
+  ! AKZ,BKZ: model discretization parameters at the center of each model
+  !     layer
+  !
+  ! Assign the 10 m winds to an artificial model level with akz=0 and bkz=1.0,
+  ! i.e. ground level
+  !*****************************************************************************
+
+  akz(1)=0.
+  bkz(1)=1.0
+  do i=1,nuvz
+     akz(i+1)=0.5*(akm(i+1)+akm(i))
+     bkz(i+1)=0.5*(bkm(i+1)+bkm(i))
+  end do
+  nuvz=nuvz+1
+
+  ! NOTE: In FLEXPART versions up to 4.0, the number of model levels was doubled
+  ! upon the transformation to z levels. In order to save computer memory, this is
+  ! not done anymore in the standard version. However, this option can still be
+  ! switched on by replacing the following lines with those below, that are
+  ! currently commented out. For this, similar changes are necessary in
+  ! verttransform.f and verttranform_nests.f
+  !*****************************************************************************
+
+  nz=nuvz
+  if (nz.gt.nzmax) stop 'nzmax too small'
+  do i=1,nuvz
+    aknew(i)=akz(i)
+    bknew(i)=bkz(i)
+  end do
+
+  ! Switch on following lines to use doubled vertical resolution
+  !*************************************************************
+  !nz=nuvz+nwz-1
+  !if (nz.gt.nzmax) stop 'nzmax too small'
+  !do 100 i=1,nwz
+  !  aknew(2*(i-1)+1)=akm(i)
+  !00     bknew(2*(i-1)+1)=bkm(i)
+  !do 110 i=2,nuvz
+  !  aknew(2*(i-1))=akz(i)
+  !10     bknew(2*(i-1))=bkz(i)
+  ! End doubled vertical resolution
+
+
+  ! Determine the uppermost level for which the convection scheme shall be applied
+  ! by assuming that there is no convection above 50 hPa (for standard SLP)
+  !*****************************************************************************
+
+  do i=1,nuvz-2
+    pint=akz(i)+bkz(i)*101325.
+    if (pint.lt.5000.) goto 96
+  end do
+96   nconvlev=i
+  if (nconvlev.gt.nconvlevmax-1) then
+    nconvlev=nconvlevmax-1
+    write(*,*) 'Attention, convection only calculated up to ', &
+         akz(nconvlev)+bkz(nconvlev)*1013.25,' hPa'
+  endif
+
+  return
+
+999   write(*,*)
+  write(*,*) ' ###########################################'// &
+       '###### '
+  write(*,*) '       TRAJECTORY MODEL SUBROUTINE GRIDCHECK:'
+  write(*,*) ' CAN NOT OPEN INPUT DATA FILE '//wfname(ifn)
+  write(*,*) ' ###########################################'// &
+       '###### '
+  write(*,*)
+  write(*,'(a)') '!!! PLEASE INSERT A NEW CD-ROM AND   !!!'
+  write(*,'(a)') '!!! PRESS ANY KEY TO CONTINUE...     !!!'
+  write(*,'(a)') '!!! ...OR TERMINATE FLEXPART PRESSING!!!'
+  write(*,'(a)') '!!! THE "X" KEY...                   !!!'
+  write(*,*)
+  read(*,'(a)') opt
+  if(opt.eq.'X') then
+    stop
+  else
+    goto 5
+  endif
+
+end subroutine gridcheck
+
Index: /branches/FP_AI/src/gridcheck_fnl.f90
===================================================================
--- /branches/FP_AI/src/gridcheck_fnl.f90	(revision 23)
+++ /branches/FP_AI/src/gridcheck_fnl.f90	(revision 23)
@@ -0,0 +1,545 @@
+!**********************************************************************
+! 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
+  !turn on support for multi fields messages
+  call grib_multi_support_on
+
+  ifield=0
+10   ifield=ifield+1
+  !
+  ! GET NEXT FIELDS
+  !
+  call grib_new_from_file(ifile,igrib,iret)
+  if (iret.eq.GRIB_END_OF_FILE )  then
+    goto 30    ! EOF DETECTED
+  elseif (iret.ne.GRIB_SUCCESS) then
+    goto 999   ! ERROR DETECTED
+  endif
+
+  !first see if we read GRIB1 or GRIB2
+  call grib_get_int(igrib,'editionNumber',gribVer,iret)
+  call grib_check(iret,gribFunction,gribErrorMsg)
+
+  if (gribVer.eq.1) then ! GRIB Edition 1
+
+  !read the grib1 identifiers
+  call grib_get_int(igrib,'indicatorOfParameter',isec1(6),iret)
+  call grib_check(iret,gribFunction,gribErrorMsg)
+  call grib_get_int(igrib,'indicatorOfTypeOfLevel',isec1(7),iret)
+  call grib_check(iret,gribFunction,gribErrorMsg)
+  call grib_get_int(igrib,'level',isec1(8),iret)
+  call grib_check(iret,gribFunction,gribErrorMsg)
+
+  !get the size and data of the values array
+  call grib_get_real4_array(igrib,'values',zsec4,iret)
+  call grib_check(iret,gribFunction,gribErrorMsg)
+
+  else ! GRIB Edition 2
+
+  !read the grib2 identifiers
+  call grib_get_int(igrib,'discipline',discipl,iret)
+  call grib_check(iret,gribFunction,gribErrorMsg)
+  call grib_get_int(igrib,'parameterCategory',parCat,iret)
+  call grib_check(iret,gribFunction,gribErrorMsg)
+  call grib_get_int(igrib,'parameterNumber',parNum,iret)
+  call grib_check(iret,gribFunction,gribErrorMsg)
+  call grib_get_int(igrib,'typeOfFirstFixedSurface',typSurf,iret)
+  call grib_check(iret,gribFunction,gribErrorMsg)
+  call grib_get_int(igrib,'scaledValueOfFirstFixedSurface', &
+       valSurf,iret)
+  call grib_check(iret,gribFunction,gribErrorMsg)
+
+  !convert to grib1 identifiers
+  isec1(6)=-1
+  isec1(7)=-1
+  isec1(8)=-1
+  if ((parCat.eq.2).and.(parNum.eq.2).and.(typSurf.eq.100)) then ! U
+    isec1(6)=33          ! indicatorOfParameter
+    isec1(7)=100         ! indicatorOfTypeOfLevel
+    isec1(8)=valSurf/100 ! level, convert to hPa
+  elseif ((parCat.eq.3).and.(parNum.eq.5).and.(typSurf.eq.1)) then ! TOPO
+    isec1(6)=7           ! indicatorOfParameter
+    isec1(7)=1           ! indicatorOfTypeOfLevel
+    isec1(8)=0
+  elseif ((parCat.eq.0).and.(parNum.eq.0).and.(typSurf.eq.1) &
+       .and.(discipl.eq.2)) then ! LSM
+    isec1(6)=81          ! indicatorOfParameter
+    isec1(7)=1           ! indicatorOfTypeOfLevel
+    isec1(8)=0
+  endif
+
+  if (isec1(6).ne.-1) then
+  !  get the size and data of the values array
+    call grib_get_real4_array(igrib,'values',zsec4,iret)
+    call grib_check(iret,gribFunction,gribErrorMsg)
+  endif
+
+  endif ! gribVer
+
+  if(ifield.eq.1) then
+
+  !get the required fields from section 2
+  !store compatible to gribex input
+  call grib_get_int(igrib,'numberOfPointsAlongAParallel', &
+       isec2(2),iret)
+  call grib_check(iret,gribFunction,gribErrorMsg)
+  call grib_get_int(igrib,'numberOfPointsAlongAMeridian', &
+       isec2(3),iret)
+  call grib_check(iret,gribFunction,gribErrorMsg)
+  call grib_get_real8(igrib,'longitudeOfFirstGridPointInDegrees', &
+       xaux1in,iret)
+  call grib_check(iret,gribFunction,gribErrorMsg)
+  call grib_get_real8(igrib,'longitudeOfLastGridPointInDegrees', &
+       xaux2in,iret)
+  call grib_check(iret,gribFunction,gribErrorMsg)
+  call grib_get_real8(igrib,'latitudeOfLastGridPointInDegrees', &
+       yaux1in,iret)
+  call grib_check(iret,gribFunction,gribErrorMsg)
+  call grib_get_real8(igrib,'latitudeOfFirstGridPointInDegrees', &
+       yaux2in,iret)
+  call grib_check(iret,gribFunction,gribErrorMsg)
+
+  xaux1=xaux1in
+!  xaux2=xaux2in
+  xaux2=xaux2in+360.    !!! Transform FNL xauu2in from -1 to 359 (Xuekue Fang, 31 Jan 2013)
+  yaux1=yaux1in
+  yaux2=yaux2in
+  write(*,*) 'xaux1,xaux2,yaux1,yaux2',xaux1,xaux2,yaux1,yaux2
+  nxfield=isec2(2)
+  ny=isec2(3)
+
+  
+
+  if((abs(xaux1).lt.eps).and.(xaux2.ge.359)) then ! NCEP DATA FROM 0 TO
+    xaux1=-179.0                             ! 359 DEG EAST ->
+    xaux2=-179.0+360.-360./real(nxfield)    ! TRANSFORMED TO -179
+  endif                                      ! TO 180 DEG EAST
+  if (xaux1.gt.180) xaux1=xaux1-360.0
+  if (xaux2.gt.180) xaux2=xaux2-360.0
+  if (xaux1.lt.-180) xaux1=xaux1+360.0
+  if (xaux2.lt.-180) xaux2=xaux2+360.0
+  if (xaux2.lt.xaux1) xaux2=xaux2+360.
+  xlon0=xaux1
+  ylat0=yaux1
+  write(*,*) 'xlon0,ylat0',xlon0,ylat0
+
+  dx=(xaux2-xaux1)/real(nxfield-1)
+  dy=(yaux2-yaux1)/real(ny-1)
+  dxconst=180./(dx*r_earth*pi)
+  dyconst=180./(dy*r_earth*pi)
+  write(*,*) 'dx,dy,dxconst,dyconst',dx,dy,dxconst,dyconst
+  !HSO end edits
+
+
+  ! Check whether fields are global
+  ! If they contain the poles, specify polar stereographic map
+  ! projections using the stlmbr- and stcm2p-calls
+  !***********************************************************
+
+    xauxa=abs(xaux2+dx-360.-xaux1)
+    if (xauxa.lt.0.001) then
+      nx=nxfield+1                 ! field is cyclic
+      xglobal=.true.
+      if (abs(nxshift).ge.nx) &
+           stop 'nxshift in file par_mod is too large'
+      xlon0=xlon0+real(nxshift)*dx
+    else
+      nx=nxfield
+      xglobal=.false.
+      if (nxshift.ne.0) &
+           stop 'nxshift (par_mod) must be zero for non-global domain'
+    endif
+    nxmin1=nx-1
+    nymin1=ny-1
+    if (xlon0.gt.180.) xlon0=xlon0-360.
+    xauxa=abs(yaux1+90.)
+    if (xglobal.and.xauxa.lt.0.001) then
+      sglobal=.true.               ! field contains south pole
+  ! Enhance the map scale by factor 3 (*2=6) compared to north-south
+  ! map scale
+      sizesouth=6.*(switchsouth+90.)/dy
+      call stlmbr(southpolemap,-90.,0.)
+      call stcm2p(southpolemap,0.,0.,switchsouth,0.,sizesouth, &
+           sizesouth,switchsouth,180.)
+      switchsouthg=(switchsouth-ylat0)/dy
+    else
+      sglobal=.false.
+      switchsouthg=999999.
+    endif
+    xauxa=abs(yaux2-90.)
+    if (xglobal.and.xauxa.lt.0.001) then
+      nglobal=.true.               ! field contains north pole
+  ! Enhance the map scale by factor 3 (*2=6) compared to north-south
+  ! map scale
+      sizenorth=6.*(90.-switchnorth)/dy
+      call stlmbr(northpolemap,90.,0.)
+      call stcm2p(northpolemap,0.,0.,switchnorth,0.,sizenorth, &
+           sizenorth,switchnorth,180.)
+      switchnorthg=(switchnorth-ylat0)/dy
+    else
+      nglobal=.false.
+      switchnorthg=999999.
+    endif
+  endif ! ifield.eq.1
+
+  if (nxshift.lt.0) stop 'nxshift (par_mod) must not be negative'
+  if (nxshift.ge.nxfield) stop 'nxshift (par_mod) too large'
+
+  ! NCEP ISOBARIC LEVELS
+  !*********************
+
+  if((isec1(6).eq.33).and.(isec1(7).eq.100)) then ! check for U wind
+    iumax=iumax+1
+    pres(iumax)=real(isec1(8))*100.0
+  endif
+
+
+  i179=nint(179./dx)
+  if (dx.lt.0.7) then
+    i180=nint(180./dx)+1    ! 0.5 deg data
+  else
+    i180=nint(179./dx)+1    ! 1 deg data
+  endif
+  i181=i180+1
+
+
+  ! NCEP TERRAIN
+  !*************
+
+  if((isec1(6).eq.007).and.(isec1(7).eq.001)) then
+    do jy=0,ny-1
+      do ix=0,nxfield-1
+        help=zsec4(nxfield*(ny-jy-1)+ix+1)
+        if(ix.le.i180) then
+          oro(i179+ix,jy)=help
+          excessoro(i179+ix,jy)=0.0 ! ISOBARIC SURFACES: SUBGRID TERRAIN DISREGARDED
+        else
+          oro(ix-i181,jy)=help
+          excessoro(ix-i181,jy)=0.0 ! ISOBARIC SURFACES: SUBGRID TERRAIN DISREGARDED
+        endif
+      end do
+    end do
+  endif
+
+  ! NCEP LAND SEA MASK
+  !*******************
+
+  if((isec1(6).eq.081).and.(isec1(7).eq.001)) then
+    do jy=0,ny-1
+      do ix=0,nxfield-1
+        help=zsec4(nxfield*(ny-jy-1)+ix+1)
+        if(ix.le.i180) then
+          lsm(i179+ix,jy)=help
+        else
+          lsm(ix-i181,jy)=help
+        endif
+      end do
+    end do
+  endif
+
+  call grib_release(igrib)
+
+  goto 10                      !! READ NEXT LEVEL OR PARAMETER
+  !
+  ! CLOSING OF INPUT DATA FILE
+  !
+
+  ! HSO
+30   continue
+  call grib_close_file(ifile)
+  ! HSO end edits
+
+  nuvz=iumax
+  nwz =iumax
+  nlev_ec=iumax
+
+  if (nx.gt.nxmax) then
+   write(*,*) 'FLEXPART error: Too many grid points in x direction.'
+    write(*,*) 'Reduce resolution of wind fields.'
+    write(*,*) 'Or change parameter settings in file par_mod.'
+    write(*,*) nx,nxmax
+    stop
+  endif
+
+  if (ny.gt.nymax) then
+   write(*,*) 'FLEXPART error: Too many grid points in y direction.'
+    write(*,*) 'Reduce resolution of wind fields.'
+    write(*,*) 'Or change parameter settings in file par_mod.'
+    write(*,*) ny,nymax
+    stop
+  endif
+
+  if (nuvz.gt.nuvzmax) then
+    write(*,*) 'FLEXPART error: Too many u,v grid points in z '// &
+         'direction.'
+    write(*,*) 'Reduce resolution of wind fields.'
+    write(*,*) 'Or change parameter settings in file par_mod.'
+    write(*,*) nuvz,nuvzmax
+    stop
+  endif
+
+  if (nwz.gt.nwzmax) then
+    write(*,*) 'FLEXPART error: Too many w grid points in z '// &
+         'direction.'
+    write(*,*) 'Reduce resolution of wind fields.'
+    write(*,*) 'Or change parameter settings in file par_mod.'
+    write(*,*) nwz,nwzmax
+    stop
+  endif
+
+  ! If desired, shift all grids by nxshift grid cells
+  !**************************************************
+
+  if (xglobal) then
+    call shift_field_0(oro,nxfield,ny)
+    call shift_field_0(lsm,nxfield,ny)
+    call shift_field_0(excessoro,nxfield,ny)
+  endif
+
+  ! Output of grid info
+  !********************
+
+  write(*,*)
+  write(*,*)
+  write(*,'(a,2i7)') '# of vertical levels in NCEP data: ', &
+       nuvz,nwz
+  write(*,*)
+  write(*,'(a)') 'other 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: ', &
+       ylat0,' to ',ylat0+(ny-1)*dy,'   Grid distance: ',dy
+  write(*,*)
+
+
+  ! CALCULATE VERTICAL DISCRETIZATION OF ECMWF MODEL
+  ! PARAMETER akm,bkm DESCRIBE THE HYBRID "ETA" COORDINATE SYSTEM
+
+  numskip=nlev_ec-nuvz  ! number of ecmwf model layers not used
+                        ! by trajectory model
+  do i=1,nwz
+    j=numskip+i
+    k=nlev_ec+1+numskip+i
+    akm_usort(nwz-i+1)=pres(nwz-i+1)
+    bkm(nwz-i+1)=0.0
+  end do
+
+  !******************************
+  ! change Sabine Eckhardt: akm should always be in descending order ... readwind adapted!
+  !******************************
+      do i=1,nwz
+         if (akm_usort(1).gt.akm_usort(2)) then
+            akm(i)=akm_usort(i)
+         else
+            akm(i)=akm_usort(nwz-i+1)
+         endif
+      end do
+
+  !
+  ! CALCULATION OF AKZ, BKZ
+  ! AKZ,BKZ: model discretization parameters at the center of each model
+  !     layer
+  !
+  ! Assign the 10 m winds to an artificial model level with akz=0 and bkz=1.0,
+  ! i.e. ground level
+  !*****************************************************************************
+
+  do i=1,nuvz
+     akz(i)=akm(i)
+     bkz(i)=bkm(i)
+  end do
+
+  ! NOTE: In FLEXPART versions up to 4.0, the number of model levels was doubled
+  ! upon the transformation to z levels. In order to save computer memory, this is
+  ! not done anymore in the standard version. However, this option can still be
+  ! switched on by replacing the following lines with those below, that are
+  ! currently commented out. For this, similar changes are necessary in
+  ! verttransform.f and verttranform_nests.f
+  !*****************************************************************************
+
+  nz=nuvz
+  if (nz.gt.nzmax) stop 'nzmax too small'
+  do i=1,nuvz
+    aknew(i)=akz(i)
+    bknew(i)=bkz(i)
+  end do
+
+  ! Switch on following lines to use doubled vertical resolution
+  !*************************************************************
+  !nz=nuvz+nwz-1
+  !if (nz.gt.nzmax) stop 'nzmax too small'
+  !do 100 i=1,nwz
+  !  aknew(2*(i-1)+1)=akm(i)
+  !00     bknew(2*(i-1)+1)=bkm(i)
+  !do 110 i=2,nuvz
+  !  aknew(2*(i-1))=akz(i)
+  !10     bknew(2*(i-1))=bkz(i)
+  ! End doubled vertical resolution
+
+
+  ! Determine the uppermost level for which the convection scheme shall be applied
+  ! by assuming that there is no convection above 50 hPa (for standard SLP)
+  !*****************************************************************************
+
+  do i=1,nuvz-2
+    pint=akz(i)+bkz(i)*101325.
+    if (pint.lt.5000.) goto 96
+  end do
+96   nconvlev=i
+  if (nconvlev.gt.nconvlevmax-1) then
+    nconvlev=nconvlevmax-1
+    write(*,*) 'Attention, convection only calculated up to ', &
+         akz(nconvlev)+bkz(nconvlev)*1013.25,' hPa'
+  endif
+
+  return
+
+999   write(*,*)
+  write(*,*) ' ###########################################'// &
+       '###### '
+  write(*,*) '       TRAJECTORY MODEL SUBROUTINE GRIDCHECK:'
+  write(*,*) ' CAN NOT OPEN INPUT DATA FILE '//wfname(ifn)
+  write(*,*) ' ###########################################'// &
+       '###### '
+  write(*,*)
+  write(*,'(a)') '!!! PLEASE INSERT A NEW CD-ROM AND   !!!'
+  write(*,'(a)') '!!! PRESS ANY KEY TO CONTINUE...     !!!'
+  write(*,'(a)') '!!! ...OR TERMINATE FLEXPART PRESSING!!!'
+  write(*,'(a)') '!!! THE "X" KEY...                   !!!'
+  write(*,*)
+  read(*,'(a)') opt
+  if(opt.eq.'X') then
+    stop
+  else
+    goto 5
+  endif
+
+end subroutine gridcheck
Index: /branches/FP_AI/src/gridcheck_gfs.f90
===================================================================
--- /branches/FP_AI/src/gridcheck_gfs.f90	(revision 23)
+++ /branches/FP_AI/src/gridcheck_gfs.f90	(revision 23)
@@ -0,0 +1,538 @@
+!**********************************************************************
+! 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                *
+  ! UVHEIGHT(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
+  !turn on support for multi fields messages
+  call grib_multi_support_on
+
+  ifield=0
+10   ifield=ifield+1
+  !
+  ! GET NEXT FIELDS
+  !
+  call grib_new_from_file(ifile,igrib,iret)
+  if (iret.eq.GRIB_END_OF_FILE )  then
+    goto 30    ! EOF DETECTED
+  elseif (iret.ne.GRIB_SUCCESS) then
+    goto 999   ! ERROR DETECTED
+  endif
+
+  !first see if we read GRIB1 or GRIB2
+  call grib_get_int(igrib,'editionNumber',gribVer,iret)
+  call grib_check(iret,gribFunction,gribErrorMsg)
+
+  if (gribVer.eq.1) then ! GRIB Edition 1
+
+  !read the grib1 identifiers
+  call grib_get_int(igrib,'indicatorOfParameter',isec1(6),iret)
+  call grib_check(iret,gribFunction,gribErrorMsg)
+  call grib_get_int(igrib,'indicatorOfTypeOfLevel',isec1(7),iret)
+  call grib_check(iret,gribFunction,gribErrorMsg)
+  call grib_get_int(igrib,'level',isec1(8),iret)
+  call grib_check(iret,gribFunction,gribErrorMsg)
+
+  !get the size and data of the values array
+  call grib_get_real4_array(igrib,'values',zsec4,iret)
+  call grib_check(iret,gribFunction,gribErrorMsg)
+
+  else ! GRIB Edition 2
+
+  !read the grib2 identifiers
+  call grib_get_int(igrib,'discipline',discipl,iret)
+  call grib_check(iret,gribFunction,gribErrorMsg)
+  call grib_get_int(igrib,'parameterCategory',parCat,iret)
+  call grib_check(iret,gribFunction,gribErrorMsg)
+  call grib_get_int(igrib,'parameterNumber',parNum,iret)
+  call grib_check(iret,gribFunction,gribErrorMsg)
+  call grib_get_int(igrib,'typeOfFirstFixedSurface',typSurf,iret)
+  call grib_check(iret,gribFunction,gribErrorMsg)
+  call grib_get_int(igrib,'scaledValueOfFirstFixedSurface', &
+       valSurf,iret)
+  call grib_check(iret,gribFunction,gribErrorMsg)
+
+  !convert to grib1 identifiers
+  isec1(6)=-1
+  isec1(7)=-1
+  isec1(8)=-1
+  if ((parCat.eq.2).and.(parNum.eq.2).and.(typSurf.eq.100)) then ! U
+    isec1(6)=33          ! indicatorOfParameter
+    isec1(7)=100         ! indicatorOfTypeOfLevel
+    isec1(8)=valSurf/100 ! level, convert to hPa
+  elseif ((parCat.eq.3).and.(parNum.eq.5).and.(typSurf.eq.1)) then ! TOPO
+    isec1(6)=7           ! indicatorOfParameter
+    isec1(7)=1           ! indicatorOfTypeOfLevel
+    isec1(8)=0
+  elseif ((parCat.eq.0).and.(parNum.eq.0).and.(typSurf.eq.1) &
+       .and.(discipl.eq.2)) then ! LSM
+    isec1(6)=81          ! indicatorOfParameter
+    isec1(7)=1           ! indicatorOfTypeOfLevel
+    isec1(8)=0
+  endif
+
+  if (isec1(6).ne.-1) then
+  !  get the size and data of the values array
+    call grib_get_real4_array(igrib,'values',zsec4,iret)
+    call grib_check(iret,gribFunction,gribErrorMsg)
+  endif
+
+  endif ! gribVer
+
+  if(ifield.eq.1) then
+
+  !get the required fields from section 2
+  !store compatible to gribex input
+  call grib_get_int(igrib,'numberOfPointsAlongAParallel', &
+       isec2(2),iret)
+  call grib_check(iret,gribFunction,gribErrorMsg)
+  call grib_get_int(igrib,'numberOfPointsAlongAMeridian', &
+       isec2(3),iret)
+  call grib_check(iret,gribFunction,gribErrorMsg)
+  call grib_get_real8(igrib,'longitudeOfFirstGridPointInDegrees', &
+       xaux1in,iret)
+  call grib_check(iret,gribFunction,gribErrorMsg)
+  call grib_get_real8(igrib,'longitudeOfLastGridPointInDegrees', &
+       xaux2in,iret)
+  call grib_check(iret,gribFunction,gribErrorMsg)
+  call grib_get_real8(igrib,'latitudeOfLastGridPointInDegrees', &
+       yaux1in,iret)
+  call grib_check(iret,gribFunction,gribErrorMsg)
+  call grib_get_real8(igrib,'latitudeOfFirstGridPointInDegrees', &
+       yaux2in,iret)
+  call grib_check(iret,gribFunction,gribErrorMsg)
+
+  xaux1=xaux1in
+  xaux2=xaux2in
+  yaux1=yaux1in
+  yaux2=yaux2in
+
+  nxfield=isec2(2)
+  ny=isec2(3)
+  if((abs(xaux1).lt.eps).and.(xaux2.ge.359)) then ! NCEP DATA FROM 0 TO
+    xaux1=-179.0                             ! 359 DEG EAST ->
+    xaux2=-179.0+360.-360./real(nxfield)    ! TRANSFORMED TO -179
+  endif                                      ! TO 180 DEG EAST
+  if (xaux1.gt.180) xaux1=xaux1-360.0
+  if (xaux2.gt.180) xaux2=xaux2-360.0
+  if (xaux1.lt.-180) xaux1=xaux1+360.0
+  if (xaux2.lt.-180) xaux2=xaux2+360.0
+  if (xaux2.lt.xaux1) xaux2=xaux2+360.
+  xlon0=xaux1
+  ylat0=yaux1
+  dx=(xaux2-xaux1)/real(nxfield-1)
+  dy=(yaux2-yaux1)/real(ny-1)
+  dxconst=180./(dx*r_earth*pi)
+  dyconst=180./(dy*r_earth*pi)
+  !HSO end edits
+
+
+  ! Check whether fields are global
+  ! If they contain the poles, specify polar stereographic map
+  ! projections using the stlmbr- and stcm2p-calls
+  !***********************************************************
+
+    xauxa=abs(xaux2+dx-360.-xaux1)
+    if (xauxa.lt.0.001) then
+      nx=nxfield+1                 ! field is cyclic
+      xglobal=.true.
+      if (abs(nxshift).ge.nx) &
+           stop 'nxshift in file par_mod is too large'
+      xlon0=xlon0+real(nxshift)*dx
+    else
+      nx=nxfield
+      xglobal=.false.
+      if (nxshift.ne.0) &
+           stop 'nxshift (par_mod) must be zero for non-global domain'
+    endif
+    nxmin1=nx-1
+    nymin1=ny-1
+    if (xlon0.gt.180.) xlon0=xlon0-360.
+    xauxa=abs(yaux1+90.)
+    if (xglobal.and.xauxa.lt.0.001) then
+      sglobal=.true.               ! field contains south pole
+  ! Enhance the map scale by factor 3 (*2=6) compared to north-south
+  ! map scale
+      sizesouth=6.*(switchsouth+90.)/dy
+      call stlmbr(southpolemap,-90.,0.)
+      call stcm2p(southpolemap,0.,0.,switchsouth,0.,sizesouth, &
+           sizesouth,switchsouth,180.)
+      switchsouthg=(switchsouth-ylat0)/dy
+    else
+      sglobal=.false.
+      switchsouthg=999999.
+    endif
+    xauxa=abs(yaux2-90.)
+    if (xglobal.and.xauxa.lt.0.001) then
+      nglobal=.true.               ! field contains north pole
+  ! Enhance the map scale by factor 3 (*2=6) compared to north-south
+  ! map scale
+      sizenorth=6.*(90.-switchnorth)/dy
+      call stlmbr(northpolemap,90.,0.)
+      call stcm2p(northpolemap,0.,0.,switchnorth,0.,sizenorth, &
+           sizenorth,switchnorth,180.)
+      switchnorthg=(switchnorth-ylat0)/dy
+    else
+      nglobal=.false.
+      switchnorthg=999999.
+    endif
+  endif ! ifield.eq.1
+
+  if (nxshift.lt.0) stop 'nxshift (par_mod) must not be negative'
+  if (nxshift.ge.nxfield) stop 'nxshift (par_mod) too large'
+
+  ! NCEP ISOBARIC LEVELS
+  !*********************
+
+  if((isec1(6).eq.33).and.(isec1(7).eq.100)) then ! check for U wind
+    iumax=iumax+1
+    pres(iumax)=real(isec1(8))*100.0
+  endif
+
+
+  i179=nint(179./dx)
+  if (dx.lt.0.7) then
+    i180=nint(180./dx)+1    ! 0.5 deg data
+  else
+    i180=nint(179./dx)+1    ! 1 deg data
+  endif
+  i181=i180+1
+
+
+  ! NCEP TERRAIN
+  !*************
+
+  if((isec1(6).eq.007).and.(isec1(7).eq.001)) then
+    do jy=0,ny-1
+      do ix=0,nxfield-1
+        help=zsec4(nxfield*(ny-jy-1)+ix+1)
+        if(ix.le.i180) then
+          oro(i179+ix,jy)=help
+          excessoro(i179+ix,jy)=0.0 ! ISOBARIC SURFACES: SUBGRID TERRAIN DISREGARDED
+        else
+          oro(ix-i181,jy)=help
+          excessoro(ix-i181,jy)=0.0 ! ISOBARIC SURFACES: SUBGRID TERRAIN DISREGARDED
+        endif
+      end do
+    end do
+  endif
+
+  ! NCEP LAND SEA MASK
+  !*******************
+
+  if((isec1(6).eq.081).and.(isec1(7).eq.001)) then
+    do jy=0,ny-1
+      do ix=0,nxfield-1
+        help=zsec4(nxfield*(ny-jy-1)+ix+1)
+        if(ix.le.i180) then
+          lsm(i179+ix,jy)=help
+        else
+          lsm(ix-i181,jy)=help
+        endif
+      end do
+    end do
+  endif
+
+  call grib_release(igrib)
+
+  goto 10                      !! READ NEXT LEVEL OR PARAMETER
+  !
+  ! CLOSING OF INPUT DATA FILE
+  !
+
+  ! HSO
+30   continue
+  call grib_close_file(ifile)
+  ! HSO end edits
+
+  nuvz=iumax
+  nwz =iumax
+  nlev_ec=iumax
+
+  if (nx.gt.nxmax) then
+   write(*,*) 'FLEXPART error: Too many grid points in x direction.'
+    write(*,*) 'Reduce resolution of wind fields.'
+    write(*,*) 'Or change parameter settings in file par_mod.'
+    write(*,*) nx,nxmax
+    stop
+  endif
+
+  if (ny.gt.nymax) then
+   write(*,*) 'FLEXPART error: Too many grid points in y direction.'
+    write(*,*) 'Reduce resolution of wind fields.'
+    write(*,*) 'Or change parameter settings in file par_mod.'
+    write(*,*) ny,nymax
+    stop
+  endif
+
+  if (nuvz.gt.nuvzmax) then
+    write(*,*) 'FLEXPART error: Too many u,v grid points in z '// &
+         'direction.'
+    write(*,*) 'Reduce resolution of wind fields.'
+    write(*,*) 'Or change parameter settings in file par_mod.'
+    write(*,*) nuvz,nuvzmax
+    stop
+  endif
+
+  if (nwz.gt.nwzmax) then
+    write(*,*) 'FLEXPART error: Too many w grid points in z '// &
+         'direction.'
+    write(*,*) 'Reduce resolution of wind fields.'
+    write(*,*) 'Or change parameter settings in file par_mod.'
+    write(*,*) nwz,nwzmax
+    stop
+  endif
+
+  ! If desired, shift all grids by nxshift grid cells
+  !**************************************************
+
+  if (xglobal) then
+    call shift_field_0(oro,nxfield,ny)
+    call shift_field_0(lsm,nxfield,ny)
+    call shift_field_0(excessoro,nxfield,ny)
+  endif
+
+  ! Output of grid info
+  !********************
+
+  write(*,*)
+  write(*,*)
+  write(*,'(a,2i7)') '# of 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: ', &
+       ylat0,' to ',ylat0+(ny-1)*dy,'   Grid distance: ',dy
+  write(*,*)
+
+
+  ! CALCULATE VERTICAL DISCRETIZATION OF ECMWF MODEL
+  ! PARAMETER akm,bkm DESCRIBE THE HYBRID "ETA" COORDINATE SYSTEM
+
+  numskip=nlev_ec-nuvz  ! number of ecmwf model layers not used
+                        ! by trajectory model
+  do i=1,nwz
+    j=numskip+i
+    k=nlev_ec+1+numskip+i
+    akm_usort(nwz-i+1)=pres(nwz-i+1)
+    bkm(nwz-i+1)=0.0
+  end do
+
+  !******************************
+  ! change Sabine Eckhardt: akm should always be in descending order ... readwind adapted!
+  !******************************
+      do i=1,nwz
+         if (akm_usort(1).gt.akm_usort(2)) then
+            akm(i)=akm_usort(i)
+         else
+            akm(i)=akm_usort(nwz-i+1)
+         endif
+      end do
+
+  !
+  ! CALCULATION OF AKZ, BKZ
+  ! AKZ,BKZ: model discretization parameters at the center of each model
+  !     layer
+  !
+  ! Assign the 10 m winds to an artificial model level with akz=0 and bkz=1.0,
+  ! i.e. ground level
+  !*****************************************************************************
+
+  do i=1,nuvz
+     akz(i)=akm(i)
+     bkz(i)=bkm(i)
+  end do
+
+  ! NOTE: In FLEXPART versions up to 4.0, the number of model levels was doubled
+  ! upon the transformation to z levels. In order to save computer memory, this is
+  ! not done anymore in the standard version. However, this option can still be
+  ! switched on by replacing the following lines with those below, that are
+  ! currently commented out. For this, similar changes are necessary in
+  ! verttransform.f and verttranform_nests.f
+  !*****************************************************************************
+
+  nz=nuvz
+  if (nz.gt.nzmax) stop 'nzmax too small'
+  do i=1,nuvz
+    aknew(i)=akz(i)
+    bknew(i)=bkz(i)
+  end do
+
+  ! Switch on following lines to use doubled vertical resolution
+  !*************************************************************
+  !nz=nuvz+nwz-1
+  !if (nz.gt.nzmax) stop 'nzmax too small'
+  !do 100 i=1,nwz
+  !  aknew(2*(i-1)+1)=akm(i)
+  !00     bknew(2*(i-1)+1)=bkm(i)
+  !do 110 i=2,nuvz
+  !  aknew(2*(i-1))=akz(i)
+  !10     bknew(2*(i-1))=bkz(i)
+  ! End doubled vertical resolution
+
+
+  ! Determine the uppermost level for which the convection scheme shall be applied
+  ! by assuming that there is no convection above 50 hPa (for standard SLP)
+  !*****************************************************************************
+
+  do i=1,nuvz-2
+    pint=akz(i)+bkz(i)*101325.
+    if (pint.lt.5000.) goto 96
+  end do
+96   nconvlev=i
+  if (nconvlev.gt.nconvlevmax-1) then
+    nconvlev=nconvlevmax-1
+    write(*,*) 'Attention, convection only calculated up to ', &
+         akz(nconvlev)+bkz(nconvlev)*1013.25,' hPa'
+  endif
+
+  return
+
+999   write(*,*)
+  write(*,*) ' ###########################################'// &
+       '###### '
+  write(*,*) '       TRAJECTORY MODEL SUBROUTINE GRIDCHECK:'
+  write(*,*) ' CAN NOT OPEN INPUT DATA FILE '//wfname(ifn)
+  write(*,*) ' ###########################################'// &
+       '###### '
+  write(*,*)
+  write(*,'(a)') '!!! PLEASE INSERT A NEW CD-ROM AND   !!!'
+  write(*,'(a)') '!!! PRESS ANY KEY TO CONTINUE...     !!!'
+  write(*,'(a)') '!!! ...OR TERMINATE FLEXPART PRESSING!!!'
+  write(*,'(a)') '!!! THE "X" KEY...                   !!!'
+  write(*,*)
+  read(*,'(a)') opt
+  if(opt.eq.'X') then
+    stop
+  else
+    goto 5
+  endif
+
+end subroutine gridcheck
Index: /branches/FP_AI/src/gridcheck_nests.f90
===================================================================
--- /branches/FP_AI/src/gridcheck_nests.f90	(revision 23)
+++ /branches/FP_AI/src/gridcheck_nests.f90	(revision 23)
@@ -0,0 +1,460 @@
+!**********************************************************************
+! 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_nests
+
+  !*****************************************************************************
+  !                                                                            *
+  !     This routine checks the grid specification for the nested model        *
+  !     domains. It is similar to subroutine gridcheck, which checks the       *
+  !     mother domain.                                                         *
+  !                                                                            *
+  !     Authors: A. Stohl, G. Wotawa                                           *
+  !                                                                            *
+  !     8 February 1999                                                        *
+  !                                                                            *
+  !*****************************************************************************
+  !  CHANGE: 11/01/2008, Harald Sodemann, GRIB1/2 input with ECMWF grib_api    *
+  !  CHANGE: 03/12/2008, Harald Sodemann, change to f90 grib_api               *
+  !*****************************************************************************
+
+  use grib_api
+  use par_mod
+  use com_mod
+
+  implicit none
+
+  !HSO  parameters for grib_api
+  integer :: ifile
+  integer :: iret
+  integer :: igrib
+  integer :: gribVer,parCat,parNum,typSurf,valSurf,discipl
+  integer :: parID !added by mc for making it consistent with new gridcheck.f90
+  integer :: gotGrib
+  !HSO  end
+  integer :: i,j,k,l,ifn,ifield,iumax,iwmax,numskip,nlev_ecn
+  integer :: nuvzn,nwzn
+  real :: akmn(nwzmax),bkmn(nwzmax),akzn(nuvzmax),bkzn(nuvzmax)
+  real(kind=4) :: xaux1,xaux2,yaux1,yaux2
+  real(kind=8) :: xaux1in,xaux2in,yaux1in,yaux2in
+  real :: conversion_factor !added by mc to make it consistent with new gridchek.f90
+
+  ! VARIABLES AND ARRAYS NEEDED FOR GRIB DECODING
+
+  ! dimension of isec2 at least (22+n), where n is the number of parallels or
+  ! meridians in a quasi-regular (reduced) Gaussian or lat/long grid
+
+  ! dimension of zsec2 at least (10+nn), where nn is the number of vertical
+  ! coordinate parameters
+
+  integer :: isec1(56),isec2(22+nxmaxn+nymaxn)
+  real(kind=4) :: zsec2(60+2*nuvzmax),zsec4(jpunp)
+
+  !HSO  grib api error messages
+  character(len=24) :: gribErrorMsg = 'Error reading grib file'
+  character(len=20) :: gribFunction = 'gridcheck_nests'
+
+  xresoln(0)=1.       ! resolution enhancement for mother grid
+  yresoln(0)=1.       ! resolution enhancement for mother grid
+
+  ! Loop about all nesting levels
+  !******************************
+
+  do l=1,numbnests
+
+    iumax=0
+    iwmax=0
+
+    if(ideltas.gt.0) then
+      ifn=1
+    else
+      ifn=numbwf
+    endif
+  !
+  ! OPENING OF DATA FILE (GRIB CODE)
+  !
+  ifile=0
+  igrib=0
+  iret=0
+
+5   call grib_open_file(ifile,path(numpath+2*(l-1)+1) &
+         (1:length(numpath+2*(l-1)+1))//trim(wfnamen(l,ifn)),'r',iret)
+  if (iret.ne.GRIB_SUCCESS) then
+    goto 999   ! ERROR DETECTED
+  endif
+  !turn on support for multi fields messages
+  !call grib_multi_support_on
+
+  gotGrib=0
+  ifield=0
+10   ifield=ifield+1
+
+  !
+  ! GET NEXT FIELDS
+  !
+  call grib_new_from_file(ifile,igrib,iret)
+  if (iret.eq.GRIB_END_OF_FILE)  then
+    goto 30    ! EOF DETECTED
+  elseif (iret.ne.GRIB_SUCCESS) then
+    goto 999   ! ERROR DETECTED
+  endif
+
+  !first see if we read GRIB1 or GRIB2
+  call grib_get_int(igrib,'editionNumber',gribVer,iret)
+  call grib_check(iret,gribFunction,gribErrorMsg)
+
+  if (gribVer.eq.1) then ! GRIB Edition 1
+
+  !print*,'GRiB Edition 1'
+  !read the grib2 identifiers
+  call grib_get_int(igrib,'indicatorOfParameter',isec1(6),iret)
+  call grib_check(iret,gribFunction,gribErrorMsg)
+  call grib_get_int(igrib,'level',isec1(8),iret)
+  call grib_check(iret,gribFunction,gribErrorMsg)
+
+  !change code for etadot to code for omega
+  if (isec1(6).eq.77) then
+    isec1(6)=135
+  endif
+
+  !print*,isec1(6),isec1(8)
+
+  else
+
+  !print*,'GRiB Edition 2'
+  !read the grib2 identifiers
+  call grib_get_int(igrib,'discipline',discipl,iret)
+  call grib_check(iret,gribFunction,gribErrorMsg)
+  call grib_get_int(igrib,'parameterCategory',parCat,iret)
+  call grib_check(iret,gribFunction,gribErrorMsg)
+  call grib_get_int(igrib,'parameterNumber',parNum,iret)
+  call grib_check(iret,gribFunction,gribErrorMsg)
+  call grib_get_int(igrib,'typeOfFirstFixedSurface',typSurf,iret)
+  call grib_check(iret,gribFunction,gribErrorMsg)
+  call grib_get_int(igrib,'level',valSurf,iret)
+  call grib_check(iret,gribFunction,gribErrorMsg)
+  call grib_get_int(igrib,'paramId',parId,iret) !added by mc to make it consisitent with new grid_check.f90
+  call grib_check(iret,gribFunction,gribErrorMsg) !added by mc to make it consisitent with new  grid_check.f90
+
+  !print*,discipl,parCat,parNum,typSurf,valSurf
+
+  !convert to grib1 identifiers
+  isec1(6)=-1
+  isec1(7)=-1
+  isec1(8)=-1
+  isec1(8)=valSurf     ! level
+  if ((parCat.eq.0).and.(parNum.eq.0).and.(typSurf.eq.105)) then ! T
+    isec1(6)=130         ! indicatorOfParameter
+  elseif ((parCat.eq.2).and.(parNum.eq.2).and.(typSurf.eq.105)) then ! U
+    isec1(6)=131         ! indicatorOfParameter
+  elseif ((parCat.eq.2).and.(parNum.eq.3).and.(typSurf.eq.105)) then ! V
+    isec1(6)=132         ! indicatorOfParameter
+  elseif ((parCat.eq.1).and.(parNum.eq.0).and.(typSurf.eq.105)) then ! Q
+    isec1(6)=133         ! indicatorOfParameter
+  elseif ((parCat.eq.3).and.(parNum.eq.0).and.(typSurf.eq.1)) then !SP
+    isec1(6)=134         ! indicatorOfParameter
+  elseif ((parCat.eq.2).and.(parNum.eq.32)) then ! W, actually eta dot
+    isec1(6)=135         ! indicatorOfParameter
+  elseif ((parCat.eq.128).and.(parNum.eq.77)) then ! W, actually eta dot !added bymc to make it consistent with new gridchek.f90
+    isec1(6)=135         ! indicatorOfParameter    !                     ! " " " " " " " " " " " " " " " " " " " " " " " "  " " " 
+  elseif ((parCat.eq.3).and.(parNum.eq.0).and.(typSurf.eq.101)) then !SLP
+    isec1(6)=151         ! indicatorOfParameter
+  elseif ((parCat.eq.2).and.(parNum.eq.2).and.(typSurf.eq.103)) then ! 10U
+    isec1(6)=165         ! indicatorOfParameter
+  elseif ((parCat.eq.2).and.(parNum.eq.3).and.(typSurf.eq.103)) then ! 10V
+    isec1(6)=166         ! indicatorOfParameter
+  elseif ((parCat.eq.0).and.(parNum.eq.0).and.(typSurf.eq.103)) then ! 2T
+    isec1(6)=167         ! indicatorOfParameter
+  elseif ((parCat.eq.0).and.(parNum.eq.6).and.(typSurf.eq.103)) then ! 2D
+    isec1(6)=168         ! indicatorOfParameter
+  elseif ((parCat.eq.1).and.(parNum.eq.11).and.(typSurf.eq.1)) then ! SD
+    isec1(6)=141         ! indicatorOfParameter
+  elseif ((parCat.eq.6).and.(parNum.eq.1) .or. parId .eq. 164) then ! CC !added by mc to make it consistent with new gridchek.f90
+    isec1(6)=164         ! indicatorOfParameter
+ elseif ((parCat.eq.1).and.(parNum.eq.9) .or. parId .eq. 142) then ! LSP !added by mc to make it consistent with new gridchek.f90
+    isec1(6)=142         ! indicatorOfParameter
+  elseif ((parCat.eq.1).and.(parNum.eq.10)) then ! CP
+    isec1(6)=143         ! indicatorOfParameter
+  elseif ((parCat.eq.0).and.(parNum.eq.11).and.(typSurf.eq.1)) then ! SHF
+    isec1(6)=146         ! indicatorOfParameter
+  elseif ((parCat.eq.4).and.(parNum.eq.9).and.(typSurf.eq.1)) then ! SR
+    isec1(6)=176         ! indicatorOfParameter
+  elseif ((parCat.eq.2).and.(parNum.eq.17) .or. parId .eq. 180) then ! EWSS !added by mc to make it consistent with new gridchek.f90
+    isec1(6)=180         ! indicatorOfParameter
+  elseif ((parCat.eq.2).and.(parNum.eq.18) .or. parId .eq. 181) then ! NSSS !added by mc to make it consistent with new gridchek.f90
+    isec1(6)=181         ! indicatorOfParameter
+  elseif ((parCat.eq.3).and.(parNum.eq.4)) then ! ORO
+    isec1(6)=129         ! indicatorOfParameter
+  elseif ((parCat.eq.3).and.(parNum.eq.7) .or. parId .eq. 160) then ! SDO !added by mc to make it consistent with new gridchek.f90
+    isec1(6)=160         ! indicatorOfParameter
+  elseif ((discipl.eq.2).and.(parCat.eq.0).and.(parNum.eq.0).and. &
+       (typSurf.eq.1)) then ! LSM
+    isec1(6)=172         ! indicatorOfParameter
+  else
+    print*,'***ERROR: undefined GRiB2 message found!',discipl, &
+         parCat,parNum,typSurf
+  endif
+  if(parId .ne. isec1(6) .and. parId .ne. 77) then !added by mc to make it consistent with new gridchek.f90
+    write(*,*) 'parId',parId, 'isec1(6)',isec1(6)
+!    stop
+  endif
+
+  endif
+
+  !get the size and data of the values array
+  if (isec1(6).ne.-1) then
+    call grib_get_real4_array(igrib,'values',zsec4,iret)
+    call grib_check(iret,gribFunction,gribErrorMsg)
+  endif
+
+  !HSO  get the required fields from section 2 in a gribex compatible manner
+  if (ifield.eq.1) then
+    call grib_get_int(igrib,'numberOfPointsAlongAParallel', &
+         isec2(2),iret)
+    call grib_check(iret,gribFunction,gribErrorMsg)
+    call grib_get_int(igrib,'numberOfPointsAlongAMeridian', &
+         isec2(3),iret)
+    call grib_check(iret,gribFunction,gribErrorMsg)
+    call grib_get_int(igrib,'numberOfVerticalCoordinateValues', &
+         isec2(12),iret)
+    call grib_check(iret,gribFunction,gribErrorMsg)
+  !HSO    get the size and data of the vertical coordinate array
+    call grib_get_real4_array(igrib,'pv',zsec2,iret)
+    call grib_check(iret,gribFunction,gribErrorMsg)
+
+    nxn(l)=isec2(2)
+    nyn(l)=isec2(3)
+    nlev_ecn=isec2(12)/2-1
+  endif ! ifield
+
+  !HSO  get the second part of the grid dimensions only from GRiB1 messages
+  if (isec1(6) .eq. 167 .and. (gotGrib.eq.0)) then !added by mc to make it consistent with new gridchek.f90 note that gotGrid must be changed in gotGrib!!
+    call grib_get_real8(igrib,'longitudeOfFirstGridPointInDegrees', & !comment by mc: note that this was in the (if (ifield.eq.1) ..end above in gridchek.f90 see line 257
+         xaux1in,iret)
+    call grib_check(iret,gribFunction,gribErrorMsg)
+    call grib_get_real8(igrib,'longitudeOfLastGridPointInDegrees', &
+         xaux2in,iret)
+    call grib_check(iret,gribFunction,gribErrorMsg)
+    call grib_get_real8(igrib,'latitudeOfLastGridPointInDegrees', &
+         yaux1in,iret)
+    call grib_check(iret,gribFunction,gribErrorMsg)
+    call grib_get_real8(igrib,'latitudeOfFirstGridPointInDegrees', &
+         yaux2in,iret)
+    call grib_check(iret,gribFunction,gribErrorMsg)
+    xaux1=xaux1in
+    xaux2=xaux2in
+    yaux1=yaux1in
+    yaux2=yaux2in
+    if(xaux1.gt.180.) xaux1=xaux1-360.0
+    if(xaux2.gt.180.) xaux2=xaux2-360.0
+    if(xaux1.lt.-180.) xaux1=xaux1+360.0
+    if(xaux2.lt.-180.) xaux2=xaux2+360.0
+    if (xaux2.lt.xaux1) xaux2=xaux2+360.0
+    xlon0n(l)=xaux1
+    ylat0n(l)=yaux1
+    dxn(l)=(xaux2-xaux1)/real(nxn(l)-1)
+    dyn(l)=(yaux2-yaux1)/real(nyn(l)-1)
+    gotGrib=1 !commetn by mc note tahthere gotGRIB is used instead of gotGrid!!!
+  endif ! ifield.eq.1
+
+  k=isec1(8)
+  if(isec1(6).eq.131) iumax=max(iumax,nlev_ec-k+1)
+  if(isec1(6).eq.135) iwmax=max(iwmax,nlev_ec-k+1)
+
+  if(isec1(6).eq.129) then
+    do j=0,nyn(l)-1
+      do i=0,nxn(l)-1
+        oron(i,j,l)=zsec4(nxn(l)*(nyn(l)-j-1)+i+1)/ga
+      end do
+    end do
+  endif
+  if(isec1(6).eq.172) then
+    do j=0,nyn(l)-1
+      do i=0,nxn(l)-1
+        lsmn(i,j,l)=zsec4(nxn(l)*(nyn(l)-j-1)+i+1)/ga
+      end do
+    end do
+  endif
+  if(isec1(6).eq.160) then
+    do j=0,nyn(l)-1
+      do i=0,nxn(l)-1
+        excessoron(i,j,l)=zsec4(nxn(l)*(nyn(l)-j-1)+i+1)/ga
+      end do
+    end do
+  endif
+
+  call grib_release(igrib)
+  goto 10                 !! READ NEXT LEVEL OR PARAMETER
+  !
+  ! CLOSING OF INPUT DATA FILE
+  !
+
+30   call grib_close_file(ifile)
+
+  !error message if no fields found with correct first longitude in it
+  if (gotGrib.eq.0) then
+    print*,'***ERROR: input file needs to contain GRiB1 formatted'// &
+         'messages'
+    stop
+  endif
+
+  nuvzn=iumax
+  nwzn=iwmax
+  if(nuvzn.eq.nlev_ec) nwzn=nlev_ecn+1
+
+  if (nxn(l).gt.nxmaxn) then
+  write(*,*) 'FLEXPART error: Too many grid points in x direction.'
+  write(*,*) 'Reduce resolution of wind fields (file GRIDSPEC)'
+  write(*,*) 'for nesting level ',l
+  write(*,*) 'Or change parameter settings in file par_mod.'
+  write(*,*) nxn(l),nxmaxn
+  stop
+  endif
+
+  if (nyn(l).gt.nymaxn) then
+  write(*,*) 'FLEXPART error: Too many grid points in y direction.'
+  write(*,*) 'Reduce resolution of wind fields (file GRIDSPEC)'
+  write(*,*) 'for nesting level ',l
+  write(*,*) 'Or change parameter settings in file par_mod.'
+  write(*,*) nyn(l),nymaxn
+  stop
+  endif
+
+  if ((nuvzn.gt.nuvzmax).or.(nwzn.gt.nwzmax)) then
+  write(*,*) 'FLEXPART error: Nested wind fields have too many'// &
+       'vertical levels.'
+  write(*,*) 'Problem was encountered for nesting level ',l
+  stop
+  endif
+
+
+  ! Output of grid info
+  !********************
+
+  write(*,'(a,i2)') '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: ', &
+       ylat0n(l),' to ',ylat0n(l)+(nyn(l)-1)*dyn(l), &
+       '   Grid distance: ',dyn(l)
+  write(*,*)
+
+  ! Determine, how much the resolutions in the nests are enhanced as
+  ! compared to the mother grid
+  !*****************************************************************
+
+  xresoln(l)=dx/dxn(l)
+  yresoln(l)=dy/dyn(l)
+
+  ! Determine the mother grid coordinates of the corner points of the
+  ! nested grids
+  ! Convert first to geographical coordinates, then to grid coordinates
+  !********************************************************************
+
+  xaux1=xlon0n(l)
+  xaux2=xlon0n(l)+real(nxn(l)-1)*dxn(l)
+  yaux1=ylat0n(l)
+  yaux2=ylat0n(l)+real(nyn(l)-1)*dyn(l)
+
+  xln(l)=(xaux1-xlon0)/dx
+  xrn(l)=(xaux2-xlon0)/dx
+  yln(l)=(yaux1-ylat0)/dy
+  yrn(l)=(yaux2-ylat0)/dy
+
+
+  if ((xln(l).lt.0.).or.(yln(l).lt.0.).or. &
+       (xrn(l).gt.real(nxmin1)).or.(yrn(l).gt.real(nymin1))) then
+    write(*,*) 'Nested domain does not fit into mother domain'
+    write(*,*) 'For global mother domain fields, you can shift'
+    write(*,*) 'shift the mother domain into x-direction'
+    write(*,*) 'by setting nxshift (file par_mod) to a'
+    write(*,*) 'positive value. Execution is terminated.'
+    stop
+  endif
+
+
+  ! CALCULATE VERTICAL DISCRETIZATION OF ECMWF MODEL
+  ! PARAMETER akm,bkm DESCRIBE THE HYBRID "ETA" COORDINATE SYSTEM
+
+  numskip=nlev_ecn-nuvzn ! number of ecmwf model layers not used by FLEXPART
+  do i=1,nwzn
+    j=numskip+i
+    k=nlev_ecn+1+numskip+i
+    akmn(nwzn-i+1)=zsec2(j)
+    bkmn(nwzn-i+1)=zsec2(k)
+  end do
+
+  !
+  ! CALCULATION OF AKZ, BKZ
+  ! AKZ,BKZ: model discretization parameters at the center of each model
+  !     layer
+  !
+  ! Assign the 10 m winds to an artificial model level with akz=0 and bkz=1.0,
+  ! i.e. ground level
+  !*****************************************************************************
+
+    akzn(1)=0.
+    bkzn(1)=1.0
+    do i=1,nuvzn
+      akzn(i+1)=0.5*(akmn(i+1)+akmn(i))
+      bkzn(i+1)=0.5*(bkmn(i+1)+bkmn(i))
+    end do
+    nuvzn=nuvzn+1
+
+  ! Check, whether the heights of the model levels of the nested
+  ! wind fields are consistent with those of the mother domain.
+  ! If not, terminate model run.
+  !*************************************************************
+
+    do i=1,nuvz
+      if ((akzn(i).ne.akz(i)).or.(bkzn(i).ne.bkz(i))) then
+  write(*,*) 'FLEXPART error: The wind fields of nesting level',l
+  write(*,*) 'are not consistent with the mother domain:'
+  write(*,*) 'Differences in vertical levels detected.'
+        stop
+      endif
+    end do
+
+    do i=1,nwz
+      if ((akmn(i).ne.akm(i)).or.(bkmn(i).ne.bkm(i))) then
+  write(*,*) 'FLEXPART error: The wind fields of nesting level',l
+  write(*,*) 'are not consistent with the mother domain:'
+  write(*,*) 'Differences in vertical levels detected.'
+        stop
+      endif
+    end do
+
+  end do
+
+  return
+
+999   write(*,*)
+  write(*,*) ' ###########################################'// &
+       '###### '
+  write(*,*) '                FLEXPART SUBROUTINE GRIDCHECK:'
+  write(*,*) ' CAN NOT OPEN INPUT DATA FILE '//wfnamen(l,ifn)
+  write(*,*) ' FOR NESTING LEVEL ',k
+  write(*,*) ' ###########################################'// &
+       '###### '
+  stop
+
+end subroutine gridcheck_nests
Index: /branches/FP_AI/src/hanna.f90
===================================================================
--- /branches/FP_AI/src/hanna.f90	(revision 23)
+++ /branches/FP_AI/src/hanna.f90	(revision 23)
@@ -0,0 +1,126 @@
+!**********************************************************************
+! 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 hanna(z)
+  !                 i
+  !*****************************************************************************
+  !                                                                            *
+  !   Computation of \sigma_i and \tau_L based on the scheme of Hanna (1982)   *
+  !                                                                            *
+  !   Author: A. Stohl                                                         *
+  !                                                                            *
+  !   4 December 1997                                                          *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! dsigwdz [1/s]     vertical gradient of sigw                                *
+  ! ol [m]            Obukhov length                                           *
+  ! sigu, sigv, sigw  standard deviations of turbulent velocity fluctuations   *
+  ! tlu [s]           Lagrangian time scale for the along wind component.      *
+  ! tlv [s]           Lagrangian time scale for the cross wind component.      *
+  ! tlw [s]           Lagrangian time scale for the vertical wind component.   *
+  ! ust, ustar [m/s]  friction velocity                                        *
+  ! wst, wstar [m/s]  convective velocity scale                                *
+  !                                                                            *
+  !*****************************************************************************
+
+  use par_mod
+  use com_mod
+  use hanna_mod
+
+  implicit none
+
+  real :: corr,z
+
+
+
+  !**********************
+  ! 1. Neutral conditions
+  !**********************
+
+  if (h/abs(ol).lt.1.) then
+    ust=max(1.e-4,ust)
+    corr=z/ust
+    sigu=1.e-2+2.0*ust*exp(-3.e-4*corr)
+    sigw=1.3*ust*exp(-2.e-4*corr)
+    dsigwdz=-2.e-4*sigw
+    sigw=sigw+1.e-2
+    sigv=sigw
+    tlu=0.5*z/sigw/(1.+1.5e-3*corr)
+    tlv=tlu
+    tlw=tlu
+
+
+  !***********************
+  ! 2. Unstable conditions
+  !***********************
+
+  else if (ol.lt.0.) then
+
+
+  ! Determine sigmas
+  !*****************
+
+    sigu=1.e-2+ust*(12-0.5*h/ol)**0.33333
+    sigv=sigu
+    sigw=sqrt(1.2*wst**2*(1.-.9*zeta)*zeta**0.66666+ &
+         (1.8-1.4*zeta)*ust**2)+1.e-2
+    dsigwdz=0.5/sigw/h*(-1.4*ust**2+wst**2* &
+         (0.8*max(zeta,1.e-3)**(-.33333)-1.8*zeta**0.66666))
+
+
+  ! Determine average Lagrangian time scale
+  !****************************************
+
+    tlu=0.15*h/sigu
+    tlv=tlu
+    if (z.lt.abs(ol)) then
+      tlw=0.1*z/(sigw*(0.55-0.38*abs(z/ol)))
+    else if (zeta.lt.0.1) then
+      tlw=0.59*z/sigw
+    else
+      tlw=0.15*h/sigw*(1.-exp(-5*zeta))
+    endif
+
+
+  !*********************
+  ! 3. Stable conditions
+  !*********************
+
+  else
+    sigu=1.e-2+2.*ust*(1.-zeta)
+    sigv=1.e-2+1.3*ust*(1.-zeta)
+    sigw=sigv
+    dsigwdz=-1.3*ust/h
+    tlu=0.15*h/sigu*(sqrt(zeta))
+    tlv=0.467*tlu
+    tlw=0.1*h/sigw*zeta**0.8
+  endif
+
+
+  tlu=max(10.,tlu)
+  tlv=max(10.,tlv)
+  tlw=max(30.,tlw)
+
+  if (dsigwdz.eq.0.) dsigwdz=1.e-10
+
+end subroutine hanna
Index: /branches/FP_AI/src/hanna1.f90
===================================================================
--- /branches/FP_AI/src/hanna1.f90	(revision 23)
+++ /branches/FP_AI/src/hanna1.f90	(revision 23)
@@ -0,0 +1,149 @@
+!**********************************************************************
+! 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 hanna1(z)
+  !                  i
+  !*****************************************************************************
+  !                                                                            *
+  !   Computation of \sigma_i and \tau_L based on the scheme of Hanna (1982)   *
+  !                                                                            *
+  !   Author: A. Stohl                                                         *
+  !                                                                            *
+  !   4 December 1997                                                          *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! dsigwdz [1/s]     vertical gradient of sigw                                *
+  ! ol [m]            Obukhov length                                           *
+  ! sigu, sigv, sigw  standard deviations of turbulent velocity fluctuations   *
+  ! tlu [s]           Lagrangian time scale for the along wind component.      *
+  ! tlv [s]           Lagrangian time scale for the cross wind component.      *
+  ! tlw [s]           Lagrangian time scale for the vertical wind component.   *
+  ! ust, ustar [m/s]  friction velocity                                        *
+  ! wst, wstar [m/s]  convective velocity scale                                *
+  !                                                                            *
+  !*****************************************************************************
+
+  use par_mod
+  use com_mod
+  use hanna_mod
+
+  implicit none
+
+  real :: z,s1,s2
+
+
+
+  !**********************
+  ! 1. Neutral conditions
+  !**********************
+
+  if (h/abs(ol).lt.1.) then
+
+    ust=max(1.e-4,ust)
+    sigu=2.0*ust*exp(-3.e-4*z/ust)
+    sigu=max(sigu,1.e-5)
+    sigv=1.3*ust*exp(-2.e-4*z/ust)
+    sigv=max(sigv,1.e-5)
+    sigw=sigv
+    dsigw2dz=-6.76e-4*ust*exp(-4.e-4*z/ust)
+    tlu=0.5*z/sigw/(1.+1.5e-3*z/ust)
+    tlv=tlu
+    tlw=tlu
+
+
+  !***********************
+  ! 2. Unstable conditions
+  !***********************
+
+  else if (ol.lt.0.) then
+
+
+  ! Determine sigmas
+  !*****************
+
+    sigu=ust*(12-0.5*h/ol)**0.33333
+    sigu=max(sigu,1.e-6)
+    sigv=sigu
+
+    if (zeta.lt.0.03) then
+      sigw=0.96*wst*(3*zeta-ol/h)**0.33333
+      dsigw2dz=1.8432*wst*wst/h*(3*zeta-ol/h)**(-0.33333)
+    else if (zeta.lt.0.4) then
+      s1=0.96*(3*zeta-ol/h)**0.33333
+      s2=0.763*zeta**0.175
+      if (s1.lt.s2) then
+        sigw=wst*s1
+        dsigw2dz=1.8432*wst*wst/h*(3*zeta-ol/h)**(-0.33333)
+      else
+        sigw=wst*s2
+        dsigw2dz=0.203759*wst*wst/h*zeta**(-0.65)
+      endif
+    else if (zeta.lt.0.96) then
+      sigw=0.722*wst*(1-zeta)**0.207
+      dsigw2dz=-.215812*wst*wst/h*(1-zeta)**(-0.586)
+    else if (zeta.lt.1.00) then
+      sigw=0.37*wst
+      dsigw2dz=0.
+    endif
+    sigw=max(sigw,1.e-6)
+
+
+  ! Determine average Lagrangian time scale
+  !****************************************
+
+    tlu=0.15*h/sigu
+    tlv=tlu
+    if (z.lt.abs(ol)) then
+      tlw=0.1*z/(sigw*(0.55-0.38*abs(z/ol)))
+    else if (zeta.lt.0.1) then
+      tlw=0.59*z/sigw
+    else
+      tlw=0.15*h/sigw*(1.-exp(-5*zeta))
+    endif
+
+
+  !*********************
+  ! 3. Stable conditions
+  !*********************
+
+  else
+    sigu=2.*ust*(1.-zeta)
+    sigv=1.3*ust*(1.-zeta)
+    sigu=max(sigu,1.e-6)
+    sigv=max(sigv,1.e-6)
+    sigw=sigv
+    dsigw2dz=3.38*ust*ust*(zeta-1.)/h
+    tlu=0.15*h/sigu*(sqrt(zeta))
+    tlv=0.467*tlu
+    tlw=0.1*h/sigw*zeta**0.8
+  endif
+
+
+
+
+  tlu=max(10.,tlu)
+  tlv=max(10.,tlv)
+  tlw=max(30.,tlw)
+
+
+end subroutine hanna1
Index: /branches/FP_AI/src/hanna_mod.f90
===================================================================
--- /branches/FP_AI/src/hanna_mod.f90	(revision 23)
+++ /branches/FP_AI/src/hanna_mod.f90	(revision 23)
@@ -0,0 +1,8 @@
+module hanna_mod
+
+  implicit none
+
+  real :: ust,wst,ol,h,zeta,sigu,sigv,tlu,tlv,tlw
+  real :: sigw,dsigwdz,dsigw2dz
+
+end module hanna_mod
Index: /branches/FP_AI/src/hanna_short.f90
===================================================================
--- /branches/FP_AI/src/hanna_short.f90	(revision 23)
+++ /branches/FP_AI/src/hanna_short.f90	(revision 23)
@@ -0,0 +1,112 @@
+!**********************************************************************
+! 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 hanna_short(z)
+  !                       i
+  !*****************************************************************************
+  !                                                                            *
+  !   Computation of \sigma_i and \tau_L based on the scheme of Hanna (1982)   *
+  !                                                                            *
+  !   Author: A. Stohl                                                         *
+  !                                                                            *
+  !   4 December 1997                                                          *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! dsigwdz [1/s]     vertical gradient of sigw                                *
+  ! ol [m]            Obukhov length                                           *
+  ! sigu, sigv, sigw  standard deviations of turbulent velocity fluctuations   *
+  ! tlu [s]           Lagrangian time scale for the along wind component.      *
+  ! tlv [s]           Lagrangian time scale for the cross wind component.      *
+  ! tlw [s]           Lagrangian time scale for the vertical wind component.   *
+  ! ust, ustar [m/s]  friction velocity                                        *
+  ! wst, wstar [m/s]  convective velocity scale                                *
+  !                                                                            *
+  !*****************************************************************************
+
+  use par_mod
+  use com_mod
+  use hanna_mod
+
+  implicit none
+
+  real :: z
+
+
+
+  !**********************
+  ! 1. Neutral conditions
+  !**********************
+
+  if (h/abs(ol).lt.1.) then
+    ust=max(1.e-4,ust)
+    sigw=1.3*exp(-2.e-4*z/ust)
+    dsigwdz=-2.e-4*sigw
+    sigw=sigw*ust+1.e-2
+    tlw=0.5*z/sigw/(1.+1.5e-3*z/ust)
+
+
+  !***********************
+  ! 2. Unstable conditions
+  !***********************
+
+  else if (ol.lt.0.) then
+
+
+  ! Determine sigmas
+  !*****************
+
+    sigw=sqrt(1.2*wst**2*(1.-.9*zeta)*zeta**0.66666+ &
+         (1.8-1.4*zeta)*ust**2)+1.e-2
+    dsigwdz=0.5/sigw/h*(-1.4*ust**2+wst**2* &
+         (0.8*max(zeta,1.e-3)**(-.33333)-1.8*zeta**0.66666))
+
+
+  ! Determine average Lagrangian time scale
+  !****************************************
+
+    if (z.lt.abs(ol)) then
+      tlw=0.1*z/(sigw*(0.55-0.38*abs(z/ol)))
+    else if (zeta.lt.0.1) then
+      tlw=0.59*z/sigw
+    else
+      tlw=0.15*h/sigw*(1.-exp(-5*zeta))
+    endif
+
+
+  !*********************
+  ! 3. Stable conditions
+  !*********************
+
+  else
+    sigw=1.e-2+1.3*ust*(1.-zeta)
+    dsigwdz=-1.3*ust/h
+    tlw=0.1*h/sigw*zeta**0.8
+  endif
+
+
+  tlu=max(10.,tlu)
+  tlv=max(10.,tlv)
+  tlw=max(30.,tlw)
+  if (dsigwdz.eq.0.) dsigwdz=1.e-10
+
+end subroutine hanna_short
Index: /branches/FP_AI/src/init_domainfill.f90
===================================================================
--- /branches/FP_AI/src/init_domainfill.f90	(revision 23)
+++ /branches/FP_AI/src/init_domainfill.f90	(revision 23)
@@ -0,0 +1,416 @@
+!**********************************************************************
+! 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 init_domainfill
+  !
+  !*****************************************************************************
+  !                                                                            *
+  ! Initializes particles equally distributed over the first release location  *
+  ! specified in file RELEASES. This box is assumed to be the domain for doing *
+  ! domain-filling trajectory calculations.                                    *
+  ! All particles carry the same amount of mass which alltogether comprises the*
+  ! mass of air within the box.                                                *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     15 October 2002                                                        *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  !                                                                            *
+  ! numparticlecount    consecutively counts the number of particles released  *
+  ! nx_we(2)       grid indices for western and eastern boundary of domain-    *
+  !                filling trajectory calculations                             *
+  ! ny_sn(2)       grid indices for southern and northern boundary of domain-  *
+  !                filling trajectory calculations                             *
+  !                                                                            *
+  !*****************************************************************************
+
+  use point_mod
+  use par_mod
+  use com_mod
+
+  implicit none
+
+  integer :: j,ix,jy,kz,ncolumn,numparttot
+  real :: gridarea(0:nymax-1),pp(nzmax),ylat,ylatp,ylatm,hzone,ran1
+  real :: cosfactm,cosfactp,deltacol,dz1,dz2,dz,pnew,fractus
+  real,parameter :: pih=pi/180.
+  real :: colmass(0:nxmax-1,0:nymax-1),colmasstotal,zposition
+
+  integer :: ixm,ixp,jym,jyp,indzm,indzp,in,indzh,i,jj
+  real :: pvpart,ddx,ddy,rddx,rddy,p1,p2,p3,p4,y1(2)
+
+  integer :: idummy = -11
+
+
+  ! Determine the release region (only full grid cells), over which particles
+  ! shall be initialized
+  ! Use 2 fields for west/east and south/north boundary
+  !**************************************************************************
+
+  nx_we(1)=max(int(xpoint1(1)),0)
+  nx_we(2)=min((int(xpoint2(1))+1),nxmin1)
+  ny_sn(1)=max(int(ypoint1(1)),0)
+  ny_sn(2)=min((int(ypoint2(1))+1),nymin1)
+
+  ! For global simulations (both global wind data and global domain-filling),
+  ! set a switch, such that no boundary conditions are used
+  !**************************************************************************
+  if (xglobal.and.sglobal.and.nglobal) then
+    if ((nx_we(1).eq.0).and.(nx_we(2).eq.nxmin1).and. &
+         (ny_sn(1).eq.0).and.(ny_sn(2).eq.nymin1)) then
+      gdomainfill=.true.
+    else
+      gdomainfill=.false.
+    endif
+  endif
+
+  ! Do not release particles twice (i.e., not at both in the leftmost and rightmost
+  ! grid cell) for a global domain
+  !*****************************************************************************
+  if (xglobal) nx_we(2)=min(nx_we(2),nx-2)
+
+
+  ! Calculate area of grid cell with formula M=2*pi*R*h*dx/360,
+  ! see Netz, Formeln der Mathematik, 5. Auflage (1983), p.90
+  !************************************************************
+
+  do jy=ny_sn(1),ny_sn(2)      ! loop about latitudes
+    ylat=ylat0+real(jy)*dy
+    ylatp=ylat+0.5*dy
+    ylatm=ylat-0.5*dy
+    if ((ylatm.lt.0).and.(ylatp.gt.0.)) then
+      hzone=1./dyconst
+    else
+      cosfactp=cos(ylatp*pih)*r_earth
+      cosfactm=cos(ylatm*pih)*r_earth
+      if (cosfactp.lt.cosfactm) then
+        hzone=sqrt(r_earth**2-cosfactp**2)- &
+             sqrt(r_earth**2-cosfactm**2)
+      else
+        hzone=sqrt(r_earth**2-cosfactm**2)- &
+             sqrt(r_earth**2-cosfactp**2)
+      endif
+    endif
+    gridarea(jy)=2.*pi*r_earth*hzone*dx/360.
+  end do
+
+  ! Do the same for the south pole
+
+  if (sglobal) then
+    ylat=ylat0
+    ylatp=ylat+0.5*dy
+    ylatm=ylat
+    cosfactm=0.
+    cosfactp=cos(ylatp*pih)*r_earth
+    hzone=sqrt(r_earth**2-cosfactm**2)- &
+         sqrt(r_earth**2-cosfactp**2)
+    gridarea(0)=2.*pi*r_earth*hzone*dx/360.
+  endif
+
+  ! Do the same for the north pole
+
+  if (nglobal) then
+    ylat=ylat0+real(nymin1)*dy
+    ylatp=ylat
+    ylatm=ylat-0.5*dy
+    cosfactp=0.
+    cosfactm=cos(ylatm*pih)*r_earth
+    hzone=sqrt(r_earth**2-cosfactp**2)- &
+         sqrt(r_earth**2-cosfactm**2)
+    gridarea(nymin1)=2.*pi*r_earth*hzone*dx/360.
+  endif
+
+
+  ! Calculate total mass of each grid column and of the whole atmosphere
+  !*********************************************************************
+
+  colmasstotal=0.
+  do jy=ny_sn(1),ny_sn(2)          ! loop about latitudes
+    do ix=nx_we(1),nx_we(2)      ! loop about longitudes
+      pp(1)=rho(ix,jy,1,1)*r_air*tt(ix,jy,1,1)
+      pp(nz)=rho(ix,jy,nz,1)*r_air*tt(ix,jy,nz,1)
+      colmass(ix,jy)=(pp(1)-pp(nz))/ga*gridarea(jy)
+      colmasstotal=colmasstotal+colmass(ix,jy)
+    end do
+  end do
+
+           write(*,*) 'Atm. mass: ',colmasstotal
+
+
+  if (ipin.eq.0) numpart=0
+
+  ! Determine the particle positions
+  !*********************************
+
+  numparttot=0
+  numcolumn=0
+  do jy=ny_sn(1),ny_sn(2)      ! loop about latitudes
+    ylat=ylat0+real(jy)*dy
+    do ix=nx_we(1),nx_we(2)      ! loop about longitudes
+      ncolumn=nint(0.999*real(npart(1))*colmass(ix,jy)/ &
+           colmasstotal)
+      if (ncolumn.eq.0) goto 30
+      if (ncolumn.gt.numcolumn) numcolumn=ncolumn
+
+  ! Calculate pressure at the altitudes of model surfaces, using the air density
+  ! information, which is stored as a 3-d field
+  !*****************************************************************************
+
+      do kz=1,nz
+        pp(kz)=rho(ix,jy,kz,1)*r_air*tt(ix,jy,kz,1)
+      end do
+
+
+      deltacol=(pp(1)-pp(nz))/real(ncolumn)
+      pnew=pp(1)+deltacol/2.
+      jj=0
+      do j=1,ncolumn
+        jj=jj+1
+
+
+  ! For columns with many particles (i.e. around the equator), distribute
+  ! the particles equally, for columns with few particles (i.e. around the
+  ! poles), distribute the particles randomly
+  !***********************************************************************
+
+
+        if (ncolumn.gt.20) then
+          pnew=pnew-deltacol
+        else
+          pnew=pp(1)-ran1(idummy)*(pp(1)-pp(nz))
+        endif
+
+        do kz=1,nz-1
+          if ((pp(kz).ge.pnew).and.(pp(kz+1).lt.pnew)) then
+            dz1=pp(kz)-pnew
+            dz2=pnew-pp(kz+1)
+            dz=1./(dz1+dz2)
+
+  ! Assign particle position
+  !*************************
+  ! Do the following steps only if particles are not read in from previous model run
+  !*****************************************************************************
+            if (ipin.eq.0) then
+              xtra1(numpart+jj)=real(ix)-0.5+ran1(idummy)
+              if (ix.eq.0) xtra1(numpart+jj)=ran1(idummy)
+              if (ix.eq.nxmin1) xtra1(numpart+jj)= &
+                   real(nxmin1)-ran1(idummy)
+              ytra1(numpart+jj)=real(jy)-0.5+ran1(idummy)
+              ztra1(numpart+jj)=(height(kz)*dz2+height(kz+1)*dz1)*dz
+              if (ztra1(numpart+jj).gt.height(nz)-0.5) &
+                   ztra1(numpart+jj)=height(nz)-0.5
+
+
+  ! Interpolate PV to the particle position
+  !****************************************
+              ixm=int(xtra1(numpart+jj))
+              jym=int(ytra1(numpart+jj))
+              ixp=ixm+1
+              jyp=jym+1
+              ddx=xtra1(numpart+jj)-real(ixm)
+              ddy=ytra1(numpart+jj)-real(jym)
+              rddx=1.-ddx
+              rddy=1.-ddy
+              p1=rddx*rddy
+              p2=ddx*rddy
+              p3=rddx*ddy
+              p4=ddx*ddy
+              do i=2,nz
+                if (height(i).gt.ztra1(numpart+jj)) then
+                  indzm=i-1
+                  indzp=i
+                  goto 6
+                endif
+              end do
+6             continue
+              dz1=ztra1(numpart+jj)-height(indzm)
+              dz2=height(indzp)-ztra1(numpart+jj)
+              dz=1./(dz1+dz2)
+              do in=1,2
+                indzh=indzm+in-1
+                y1(in)=p1*pv(ixm,jym,indzh,1) &
+                     +p2*pv(ixp,jym,indzh,1) &
+                     +p3*pv(ixm,jyp,indzh,1) &
+                     +p4*pv(ixp,jyp,indzh,1)
+              end do
+              pvpart=(dz2*y1(1)+dz1*y1(2))*dz
+              if (ylat.lt.0.) pvpart=-1.*pvpart
+
+
+  ! For domain-filling option 2 (stratospheric O3), do the rest only in the stratosphere
+  !*****************************************************************************
+
+              if (((ztra1(numpart+jj).gt.3000.).and. &
+                   (pvpart.gt.pvcrit)).or.(mdomainfill.eq.1)) then
+
+  ! Assign certain properties to the particle
+  !******************************************
+                nclass(numpart+jj)=min(int(ran1(idummy)* &
+                     real(nclassunc))+1,nclassunc)
+                numparticlecount=numparticlecount+1
+                npoint(numpart+jj)=numparticlecount
+                idt(numpart+jj)=mintime
+                itra1(numpart+jj)=0
+                itramem(numpart+jj)=0
+                itrasplit(numpart+jj)=itra1(numpart+jj)+ldirect* &
+                     itsplit
+                xmass1(numpart+jj,1)=colmass(ix,jy)/real(ncolumn)
+                if (mdomainfill.eq.2) xmass1(numpart+jj,1)= &
+                     xmass1(numpart+jj,1)*pvpart*48./29.*ozonescale/10.**9
+              else
+                jj=jj-1
+              endif
+            endif
+          endif
+        end do
+      end do
+      numparttot=numparttot+ncolumn
+      if (ipin.eq.0) numpart=numpart+jj
+30    continue
+    end do
+  end do
+
+
+  ! Check whether numpart is really smaller than maxpart
+  !*****************************************************
+
+  if (numpart.gt.maxpart) then
+    write(*,*) 'numpart too large: change source in init_atm_mass.f'
+    write(*,*) 'numpart: ',numpart,' maxpart: ',maxpart
+  endif
+
+
+  xmassperparticle=colmasstotal/real(numparttot)
+
+
+  ! Make sure that all particles are within domain
+  !***********************************************
+
+  do j=1,numpart
+    if ((xtra1(j).lt.0.).or.(xtra1(j).ge.real(nxmin1)).or. &
+         (ytra1(j).lt.0.).or.(ytra1(j).ge.real(nymin1))) then
+      itra1(j)=-999999999
+    endif
+  end do
+
+
+
+
+  ! For boundary conditions, we need fewer particle release heights per column,
+  ! because otherwise it takes too long until enough mass has accumulated to
+  ! release a particle at the boundary (would take dx/u seconds), leading to
+  ! relatively large position errors of the order of one grid distance.
+  ! It's better to release fewer particles per column, but to do so more often.
+  ! Thus, use on the order of nz starting heights per column.
+  ! We thus repeat the above to determine fewer starting heights, that are
+  ! used furtheron in subroutine boundcond_domainfill.f.
+  !****************************************************************************
+
+  fractus=real(numcolumn)/real(nz)
+  write(*,*) 'Total number of particles at model start: ',numpart
+  write(*,*) 'Maximum number of particles per column: ',numcolumn
+  write(*,*) 'If ',fractus,' <1, better use more particles'
+  fractus=sqrt(max(fractus,1.))/2.
+
+  do jy=ny_sn(1),ny_sn(2)      ! loop about latitudes
+    do ix=nx_we(1),nx_we(2)      ! loop about longitudes
+      ncolumn=nint(0.999/fractus*real(npart(1))*colmass(ix,jy) &
+           /colmasstotal)
+      if (ncolumn.gt.maxcolumn) stop 'maxcolumn too small'
+      if (ncolumn.eq.0) goto 80
+
+
+  ! Memorize how many particles per column shall be used for all boundaries
+  ! This is further used in subroutine boundcond_domainfill.f
+  ! Use 2 fields for west/east and south/north boundary
+  !************************************************************************
+
+      if (ix.eq.nx_we(1)) numcolumn_we(1,jy)=ncolumn
+      if (ix.eq.nx_we(2)) numcolumn_we(2,jy)=ncolumn
+      if (jy.eq.ny_sn(1)) numcolumn_sn(1,ix)=ncolumn
+      if (jy.eq.ny_sn(2)) numcolumn_sn(2,ix)=ncolumn
+
+  ! Calculate pressure at the altitudes of model surfaces, using the air density
+  ! information, which is stored as a 3-d field
+  !*****************************************************************************
+
+      do kz=1,nz
+        pp(kz)=rho(ix,jy,kz,1)*r_air*tt(ix,jy,kz,1)
+      end do
+
+  ! Determine the reference starting altitudes
+  !*******************************************
+
+      deltacol=(pp(1)-pp(nz))/real(ncolumn)
+      pnew=pp(1)+deltacol/2.
+      do j=1,ncolumn
+        pnew=pnew-deltacol
+        do kz=1,nz-1
+          if ((pp(kz).ge.pnew).and.(pp(kz+1).lt.pnew)) then
+            dz1=pp(kz)-pnew
+            dz2=pnew-pp(kz+1)
+            dz=1./(dz1+dz2)
+            zposition=(height(kz)*dz2+height(kz+1)*dz1)*dz
+           if (zposition.gt.height(nz)-0.5) zposition=height(nz)-0.5
+
+  ! Memorize vertical positions where particles are introduced
+  ! This is further used in subroutine boundcond_domainfill.f
+  !***********************************************************
+
+            if (ix.eq.nx_we(1)) zcolumn_we(1,jy,j)=zposition
+            if (ix.eq.nx_we(2)) zcolumn_we(2,jy,j)=zposition
+            if (jy.eq.ny_sn(1)) zcolumn_sn(1,ix,j)=zposition
+            if (jy.eq.ny_sn(2)) zcolumn_sn(2,ix,j)=zposition
+
+  ! Initialize mass that has accumulated at boundary to zero
+  !*********************************************************
+
+            acc_mass_we(1,jy,j)=0.
+            acc_mass_we(2,jy,j)=0.
+            acc_mass_sn(1,jy,j)=0.
+            acc_mass_sn(2,jy,j)=0.
+          endif
+        end do
+      end do
+80    continue
+    end do
+  end do
+
+  ! If particles shall be read in to continue an existing run,
+  ! then the accumulated masses at the domain boundaries must be read in, too.
+  ! This overrides any previous calculations.
+  !***************************************************************************
+
+  if (ipin.eq.1) then
+    open(unitboundcond,file=path(2)(1:length(2))//'boundcond.bin', &
+         form='unformatted')
+    read(unitboundcond) numcolumn_we,numcolumn_sn, &
+         zcolumn_we,zcolumn_sn,acc_mass_we,acc_mass_sn
+    close(unitboundcond)
+  endif
+
+
+
+
+end subroutine init_domainfill
Index: /branches/FP_AI/src/initial_cond_calc.f90
===================================================================
--- /branches/FP_AI/src/initial_cond_calc.f90	(revision 23)
+++ /branches/FP_AI/src/initial_cond_calc.f90	(revision 23)
@@ -0,0 +1,213 @@
+!**********************************************************************
+! 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 initial_cond_calc(itime,i)
+  !                               i   i
+  !*****************************************************************************
+  !                                                                            *
+  !     Calculation of the sensitivity to initial conditions for BW runs       *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     15 January 2010                                                        *
+  !                                                                            *
+  !*****************************************************************************
+
+  use unc_mod
+  use outg_mod
+  use par_mod
+  use com_mod
+
+  implicit none
+
+  integer :: itime,i,ix,jy,ixp,jyp,kz,ks
+  integer :: il,ind,indz,indzp,nrelpointer
+  real :: rddx,rddy,p1,p2,p3,p4,dz1,dz2,dz
+  real :: ddx,ddy
+  real :: rhoprof(2),rhoi,xl,yl,wx,wy,w
+
+
+  ! For forward simulations, make a loop over the number of species;
+  ! for backward simulations, make an additional loop over the release points
+  !**************************************************************************
+
+
+  if (itra1(i).ne.itime) return
+
+  ! Depending on output option, calculate air density or set it to 1
+  ! linit_cond: 1=mass unit, 2=mass mixing ratio unit
+  !*****************************************************************
+
+
+  if (linit_cond.eq.1) then     ! mass unit
+
+    ix=int(xtra1(i))
+    jy=int(ytra1(i))
+    ixp=ix+1
+    jyp=jy+1
+    ddx=xtra1(i)-real(ix)
+    ddy=ytra1(i)-real(jy)
+    rddx=1.-ddx
+    rddy=1.-ddy
+    p1=rddx*rddy
+    p2=ddx*rddy
+    p3=rddx*ddy
+    p4=ddx*ddy
+
+    do il=2,nz
+      if (height(il).gt.ztra1(i)) then
+        indz=il-1
+        indzp=il
+        goto 6
+      endif
+    end do
+6   continue
+
+    dz1=ztra1(i)-height(indz)
+    dz2=height(indzp)-ztra1(i)
+    dz=1./(dz1+dz2)
+
+  ! Take density from 2nd wind field in memory (accurate enough, no time interpolation needed)
+  !*****************************************************************************
+    do ind=indz,indzp
+      rhoprof(ind-indz+1)=p1*rho(ix ,jy ,ind,2) &
+           +p2*rho(ixp,jy ,ind,2) &
+           +p3*rho(ix ,jyp,ind,2) &
+           +p4*rho(ixp,jyp,ind,2)
+    end do
+    rhoi=(dz1*rhoprof(2)+dz2*rhoprof(1))*dz
+  elseif (linit_cond.eq.2) then    ! mass mixing ratio unit
+    rhoi=1.
+  endif
+
+
+  !****************************************************************************
+  ! 1. Evaluate grid concentrations using a uniform kernel of bandwidths dx, dy
+  !****************************************************************************
+
+
+  ! For backward simulations, look from which release point the particle comes from
+  ! For domain-filling trajectory option, npoint contains a consecutive particle
+  ! number, not the release point information. Therefore, nrelpointer is set to 1
+  ! for the domain-filling option.
+  !*****************************************************************************
+
+  if ((ioutputforeachrelease.eq.0).or.(mdomainfill.eq.1)) then
+    nrelpointer=1
+  else
+    nrelpointer=npoint(i)
+  endif
+
+  do kz=1,numzgrid                ! determine height of cell
+    if (outheight(kz).gt.ztra1(i)) goto 21
+  end do
+21   continue
+  if (kz.le.numzgrid) then           ! inside output domain
+
+
+    xl=(xtra1(i)*dx+xoutshift)/dxout
+    yl=(ytra1(i)*dy+youtshift)/dyout
+    ix=int(xl)
+    if (xl.lt.0.) ix=ix-1
+    jy=int(yl)
+    if (yl.lt.0.) jy=jy-1
+
+
+  ! If a particle is close to the domain boundary, do not use the kernel either
+  !****************************************************************************
+
+    if ((xl.lt.0.5).or.(yl.lt.0.5).or. &
+         (xl.gt.real(numxgrid-1)-0.5).or. &
+         (yl.gt.real(numygrid-1)-0.5)) then             ! no kernel, direct attribution to grid cell
+      if ((ix.ge.0).and.(jy.ge.0).and.(ix.le.numxgrid-1).and. &
+           (jy.le.numygrid-1)) then
+        do ks=1,nspec
+          init_cond(ix,jy,kz,ks,nrelpointer)= &
+               init_cond(ix,jy,kz,ks,nrelpointer)+ &
+               xmass1(i,ks)/rhoi
+        end do
+      endif
+
+    else                                 ! attribution via uniform kernel
+
+      ddx=xl-real(ix)                   ! distance to left cell border
+      ddy=yl-real(jy)                   ! distance to lower cell border
+      if (ddx.gt.0.5) then
+        ixp=ix+1
+        wx=1.5-ddx
+      else
+        ixp=ix-1
+        wx=0.5+ddx
+      endif
+
+      if (ddy.gt.0.5) then
+        jyp=jy+1
+        wy=1.5-ddy
+      else
+        jyp=jy-1
+        wy=0.5+ddy
+      endif
+
+
+  ! Determine mass fractions for four grid points
+  !**********************************************
+
+      if ((ix.ge.0).and.(ix.le.numxgrid-1)) then
+        if ((jy.ge.0).and.(jy.le.numygrid-1)) then
+          w=wx*wy
+          do ks=1,nspec
+            init_cond(ix,jy,kz,ks,nrelpointer)= &
+                 init_cond(ix,jy,kz,ks,nrelpointer)+xmass1(i,ks)/rhoi*w
+          end do
+        endif
+
+        if ((jyp.ge.0).and.(jyp.le.numygrid-1)) then
+          w=wx*(1.-wy)
+          do ks=1,nspec
+            init_cond(ix,jyp,kz,ks,nrelpointer)= &
+                 init_cond(ix,jyp,kz,ks,nrelpointer)+xmass1(i,ks)/rhoi*w
+          end do
+        endif
+      endif
+
+
+      if ((ixp.ge.0).and.(ixp.le.numxgrid-1)) then
+        if ((jyp.ge.0).and.(jyp.le.numygrid-1)) then
+          w=(1.-wx)*(1.-wy)
+          do ks=1,nspec
+            init_cond(ixp,jyp,kz,ks,nrelpointer)= &
+                 init_cond(ixp,jyp,kz,ks,nrelpointer)+xmass1(i,ks)/rhoi*w
+          end do
+        endif
+
+        if ((jy.ge.0).and.(jy.le.numygrid-1)) then
+          w=(1.-wx)*wy
+          do ks=1,nspec
+            init_cond(ixp,jy,kz,ks,nrelpointer)= &
+                 init_cond(ixp,jy,kz,ks,nrelpointer)+xmass1(i,ks)/rhoi*w
+          end do
+        endif
+      endif
+    endif
+
+  endif
+
+end subroutine initial_cond_calc
Index: /branches/FP_AI/src/initial_cond_output.f90
===================================================================
--- /branches/FP_AI/src/initial_cond_output.f90	(revision 23)
+++ /branches/FP_AI/src/initial_cond_output.f90	(revision 23)
@@ -0,0 +1,151 @@
+!**********************************************************************
+! 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 initial_cond_output(itime)
+  !                                 i
+  !*****************************************************************************
+  !                                                                            *
+  !     Output of the initial condition sensitivity field.                     *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     24 May 1995                                                            *
+  !                                                                            *
+  !     13 April 1999, Major update: if output size is smaller, dump output    *
+  !                    in sparse matrix format; additional output of           *
+  !                    uncertainty                                             *
+  !                                                                            *
+  !     05 April 2000, Major update: output of age classes; output for backward*
+  !                    runs is time spent in grid cell times total mass of     *
+  !                    species.                                                *
+  !                                                                            *
+  !     17 February 2002, Appropriate dimensions for backward and forward runs *
+  !                       are now specified in file par_mod                    *
+  !                                                                            *
+  !     June 2006, write grid in sparse matrix with a single write command     *
+  !                in order to save disk space                                 *
+  !                                                                            *
+  !     2008 new sparse matrix format                                          *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! ncells          number of cells with non-zero concentrations               *
+  ! sparse          .true. if in sparse matrix format, else .false.            *
+  !                                                                            *
+  !*****************************************************************************
+
+  use unc_mod
+  use point_mod
+  use outg_mod
+  use par_mod
+  use com_mod
+
+  implicit none
+
+  integer :: itime,i,ix,jy,kz,ks,kp,sp_count_i,sp_count_r
+  real :: sp_fact,fact_recept
+  real,parameter :: smallnum = tiny(0.0) ! smallest number that can be handled
+  logical :: sp_zer
+  character(len=3) :: anspec
+
+
+  !*********************************************************************
+  ! Determine the standard deviation of the mean concentration or mixing
+  ! ratio (uncertainty of the output) and the dry and wet deposition
+  !*********************************************************************
+
+  do ks=1,nspec
+
+    write(anspec,'(i3.3)') ks
+    open(97,file=path(2)(1:length(2))//'grid_initial'// &
+         '_'//anspec,form='unformatted')
+    write(97) itime
+
+    do kp=1,maxpointspec_act
+
+      if (ind_rel.eq.1) then
+        fact_recept=rho_rel(kp)
+      else
+        fact_recept=1.
+      endif
+
+  !*******************************************************************
+  ! Generate output: may be in concentration (ng/m3) or in mixing
+  ! ratio (ppt) or both
+  ! Output the position and the values alternated multiplied by
+  ! 1 or -1, first line is number of values, number of positions
+  ! For backward simulations, the unit is seconds, stored in grid_time
+  !*******************************************************************
+
+  ! Write out dummy "wet and dry deposition" fields, to keep same format
+  ! as for concentration output
+      sp_count_i=0
+      sp_count_r=0
+      write(97) sp_count_i
+      write(97) (sparse_dump_i(i),i=1,sp_count_i)
+      write(97) sp_count_r
+      write(97) (sparse_dump_r(i),i=1,sp_count_r)
+      write(97) sp_count_i
+      write(97) (sparse_dump_i(i),i=1,sp_count_i)
+      write(97) sp_count_r
+      write(97) (sparse_dump_r(i),i=1,sp_count_r)
+
+
+  ! Write out sensitivity to initial conditions
+      sp_count_i=0
+      sp_count_r=0
+      sp_fact=-1.
+      sp_zer=.true.
+      do kz=1,numzgrid
+        do jy=0,numygrid-1
+          do ix=0,numxgrid-1
+            if (init_cond(ix,jy,kz,ks,kp).gt.smallnum) then
+              if (sp_zer.eqv..true.) then ! first non zero value
+                sp_count_i=sp_count_i+1
+                sparse_dump_i(sp_count_i)= &
+                     ix+jy*numxgrid+kz*numxgrid*numygrid
+                sp_zer=.false.
+                sp_fact=sp_fact*(-1.)
+              endif
+              sp_count_r=sp_count_r+1
+              sparse_dump_r(sp_count_r)=sp_fact* &
+                   init_cond(ix,jy,kz,ks,kp)/xmass(kp,ks)*fact_recept
+            else ! concentration is zero
+              sp_zer=.true.
+            endif
+          end do
+        end do
+      end do
+      write(97) sp_count_i
+      write(97) (sparse_dump_i(i),i=1,sp_count_i)
+      write(97) sp_count_r
+      write(97) (sparse_dump_r(i),i=1,sp_count_r)
+
+
+    end do
+
+    close(97)
+
+  end do
+
+
+end subroutine initial_cond_output
Index: /branches/FP_AI/src/initialize.f90
===================================================================
--- /branches/FP_AI/src/initialize.f90	(revision 23)
+++ /branches/FP_AI/src/initialize.f90	(revision 23)
@@ -0,0 +1,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/>.   *
+!**********************************************************************
+
+subroutine initialize(itime,ldt,up,vp,wp, &
+       usigold,vsigold,wsigold,xt,yt,zt,icbt)
+  !                        i    i   o  o  o
+  !        o       o       o    i  i  i   o
+  !*****************************************************************************
+  !                                                                            *
+  !  Calculation of trajectories utilizing a zero-acceleration scheme. The time*
+  !  step is determined by the Courant-Friedrichs-Lewy (CFL) criterion. This   *
+  !  means that the time step must be so small that the displacement within    *
+  !  this time step is smaller than 1 grid distance. Additionally, a temporal  *
+  !  CFL criterion is introduced: the time step must be smaller than the time  *
+  !  interval of the wind fields used for interpolation.                       *
+  !  For random walk simulations, these are the only time step criteria.       *
+  !  For the other options, the time step is also limited by the Lagrangian    *
+  !  time scale.                                                               *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     16 December 1997                                                       *
+  !                                                                            *
+  !  Literature:                                                               *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! h [m]              Mixing height                                           *
+  ! lwindinterv [s]    time interval between two wind fields                   *
+  ! itime [s]          current temporal position                               *
+  ! ldt [s]            Suggested time step for next integration                *
+  ! ladvance [s]       Total integration time period                           *
+  ! rannumb(maxrand)   normally distributed random variables                   *
+  ! up,vp,wp           random velocities due to turbulence                     *
+  ! usig,vsig,wsig     uncertainties of wind velocities due to interpolation   *
+  ! usigold,vsigold,wsigold  like usig, etc., but for the last time step       *
+  ! xt,yt,zt           Next time step's spatial position of trajectory         *
+  !                                                                            *
+  !                                                                            *
+  ! Constants:                                                                 *
+  ! cfl                factor, by which the time step has to be smaller than   *
+  !                    the spatial CFL-criterion                               *
+  ! cflt               factor, by which the time step has to be smaller than   *
+  !                    the temporal CFL-criterion                              *
+  !                                                                            *
+  !*****************************************************************************
+
+  use par_mod
+  use com_mod
+  use interpol_mod
+  use hanna_mod
+
+  implicit none
+
+  integer :: itime
+  integer :: ldt,nrand
+  integer(kind=2) :: icbt
+  real :: zt,dz,dz1,dz2,up,vp,wp,usigold,vsigold,wsigold,ran3
+  real(kind=dp) :: xt,yt
+  save idummy
+
+  integer :: idummy = -7
+
+  icbt=1           ! initialize particle to "no reflection"
+
+  nrand=int(ran3(idummy)*real(maxrand-1))+1
+
+
+  !******************************
+  ! 2. Interpolate necessary data
+  !******************************
+
+  ! Compute maximum mixing height around particle position
+  !*******************************************************
+
+  ix=int(xt)
+  jy=int(yt)
+  ixp=ix+1
+  jyp=jy+1
+
+  h=max(hmix(ix ,jy ,1,memind(1)), &
+       hmix(ixp,jy ,1,memind(1)), &
+       hmix(ix ,jyp,1,memind(1)), &
+       hmix(ixp,jyp,1,memind(1)), &
+       hmix(ix ,jy ,1,memind(2)), &
+       hmix(ixp,jy ,1,memind(2)), &
+       hmix(ix ,jyp,1,memind(2)), &
+       hmix(ixp,jyp,1,memind(2)))
+
+  zeta=zt/h
+
+
+  !*************************************************************
+  ! If particle is in the PBL, interpolate once and then make a
+  ! time loop until end of interval is reached
+  !*************************************************************
+
+  if (zeta.le.1.) then
+
+    call interpol_all(itime,real(xt),real(yt),zt)
+
+
+  ! Vertical interpolation of u,v,w,rho and drhodz
+  !***********************************************
+
+  ! Vertical distance to the level below and above current position
+  ! both in terms of (u,v) and (w) fields
+  !****************************************************************
+
+    dz1=zt-height(indz)
+    dz2=height(indzp)-zt
+    dz=1./(dz1+dz2)
+
+    u=(dz1*uprof(indzp)+dz2*uprof(indz))*dz
+    v=(dz1*vprof(indzp)+dz2*vprof(indz))*dz
+    w=(dz1*wprof(indzp)+dz2*wprof(indz))*dz
+
+
+  ! Compute the turbulent disturbances
+
+  ! Determine the sigmas and the timescales
+  !****************************************
+
+    if (turbswitch) then
+      call hanna(zt)
+    else
+      call hanna1(zt)
+    endif
+
+
+  ! Determine the new diffusivity velocities
+  !*****************************************
+
+    if (nrand+2.gt.maxrand) nrand=1
+    up=rannumb(nrand)*sigu
+    vp=rannumb(nrand+1)*sigv
+    wp=rannumb(nrand+2)
+    if (.not.turbswitch) wp=wp*sigw
+
+
+  ! Determine time step for next integration
+  !*****************************************
+
+    if (turbswitch) then
+      ldt=int(min(tlw,h/max(2.*abs(wp*sigw),1.e-5), &
+           0.5/abs(dsigwdz),600.)*ctl)
+    else
+      ldt=int(min(tlw,h/max(2.*abs(wp),1.e-5),600.)*ctl)
+    endif
+    ldt=max(ldt,mintime)
+
+
+    usig=(usigprof(indzp)+usigprof(indz))/2.
+    vsig=(vsigprof(indzp)+vsigprof(indz))/2.
+    wsig=(wsigprof(indzp)+wsigprof(indz))/2.
+
+  else
+
+
+
+  !**********************************************************
+  ! For all particles that are outside the PBL, make a single
+  ! time step. Only horizontal turbulent disturbances are
+  ! calculated. Vertical disturbances are reset.
+  !**********************************************************
+
+
+  ! Interpolate the wind
+  !*********************
+
+    call interpol_wind(itime,real(xt),real(yt),zt)
+
+
+  ! Compute everything for above the PBL
+
+  ! Assume constant turbulent perturbations
+  !****************************************
+
+    ldt=abs(lsynctime)
+
+    if (nrand+1.gt.maxrand) nrand=1
+    up=rannumb(nrand)*0.3
+    vp=rannumb(nrand+1)*0.3
+    nrand=nrand+2
+    wp=0.
+    sigw=0.
+
+  endif
+
+  !****************************************************************
+  ! Add mesoscale random disturbances
+  ! This is done only once for the whole lsynctime interval to save
+  ! computation time
+  !****************************************************************
+
+
+  ! It is assumed that the average interpolation error is 1/2 sigma
+  ! of the surrounding points, autocorrelation time constant is
+  ! 1/2 of time interval between wind fields
+  !****************************************************************
+
+  if (nrand+2.gt.maxrand) nrand=1
+  usigold=rannumb(nrand)*usig
+  vsigold=rannumb(nrand+1)*vsig
+  wsigold=rannumb(nrand+2)*wsig
+
+end subroutine initialize
Index: /branches/FP_AI/src/interpol_all.f90
===================================================================
--- /branches/FP_AI/src/interpol_all.f90	(revision 23)
+++ /branches/FP_AI/src/interpol_all.f90	(revision 23)
@@ -0,0 +1,261 @@
+!**********************************************************************
+! 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 interpol_all(itime,xt,yt,zt)
+  !                          i   i  i  i
+  !*****************************************************************************
+  !                                                                            *
+  !  This subroutine interpolates everything that is needed for calculating the*
+  !  dispersion.                                                               *
+  !                                                                            *
+  !    Author: A. Stohl                                                        *
+  !                                                                            *
+  !    16 December 1997                                                        *
+  !                                                                            *
+  !  Revision March 2005 by AST : all output variables in common block cal-    *
+  !                               culation of standard deviation done in this  *
+  !                               routine rather than subroutine call in order *
+  !                               to save computation time                     *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! itime [s]          current temporal position                               *
+  ! memtime(3) [s]     times of the wind fields in memory                      *
+  ! xt,yt,zt           coordinates position for which wind data shall be       *
+  !                    culated                                                 *
+  !                                                                            *
+  ! Constants:                                                                 *
+  !                                                                            *
+  !*****************************************************************************
+
+  use par_mod
+  use com_mod
+  use interpol_mod
+  use hanna_mod
+
+  implicit none
+
+  integer :: itime
+  real :: xt,yt,zt
+
+  ! Auxiliary variables needed for interpolation
+  real :: ust1(2),wst1(2),oli1(2),oliaux
+  real :: y1(2),y2(2),y3(2),rho1(2),rhograd1(2)
+  real :: usl,vsl,wsl,usq,vsq,wsq,xaux
+  integer :: i,m,n,indexh
+  real,parameter :: eps=1.0e-30
+
+
+  !********************************************
+  ! Multilinear interpolation in time and space
+  !********************************************
+
+  ! Determine the lower left corner and its distance to the current position
+  !*************************************************************************
+
+  ddx=xt-real(ix)
+  ddy=yt-real(jy)
+  rddx=1.-ddx
+  rddy=1.-ddy
+  p1=rddx*rddy
+  p2=ddx*rddy
+  p3=rddx*ddy
+  p4=ddx*ddy
+
+  ! Calculate variables for time interpolation
+  !*******************************************
+
+  dt1=real(itime-memtime(1))
+  dt2=real(memtime(2)-itime)
+  dtt=1./(dt1+dt2)
+
+
+  !*****************************************
+  ! 1. Interpolate u*, w* and Obukhov length
+  !*****************************************
+
+  ! a) Bilinear horizontal interpolation
+
+  do m=1,2
+    indexh=memind(m)
+
+    ust1(m)=p1*ustar(ix ,jy ,1,indexh) &
+         + p2*ustar(ixp,jy ,1,indexh) &
+         + p3*ustar(ix ,jyp,1,indexh) &
+         + p4*ustar(ixp,jyp,1,indexh)
+    wst1(m)=p1*wstar(ix ,jy ,1,indexh) &
+         + p2*wstar(ixp,jy ,1,indexh) &
+         + p3*wstar(ix ,jyp,1,indexh) &
+         + p4*wstar(ixp,jyp,1,indexh)
+    oli1(m)=p1*oli(ix ,jy ,1,indexh) &
+         + p2*oli(ixp,jy ,1,indexh) &
+         + p3*oli(ix ,jyp,1,indexh) &
+         + p4*oli(ixp,jyp,1,indexh)
+  end do
+
+  ! b) Temporal interpolation
+
+  ust=(ust1(1)*dt2+ust1(2)*dt1)*dtt
+  wst=(wst1(1)*dt2+wst1(2)*dt1)*dtt
+  oliaux=(oli1(1)*dt2+oli1(2)*dt1)*dtt
+
+  if (oliaux.ne.0.) then
+    ol=1./oliaux
+  else
+    ol=99999.
+  endif
+
+
+  !*****************************************************
+  ! 2. Interpolate vertical profiles of u,v,w,rho,drhodz
+  !*****************************************************
+
+
+  ! Determine the level below the current position
+  !***********************************************
+
+  do i=2,nz
+    if (height(i).gt.zt) then
+      indz=i-1
+      indzp=i
+      goto 6
+    endif
+  end do
+6   continue
+
+  !**************************************
+  ! 1.) Bilinear horizontal interpolation
+  ! 2.) Temporal interpolation (linear)
+  !**************************************
+
+  ! Loop over 2 time steps and indz levels
+  !***************************************
+
+  do n=indz,indzp
+    usl=0.
+    vsl=0.
+    wsl=0.
+    usq=0.
+    vsq=0.
+    wsq=0.
+    do m=1,2
+      indexh=memind(m)
+      if (ngrid.lt.0) then
+        y1(m)=p1*uupol(ix ,jy ,n,indexh) &
+             +p2*uupol(ixp,jy ,n,indexh) &
+             +p3*uupol(ix ,jyp,n,indexh) &
+             +p4*uupol(ixp,jyp,n,indexh)
+        y2(m)=p1*vvpol(ix ,jy ,n,indexh) &
+             +p2*vvpol(ixp,jy ,n,indexh) &
+             +p3*vvpol(ix ,jyp,n,indexh) &
+             +p4*vvpol(ixp,jyp,n,indexh)
+        usl=usl+uupol(ix ,jy ,n,indexh)+uupol(ixp,jy ,n,indexh) &
+             +uupol(ix ,jyp,n,indexh)+uupol(ixp,jyp,n,indexh)
+        vsl=vsl+vvpol(ix ,jy ,n,indexh)+vvpol(ixp,jy ,n,indexh) &
+             +vvpol(ix ,jyp,n,indexh)+vvpol(ixp,jyp,n,indexh)
+
+        usq=usq+uupol(ix ,jy ,n,indexh)*uupol(ix ,jy ,n,indexh)+ &
+             uupol(ixp,jy ,n,indexh)*uupol(ixp,jy ,n,indexh)+ &
+             uupol(ix ,jyp,n,indexh)*uupol(ix ,jyp,n,indexh)+ &
+             uupol(ixp,jyp,n,indexh)*uupol(ixp,jyp,n,indexh)
+        vsq=vsq+vvpol(ix ,jy ,n,indexh)*vvpol(ix ,jy ,n,indexh)+ &
+             vvpol(ixp,jy ,n,indexh)*vvpol(ixp,jy ,n,indexh)+ &
+             vvpol(ix ,jyp,n,indexh)*vvpol(ix ,jyp,n,indexh)+ &
+             vvpol(ixp,jyp,n,indexh)*vvpol(ixp,jyp,n,indexh)
+      else
+        y1(m)=p1*uu(ix ,jy ,n,indexh) &
+             +p2*uu(ixp,jy ,n,indexh) &
+             +p3*uu(ix ,jyp,n,indexh) &
+             +p4*uu(ixp,jyp,n,indexh)
+        y2(m)=p1*vv(ix ,jy ,n,indexh) &
+             +p2*vv(ixp,jy ,n,indexh) &
+             +p3*vv(ix ,jyp,n,indexh) &
+             +p4*vv(ixp,jyp,n,indexh)
+        usl=usl+uu(ix ,jy ,n,indexh)+uu(ixp,jy ,n,indexh) &
+             +uu(ix ,jyp,n,indexh)+uu(ixp,jyp,n,indexh)
+        vsl=vsl+vv(ix ,jy ,n,indexh)+vv(ixp,jy ,n,indexh) &
+             +vv(ix ,jyp,n,indexh)+vv(ixp,jyp,n,indexh)
+
+        usq=usq+uu(ix ,jy ,n,indexh)*uu(ix ,jy ,n,indexh)+ &
+             uu(ixp,jy ,n,indexh)*uu(ixp,jy ,n,indexh)+ &
+             uu(ix ,jyp,n,indexh)*uu(ix ,jyp,n,indexh)+ &
+             uu(ixp,jyp,n,indexh)*uu(ixp,jyp,n,indexh)
+        vsq=vsq+vv(ix ,jy ,n,indexh)*vv(ix ,jy ,n,indexh)+ &
+             vv(ixp,jy ,n,indexh)*vv(ixp,jy ,n,indexh)+ &
+             vv(ix ,jyp,n,indexh)*vv(ix ,jyp,n,indexh)+ &
+             vv(ixp,jyp,n,indexh)*vv(ixp,jyp,n,indexh)
+      endif
+      y3(m)=p1*ww(ix ,jy ,n,indexh) &
+           +p2*ww(ixp,jy ,n,indexh) &
+           +p3*ww(ix ,jyp,n,indexh) &
+           +p4*ww(ixp,jyp,n,indexh)
+      rhograd1(m)=p1*drhodz(ix ,jy ,n,indexh) &
+           +p2*drhodz(ixp,jy ,n,indexh) &
+           +p3*drhodz(ix ,jyp,n,indexh) &
+           +p4*drhodz(ixp,jyp,n,indexh)
+      rho1(m)=p1*rho(ix ,jy ,n,indexh) &
+           +p2*rho(ixp,jy ,n,indexh) &
+           +p3*rho(ix ,jyp,n,indexh) &
+           +p4*rho(ixp,jyp,n,indexh)
+      wsl=wsl+ww(ix ,jy ,n,indexh)+ww(ixp,jy ,n,indexh) &
+           +ww(ix ,jyp,n,indexh)+ww(ixp,jyp,n,indexh)
+      wsq=wsq+ww(ix ,jy ,n,indexh)*ww(ix ,jy ,n,indexh)+ &
+           ww(ixp,jy ,n,indexh)*ww(ixp,jy ,n,indexh)+ &
+           ww(ix ,jyp,n,indexh)*ww(ix ,jyp,n,indexh)+ &
+           ww(ixp,jyp,n,indexh)*ww(ixp,jyp,n,indexh)
+    end do
+    uprof(n)=(y1(1)*dt2+y1(2)*dt1)*dtt
+    vprof(n)=(y2(1)*dt2+y2(2)*dt1)*dtt
+    wprof(n)=(y3(1)*dt2+y3(2)*dt1)*dtt
+    rhoprof(n)=(rho1(1)*dt2+rho1(2)*dt1)*dtt
+    rhogradprof(n)=(rhograd1(1)*dt2+rhograd1(2)*dt1)*dtt
+    indzindicator(n)=.false.
+
+  ! Compute standard deviations
+  !****************************
+
+    xaux=usq-usl*usl/8.
+    if (xaux.lt.eps) then
+      usigprof(n)=0.
+    else
+      usigprof(n)=sqrt(xaux/7.)
+    endif
+
+    xaux=vsq-vsl*vsl/8.
+    if (xaux.lt.eps) then
+      vsigprof(n)=0.
+    else
+      vsigprof(n)=sqrt(xaux/7.)
+    endif
+
+
+    xaux=wsq-wsl*wsl/8.
+    if (xaux.lt.eps) then
+      wsigprof(n)=0.
+    else
+      wsigprof(n)=sqrt(xaux/7.)
+    endif
+
+  end do
+
+
+end subroutine interpol_all
Index: /branches/FP_AI/src/interpol_all_nests.f90
===================================================================
--- /branches/FP_AI/src/interpol_all_nests.f90	(revision 23)
+++ /branches/FP_AI/src/interpol_all_nests.f90	(revision 23)
@@ -0,0 +1,239 @@
+!**********************************************************************
+! 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 interpol_all_nests(itime,xt,yt,zt)
+  !                                i   i  i  i
+  !*****************************************************************************
+  !                                                                            *
+  !  This subroutine interpolates everything that is needed for calculating the*
+  !  dispersion.                                                               *
+  !  Version for interpolating nested grids.                                   *
+  !                                                                            *
+  !    Author: A. Stohl                                                        *
+  !                                                                            *
+  !    9 February 1999                                                         *
+  !    16 December 1997                                                        *
+  !                                                                            *
+  !  Revision March 2005 by AST : all output variables in common block cal-    *
+  !                               culation of standard deviation done in this  *
+  !                               routine rather than subroutine call in order *
+  !                               to save computation time                     *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! itime [s]          current temporal position                               *
+  ! memtime(3) [s]     times of the wind fields in memory                      *
+  ! xt,yt,zt           coordinates position for which wind data shall be       *
+  !                    calculated                                              *
+  !                                                                            *
+  ! Constants:                                                                 *
+  !                                                                            *
+  !*****************************************************************************
+
+  use par_mod
+  use com_mod
+  use interpol_mod
+  use hanna_mod
+
+  implicit none
+
+  integer :: itime
+  real :: xt,yt,zt
+
+  ! Auxiliary variables needed for interpolation
+  real :: ust1(2),wst1(2),oli1(2),oliaux
+  real :: y1(2),y2(2),y3(2),rho1(2),rhograd1(2)
+  real :: usl,vsl,wsl,usq,vsq,wsq,xaux
+  integer :: i,m,n,indexh
+  real,parameter :: eps=1.0e-30
+
+
+  !********************************************
+  ! Multilinear interpolation in time and space
+  !********************************************
+
+  ! Determine the lower left corner and its distance to the current position
+  !*************************************************************************
+
+  ddx=xt-real(ix)
+  ddy=yt-real(jy)
+  rddx=1.-ddx
+  rddy=1.-ddy
+  p1=rddx*rddy
+  p2=ddx*rddy
+  p3=rddx*ddy
+  p4=ddx*ddy
+
+  ! Calculate variables for time interpolation
+  !*******************************************
+
+  dt1=real(itime-memtime(1))
+  dt2=real(memtime(2)-itime)
+  dtt=1./(dt1+dt2)
+
+
+  !*****************************************
+  ! 1. Interpolate u*, w* and Obukhov length
+  !*****************************************
+
+  ! a) Bilinear horizontal interpolation
+
+  do m=1,2
+    indexh=memind(m)
+
+    ust1(m)=p1*ustarn(ix ,jy ,1,indexh,ngrid) &
+         + p2*ustarn(ixp,jy ,1,indexh,ngrid) &
+         + p3*ustarn(ix ,jyp,1,indexh,ngrid) &
+         + p4*ustarn(ixp,jyp,1,indexh,ngrid)
+    wst1(m)=p1*wstarn(ix ,jy ,1,indexh,ngrid) &
+         + p2*wstarn(ixp,jy ,1,indexh,ngrid) &
+         + p3*wstarn(ix ,jyp,1,indexh,ngrid) &
+         + p4*wstarn(ixp,jyp,1,indexh,ngrid)
+    oli1(m)=p1*olin(ix ,jy ,1,indexh,ngrid) &
+         + p2*olin(ixp,jy ,1,indexh,ngrid) &
+         + p3*olin(ix ,jyp,1,indexh,ngrid) &
+         + p4*olin(ixp,jyp,1,indexh,ngrid)
+  end do
+
+  ! b) Temporal interpolation
+
+  ust=(ust1(1)*dt2+ust1(2)*dt1)*dtt
+  wst=(wst1(1)*dt2+wst1(2)*dt1)*dtt
+  oliaux=(oli1(1)*dt2+oli1(2)*dt1)*dtt
+
+  if (oliaux.ne.0.) then
+    ol=1./oliaux
+  else
+    ol=99999.
+  endif
+
+
+  !*****************************************************
+  ! 2. Interpolate vertical profiles of u,v,w,rho,drhodz
+  !*****************************************************
+
+
+  ! Determine the level below the current position
+  !***********************************************
+
+  do i=2,nz
+    if (height(i).gt.zt) then
+      indz=i-1
+      indzp=i
+      goto 6
+    endif
+  end do
+6   continue
+
+  !**************************************
+  ! 1.) Bilinear horizontal interpolation
+  ! 2.) Temporal interpolation (linear)
+  !**************************************
+
+  ! Loop over 2 time steps and indz levels
+  !***************************************
+
+  do n=indz,indz+1
+    usl=0.
+    vsl=0.
+    wsl=0.
+    usq=0.
+    vsq=0.
+    wsq=0.
+    do m=1,2
+      indexh=memind(m)
+      y1(m)=p1*uun(ix ,jy ,n,indexh,ngrid) &
+           +p2*uun(ixp,jy ,n,indexh,ngrid) &
+           +p3*uun(ix ,jyp,n,indexh,ngrid) &
+           +p4*uun(ixp,jyp,n,indexh,ngrid)
+      y2(m)=p1*vvn(ix ,jy ,n,indexh,ngrid) &
+           +p2*vvn(ixp,jy ,n,indexh,ngrid) &
+           +p3*vvn(ix ,jyp,n,indexh,ngrid) &
+           +p4*vvn(ixp,jyp,n,indexh,ngrid)
+      y3(m)=p1*wwn(ix ,jy ,n,indexh,ngrid) &
+           +p2*wwn(ixp,jy ,n,indexh,ngrid) &
+           +p3*wwn(ix ,jyp,n,indexh,ngrid) &
+           +p4*wwn(ixp,jyp,n,indexh,ngrid)
+      rhograd1(m)=p1*drhodzn(ix ,jy ,n,indexh,ngrid) &
+           +p2*drhodzn(ixp,jy ,n,indexh,ngrid) &
+           +p3*drhodzn(ix ,jyp,n,indexh,ngrid) &
+           +p4*drhodzn(ixp,jyp,n,indexh,ngrid)
+      rho1(m)=p1*rhon(ix ,jy ,n,indexh,ngrid) &
+           +p2*rhon(ixp,jy ,n,indexh,ngrid) &
+           +p3*rhon(ix ,jyp,n,indexh,ngrid) &
+           +p4*rhon(ixp,jyp,n,indexh,ngrid)
+
+     usl=usl+uun(ix ,jy ,n,indexh,ngrid)+uun(ixp,jy ,n,indexh,ngrid) &
+          +uun(ix ,jyp,n,indexh,ngrid)+uun(ixp,jyp,n,indexh,ngrid)
+     vsl=vsl+vvn(ix ,jy ,n,indexh,ngrid)+vvn(ixp,jy ,n,indexh,ngrid) &
+          +vvn(ix ,jyp,n,indexh,ngrid)+vvn(ixp,jyp,n,indexh,ngrid)
+     wsl=wsl+wwn(ix ,jy ,n,indexh,ngrid)+wwn(ixp,jy ,n,indexh,ngrid) &
+          +wwn(ix ,jyp,n,indexh,ngrid)+wwn(ixp,jyp,n,indexh,ngrid)
+
+    usq=usq+uun(ix ,jy ,n,indexh,ngrid)*uun(ix ,jy ,n,indexh,ngrid)+ &
+         uun(ixp,jy ,n,indexh,ngrid)*uun(ixp,jy ,n,indexh,ngrid)+ &
+         uun(ix ,jyp,n,indexh,ngrid)*uun(ix ,jyp,n,indexh,ngrid)+ &
+         uun(ixp,jyp,n,indexh,ngrid)*uun(ixp,jyp,n,indexh,ngrid)
+    vsq=vsq+vvn(ix ,jy ,n,indexh,ngrid)*vvn(ix ,jy ,n,indexh,ngrid)+ &
+         vvn(ixp,jy ,n,indexh,ngrid)*vvn(ixp,jy ,n,indexh,ngrid)+ &
+         vvn(ix ,jyp,n,indexh,ngrid)*vvn(ix ,jyp,n,indexh,ngrid)+ &
+         vvn(ixp,jyp,n,indexh,ngrid)*vvn(ixp,jyp,n,indexh,ngrid)
+    wsq=wsq+wwn(ix ,jy ,n,indexh,ngrid)*wwn(ix ,jy ,n,indexh,ngrid)+ &
+         wwn(ixp,jy ,n,indexh,ngrid)*wwn(ixp,jy ,n,indexh,ngrid)+ &
+         wwn(ix ,jyp,n,indexh,ngrid)*wwn(ix ,jyp,n,indexh,ngrid)+ &
+         wwn(ixp,jyp,n,indexh,ngrid)*wwn(ixp,jyp,n,indexh,ngrid)
+    end do
+    uprof(n)=(y1(1)*dt2+y1(2)*dt1)*dtt
+    vprof(n)=(y2(1)*dt2+y2(2)*dt1)*dtt
+    wprof(n)=(y3(1)*dt2+y3(2)*dt1)*dtt
+    rhoprof(n)=(rho1(1)*dt2+rho1(2)*dt1)*dtt
+    rhogradprof(n)=(rhograd1(1)*dt2+rhograd1(2)*dt1)*dtt
+    indzindicator(n)=.false.
+
+  ! Compute standard deviations
+  !****************************
+
+    xaux=usq-usl*usl/8.
+    if (xaux.lt.eps) then
+      usigprof(n)=0.
+    else
+      usigprof(n)=sqrt(xaux/7.)
+    endif
+
+    xaux=vsq-vsl*vsl/8.
+    if (xaux.lt.eps) then
+      vsigprof(n)=0.
+    else
+      vsigprof(n)=sqrt(xaux/7.)
+    endif
+
+
+    xaux=wsq-wsl*wsl/8.
+    if (xaux.lt.eps) then
+      wsigprof(n)=0.
+    else
+      wsigprof(n)=sqrt(xaux/7.)
+    endif
+
+  end do
+
+end subroutine interpol_all_nests
Index: /branches/FP_AI/src/interpol_misslev.f90
===================================================================
--- /branches/FP_AI/src/interpol_misslev.f90	(revision 23)
+++ /branches/FP_AI/src/interpol_misslev.f90	(revision 23)
@@ -0,0 +1,180 @@
+!**********************************************************************
+! 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 interpol_misslev(n)
+  !                            i
+  !*****************************************************************************
+  !                                                                            *
+  !  This subroutine interpolates u,v,w, density and density gradients.        *
+  !                                                                            *
+  !    Author: A. Stohl                                                        *
+  !                                                                            *
+  !    16 December 1997                                                        *
+  !    Update: 2 March 1999                                                    *
+  !                                                                            *
+  !  Revision March 2005 by AST : all output variables in common block cal-    *
+  !                               culation of standard deviation done in this  *
+  !                               routine rather than subroutine call in order *
+  !                               to save computation time                     *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! n                  level                                                   *
+  !                                                                            *
+  ! Constants:                                                                 *
+  !                                                                            *
+  !*****************************************************************************
+
+  use par_mod
+  use com_mod
+  use interpol_mod
+  use hanna_mod
+
+  implicit none
+
+  ! Auxiliary variables needed for interpolation
+  real :: y1(2),y2(2),y3(2),rho1(2),rhograd1(2)
+  real :: usl,vsl,wsl,usq,vsq,wsq,xaux
+  integer :: m,n,indexh
+  real,parameter :: eps=1.0e-30
+
+
+  !********************************************
+  ! Multilinear interpolation in time and space
+  !********************************************
+
+
+  !**************************************
+  ! 1.) Bilinear horizontal interpolation
+  ! 2.) Temporal interpolation (linear)
+  !**************************************
+
+  ! Loop over 2 time steps
+  !***********************
+
+  usl=0.
+  vsl=0.
+  wsl=0.
+  usq=0.
+  vsq=0.
+  wsq=0.
+  do m=1,2
+    indexh=memind(m)
+    if (ngrid.lt.0) then
+      y1(m)=p1*uupol(ix ,jy ,n,indexh) &
+           +p2*uupol(ixp,jy ,n,indexh) &
+           +p3*uupol(ix ,jyp,n,indexh) &
+           +p4*uupol(ixp,jyp,n,indexh)
+      y2(m)=p1*vvpol(ix ,jy ,n,indexh) &
+           +p2*vvpol(ixp,jy ,n,indexh) &
+           +p3*vvpol(ix ,jyp,n,indexh) &
+           +p4*vvpol(ixp,jyp,n,indexh)
+        usl=usl+uupol(ix ,jy ,n,indexh)+uupol(ixp,jy ,n,indexh) &
+             +uupol(ix ,jyp,n,indexh)+uupol(ixp,jyp,n,indexh)
+        vsl=vsl+vvpol(ix ,jy ,n,indexh)+vvpol(ixp,jy ,n,indexh) &
+             +vvpol(ix ,jyp,n,indexh)+vvpol(ixp,jyp,n,indexh)
+
+        usq=usq+uupol(ix ,jy ,n,indexh)*uupol(ix ,jy ,n,indexh)+ &
+             uupol(ixp,jy ,n,indexh)*uupol(ixp,jy ,n,indexh)+ &
+             uupol(ix ,jyp,n,indexh)*uupol(ix ,jyp,n,indexh)+ &
+             uupol(ixp,jyp,n,indexh)*uupol(ixp,jyp,n,indexh)
+        vsq=vsq+vvpol(ix ,jy ,n,indexh)*vvpol(ix ,jy ,n,indexh)+ &
+             vvpol(ixp,jy ,n,indexh)*vvpol(ixp,jy ,n,indexh)+ &
+             vvpol(ix ,jyp,n,indexh)*vvpol(ix ,jyp,n,indexh)+ &
+             vvpol(ixp,jyp,n,indexh)*vvpol(ixp,jyp,n,indexh)
+    else
+      y1(m)=p1*uu(ix ,jy ,n,indexh) &
+           +p2*uu(ixp,jy ,n,indexh) &
+           +p3*uu(ix ,jyp,n,indexh) &
+           +p4*uu(ixp,jyp,n,indexh)
+      y2(m)=p1*vv(ix ,jy ,n,indexh) &
+           +p2*vv(ixp,jy ,n,indexh) &
+           +p3*vv(ix ,jyp,n,indexh) &
+           +p4*vv(ixp,jyp,n,indexh)
+      usl=usl+uu(ix ,jy ,n,indexh)+uu(ixp,jy ,n,indexh) &
+           +uu(ix ,jyp,n,indexh)+uu(ixp,jyp,n,indexh)
+      vsl=vsl+vv(ix ,jy ,n,indexh)+vv(ixp,jy ,n,indexh) &
+           +vv(ix ,jyp,n,indexh)+vv(ixp,jyp,n,indexh)
+
+      usq=usq+uu(ix ,jy ,n,indexh)*uu(ix ,jy ,n,indexh)+ &
+           uu(ixp,jy ,n,indexh)*uu(ixp,jy ,n,indexh)+ &
+           uu(ix ,jyp,n,indexh)*uu(ix ,jyp,n,indexh)+ &
+           uu(ixp,jyp,n,indexh)*uu(ixp,jyp,n,indexh)
+      vsq=vsq+vv(ix ,jy ,n,indexh)*vv(ix ,jy ,n,indexh)+ &
+           vv(ixp,jy ,n,indexh)*vv(ixp,jy ,n,indexh)+ &
+           vv(ix ,jyp,n,indexh)*vv(ix ,jyp,n,indexh)+ &
+           vv(ixp,jyp,n,indexh)*vv(ixp,jyp,n,indexh)
+    endif
+    y3(m)=p1*ww(ix ,jy ,n,indexh) &
+         +p2*ww(ixp,jy ,n,indexh) &
+         +p3*ww(ix ,jyp,n,indexh) &
+         +p4*ww(ixp,jyp,n,indexh)
+    rhograd1(m)=p1*drhodz(ix ,jy ,n,indexh) &
+         +p2*drhodz(ixp,jy ,n,indexh) &
+         +p3*drhodz(ix ,jyp,n,indexh) &
+         +p4*drhodz(ixp,jyp,n,indexh)
+    rho1(m)=p1*rho(ix ,jy ,n,indexh) &
+         +p2*rho(ixp,jy ,n,indexh) &
+         +p3*rho(ix ,jyp,n,indexh) &
+         +p4*rho(ixp,jyp,n,indexh)
+    wsl=wsl+ww(ix ,jy ,n,indexh)+ww(ixp,jy ,n,indexh) &
+         +ww(ix ,jyp,n,indexh)+ww(ixp,jyp,n,indexh)
+    wsq=wsq+ww(ix ,jy ,n,indexh)*ww(ix ,jy ,n,indexh)+ &
+         ww(ixp,jy ,n,indexh)*ww(ixp,jy ,n,indexh)+ &
+         ww(ix ,jyp,n,indexh)*ww(ix ,jyp,n,indexh)+ &
+         ww(ixp,jyp,n,indexh)*ww(ixp,jyp,n,indexh)
+  end do
+  uprof(n)=(y1(1)*dt2+y1(2)*dt1)*dtt
+  vprof(n)=(y2(1)*dt2+y2(2)*dt1)*dtt
+  wprof(n)=(y3(1)*dt2+y3(2)*dt1)*dtt
+  rhoprof(n)=(rho1(1)*dt2+rho1(2)*dt1)*dtt
+  rhogradprof(n)=(rhograd1(1)*dt2+rhograd1(2)*dt1)*dtt
+  indzindicator(n)=.false.
+
+
+  ! Compute standard deviations
+  !****************************
+
+  xaux=usq-usl*usl/8.
+  if (xaux.lt.eps) then
+    usigprof(n)=0.
+  else
+    usigprof(n)=sqrt(xaux/7.)
+  endif
+
+  xaux=vsq-vsl*vsl/8.
+  if (xaux.lt.eps) then
+    vsigprof(n)=0.
+  else
+    vsigprof(n)=sqrt(xaux/7.)
+  endif
+
+
+  xaux=wsq-wsl*wsl/8.
+  if (xaux.lt.eps) then
+    wsigprof(n)=0.
+  else
+    wsigprof(n)=sqrt(xaux/7.)
+  endif
+
+
+end subroutine interpol_misslev
Index: /branches/FP_AI/src/interpol_misslev_nests.f90
===================================================================
--- /branches/FP_AI/src/interpol_misslev_nests.f90	(revision 23)
+++ /branches/FP_AI/src/interpol_misslev_nests.f90	(revision 23)
@@ -0,0 +1,149 @@
+!**********************************************************************
+! 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 interpol_misslev_nests(n)
+  !                                  i
+  !*****************************************************************************
+  !                                                                            *
+  !  This subroutine interpolates u,v,w, density and density gradients.        *
+  !                                                                            *
+  !    Author: A. Stohl                                                        *
+  !                                                                            *
+  !    16 December 1997                                                        *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! n                  level                                                   *
+  !                                                                            *
+  ! Constants:                                                                 *
+  !                                                                            *
+  !*****************************************************************************
+
+  use par_mod
+  use com_mod
+  use interpol_mod
+  use hanna_mod
+
+  implicit none
+
+  ! Auxiliary variables needed for interpolation
+  real :: y1(2),y2(2),y3(2),rho1(2),rhograd1(2)
+  real :: usl,vsl,wsl,usq,vsq,wsq,xaux
+  integer :: m,n,indexh
+  real,parameter :: eps=1.0e-30
+
+
+  !********************************************
+  ! Multilinear interpolation in time and space
+  !********************************************
+
+
+  !**************************************
+  ! 1.) Bilinear horizontal interpolation
+  ! 2.) Temporal interpolation (linear)
+  !**************************************
+
+  ! Loop over 2 time steps
+  !***********************
+
+  usl=0.
+  vsl=0.
+  wsl=0.
+  usq=0.
+  vsq=0.
+  wsq=0.
+  do m=1,2
+    indexh=memind(m)
+    y1(m)=p1*uun(ix ,jy ,n,indexh,ngrid) &
+         +p2*uun(ixp,jy ,n,indexh,ngrid) &
+         +p3*uun(ix ,jyp,n,indexh,ngrid) &
+         +p4*uun(ixp,jyp,n,indexh,ngrid)
+    y2(m)=p1*vvn(ix ,jy ,n,indexh,ngrid) &
+         +p2*vvn(ixp,jy ,n,indexh,ngrid) &
+         +p3*vvn(ix ,jyp,n,indexh,ngrid) &
+         +p4*vvn(ixp,jyp,n,indexh,ngrid)
+    y3(m)=p1*wwn(ix ,jy ,n,indexh,ngrid) &
+         +p2*wwn(ixp,jy ,n,indexh,ngrid) &
+         +p3*wwn(ix ,jyp,n,indexh,ngrid) &
+         +p4*wwn(ixp,jyp,n,indexh,ngrid)
+    rho1(m)=p1*rhon(ix ,jy ,n,indexh,ngrid) &
+         +p2*rhon(ixp,jy ,n,indexh,ngrid) &
+         +p3*rhon(ix ,jyp,n,indexh,ngrid) &
+         +p4*rhon(ixp,jyp,n,indexh,ngrid)
+    rhograd1(m)=p1*drhodzn(ix ,jy ,n,indexh,ngrid) &
+         +p2*drhodzn(ixp,jy ,n,indexh,ngrid) &
+         +p3*drhodzn(ix ,jyp,n,indexh,ngrid) &
+         +p4*drhodzn(ixp,jyp,n,indexh,ngrid)
+
+     usl=usl+uun(ix ,jy ,n,indexh,ngrid)+uun(ixp,jy ,n,indexh,ngrid) &
+          +uun(ix ,jyp,n,indexh,ngrid)+uun(ixp,jyp,n,indexh,ngrid)
+     vsl=vsl+vvn(ix ,jy ,n,indexh,ngrid)+vvn(ixp,jy ,n,indexh,ngrid) &
+          +vvn(ix ,jyp,n,indexh,ngrid)+vvn(ixp,jyp,n,indexh,ngrid)
+     wsl=wsl+wwn(ix ,jy ,n,indexh,ngrid)+wwn(ixp,jy ,n,indexh,ngrid) &
+          +wwn(ix ,jyp,n,indexh,ngrid)+wwn(ixp,jyp,n,indexh,ngrid)
+
+    usq=usq+uun(ix ,jy ,n,indexh,ngrid)*uun(ix ,jy ,n,indexh,ngrid)+ &
+         uun(ixp,jy ,n,indexh,ngrid)*uun(ixp,jy ,n,indexh,ngrid)+ &
+         uun(ix ,jyp,n,indexh,ngrid)*uun(ix ,jyp,n,indexh,ngrid)+ &
+         uun(ixp,jyp,n,indexh,ngrid)*uun(ixp,jyp,n,indexh,ngrid)
+    vsq=vsq+vvn(ix ,jy ,n,indexh,ngrid)*vvn(ix ,jy ,n,indexh,ngrid)+ &
+         vvn(ixp,jy ,n,indexh,ngrid)*vvn(ixp,jy ,n,indexh,ngrid)+ &
+         vvn(ix ,jyp,n,indexh,ngrid)*vvn(ix ,jyp,n,indexh,ngrid)+ &
+         vvn(ixp,jyp,n,indexh,ngrid)*vvn(ixp,jyp,n,indexh,ngrid)
+    wsq=wsq+wwn(ix ,jy ,n,indexh,ngrid)*wwn(ix ,jy ,n,indexh,ngrid)+ &
+         wwn(ixp,jy ,n,indexh,ngrid)*wwn(ixp,jy ,n,indexh,ngrid)+ &
+         wwn(ix ,jyp,n,indexh,ngrid)*wwn(ix ,jyp,n,indexh,ngrid)+ &
+         wwn(ixp,jyp,n,indexh,ngrid)*wwn(ixp,jyp,n,indexh,ngrid)
+  end do
+  uprof(n)=(y1(1)*dt2+y1(2)*dt1)*dtt
+  vprof(n)=(y2(1)*dt2+y2(2)*dt1)*dtt
+  wprof(n)=(y3(1)*dt2+y3(2)*dt1)*dtt
+  rhoprof(n)=(rho1(1)*dt2+rho1(2)*dt1)*dtt
+  rhogradprof(n)=(rhograd1(1)*dt2+rhograd1(2)*dt1)*dtt
+  indzindicator(n)=.false.
+
+  ! Compute standard deviations
+  !****************************
+
+  xaux=usq-usl*usl/8.
+  if (xaux.lt.eps) then
+    usigprof(n)=0.
+  else
+    usigprof(n)=sqrt(xaux/7.)
+  endif
+
+  xaux=vsq-vsl*vsl/8.
+  if (xaux.lt.eps) then
+    vsigprof(n)=0.
+  else
+    vsigprof(n)=sqrt(xaux/7.)
+  endif
+
+
+  xaux=wsq-wsl*wsl/8.
+  if (xaux.lt.eps) then
+    wsigprof(n)=0.
+  else
+    wsigprof(n)=sqrt(xaux/7.)
+  endif
+
+end subroutine interpol_misslev_nests
Index: /branches/FP_AI/src/interpol_mod.f90
===================================================================
--- /branches/FP_AI/src/interpol_mod.f90	(revision 23)
+++ /branches/FP_AI/src/interpol_mod.f90	(revision 23)
@@ -0,0 +1,20 @@
+module interpol_mod
+
+  use par_mod, only: nzmax, maxspec
+
+  implicit none
+
+  real :: uprof(nzmax),vprof(nzmax),wprof(nzmax)
+  real :: usigprof(nzmax),vsigprof(nzmax),wsigprof(nzmax)
+  real :: rhoprof(nzmax),rhogradprof(nzmax)
+
+  real :: u,v,w,usig,vsig,wsig,pvi
+
+  real :: p1,p2,p3,p4,ddx,ddy,rddx,rddy,dtt,dt1,dt2
+  integer :: ix,jy,ixp,jyp,ngrid,indz,indzp
+  logical :: depoindicator(maxspec)
+  logical :: indzindicator(nzmax)
+
+end module interpol_mod
+
+
Index: /branches/FP_AI/src/interpol_rain.f90
===================================================================
--- /branches/FP_AI/src/interpol_rain.f90	(revision 23)
+++ /branches/FP_AI/src/interpol_rain.f90	(revision 23)
@@ -0,0 +1,145 @@
+!**********************************************************************
+! 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 interpol_rain(yy1,yy2,yy3,nxmax,nymax,nzmax,nx, &
+       ny,memind,xt,yt,level,itime1,itime2,itime,yint1,yint2,yint3)
+  !                          i   i   i    i    i     i   i
+  !i    i    i  i    i     i      i      i     o     o     o
+  !****************************************************************************
+  !                                                                           *
+  !  Interpolation of meteorological fields on 2-d model layers.              *
+  !  In horizontal direction bilinear interpolation interpolation is used.    *
+  !  Temporally a linear interpolation is used.                               *
+  !  Three fields are interpolated at the same time.                          *
+  !                                                                           *
+  !  This is a special version of levlininterpol to save CPU time.            *
+  !                                                                           *
+  !  1 first time                                                             *
+  !  2 second time                                                            *
+  !                                                                           *
+  !                                                                           *
+  !     Author: A. Stohl                                                      *
+  !                                                                           *
+  !     30 August 1996                                                        *
+  !                                                                           *
+  !****************************************************************************
+  !                                                                           *
+  ! Variables:                                                                *
+  !                                                                           *
+  ! dt1,dt2              time differences between fields and current position *
+  ! dz1,dz2              z distance between levels and current position       *
+  ! height(nzmax)        heights of the model levels                          *
+  ! indexh               help variable                                        *
+  ! indz                 the level closest to the current trajectory position *
+  ! indzh                help variable                                        *
+  ! itime                current time                                         *
+  ! itime1               time of the first wind field                         *
+  ! itime2               time of the second wind field                        *
+  ! ix,jy                x,y coordinates of lower left subgrid point          *
+  ! level                level at which interpolation shall be done           *
+  ! memind(3)            points to the places of the wind fields              *
+  ! nx,ny                actual field dimensions in x,y and z direction       *
+  ! nxmax,nymax,nzmax    maximum field dimensions in x,y and z direction      *
+  ! xt                   current x coordinate                                 *
+  ! yint                 the final interpolated value                         *
+  ! yt                   current y coordinate                                 *
+  ! yy(0:nxmax,0:nymax,nzmax,3) meteorological field used for interpolation   *
+  ! zt                   current z coordinate                                 *
+  !                                                                           *
+  !****************************************************************************
+
+  implicit none
+
+  integer :: nx,ny,nxmax,nymax,nzmax,memind(2),m,ix,jy,ixp,jyp
+  integer :: itime,itime1,itime2,level,indexh
+  real :: yy1(0:nxmax-1,0:nymax-1,nzmax,2)
+  real :: yy2(0:nxmax-1,0:nymax-1,nzmax,2)
+  real :: yy3(0:nxmax-1,0:nymax-1,nzmax,2)
+  real :: ddx,ddy,rddx,rddy,dt1,dt2,dt,y1(2),y2(2),y3(2)
+  real :: xt,yt,yint1,yint2,yint3,p1,p2,p3,p4
+
+
+
+  ! If point at border of grid -> small displacement into grid
+  !***********************************************************
+
+  if (xt.ge.real(nx-1)) xt=real(nx-1)-0.00001
+  if (yt.ge.real(ny-1)) yt=real(ny-1)-0.00001
+
+
+
+  !**********************************************************************
+  ! 1.) Bilinear horizontal interpolation
+  ! This has to be done separately for 2 fields (Temporal)
+  !*******************************************************
+
+  ! Determine the lower left corner and its distance to the current position
+  !*************************************************************************
+
+  ix=int(xt)
+  jy=int(yt)
+  ixp=ix+1
+  jyp=jy+1
+  ddx=xt-real(ix)
+  ddy=yt-real(jy)
+  rddx=1.-ddx
+  rddy=1.-ddy
+  p1=rddx*rddy
+  p2=ddx*rddy
+  p3=rddx*ddy
+  p4=ddx*ddy
+
+
+  ! Loop over 2 time steps
+  !***********************
+
+  do m=1,2
+    indexh=memind(m)
+
+    y1(m)=p1*yy1(ix ,jy ,level,indexh) &
+         + p2*yy1(ixp,jy ,level,indexh) &
+         + p3*yy1(ix ,jyp,level,indexh) &
+         + p4*yy1(ixp,jyp,level,indexh)
+    y2(m)=p1*yy2(ix ,jy ,level,indexh) &
+         + p2*yy2(ixp,jy ,level,indexh) &
+         + p3*yy2(ix ,jyp,level,indexh) &
+         + p4*yy2(ixp,jyp,level,indexh)
+    y3(m)=p1*yy3(ix ,jy ,level,indexh) &
+         + p2*yy3(ixp,jy ,level,indexh) &
+         + p3*yy3(ix ,jyp,level,indexh) &
+         + p4*yy3(ixp,jyp,level,indexh)
+  end do
+
+
+  !************************************
+  ! 2.) Temporal interpolation (linear)
+  !************************************
+
+  dt1=real(itime-itime1)
+  dt2=real(itime2-itime)
+  dt=dt1+dt2
+
+  yint1=(y1(1)*dt2+y1(2)*dt1)/dt
+  yint2=(y2(1)*dt2+y2(2)*dt1)/dt
+  yint3=(y3(1)*dt2+y3(2)*dt1)/dt
+
+
+end subroutine interpol_rain
Index: /branches/FP_AI/src/interpol_rain_nests.f90
===================================================================
--- /branches/FP_AI/src/interpol_rain_nests.f90	(revision 23)
+++ /branches/FP_AI/src/interpol_rain_nests.f90	(revision 23)
@@ -0,0 +1,152 @@
+!**********************************************************************
+! 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 interpol_rain_nests(yy1,yy2,yy3,nxmaxn,nymaxn,nzmax, &
+       maxnests,ngrid,nxn,nyn,memind,xt,yt,level,itime1,itime2,itime, &
+       yint1,yint2,yint3)
+  !                                i   i   i    i      i      i
+  !   i       i    i   i    i    i  i    i     i      i      i
+  !  o     o     o
+  !****************************************************************************
+  !                                                                           *
+  !  Interpolation of meteorological fields on 2-d model layers for nested    *
+  !  grids. This routine is related to levlin3interpol.f for the mother domain*
+  !                                                                           *
+  !  In horizontal direction bilinear interpolation interpolation is used.    *
+  !  Temporally a linear interpolation is used.                               *
+  !  Three fields are interpolated at the same time.                          *
+  !                                                                           *
+  !  This is a special version of levlininterpol to save CPU time.            *
+  !                                                                           *
+  !  1 first time                                                             *
+  !  2 second time                                                            *
+  !                                                                           *
+  !                                                                           *
+  !     Author: A. Stohl                                                      *
+  !                                                                           *
+  !     15 March 2000                                                         *
+  !                                                                           *
+  !****************************************************************************
+  !                                                                           *
+  ! Variables:                                                                *
+  !                                                                           *
+  ! dt1,dt2              time differences between fields and current position *
+  ! dz1,dz2              z distance between levels and current position       *
+  ! height(nzmax)        heights of the model levels                          *
+  ! indexh               help variable                                        *
+  ! indz                 the level closest to the current trajectory position *
+  ! indzh                help variable                                        *
+  ! itime                current time                                         *
+  ! itime1               time of the first wind field                         *
+  ! itime2               time of the second wind field                        *
+  ! ix,jy                x,y coordinates of lower left subgrid point          *
+  ! level                level at which interpolation shall be done           *
+  ! memind(3)            points to the places of the wind fields              *
+  ! nx,ny                actual field dimensions in x,y and z direction       *
+  ! nxmax,nymax,nzmax    maximum field dimensions in x,y and z direction      *
+  ! xt                   current x coordinate                                 *
+  ! yint                 the final interpolated value                         *
+  ! yt                   current y coordinate                                 *
+  ! yy(0:nxmax,0:nymax,nzmax,3) meteorological field used for interpolation   *
+  ! zt                   current z coordinate                                 *
+  !                                                                           *
+  !****************************************************************************
+
+  implicit none
+
+  integer :: maxnests,ngrid
+  integer :: nxn(maxnests),nyn(maxnests),nxmaxn,nymaxn,nzmax,memind(2)
+  integer :: m,ix,jy,ixp,jyp,itime,itime1,itime2,level,indexh
+  real :: yy1(0:nxmaxn-1,0:nymaxn-1,nzmax,2,maxnests)
+  real :: yy2(0:nxmaxn-1,0:nymaxn-1,nzmax,2,maxnests)
+  real :: yy3(0:nxmaxn-1,0:nymaxn-1,nzmax,2,maxnests)
+  real :: ddx,ddy,rddx,rddy,dt1,dt2,dt,y1(2),y2(2),y3(2)
+  real :: xt,yt,yint1,yint2,yint3,p1,p2,p3,p4
+
+
+
+  ! If point at border of grid -> small displacement into grid
+  !***********************************************************
+
+  if (xt.ge.(real(nxn(ngrid)-1)-0.0001)) &
+       xt=real(nxn(ngrid)-1)-0.0001
+  if (yt.ge.(real(nyn(ngrid)-1)-0.0001)) &
+       yt=real(nyn(ngrid)-1)-0.0001
+
+
+
+  !**********************************************************************
+  ! 1.) Bilinear horizontal interpolation
+  ! This has to be done separately for 2 fields (Temporal)
+  !*******************************************************
+
+  ! Determine the lower left corner and its distance to the current position
+  !*************************************************************************
+
+  ix=int(xt)
+  jy=int(yt)
+  ixp=ix+1
+  jyp=jy+1
+  ddx=xt-real(ix)
+  ddy=yt-real(jy)
+  rddx=1.-ddx
+  rddy=1.-ddy
+  p1=rddx*rddy
+  p2=ddx*rddy
+  p3=rddx*ddy
+  p4=ddx*ddy
+
+
+  ! Loop over 2 time steps
+  !***********************
+
+  do m=1,2
+    indexh=memind(m)
+
+    y1(m)=p1*yy1(ix ,jy ,level,indexh,ngrid) &
+         + p2*yy1(ixp,jy ,level,indexh,ngrid) &
+         + p3*yy1(ix ,jyp,level,indexh,ngrid) &
+         + p4*yy1(ixp,jyp,level,indexh,ngrid)
+    y2(m)=p1*yy2(ix ,jy ,level,indexh,ngrid) &
+         + p2*yy2(ixp,jy ,level,indexh,ngrid) &
+         + p3*yy2(ix ,jyp,level,indexh,ngrid) &
+         + p4*yy2(ixp,jyp,level,indexh,ngrid)
+    y3(m)=p1*yy3(ix ,jy ,level,indexh,ngrid) &
+         + p2*yy3(ixp,jy ,level,indexh,ngrid) &
+         + p3*yy3(ix ,jyp,level,indexh,ngrid) &
+         + p4*yy3(ixp,jyp,level,indexh,ngrid)
+  end do
+
+
+  !************************************
+  ! 2.) Temporal interpolation (linear)
+  !************************************
+
+  dt1=real(itime-itime1)
+  dt2=real(itime2-itime)
+  dt=dt1+dt2
+
+  yint1=(y1(1)*dt2+y1(2)*dt1)/dt
+  yint2=(y2(1)*dt2+y2(2)*dt1)/dt
+  yint3=(y3(1)*dt2+y3(2)*dt1)/dt
+
+
+end subroutine interpol_rain_nests
Index: /branches/FP_AI/src/interpol_vdep.f90
===================================================================
--- /branches/FP_AI/src/interpol_vdep.f90	(revision 23)
+++ /branches/FP_AI/src/interpol_vdep.f90	(revision 23)
@@ -0,0 +1,75 @@
+!**********************************************************************
+! 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 interpol_vdep(level,vdepo)
+  !                           i     o
+  !****************************************************************************
+  !                                                                           *
+  !  Interpolation of the deposition velocity on 2-d model layer.             *
+  !  In horizontal direction bilinear interpolation interpolation is used.    *
+  !  Temporally a linear interpolation is used.                               *
+  !                                                                           *
+  !  1 first time                                                             *
+  !  2 second time                                                            *
+  !                                                                           *
+  !                                                                           *
+  !     Author: A. Stohl                                                      *
+  !                                                                           *
+  !     30 May 1994                                                           *
+  !                                                                           *
+  !****************************************************************************
+  !                                                                           *
+  ! Variables:                                                                *
+  !                                                                           *
+  ! level                number of species for which interpolation is done    *
+  !                                                                           *
+  !****************************************************************************
+
+  use par_mod
+  use com_mod
+  use interpol_mod
+
+  implicit none
+
+  integer :: level,indexh,m
+  real :: y(2),vdepo
+
+  ! a) Bilinear horizontal interpolation
+
+  do m=1,2
+    indexh=memind(m)
+
+    y(m)=p1*vdep(ix ,jy ,level,indexh) &
+         +p2*vdep(ixp,jy ,level,indexh) &
+         +p3*vdep(ix ,jyp,level,indexh) &
+         +p4*vdep(ixp,jyp,level,indexh)
+  end do
+
+
+
+  ! b) Temporal interpolation
+
+  vdepo=(y(1)*dt2+y(2)*dt1)*dtt
+
+  depoindicator(level)=.false.
+
+
+end subroutine interpol_vdep
Index: /branches/FP_AI/src/interpol_vdep_nests.f90
===================================================================
--- /branches/FP_AI/src/interpol_vdep_nests.f90	(revision 23)
+++ /branches/FP_AI/src/interpol_vdep_nests.f90	(revision 23)
@@ -0,0 +1,74 @@
+!**********************************************************************
+! 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 interpol_vdep_nests(level,vdepo)
+  !                                 i     o
+  !****************************************************************************
+  !                                                                           *
+  !  Interpolation of the deposition velocity on 2-d model layer.             *
+  !  In horizontal direction bilinear interpolation interpolation is used.    *
+  !  Temporally a linear interpolation is used.                               *
+  !                                                                           *
+  !  1 first time                                                             *
+  !  2 second time                                                            *
+  !                                                                           *
+  !                                                                           *
+  !     Author: A. Stohl                                                      *
+  !                                                                           *
+  !     30 May 1994                                                           *
+  !                                                                           *
+  !****************************************************************************
+  !                                                                           *
+  ! Variables:                                                                *
+  !                                                                           *
+  ! level                number of species for which interpolation is done    *
+  !                                                                           *
+  !****************************************************************************
+
+  use par_mod
+  use com_mod
+  use interpol_mod
+
+  implicit none
+
+  integer :: level,indexh,m
+  real :: y(2),vdepo
+
+  ! a) Bilinear horizontal interpolation
+
+  do m=1,2
+    indexh=memind(m)
+
+    y(m)=p1*vdepn(ix ,jy ,level,indexh,ngrid) &
+         +p2*vdepn(ixp,jy ,level,indexh,ngrid) &
+         +p3*vdepn(ix ,jyp,level,indexh,ngrid) &
+         +p4*vdepn(ixp,jyp,level,indexh,ngrid)
+  end do
+
+
+  ! b) Temporal interpolation
+
+  vdepo=(y(1)*dt2+y(2)*dt1)*dtt
+
+  depoindicator(level)=.false.
+
+
+end subroutine interpol_vdep_nests
Index: /branches/FP_AI/src/interpol_wind.f90
===================================================================
--- /branches/FP_AI/src/interpol_wind.f90	(revision 23)
+++ /branches/FP_AI/src/interpol_wind.f90	(revision 23)
@@ -0,0 +1,234 @@
+!**********************************************************************
+! 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 interpol_wind(itime,xt,yt,zt)
+  !                           i   i  i  i
+  !*****************************************************************************
+  !                                                                            *
+  !  This subroutine interpolates the wind data to current trajectory position.*
+  !                                                                            *
+  !    Author: A. Stohl                                                        *
+  !                                                                            *
+  !    16 December 1997                                                        *
+  !                                                                            *
+  !  Revision March 2005 by AST : all output variables in common block cal-    *
+  !                               culation of standard deviation done in this  *
+  !                               routine rather than subroutine call in order *
+  !                               to save computation time                     *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! u,v,w              wind components                                         *
+  ! itime [s]          current temporal position                               *
+  ! memtime(3) [s]     times of the wind fields in memory                      *
+  ! xt,yt,zt           coordinates position for which wind data shall be       *
+  !                    calculated                                              *
+  !                                                                            *
+  ! Constants:                                                                 *
+  !                                                                            *
+  !*****************************************************************************
+
+  use par_mod
+  use com_mod
+  use interpol_mod
+
+  implicit none
+
+  integer :: itime
+  real :: xt,yt,zt
+
+  ! Auxiliary variables needed for interpolation
+  real :: dz1,dz2,dz
+  real :: u1(2),v1(2),w1(2),uh(2),vh(2),wh(2)
+  real :: usl,vsl,wsl,usq,vsq,wsq,xaux
+  integer :: i,m,n,indexh,indzh
+  real,parameter :: eps=1.0e-30
+
+
+  !********************************************
+  ! Multilinear interpolation in time and space
+  !********************************************
+
+  ! Determine the lower left corner and its distance to the current position
+  !*************************************************************************
+
+  ddx=xt-real(ix)
+  ddy=yt-real(jy)
+  rddx=1.-ddx
+  rddy=1.-ddy
+  p1=rddx*rddy
+  p2=ddx*rddy
+  p3=rddx*ddy
+  p4=ddx*ddy
+
+  ! Calculate variables for time interpolation
+  !*******************************************
+
+  dt1=real(itime-memtime(1))
+  dt2=real(memtime(2)-itime)
+  dtt=1./(dt1+dt2)
+
+  ! Determine the level below the current position for u,v
+  !*******************************************************
+
+  do i=2,nz
+    if (height(i).gt.zt) then
+      indz=i-1
+      goto 6
+    endif
+  end do
+6   continue
+
+
+  ! Vertical distance to the level below and above current position
+  !****************************************************************
+
+  dz=1./(height(indz+1)-height(indz))
+  dz1=(zt-height(indz))*dz
+  dz2=(height(indz+1)-zt)*dz
+
+  !**********************************************************************
+  ! 1.) Bilinear horizontal interpolation
+  ! This has to be done separately for 6 fields (Temporal(2)*Vertical(3))
+  !**********************************************************************
+
+  ! Loop over 2 time steps and 2 levels
+  !************************************
+
+  usl=0.
+  vsl=0.
+  wsl=0.
+  usq=0.
+  vsq=0.
+  wsq=0.
+  do m=1,2
+    indexh=memind(m)
+    do n=1,2
+      indzh=indz+n-1
+
+      if (ngrid.lt.0) then
+        u1(n)=p1*uupol(ix ,jy ,indzh,indexh) &
+             +p2*uupol(ixp,jy ,indzh,indexh) &
+             +p3*uupol(ix ,jyp,indzh,indexh) &
+             +p4*uupol(ixp,jyp,indzh,indexh)
+        v1(n)=p1*vvpol(ix ,jy ,indzh,indexh) &
+             +p2*vvpol(ixp,jy ,indzh,indexh) &
+             +p3*vvpol(ix ,jyp,indzh,indexh) &
+             +p4*vvpol(ixp,jyp,indzh,indexh)
+        usl=usl+uupol(ix ,jy ,indzh,indexh)+ &
+             uupol(ixp,jy ,indzh,indexh) &
+             +uupol(ix ,jyp,indzh,indexh)+uupol(ixp,jyp,indzh,indexh)
+        vsl=vsl+vvpol(ix ,jy ,indzh,indexh)+ &
+             vvpol(ixp,jy ,indzh,indexh) &
+             +vvpol(ix ,jyp,indzh,indexh)+vvpol(ixp,jyp,indzh,indexh)
+
+        usq=usq+uupol(ix ,jy ,indzh,indexh)* &
+             uupol(ix ,jy ,indzh,indexh)+ &
+             uupol(ixp,jy ,indzh,indexh)*uupol(ixp,jy ,indzh,indexh)+ &
+             uupol(ix ,jyp,indzh,indexh)*uupol(ix ,jyp,indzh,indexh)+ &
+             uupol(ixp,jyp,indzh,indexh)*uupol(ixp,jyp,indzh,indexh)
+        vsq=vsq+vvpol(ix ,jy ,indzh,indexh)* &
+             vvpol(ix ,jy ,indzh,indexh)+ &
+             vvpol(ixp,jy ,indzh,indexh)*vvpol(ixp,jy ,indzh,indexh)+ &
+             vvpol(ix ,jyp,indzh,indexh)*vvpol(ix ,jyp,indzh,indexh)+ &
+             vvpol(ixp,jyp,indzh,indexh)*vvpol(ixp,jyp,indzh,indexh)
+      else
+        u1(n)=p1*uu(ix ,jy ,indzh,indexh) &
+             +p2*uu(ixp,jy ,indzh,indexh) &
+             +p3*uu(ix ,jyp,indzh,indexh) &
+             +p4*uu(ixp,jyp,indzh,indexh)
+        v1(n)=p1*vv(ix ,jy ,indzh,indexh) &
+             +p2*vv(ixp,jy ,indzh,indexh) &
+             +p3*vv(ix ,jyp,indzh,indexh) &
+             +p4*vv(ixp,jyp,indzh,indexh)
+        usl=usl+uu(ix ,jy ,indzh,indexh)+uu(ixp,jy ,indzh,indexh) &
+             +uu(ix ,jyp,indzh,indexh)+uu(ixp,jyp,indzh,indexh)
+        vsl=vsl+vv(ix ,jy ,indzh,indexh)+vv(ixp,jy ,indzh,indexh) &
+             +vv(ix ,jyp,indzh,indexh)+vv(ixp,jyp,indzh,indexh)
+
+        usq=usq+uu(ix ,jy ,indzh,indexh)*uu(ix ,jy ,indzh,indexh)+ &
+             uu(ixp,jy ,indzh,indexh)*uu(ixp,jy ,indzh,indexh)+ &
+             uu(ix ,jyp,indzh,indexh)*uu(ix ,jyp,indzh,indexh)+ &
+             uu(ixp,jyp,indzh,indexh)*uu(ixp,jyp,indzh,indexh)
+        vsq=vsq+vv(ix ,jy ,indzh,indexh)*vv(ix ,jy ,indzh,indexh)+ &
+             vv(ixp,jy ,indzh,indexh)*vv(ixp,jy ,indzh,indexh)+ &
+             vv(ix ,jyp,indzh,indexh)*vv(ix ,jyp,indzh,indexh)+ &
+             vv(ixp,jyp,indzh,indexh)*vv(ixp,jyp,indzh,indexh)
+      endif
+      w1(n)=p1*ww(ix ,jy ,indzh,indexh) &
+           +p2*ww(ixp,jy ,indzh,indexh) &
+           +p3*ww(ix ,jyp,indzh,indexh) &
+           +p4*ww(ixp,jyp,indzh,indexh)
+      wsl=wsl+ww(ix ,jy ,indzh,indexh)+ww(ixp,jy ,indzh,indexh) &
+           +ww(ix ,jyp,indzh,indexh)+ww(ixp,jyp,indzh,indexh)
+      wsq=wsq+ww(ix ,jy ,indzh,indexh)*ww(ix ,jy ,indzh,indexh)+ &
+           ww(ixp,jy ,indzh,indexh)*ww(ixp,jy ,indzh,indexh)+ &
+           ww(ix ,jyp,indzh,indexh)*ww(ix ,jyp,indzh,indexh)+ &
+           ww(ixp,jyp,indzh,indexh)*ww(ixp,jyp,indzh,indexh)
+    end do
+
+
+  !**********************************
+  ! 2.) Linear vertical interpolation
+  !**********************************
+
+    uh(m)=dz2*u1(1)+dz1*u1(2)
+    vh(m)=dz2*v1(1)+dz1*v1(2)
+    wh(m)=dz2*w1(1)+dz1*w1(2)
+  end do
+
+
+  !************************************
+  ! 3.) Temporal interpolation (linear)
+  !************************************
+
+  u=(uh(1)*dt2+uh(2)*dt1)*dtt
+  v=(vh(1)*dt2+vh(2)*dt1)*dtt
+  w=(wh(1)*dt2+wh(2)*dt1)*dtt
+
+
+  ! Compute standard deviations
+  !****************************
+
+  xaux=usq-usl*usl/16.
+  if (xaux.lt.eps) then
+    usig=0.
+  else
+    usig=sqrt(xaux/15.)
+  endif
+
+  xaux=vsq-vsl*vsl/16.
+  if (xaux.lt.eps) then
+    vsig=0.
+  else
+    vsig=sqrt(xaux/15.)
+  endif
+
+
+  xaux=wsq-wsl*wsl/16.
+  if (xaux.lt.eps) then
+    wsig=0.
+  else
+    wsig=sqrt(xaux/15.)
+  endif
+
+end subroutine interpol_wind
Index: /branches/FP_AI/src/interpol_wind_nests.f90
===================================================================
--- /branches/FP_AI/src/interpol_wind_nests.f90	(revision 23)
+++ /branches/FP_AI/src/interpol_wind_nests.f90	(revision 23)
@@ -0,0 +1,218 @@
+!**********************************************************************
+! 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 interpol_wind_nests(itime,xt,yt,zt)
+  !                                 i   i  i  i
+  !*****************************************************************************
+  !                                                                            *
+  !  This subroutine interpolates the wind data to current trajectory position.*
+  !                                                                            *
+  !    Author: A. Stohl                                                        *
+  !                                                                            *
+  !    16 December 1997                                                        *
+  !    16 December 1997                                                        *
+  !                                                                            *
+  !  Revision March 2005 by AST : all output variables in common block cal-    *
+  !                               culation of standard deviation done in this  *
+  !                               routine rather than subroutine call in order *
+  !                               to save computation time                     *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! u,v,w              wind components                                         *
+  ! itime [s]          current temporal position                               *
+  ! memtime(3) [s]     times of the wind fields in memory                      *
+  ! xt,yt,zt           coordinates position for which wind data shall be       *
+  !                    calculated                                              *
+  !                                                                            *
+  ! Constants:                                                                 *
+  !                                                                            *
+  !*****************************************************************************
+
+  use par_mod
+  use com_mod
+  use interpol_mod
+
+  implicit none
+
+  integer :: itime
+  real :: xt,yt,zt
+
+  ! Auxiliary variables needed for interpolation
+  real :: dz1,dz2,dz
+  real :: u1(2),v1(2),w1(2),uh(2),vh(2),wh(2)
+  real :: usl,vsl,wsl,usq,vsq,wsq,xaux
+  integer :: i,m,n,indexh,indzh
+  real,parameter :: eps=1.0e-30
+
+
+  !********************************************
+  ! Multilinear interpolation in time and space
+  !********************************************
+
+  ! Determine the lower left corner and its distance to the current position
+  !*************************************************************************
+
+  ddx=xt-real(ix)
+  ddy=yt-real(jy)
+  rddx=1.-ddx
+  rddy=1.-ddy
+  p1=rddx*rddy
+  p2=ddx*rddy
+  p3=rddx*ddy
+  p4=ddx*ddy
+
+  ! Calculate variables for time interpolation
+  !*******************************************
+
+  dt1=real(itime-memtime(1))
+  dt2=real(memtime(2)-itime)
+  dtt=1./(dt1+dt2)
+
+  ! Determine the level below the current position for u,v
+  !*******************************************************
+
+  do i=2,nz
+    if (height(i).gt.zt) then
+      indz=i-1
+      goto 6
+    endif
+  end do
+6   continue
+
+
+  ! Vertical distance to the level below and above current position
+  !****************************************************************
+
+  dz=1./(height(indz+1)-height(indz))
+  dz1=(zt-height(indz))*dz
+  dz2=(height(indz+1)-zt)*dz
+
+
+  !**********************************************************************
+  ! 1.) Bilinear horizontal interpolation
+  ! This has to be done separately for 6 fields (Temporal(2)*Vertical(3))
+  !**********************************************************************
+
+  ! Loop over 2 time steps and 2 levels
+  !************************************
+
+  usl=0.
+  vsl=0.
+  wsl=0.
+  usq=0.
+  vsq=0.
+  wsq=0.
+  do m=1,2
+    indexh=memind(m)
+    do n=1,2
+      indzh=indz+n-1
+
+      u1(n)=p1*uun(ix ,jy ,indzh,indexh,ngrid) &
+           +p2*uun(ixp,jy ,indzh,indexh,ngrid) &
+           +p3*uun(ix ,jyp,indzh,indexh,ngrid) &
+           +p4*uun(ixp,jyp,indzh,indexh,ngrid)
+      v1(n)=p1*vvn(ix ,jy ,indzh,indexh,ngrid) &
+           +p2*vvn(ixp,jy ,indzh,indexh,ngrid) &
+           +p3*vvn(ix ,jyp,indzh,indexh,ngrid) &
+           +p4*vvn(ixp,jyp,indzh,indexh,ngrid)
+      w1(n)=p1*wwn(ix ,jy ,indzh,indexh,ngrid) &
+           +p2*wwn(ixp,jy ,indzh,indexh,ngrid) &
+           +p3*wwn(ix ,jyp,indzh,indexh,ngrid) &
+           +p4*wwn(ixp,jyp,indzh,indexh,ngrid)
+
+      usl=usl+uun(ix ,jy ,indzh,indexh,ngrid)+ &
+           uun(ixp,jy ,indzh,indexh,ngrid) &
+           +uun(ix ,jyp,indzh,indexh,ngrid)+ &
+           uun(ixp,jyp,indzh,indexh,ngrid)
+      vsl=vsl+vvn(ix ,jy ,indzh,indexh,ngrid)+ &
+           vvn(ixp,jy ,indzh,indexh,ngrid) &
+           +vvn(ix ,jyp,indzh,indexh,ngrid)+ &
+           vvn(ixp,jyp,indzh,indexh,ngrid)
+      wsl=wsl+wwn(ix ,jy ,indzh,indexh,ngrid)+ &
+           wwn(ixp,jy ,indzh,indexh,ngrid) &
+           +wwn(ix ,jyp,indzh,indexh,ngrid)+ &
+           wwn(ixp,jyp,indzh,indexh,ngrid)
+
+      usq=usq+uun(ix ,jy ,indzh,indexh,ngrid)* &
+           uun(ix ,jy ,indzh,indexh,ngrid)+ &
+           uun(ixp,jy ,indzh,indexh,ngrid)*uun(ixp,jy ,indzh,indexh,ngrid)+ &
+           uun(ix ,jyp,indzh,indexh,ngrid)*uun(ix ,jyp,indzh,indexh,ngrid)+ &
+           uun(ixp,jyp,indzh,indexh,ngrid)*uun(ixp,jyp,indzh,indexh,ngrid)
+      vsq=vsq+vvn(ix ,jy ,indzh,indexh,ngrid)* &
+           vvn(ix ,jy ,indzh,indexh,ngrid)+ &
+           vvn(ixp,jy ,indzh,indexh,ngrid)*vvn(ixp,jy ,indzh,indexh,ngrid)+ &
+           vvn(ix ,jyp,indzh,indexh,ngrid)*vvn(ix ,jyp,indzh,indexh,ngrid)+ &
+           vvn(ixp,jyp,indzh,indexh,ngrid)*vvn(ixp,jyp,indzh,indexh,ngrid)
+      wsq=wsq+wwn(ix ,jy ,indzh,indexh,ngrid)* &
+           wwn(ix ,jy ,indzh,indexh,ngrid)+ &
+           wwn(ixp,jy ,indzh,indexh,ngrid)*wwn(ixp,jy ,indzh,indexh,ngrid)+ &
+           wwn(ix ,jyp,indzh,indexh,ngrid)*wwn(ix ,jyp,indzh,indexh,ngrid)+ &
+           wwn(ixp,jyp,indzh,indexh,ngrid)*wwn(ixp,jyp,indzh,indexh,ngrid)
+    end do
+
+
+  !**********************************
+  ! 2.) Linear vertical interpolation
+  !**********************************
+
+    uh(m)=dz2*u1(1)+dz1*u1(2)
+    vh(m)=dz2*v1(1)+dz1*v1(2)
+    wh(m)=dz2*w1(1)+dz1*w1(2)
+  end do
+
+
+  !************************************
+  ! 3.) Temporal interpolation (linear)
+  !************************************
+
+  u=(uh(1)*dt2+uh(2)*dt1)*dtt
+  v=(vh(1)*dt2+vh(2)*dt1)*dtt
+  w=(wh(1)*dt2+wh(2)*dt1)*dtt
+
+
+  ! Compute standard deviations
+  !****************************
+
+  xaux=usq-usl*usl/16.
+  if (xaux.lt.eps) then
+    usig=0.
+  else
+    usig=sqrt(xaux/15.)
+  endif
+
+  xaux=vsq-vsl*vsl/16.
+  if (xaux.lt.eps) then
+    vsig=0.
+  else
+    vsig=sqrt(xaux/15.)
+  endif
+
+
+  xaux=wsq-wsl*wsl/16.
+  if (xaux.lt.eps) then
+    wsig=0.
+  else
+    wsig=sqrt(xaux/15.)
+  endif
+
+end subroutine interpol_wind_nests
Index: /branches/FP_AI/src/interpol_wind_short.f90
===================================================================
--- /branches/FP_AI/src/interpol_wind_short.f90	(revision 23)
+++ /branches/FP_AI/src/interpol_wind_short.f90	(revision 23)
@@ -0,0 +1,160 @@
+!**********************************************************************
+! 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 interpol_wind_short(itime,xt,yt,zt)
+  !                                 i   i  i  i
+  !*****************************************************************************
+  !                                                                            *
+  !  This subroutine interpolates the wind data to current trajectory position.*
+  !                                                                            *
+  !    Author: A. Stohl                                                        *
+  !                                                                            *
+  !    16 December 1997                                                        *
+  !                                                                            *
+  !  Revision March 2005 by AST : all output variables in common block         *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! u,v,w              wind components                                         *
+  ! itime [s]          current temporal position                               *
+  ! memtime(3) [s]     times of the wind fields in memory                      *
+  ! xt,yt,zt           coordinates position for which wind data shall be       *
+  !                    calculated                                              *
+  !                                                                            *
+  ! Constants:                                                                 *
+  !                                                                            *
+  !*****************************************************************************
+
+  use par_mod
+  use com_mod
+  use interpol_mod
+
+  implicit none
+
+  integer :: itime
+  real :: xt,yt,zt
+
+  ! Auxiliary variables needed for interpolation
+  real :: dz1,dz2,dz
+  real :: u1(2),v1(2),w1(2),uh(2),vh(2),wh(2)
+  integer :: i,m,n,indexh,indzh
+
+
+  !********************************************
+  ! Multilinear interpolation in time and space
+  !********************************************
+
+  ddx=xt-real(ix)
+  ddy=yt-real(jy)
+  rddx=1.-ddx
+  rddy=1.-ddy
+  p1=rddx*rddy
+  p2=ddx*rddy
+  p3=rddx*ddy
+  p4=ddx*ddy
+
+  ! Calculate variables for time interpolation
+  !*******************************************
+
+  dt1=real(itime-memtime(1))
+  dt2=real(memtime(2)-itime)
+  dtt=1./(dt1+dt2)
+
+  ! Determine the level below the current position for u,v
+  !*******************************************************
+
+  do i=2,nz
+    if (height(i).gt.zt) then
+      indz=i-1
+      goto 6
+    endif
+  end do
+6   continue
+
+
+  ! Vertical distance to the level below and above current position
+  !****************************************************************
+
+  dz=1./(height(indz+1)-height(indz))
+  dz1=(zt-height(indz))*dz
+  dz2=(height(indz+1)-zt)*dz
+
+
+  !**********************************************************************
+  ! 1.) Bilinear horizontal interpolation
+  ! This has to be done separately for 6 fields (Temporal(2)*Vertical(3))
+  !**********************************************************************
+
+  ! Loop over 2 time steps and 2 levels
+  !************************************
+
+  do m=1,2
+    indexh=memind(m)
+    do n=1,2
+      indzh=indz+n-1
+
+      if (ngrid.lt.0) then
+        u1(n)=p1*uupol(ix ,jy ,indzh,indexh) &
+             +p2*uupol(ixp,jy ,indzh,indexh) &
+             +p3*uupol(ix ,jyp,indzh,indexh) &
+             +p4*uupol(ixp,jyp,indzh,indexh)
+        v1(n)=p1*vvpol(ix ,jy ,indzh,indexh) &
+             +p2*vvpol(ixp,jy ,indzh,indexh) &
+             +p3*vvpol(ix ,jyp,indzh,indexh) &
+             +p4*vvpol(ixp,jyp,indzh,indexh)
+      else
+        u1(n)=p1*uu(ix ,jy ,indzh,indexh) &
+             +p2*uu(ixp,jy ,indzh,indexh) &
+             +p3*uu(ix ,jyp,indzh,indexh) &
+             +p4*uu(ixp,jyp,indzh,indexh)
+        v1(n)=p1*vv(ix ,jy ,indzh,indexh) &
+             +p2*vv(ixp,jy ,indzh,indexh) &
+             +p3*vv(ix ,jyp,indzh,indexh) &
+             +p4*vv(ixp,jyp,indzh,indexh)
+      endif
+      w1(n)=p1*ww(ix ,jy ,indzh,indexh) &
+           +p2*ww(ixp,jy ,indzh,indexh) &
+           +p3*ww(ix ,jyp,indzh,indexh) &
+           +p4*ww(ixp,jyp,indzh,indexh)
+    end do
+
+
+  !**********************************
+  ! 2.) Linear vertical interpolation
+  !**********************************
+
+    uh(m)=dz2*u1(1)+dz1*u1(2)
+    vh(m)=dz2*v1(1)+dz1*v1(2)
+    wh(m)=dz2*w1(1)+dz1*w1(2)
+  end do
+
+
+
+  !************************************
+  ! 3.) Temporal interpolation (linear)
+  !************************************
+
+  u=(uh(1)*dt2+uh(2)*dt1)*dtt
+  v=(vh(1)*dt2+vh(2)*dt1)*dtt
+  w=(wh(1)*dt2+wh(2)*dt1)*dtt
+
+end subroutine interpol_wind_short
Index: /branches/FP_AI/src/interpol_wind_short_nests.f90
===================================================================
--- /branches/FP_AI/src/interpol_wind_short_nests.f90	(revision 23)
+++ /branches/FP_AI/src/interpol_wind_short_nests.f90	(revision 23)
@@ -0,0 +1,149 @@
+!**********************************************************************
+! 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 interpol_wind_short_nests(itime,xt,yt,zt)
+  !                                       i   i  i  i
+  !*****************************************************************************
+  !                                                                            *
+  !  This subroutine interpolates the wind data to current trajectory position.*
+  !                                                                            *
+  !    Author: A. Stohl                                                        *
+  !                                                                            *
+  !    16 December 1997                                                        *
+  !                                                                            *
+  !  Revision March 2005 by AST : all output variables in common block         *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! u,v,w              wind components                                         *
+  ! itime [s]          current temporal position                               *
+  ! memtime(3) [s]     times of the wind fields in memory                      *
+  ! xt,yt,zt           coordinates position for which wind data shall be       *
+  !                    calculated                                              *
+  !                                                                            *
+  ! Constants:                                                                 *
+  !                                                                            *
+  !*****************************************************************************
+
+  use par_mod
+  use com_mod
+  use interpol_mod
+
+  implicit none
+
+  integer :: itime
+  real :: xt,yt,zt
+
+  ! Auxiliary variables needed for interpolation
+  real :: dz1,dz2,dz
+  real :: u1(2),v1(2),w1(2),uh(2),vh(2),wh(2)
+  integer :: i,m,n,indexh,indzh
+
+
+  !********************************************
+  ! Multilinear interpolation in time and space
+  !********************************************
+
+  ddx=xt-real(ix)
+  ddy=yt-real(jy)
+  rddx=1.-ddx
+  rddy=1.-ddy
+  p1=rddx*rddy
+  p2=ddx*rddy
+  p3=rddx*ddy
+  p4=ddx*ddy
+
+  ! Calculate variables for time interpolation
+  !*******************************************
+
+  dt1=real(itime-memtime(1))
+  dt2=real(memtime(2)-itime)
+  dtt=1./(dt1+dt2)
+
+  ! Determine the level below the current position for u,v
+  !*******************************************************
+
+  do i=2,nz
+    if (height(i).gt.zt) then
+      indz=i-1
+      goto 6
+    endif
+  end do
+6   continue
+
+
+  ! Vertical distance to the level below and above current position
+  !****************************************************************
+
+  dz=1./(height(indz+1)-height(indz))
+  dz1=(zt-height(indz))*dz
+  dz2=(height(indz+1)-zt)*dz
+
+
+  !**********************************************************************
+  ! 1.) Bilinear horizontal interpolation
+  ! This has to be done separately for 6 fields (Temporal(2)*Vertical(3))
+  !**********************************************************************
+
+  ! Loop over 2 time steps and 2 levels
+  !************************************
+
+  do m=1,2
+    indexh=memind(m)
+    do n=1,2
+      indzh=indz+n-1
+
+      u1(n)=p1*uun(ix ,jy ,indzh,indexh,ngrid) &
+           +p2*uun(ixp,jy ,indzh,indexh,ngrid) &
+           +p3*uun(ix ,jyp,indzh,indexh,ngrid) &
+           +p4*uun(ixp,jyp,indzh,indexh,ngrid)
+      v1(n)=p1*vvn(ix ,jy ,indzh,indexh,ngrid) &
+           +p2*vvn(ixp,jy ,indzh,indexh,ngrid) &
+           +p3*vvn(ix ,jyp,indzh,indexh,ngrid) &
+           +p4*vvn(ixp,jyp,indzh,indexh,ngrid)
+      w1(n)=p1*wwn(ix ,jy ,indzh,indexh,ngrid) &
+           +p2*wwn(ixp,jy ,indzh,indexh,ngrid) &
+           +p3*wwn(ix ,jyp,indzh,indexh,ngrid) &
+           +p4*wwn(ixp,jyp,indzh,indexh,ngrid)
+
+    end do
+
+
+  !**********************************
+  ! 2.) Linear vertical interpolation
+  !**********************************
+
+    uh(m)=dz2*u1(1)+dz1*u1(2)
+    vh(m)=dz2*v1(1)+dz1*v1(2)
+    wh(m)=dz2*w1(1)+dz1*w1(2)
+  end do
+
+
+  !************************************
+  ! 3.) Temporal interpolation (linear)
+  !************************************
+
+  u=(uh(1)*dt2+uh(2)*dt1)*dtt
+  v=(vh(1)*dt2+vh(2)*dt1)*dtt
+  w=(wh(1)*dt2+wh(2)*dt1)*dtt
+
+end subroutine interpol_wind_short_nests
Index: /branches/FP_AI/src/juldate.f90
===================================================================
--- /branches/FP_AI/src/juldate.f90	(revision 23)
+++ /branches/FP_AI/src/juldate.f90	(revision 23)
@@ -0,0 +1,85 @@
+!**********************************************************************
+! 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/>.   *
+!**********************************************************************
+
+function juldate(yyyymmdd,hhmiss)
+
+  !*****************************************************************************
+  !                                                                            *
+  !     Calculates the Julian date                                             *
+  !                                                                            *
+  !     AUTHOR: Andreas Stohl (15 October 1993)                                *
+  !                                                                            *
+  !     Variables:                                                             *
+  !     dd             Day                                                     *
+  !     hh             Hour                                                    *
+  !     hhmiss         Hour, minute + second                                   *
+  !     ja,jm,jy       help variables                                          *
+  !     juldate        Julian Date                                             *
+  !     julday         help variable                                           *
+  !     mi             Minute                                                  *
+  !     mm             Month                                                   *
+  !     ss             Second                                                  *
+  !     yyyy           Year                                                    *
+  !     yyyymmddhh     Date and Time                                           *
+  !                                                                            *
+  !     Constants:                                                             *
+  !     igreg          help constant                                           *
+  !                                                                            *
+  !*****************************************************************************
+
+  use par_mod, only: dp
+
+  implicit none
+
+  integer           :: yyyymmdd,yyyy,mm,dd,hh,mi,ss,hhmiss
+  integer           :: julday,jy,jm,ja
+  integer,parameter :: igreg=15+31*(10+12*1582)
+  real(kind=dp)     :: juldate
+
+  yyyy=yyyymmdd/10000
+  mm=(yyyymmdd-10000*yyyy)/100
+  dd=yyyymmdd-10000*yyyy-100*mm
+  hh=hhmiss/10000
+  mi=(hhmiss-10000*hh)/100
+  ss=hhmiss-10000*hh-100*mi
+
+  if (yyyy.eq.0) then
+     print*, 'there is no year zero.'
+     stop
+  end if
+  if (yyyy.lt.0) yyyy=yyyy+1
+  if (mm.gt.2) then
+    jy=yyyy
+    jm=mm+1
+  else
+    jy=yyyy-1
+    jm=mm+13
+  endif
+  julday=int(365.25*jy)+int(30.6001*jm)+dd+1720995
+  if (dd+31*(mm+12*yyyy).ge.igreg) then
+    ja=int(0.01*jy)
+    julday=julday+2-ja+int(0.25*ja)
+  endif
+
+  juldate=real(julday,kind=dp)   + real(hh,kind=dp)/24._dp + &
+       real(mi,kind=dp)/1440._dp  + real(ss,kind=dp)/86400._dp
+
+end function juldate
Index: /branches/FP_AI/src/mean.f90
===================================================================
--- /branches/FP_AI/src/mean.f90	(revision 23)
+++ /branches/FP_AI/src/mean.f90	(revision 23)
@@ -0,0 +1,66 @@
+!**********************************************************************
+! 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 mean(x,xm,xs,number)
+
+  !*****************************************************************************
+  !                                                                            *
+  !  This subroutine calculates mean and standard deviation of a given element.*
+  !                                                                            *
+  !      AUTHOR: Andreas Stohl, 25 January 1994                                *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! x(number)           field of input data                                    *
+  ! xm                  mean                                                   *
+  ! xs                  standard deviation                                     *
+  ! number              number of elements of field x                          *
+  !                                                                            *
+  ! Constants:                                                                 *
+  ! eps                 tiny number                                            *
+  !                                                                            *
+  !*****************************************************************************
+
+  implicit none
+
+  integer :: number,i
+  real :: x(number),xm,xs,xl,xq,xaux
+  real,parameter :: eps=1.0e-30
+
+  xl=0.
+  xq=0.
+  do i=1,number
+    xl=xl+x(i)
+    xq=xq+x(i)*x(i)
+  end do
+
+  xm=xl/real(number)
+
+  xaux=xq-xl*xl/real(number)
+
+  if (xaux.lt.eps) then
+    xs=0.
+  else
+    xs=sqrt(xaux/real(number-1))
+  endif
+
+end subroutine mean
Index: /branches/FP_AI/src/obukhov.f90
===================================================================
--- /branches/FP_AI/src/obukhov.f90	(revision 23)
+++ /branches/FP_AI/src/obukhov.f90	(revision 23)
@@ -0,0 +1,78 @@
+!**********************************************************************
+! 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/>.   *
+!**********************************************************************
+
+real function obukhov(ps,tsurf,tdsurf,tlev,ustar,hf,akm,bkm)
+
+  !********************************************************************
+  !                                                                   *
+  !                       Author: G. WOTAWA                           *
+  !                       Date:   1994-06-27                          *
+  !                                                                   *
+  !  Update: A. Stohl, 2000-09-25, avoid division by zero by          *
+  !  setting ustar to minimum value                                   *
+  !                                                                   *
+  !********************************************************************
+  !                                                                   *
+  !     This program calculates Obukhov scale height from surface     *
+  !     meteorological data and sensible heat flux.                   *
+  !                                                                   *
+  !********************************************************************
+  !                                                                   *
+  !     INPUT:                                                        *
+  !                                                                   *
+  !     ps      surface pressure [Pa]                                 *
+  !     tsurf   surface temperature [K]                               *
+  !     tdsurf  surface dew point [K]                                 *
+  !     tlev    temperature first model level [K]                     *
+  !     ustar   scale velocity [m/s]                                  *
+  !     hf      surface sensible heat flux [W/m2]                     *
+  !     akm     ECMWF vertical discretization parameter               *
+  !     bkm     ECMWF vertical discretization parameter               *
+  !                                                                   *
+  !********************************************************************
+
+  use par_mod
+
+  implicit none
+
+  real :: akm(nwzmax),bkm(nwzmax)
+  real :: ps,tsurf,tdsurf,tlev,ustar,hf,e,ew,tv,rhoa,plev
+  real :: ak1,bk1,theta,thetastar
+
+
+  e=ew(tdsurf)                           ! vapor pressure
+  tv=tsurf*(1.+0.378*e/ps)               ! virtual temperature
+  rhoa=ps/(r_air*tv)                      ! air density
+  ak1=(akm(1)+akm(2))/2.
+  bk1=(bkm(1)+bkm(2))/2.
+  plev=ak1+bk1*ps                        ! Pressure level 1
+  theta=tlev*(100000./plev)**(r_air/cpa) ! potential temperature
+  if (ustar.le.0.) ustar=1.e-8
+  thetastar=hf/(rhoa*cpa*ustar)           ! scale temperature
+  if(abs(thetastar).gt.1.e-10) then
+     obukhov=theta*ustar**2/(karman*ga*thetastar)
+  else
+     obukhov=9999                        ! zero heat flux
+  endif
+  if (obukhov.gt. 9999.) obukhov= 9999.
+  if (obukhov.lt.-9999.) obukhov=-9999.
+
+end function obukhov
Index: /branches/FP_AI/src/obukhov_gfs.f90
===================================================================
--- /branches/FP_AI/src/obukhov_gfs.f90	(revision 23)
+++ /branches/FP_AI/src/obukhov_gfs.f90	(revision 23)
@@ -0,0 +1,76 @@
+!**********************************************************************
+! 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/>.   *
+!**********************************************************************
+
+real function obukhov(ps,tsurf,tdsurf,tlev,ustar,hf,plev)
+
+  !********************************************************************
+  !                                                                   *
+  !                       Author: G. WOTAWA                           *
+  !                       Date:   1994-06-27                          *
+  !                                                                   *
+  !  Update: A. Stohl, 2000-09-25, avoid division by zero by          *
+  !  setting ustar to minimum value                                   *
+  !                                                                   *
+  !  CHANGE: 17/11/2005 Caroline Forster NCEP GFS version             *
+  !                                                                   *
+  !********************************************************************
+  !                                                                   *
+  !     This program calculates Obukhov scale height from surface     *
+  !     meteorological data and sensible heat flux.                   *
+  !                                                                   *
+  !********************************************************************
+  !                                                                   *
+  !     INPUT:                                                        *
+  !                                                                   *
+  !     ps      surface pressure [Pa]                                 *
+  !     tsurf   surface temperature [K]                               *
+  !     tdsurf  surface dew point [K]                                 *
+  !     tlev    temperature first model level [K]                     *
+  !     ustar   scale velocity [m/s]                                  *
+  !     hf      surface sensible heat flux [W/m2]                     *
+  !     akm     ECMWF vertical discretization parameter               *
+  !     bkm     ECMWF vertical discretization parameter               *
+  !                                                                   *
+  !********************************************************************
+
+  use par_mod
+
+  implicit none
+
+  real :: ps,tsurf,tdsurf,tlev,ustar,hf,e,ew,tv,rhoa,plev
+  real :: theta,thetastar
+
+
+  e=ew(tdsurf)                           ! vapor pressure
+  tv=tsurf*(1.+0.378*e/ps)               ! virtual temperature
+  rhoa=ps/(r_air*tv)                      ! air density
+  theta=tlev*(100000./plev)**(r_air/cpa) ! potential temperature
+  if (ustar.le.0.) ustar=1.e-8
+  thetastar=hf/(rhoa*cpa*ustar)           ! scale temperature
+  if(abs(thetastar).gt.1.e-10) then
+     obukhov=theta*ustar**2/(karman*ga*thetastar)
+  else
+     obukhov=9999                        ! zero heat flux
+  endif
+  if (obukhov.gt. 9999.) obukhov= 9999.
+  if (obukhov.lt.-9999.) obukhov=-9999.
+
+end function obukhov
Index: /branches/FP_AI/src/oh_mod.f90
===================================================================
--- /branches/FP_AI/src/oh_mod.f90	(revision 23)
+++ /branches/FP_AI/src/oh_mod.f90	(revision 23)
@@ -0,0 +1,32 @@
+!**********************************************************************
+! 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/>.   *
+!**********************************************************************
+
+module oh_mod
+
+  !includes OH concentration field as well as the height information
+  !for this field
+
+  implicit none
+
+  real,allocatable, dimension (:,:,:,:) :: OH_field
+  real,allocatable, dimension (:) :: OH_field_height
+
+end module oh_mod
Index: /branches/FP_AI/src/ohreaction.f90
===================================================================
--- /branches/FP_AI/src/ohreaction.f90	(revision 23)
+++ /branches/FP_AI/src/ohreaction.f90	(revision 23)
@@ -0,0 +1,213 @@
+!**********************************************************************
+! 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 ohreaction(itime,ltsample,loutnext)
+  !                     i      i        i
+  !*****************************************************************************
+  !                                                                            *
+  !                                                                            *
+  !    Author: S. Eckhardt                                                     *
+  !                                                                            *
+  !    June 2007                                                               *
+  !                                                                            *
+  !                                                                            *
+  !*****************************************************************************
+  ! Variables:                                                                 *
+  ! ix,jy              indices of output grid cell for each particle           *
+  ! itime [s]          actual simulation time [s]                              *
+  ! jpart              particle index                                          *
+  ! ldeltat [s]        interval since radioactive decay was computed           *
+  ! loutnext [s]       time for which gridded deposition is next output        *
+  ! loutstep [s]       interval at which gridded deposition is output          *
+  ! oh_average [mol/m^3]   OH Concentration                                    *
+  ! ltsample [s]       interval over which mass is deposited                   *
+  !                                                                            *
+  !*****************************************************************************
+
+  use oh_mod
+  use par_mod
+  use com_mod
+
+  implicit none
+
+  integer :: jpart,itime,ltsample,loutnext,ldeltat,j,k,ix,jy
+  integer :: ngrid,il,interp_time,n,mm,indz,i
+  integer :: jjjjmmdd,ihmmss,OHx,OHy,dOHx,dOHy,OHz
+  real :: xtn,ytn,oh_average
+  !real oh_diurn_var,sum_ang
+  !real zenithangle, ang
+  real :: restmass,ohreacted,OHinc
+  real :: xlon, ylat, gas_const, act_energy
+  real :: ohreact_temp_corr, act_temp
+  real,parameter :: smallnum = tiny(0.0) ! smallest number that can be handled
+  real(kind=dp) :: jul
+
+  ! Compute interval since radioactive decay of deposited mass was computed
+  !************************************************************************
+
+  gas_const=8.314 ! define gas constant
+  act_energy=10000 ! activation energy
+
+  !write(*,*) 'OH reaction n:',n,ohreact(1)
+  if (itime.le.loutnext) then
+    ldeltat=itime-(loutnext-loutstep)
+  else                                  ! first half of next interval
+    ldeltat=itime-loutnext
+  endif
+
+
+    dOHx=360/(maxxOH-1)
+    dOHy=180/(maxyOH-1)
+
+    jul=bdate+real(itime,kind=dp)/86400._dp
+    call caldate(jul,jjjjmmdd,ihmmss)
+    mm=int((jjjjmmdd-(jjjjmmdd/10000)*10000)/100)
+
+    do jpart=1,numpart
+
+  ! Determine which nesting level to be used
+  !*****************************************
+
+    ngrid=0
+    do j=numbnests,1,-1
+      if ((xtra1(jpart).gt.xln(j)).and.(xtra1(jpart).lt.xrn(j)).and. &
+           (ytra1(jpart).gt.yln(j)).and.(ytra1(jpart).lt.yrn(j))) then
+        ngrid=j
+        goto 23
+      endif
+    end do
+23   continue
+
+
+  ! Determine nested grid coordinates
+  !**********************************
+
+    if (ngrid.gt.0) then
+      xtn=(xtra1(jpart)-xln(ngrid))*xresoln(ngrid)
+      ytn=(ytra1(jpart)-yln(ngrid))*yresoln(ngrid)
+      ix=int(xtn)
+      jy=int(ytn)
+    else
+      ix=int(xtra1(jpart))
+      jy=int(ytra1(jpart))
+    endif
+
+  n=2
+  if (abs(memtime(1)-interp_time).lt.abs(memtime(2)-interp_time)) &
+       n=1
+
+  do i=2,nz
+    if (height(i).gt.ztra1(jpart)) then
+      indz=i-1
+      goto 6
+    endif
+  end do
+6   continue
+
+  ! The concentration from the nearest available gridcell is taken
+  ! get OH concentration for the specific month and solar angle
+
+  !  write(*,*) OH_field(1,1,1,1),OH_field(10,1,1,10)
+  !  write(*,*) OH_field(1,maxxOH-1,maxyOH-1,1)
+  !  write(*,*) OH_field(10,maxxOH-1,maxyOH-1,10)
+  !  write(*,*) OH_field_height(1,10,4,1),OH_field_height(10,4,10,10)
+  !  write(*,*) OH_field_height(1,maxxOH-1,maxyOH-1,1)
+  !  write(*,*) OH_field_height(10,maxxOH-1,maxyOH-1,10)
+    interp_time=nint(itime-0.5*ltsample)
+
+  ! World coordinates
+    xlon=xtra1(jpart)*dx+xlon0
+    if (xlon.gt.180) then
+       xlon=xlon-360
+    endif
+    ylat=ytra1(jpart)*dy+ylat0
+  ! get position in the OH field - assume that the OH field is global
+    OHx=(180+xlon-1)/dOHx
+    OHy=(90+ylat-1)/dOHy
+  !  sum_ang=0
+  ! get the level of the OH height field were the actual particle is in
+  ! ztra1 is the z-coordinate of the trajectory above model orography in m
+  ! OH_field_height is the heigth of the OH field above orography
+      OHz=maxzOH
+  ! assume equally distrib. OH field, OH_field_height gives the middle of
+  ! the z coordinate
+      OHinc=(OH_field_height(3)-OH_field_height(2))/2
+      do il=2,maxzOH+1
+        if ((OH_field_height(il-1)+OHinc).gt.ztra1(jpart)) goto 26
+      end do
+26     continue
+
+     OHz=il-1
+  !   loop was not interrupted il would be 8 (9-1)
+     if (OHz.gt.maxzOH) OHz=7
+  !   write (*,*) 'OH height: '
+  !    +        ,ztra1(jpart),jpart,OHz,OH_field_height(OHz),OHinc,
+  !    +        OH_field_height
+
+    oh_average=OH_field(mm,OHx,OHy,OHz)
+    if (oh_average.gt.smallnum) then
+  !**********************************************************
+  ! if there is noOH concentration no reaction
+  ! for performance reason take average concentration and
+  ! ignore diurnal variation
+  ! do 28 il=1,24
+  !      ang=70-zenithangle(ylat,xlon,jul+(24-il)/24.)
+  !      if (ang.lt.0) then
+  !          ang=0
+  !      endif
+  !      sum_ang=sum_ang+ang
+  !28         enddo
+  !    oh_diurn_var=(ang/sum_ang)*(oh_average*24)
+  !    oh_average=oh_diurn_var
+  !**********************************************************
+
+
+  !    Computation of the OH reaction
+  !**********************************************************
+    act_temp=tt(ix,jy,indz,n)
+
+    do k=1,nspec                                  ! loop over species
+      if (ohreact(k).gt.0.) then
+        ohreact_temp_corr=ohreact(k)*oh_average* &
+             exp((act_energy/gas_const)*(1/298.15-1/act_temp))
+        ohreacted=xmass1(jpart,k)* &
+             (1.-exp(-1*ohreact_temp_corr*abs(ltsample)))
+  !      new particle mass:
+        restmass = xmass1(jpart,k)-ohreacted
+        if (restmass .gt. smallnum) then
+          xmass1(jpart,k)=restmass
+  !   write (104) xlon,ylat,ztra1(jpart),k,oh_diurn_var,jjjjmmdd,
+  !    +               ihmmss,restmass,ohreacted
+        else
+          xmass1(jpart,k)=0.
+        endif
+  !      write (*,*) 'restmass: ',restmass
+      else
+        ohreacted=0.
+      endif
+    end do
+
+  endif
+  !endif OH concentration gt 0
+    end do
+  !continue loop over all particles
+
+end subroutine ohreaction
Index: /branches/FP_AI/src/openouttraj.f90
===================================================================
--- /branches/FP_AI/src/openouttraj.f90	(revision 23)
+++ /branches/FP_AI/src/openouttraj.f90	(revision 23)
@@ -0,0 +1,85 @@
+!**********************************************************************
+! 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 openouttraj
+
+  !*****************************************************************************
+  !                                                                            *
+  !   This routine opens the output file for the plume trajectory output       *
+  !   produced by the cluster analysis.                                        *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     27 January 2001                                                        *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  !                                                                            *
+  !*****************************************************************************
+
+  use point_mod
+  use par_mod
+  use com_mod
+
+  implicit none
+
+  integer :: i
+  real :: xp1,yp1,xp2,yp2
+
+
+  ! Open output file for trajectory output
+  !***************************************
+
+  open(unitouttraj,file=path(2)(1:length(2))//'trajectories.txt', &
+       form='formatted',err=998)
+
+  if (ldirect.eq.1) then
+  write(unitouttraj,'(i8,1x,i6,1x,a)') ibdate,ibtime, trim(flexversion)
+  else
+  write(unitouttraj,'(i8,1x,i6,1x,a)') iedate,ietime, trim(flexversion)
+  endif
+  write(unitouttraj,*) method,lsubgrid,lconvection
+  write(unitouttraj,*) numpoint
+  do i=1,numpoint
+    xp1=xpoint1(i)*dx+xlon0
+    yp1=ypoint1(i)*dy+ylat0
+    xp2=xpoint2(i)*dx+xlon0
+    yp2=ypoint2(i)*dy+ylat0
+    write(unitouttraj,*) ireleasestart(i),ireleaseend(i), &
+         xp1,yp1,xp2,yp2,zpoint1(i),zpoint2(i),kindz(i),npart(i)
+    if (numpoint.le.1000) then
+      write(unitouttraj,'(a)') compoint(i)(1:40)
+    else
+      write(unitouttraj,'(a)') compoint(1001)(1:40)
+    endif
+  end do
+
+  return
+
+998   write(*,*) ' #### FLEXPART MODEL ERROR!   THE FILE         #### '
+  write(*,*) ' #### trajectories.txt                         #### '
+  write(*,*) ' #### CANNOT BE OPENED. IF A FILE WITH THIS    #### '
+  write(*,*) ' #### NAME ALREADY EXISTS, DELETE IT AND START #### '
+  write(*,*) ' #### THE PROGRAM AGAIN.                       #### '
+  stop
+
+end subroutine openouttraj
Index: /branches/FP_AI/src/openreceptors.f90
===================================================================
--- /branches/FP_AI/src/openreceptors.f90	(revision 23)
+++ /branches/FP_AI/src/openreceptors.f90	(revision 23)
@@ -0,0 +1,93 @@
+!**********************************************************************
+! 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 openreceptors
+
+  !*****************************************************************************
+  !                                                                            *
+  !  This routine opens the receptor output files and writes out the receptor  *
+  !  names and the receptor locations. The receptor output files are not       *
+  !  closed, but kept open throughout the simulation. Concentrations are       *
+  !  continuously  dumped to these files.                                      *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     7 August 2002                                                          *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! numreceptor            actual number of receptor points specified          *
+  ! receptornames          names of the receptor points                        *
+  ! xreceptor,yreceptor    coordinates of the receptor points                  *
+  !                                                                            *
+  !*****************************************************************************
+
+  use par_mod
+  use com_mod
+
+  implicit none
+
+  integer :: j
+
+  ! Open output file for receptor points and write out a short header
+  ! containing receptor names and locations
+  !******************************************************************
+
+  if (numreceptor.ge.1) then           ! do it only if receptors are specified
+
+  ! Concentration output
+  !*********************
+
+    if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
+      open(unitoutrecept,file=path(2)(1:length(2))//'receptor_conc', &
+           form='unformatted',err=997)
+      write(unitoutrecept) (receptorname(j),j=1,numreceptor)
+      write(unitoutrecept) (xreceptor(j)*dx+xlon0, &
+           yreceptor(j)*dy+ylat0,j=1,numreceptor)
+    endif
+
+  ! Mixing ratio output
+  !********************
+
+    if ((iout.eq.2).or.(iout.eq.3)) then
+      open(unitoutreceptppt,file=path(2)(1:length(2))//'receptor_pptv', &
+           form='unformatted',err=998)
+      write(unitoutreceptppt) (receptorname(j),j=1,numreceptor)
+      write(unitoutreceptppt) (xreceptor(j)*dx+xlon0, &
+           yreceptor(j)*dy+ylat0,j=1,numreceptor)
+    endif
+  endif
+
+  return
+
+
+997   write(*,*) ' #### FLEXPART MODEL ERROR! THE FILE           #### '
+  write(*,*) ' ####              receptor_conc               #### '
+  write(*,*) ' #### CANNOT BE OPENED.                        #### '
+  stop
+
+998   write(*,*) ' #### FLEXPART MODEL ERROR! THE FILE           #### '
+  write(*,*) ' ####              receptor_pptv               #### '
+  write(*,*) ' #### CANNOT BE OPENED.                        #### '
+  stop
+
+end subroutine openreceptors
Index: /branches/FP_AI/src/outg_mod.f90
===================================================================
--- /branches/FP_AI/src/outg_mod.f90	(revision 23)
+++ /branches/FP_AI/src/outg_mod.f90	(revision 23)
@@ -0,0 +1,48 @@
+!**********************************************************************
+! 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/>.   *
+!**********************************************************************
+
+module outg_mod
+
+  implicit none
+
+  real,allocatable, dimension (:) :: outheight
+  real,allocatable, dimension (:) :: outheighthalf
+  real,allocatable, dimension (:,:) :: oroout
+  real,allocatable, dimension (:,:) :: orooutn
+  real,allocatable, dimension (:,:) :: area
+  real,allocatable, dimension (:,:) :: arean
+  real,allocatable, dimension (:,:,:) :: volume
+  real,allocatable, dimension (:,:,:) :: volumen
+  real,allocatable, dimension (:,:,:) :: areaeast
+  real,allocatable, dimension (:,:,:) :: areanorth
+  real,allocatable, dimension (:,:,:) :: densityoutgrid
+  real,allocatable, dimension (:,:,:) :: factor3d
+  real,allocatable, dimension (:,:,:) :: grid
+  real,allocatable, dimension (:,:) :: wetgrid
+  real,allocatable, dimension (:,:) :: drygrid
+  real,allocatable, dimension (:,:,:) :: gridsigma
+  real,allocatable, dimension (:,:) :: drygridsigma
+  real,allocatable, dimension (:,:) :: wetgridsigma
+  real,allocatable, dimension (:) :: sparse_dump_r
+  real,allocatable, dimension (:) :: sparse_dump_u
+  integer,allocatable, dimension (:) :: sparse_dump_i
+
+end module outg_mod
Index: /branches/FP_AI/src/outgrid_init.f90
===================================================================
--- /branches/FP_AI/src/outgrid_init.f90	(revision 23)
+++ /branches/FP_AI/src/outgrid_init.f90	(revision 23)
@@ -0,0 +1,323 @@
+!**********************************************************************
+! 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 outgrid_init
+  !
+  !*****************************************************************************
+  !                                                                            *
+  !  This routine initializes the output grids                                 *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     7 August 2002                                                          *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  !                                                                            *
+  ! area               surface area of all output grid cells                   *
+  ! areaeast           eastward facing wall area of all output grid cells      *
+  ! areanorth          northward facing wall area of all output grid cells     *
+  ! volume             volumes of all output grid cells                        *
+  !                                                                            *
+  !*****************************************************************************
+
+  use flux_mod
+  use oh_mod
+  use unc_mod
+  use outg_mod
+  use par_mod
+  use com_mod
+
+  implicit none
+
+  integer :: ix,jy,kz,i,nage,l,iix,jjy,ixp,jyp,i1,j1,j,ngrid
+  integer :: ks,kp,stat
+  real :: ylat,gridarea,ylatp,ylatm,hzone,cosfactm,cosfactp
+  real :: xlon,xl,yl,ddx,ddy,rddx,rddy,p1,p2,p3,p4,xtn,ytn,oroh
+  real,parameter :: eps=nxmax/3.e5
+
+
+  ! Compute surface area and volume of each grid cell: area, volume;
+  ! and the areas of the northward and eastward facing walls: areaeast, areanorth
+  !***********************************************************************
+  do jy=0,numygrid-1
+    ylat=outlat0+(real(jy)+0.5)*dyout
+    ylatp=ylat+0.5*dyout
+    ylatm=ylat-0.5*dyout
+    if ((ylatm.lt.0).and.(ylatp.gt.0.)) then
+      hzone=dyout*r_earth*pi180
+    else
+
+  ! Calculate area of grid cell with formula M=2*pi*R*h*dx/360,
+  ! see Netz, Formeln der Mathematik, 5. Auflage (1983), p.90
+  !************************************************************
+
+      cosfactp=cos(ylatp*pi180)
+      cosfactm=cos(ylatm*pi180)
+      if (cosfactp.lt.cosfactm) then
+        hzone=sqrt(1-cosfactp**2)- &
+             sqrt(1-cosfactm**2)
+        hzone=hzone*r_earth
+      else
+        hzone=sqrt(1-cosfactm**2)- &
+             sqrt(1-cosfactp**2)
+        hzone=hzone*r_earth
+      endif
+    endif
+
+  ! Surface are of a grid cell at a latitude ylat
+  !**********************************************
+
+    gridarea=2.*pi*r_earth*hzone*dxout/360.
+
+    do ix=0,numxgrid-1
+      area(ix,jy)=gridarea
+
+  ! Volume = area x box height
+  !***************************
+
+      volume(ix,jy,1)=area(ix,jy)*outheight(1)
+      areaeast(ix,jy,1)=dyout*r_earth*pi180*outheight(1)
+      areanorth(ix,jy,1)=cos(ylat*pi180)*dxout*r_earth*pi180* &
+           outheight(1)
+      do kz=2,numzgrid
+        areaeast(ix,jy,kz)=dyout*r_earth*pi180* &
+             (outheight(kz)-outheight(kz-1))
+        areanorth(ix,jy,kz)=cos(ylat*pi180)*dxout*r_earth*pi180* &
+             (outheight(kz)-outheight(kz-1))
+        volume(ix,jy,kz)=area(ix,jy)*(outheight(kz)-outheight(kz-1))
+      end do
+    end do
+  end do
+
+
+
+
+  !******************************************************************
+  ! Determine average height of model topography in output grid cells
+  !******************************************************************
+
+  ! Loop over all output grid cells
+  !********************************
+
+  do jjy=0,numygrid-1
+    do iix=0,numxgrid-1
+      oroh=0.
+
+  ! Take 100 samples of the topography in every grid cell
+  !******************************************************
+
+      do j1=1,10
+        ylat=outlat0+(real(jjy)+real(j1)/10.-0.05)*dyout
+        yl=(ylat-ylat0)/dy
+        do i1=1,10
+          xlon=outlon0+(real(iix)+real(i1)/10.-0.05)*dxout
+          xl=(xlon-xlon0)/dx
+
+  ! Determine the nest we are in
+  !*****************************
+
+          ngrid=0
+          do j=numbnests,1,-1
+            if ((xl.gt.xln(j)+eps).and.(xl.lt.xrn(j)-eps).and. &
+                 (yl.gt.yln(j)+eps).and.(yl.lt.yrn(j)-eps)) then
+              ngrid=j
+              goto 43
+            endif
+          end do
+43        continue
+
+  ! Determine (nested) grid coordinates and auxiliary parameters used for interpolation
+  !*****************************************************************************
+
+          if (ngrid.gt.0) then
+            xtn=(xl-xln(ngrid))*xresoln(ngrid)
+            ytn=(yl-yln(ngrid))*yresoln(ngrid)
+            ix=int(xtn)
+            jy=int(ytn)
+            ddy=ytn-real(jy)
+            ddx=xtn-real(ix)
+          else
+            ix=int(xl)
+            jy=int(yl)
+            ddy=yl-real(jy)
+            ddx=xl-real(ix)
+          endif
+          ixp=ix+1
+          jyp=jy+1
+          rddx=1.-ddx
+          rddy=1.-ddy
+          p1=rddx*rddy
+          p2=ddx*rddy
+          p3=rddx*ddy
+          p4=ddx*ddy
+
+          if (ngrid.gt.0) then
+            oroh=oroh+p1*oron(ix ,jy ,ngrid) &
+                 + p2*oron(ixp,jy ,ngrid) &
+                 + p3*oron(ix ,jyp,ngrid) &
+                 + p4*oron(ixp,jyp,ngrid)
+          else
+            oroh=oroh+p1*oro(ix ,jy) &
+                 + p2*oro(ixp,jy) &
+                 + p3*oro(ix ,jyp) &
+                 + p4*oro(ixp,jyp)
+          endif
+        end do
+      end do
+
+  ! Divide by the number of samples taken
+  !**************************************
+
+      oroout(iix,jjy)=oroh/100.
+    end do
+  end do
+
+  ! if necessary allocate flux fields
+  if (iflux.eq.1) then
+    allocate(flux(6,0:numxgrid-1,0:numygrid-1,numzgrid, &
+         1:nspec,1:maxpointspec_act,1:nageclass),stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not allocate flux array '
+  endif
+
+  !write (*,*) 'allocating: in a sec',OHREA
+  if (OHREA.eqv..TRUE.) then
+  !   write (*,*) 'allocating: ',maxxOH,maxyOH,maxzOH
+    allocate(OH_field(12,0:maxxOH-1,0:maxyOH-1,maxzOH) &
+         ,stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not allocate OH array '
+    allocate(OH_field_height(7) &
+         ,stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not allocate OH array '
+  endif
+  ! gridunc,griduncn        uncertainty of outputted concentrations
+  allocate(gridunc(0:numxgrid-1,0:numygrid-1,numzgrid,maxspec, &
+       maxpointspec_act,nclassunc,maxageclass),stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not allocate gridunc'
+  if (ldirect.gt.0) then
+  allocate(wetgridunc(0:numxgrid-1,0:numygrid-1,maxspec, &
+       maxpointspec_act,nclassunc,maxageclass),stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not allocate gridunc'
+  allocate(drygridunc(0:numxgrid-1,0:numygrid-1,maxspec, &
+       maxpointspec_act,nclassunc,maxageclass),stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not allocate gridunc'
+  endif
+  !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) 
+
+  ! allocate fields for concoutput with maximum dimension of outgrid
+  ! and outgrid_nest
+
+  allocate(gridsigma(0:max(numxgrid,numxgridn)-1, &
+       0:max(numygrid,numygridn)-1,numzgrid),stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not allocate gridunc'
+  allocate(grid(0:max(numxgrid,numxgridn)-1, &
+       0:max(numygrid,numygridn)-1,numzgrid),stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not allocate gridunc'
+  allocate(densityoutgrid(0:max(numxgrid,numxgridn)-1, &
+       0:max(numygrid,numygridn)-1,numzgrid),stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not allocate gridunc'
+
+  allocate(factor3d(0:max(numxgrid,numxgridn)-1, &
+       0:max(numygrid,numygridn)-1,numzgrid),stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not allocate gridunc'
+  allocate(sparse_dump_r(max(numxgrid,numxgridn)* &
+       max(numygrid,numygridn)*numzgrid),stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not allocate gridunc'
+
+   allocate(sparse_dump_u(max(numxgrid,numxgridn)* &
+       max(numygrid,numygridn)*numzgrid),stat=stat)
+        if (stat.ne.0) write(*,*)'ERROR: could not allocate gridunc'
+
+  allocate(sparse_dump_i(max(numxgrid,numxgridn)* &
+       max(numygrid,numygridn)*numzgrid),stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not allocate gridunc'
+
+  ! deposition fields are only allocated for forward runs
+  if (ldirect.gt.0) then
+     allocate(wetgridsigma(0:max(numxgrid,numxgridn)-1, &
+          0:max(numygrid,numygridn)-1),stat=stat)
+     if (stat.ne.0) write(*,*)'ERROR: could not allocate gridunc'
+     allocate(drygridsigma(0:max(numxgrid,numxgridn)-1, &
+          0:max(numygrid,numygridn)-1),stat=stat)
+     if (stat.ne.0) write(*,*)'ERROR: could not allocate gridunc'
+     allocate(wetgrid(0:max(numxgrid,numxgridn)-1, &
+          0:max(numygrid,numygridn)-1),stat=stat)
+     if (stat.ne.0) write(*,*)'ERROR: could not allocate gridunc'
+     allocate(drygrid(0:max(numxgrid,numxgridn)-1, &
+          0:max(numygrid,numygridn)-1),stat=stat)
+     if (stat.ne.0) write(*,*)'ERROR: could not allocate gridunc'
+  endif
+
+  ! Initial condition field
+
+  if (linit_cond.gt.0) then
+    allocate(init_cond(0:numxgrid-1,0:numygrid-1,numzgrid,maxspec, &
+         maxpointspec_act),stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not allocate init_cond'
+  endif
+
+  !************************
+  ! Initialize output grids
+  !************************
+
+  do ks=1,nspec
+  do kp=1,maxpointspec_act
+    do i=1,numreceptor
+  ! Receptor points
+      creceptor(i,ks)=0.
+    end do
+    do nage=1,nageclass
+      do jy=0,numygrid-1
+        do ix=0,numxgrid-1
+          do l=1,nclassunc
+  ! Deposition fields
+            if (ldirect.gt.0) then
+            wetgridunc(ix,jy,ks,kp,l,nage)=0.
+            drygridunc(ix,jy,ks,kp,l,nage)=0.
+            endif
+            do kz=1,numzgrid
+              if (iflux.eq.1) then
+  ! Flux fields
+                 do i=1,5
+                   flux(i,ix,jy,kz,ks,kp,nage)=0.
+                 end do
+              endif
+  ! Initial condition field
+              if ((l.eq.1).and.(nage.eq.1).and.(linit_cond.gt.0)) &
+                   init_cond(ix,jy,kz,ks,kp)=0.
+  ! Concentration fields
+              gridunc(ix,jy,kz,ks,kp,l,nage)=0.
+            end do
+          end do
+        end do
+      end do
+    end do
+  end do
+  end do
+
+
+
+end subroutine outgrid_init
Index: /branches/FP_AI/src/outgrid_init_nest.f90
===================================================================
--- /branches/FP_AI/src/outgrid_init_nest.f90	(revision 23)
+++ /branches/FP_AI/src/outgrid_init_nest.f90	(revision 23)
@@ -0,0 +1,230 @@
+!**********************************************************************
+! 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 outgrid_init_nest
+
+  !*****************************************************************************
+  !                                                                            *
+  !  This routine calculates, for each grid cell of the output nest, the       *
+  !  volume and the surface area.                                              *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !    30 August 2004                                                          *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  !                                                                            *
+  ! arean              surface area of all output nest cells                   *
+  ! volumen            volumes of all output nest cells                        *
+  !                                                                            *
+  !*****************************************************************************
+
+  use unc_mod
+  use outg_mod
+  use par_mod
+  use com_mod
+
+  implicit none
+
+  integer :: ix,jy,kz,ks,kp,nage,l,iix,jjy,ixp,jyp,i1,j1,j,ngrid
+  integer :: stat
+  real :: ylat,gridarea,ylatp,ylatm,hzone,cosfactm,cosfactp
+  real :: xlon,xl,yl,ddx,ddy,rddx,rddy,p1,p2,p3,p4,xtn,ytn,oroh
+  real,parameter :: eps=nxmax/3.e5
+
+
+
+  ! gridunc,griduncn        uncertainty of outputted concentrations
+  allocate(griduncn(0:numxgridn-1,0:numygridn-1,numzgrid,maxspec, &
+       maxpointspec_act,nclassunc,maxageclass),stat=stat)
+  if (stat.ne.0) write(*,*)'ERROR:could not allocate nested gridunc'
+
+  if (ldirect.gt.0) then
+  allocate(wetgriduncn(0:numxgridn-1,0:numygridn-1,maxspec, &
+       maxpointspec_act,nclassunc,maxageclass),stat=stat)
+  if (stat.ne.0) write(*,*)'ERROR:could not allocate nested gridunc'
+  allocate(drygriduncn(0:numxgridn-1,0:numygridn-1,maxspec, &
+       maxpointspec_act,nclassunc,maxageclass),stat=stat)
+  if (stat.ne.0) write(*,*)'ERROR:could not allocate nested gridunc'
+  endif
+
+  ! Compute surface area and volume of each grid cell: area, volume;
+  ! and the areas of the northward and eastward facing walls: areaeast, areanorth
+  !***********************************************************************
+
+  do jy=0,numygridn-1
+    ylat=outlat0n+(real(jy)+0.5)*dyoutn
+    ylatp=ylat+0.5*dyoutn
+    ylatm=ylat-0.5*dyoutn
+    if ((ylatm.lt.0).and.(ylatp.gt.0.)) then
+      hzone=dyoutn*r_earth*pi180
+    else
+
+  ! Calculate area of grid cell with formula M=2*pi*R*h*dx/360,
+  ! see Netz, Formeln der Mathematik, 5. Auflage (1983), p.90
+  !************************************************************
+
+      cosfactp=cos(ylatp*pi180)
+      cosfactm=cos(ylatm*pi180)
+      if (cosfactp.lt.cosfactm) then
+        hzone=sqrt(1-cosfactp**2)- &
+             sqrt(1-cosfactm**2)
+        hzone=hzone*r_earth
+      else
+        hzone=sqrt(1-cosfactm**2)- &
+             sqrt(1-cosfactp**2)
+        hzone=hzone*r_earth
+      endif
+    endif
+
+
+
+  ! Surface are of a grid cell at a latitude ylat
+  !**********************************************
+
+    gridarea=2.*pi*r_earth*hzone*dxoutn/360.
+
+    do ix=0,numxgridn-1
+      arean(ix,jy)=gridarea
+
+  ! Volume = area x box height
+  !***************************
+
+      volumen(ix,jy,1)=arean(ix,jy)*outheight(1)
+      do kz=2,numzgrid
+        volumen(ix,jy,kz)=arean(ix,jy)*(outheight(kz)-outheight(kz-1))
+      end do
+    end do
+  end do
+
+
+  !**************************************************************************
+  ! Determine average height of model topography in nesteed output grid cells
+  !**************************************************************************
+
+  ! Loop over all output grid cells
+  !********************************
+
+  do jjy=0,numygridn-1
+    do iix=0,numxgridn-1
+      oroh=0.
+
+  ! Take 100 samples of the topography in every grid cell
+  !******************************************************
+
+      do j1=1,10
+        ylat=outlat0n+(real(jjy)+real(j1)/10.-0.05)*dyoutn
+        yl=(ylat-ylat0)/dy
+        do i1=1,10
+          xlon=outlon0n+(real(iix)+real(i1)/10.-0.05)*dxoutn
+          xl=(xlon-xlon0)/dx
+
+  ! Determine the nest we are in
+  !*****************************
+
+          ngrid=0
+          do j=numbnests,1,-1
+            if ((xl.gt.xln(j)+eps).and.(xl.lt.xrn(j)-eps).and. &
+                 (yl.gt.yln(j)+eps).and.(yl.lt.yrn(j)-eps)) then
+              ngrid=j
+              goto 43
+            endif
+          end do
+43        continue
+
+  ! Determine (nested) grid coordinates and auxiliary parameters used for interpolation
+  !*****************************************************************************
+
+          if (ngrid.gt.0) then
+            xtn=(xl-xln(ngrid))*xresoln(ngrid)
+            ytn=(yl-yln(ngrid))*yresoln(ngrid)
+            ix=int(xtn)
+            jy=int(ytn)
+            ddy=ytn-real(jy)
+            ddx=xtn-real(ix)
+          else
+            ix=int(xl)
+            jy=int(yl)
+            ddy=yl-real(jy)
+            ddx=xl-real(ix)
+          endif
+          ixp=ix+1
+          jyp=jy+1
+          rddx=1.-ddx
+          rddy=1.-ddy
+          p1=rddx*rddy
+          p2=ddx*rddy
+          p3=rddx*ddy
+          p4=ddx*ddy
+
+          if (ngrid.gt.0) then
+            oroh=oroh+p1*oron(ix ,jy ,ngrid) &
+                 + p2*oron(ixp,jy ,ngrid) &
+                 + p3*oron(ix ,jyp,ngrid) &
+                 + p4*oron(ixp,jyp,ngrid)
+          else
+            oroh=oroh+p1*oro(ix ,jy) &
+                 + p2*oro(ixp,jy) &
+                 + p3*oro(ix ,jyp) &
+                 + p4*oro(ixp,jyp)
+          endif
+        end do
+      end do
+
+  ! Divide by the number of samples taken
+  !**************************************
+
+      orooutn(iix,jjy)=oroh/100.
+    end do
+  end do
+
+
+
+  !*******************************
+  ! Initialization of output grids
+  !*******************************
+
+  do kp=1,maxpointspec_act
+  do ks=1,nspec
+    do nage=1,nageclass
+      do jy=0,numygridn-1
+        do ix=0,numxgridn-1
+          do l=1,nclassunc
+  ! Deposition fields
+            if (ldirect.gt.0) then
+              wetgriduncn(ix,jy,ks,kp,l,nage)=0.
+              drygriduncn(ix,jy,ks,kp,l,nage)=0.
+            endif
+  ! Concentration fields
+            do kz=1,numzgrid
+              griduncn(ix,jy,kz,ks,kp,l,nage)=0.
+            end do
+          end do
+        end do
+      end do
+    end do
+  end do
+  end do
+
+
+end subroutine outgrid_init_nest
Index: /branches/FP_AI/src/par_mod.f90
===================================================================
--- /branches/FP_AI/src/par_mod.f90	(revision 23)
+++ /branches/FP_AI/src/par_mod.f90	(revision 23)
@@ -0,0 +1,276 @@
+!**********************************************************************
+! 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/>.   *
+!**********************************************************************
+
+!*******************************************************************************
+!   Include file for calculation of particle trajectories (Program FLEXPART)   *
+!        This file contains the parameter statements used in FLEXPART          *
+!                                                                              *
+!        Author: A. Stohl                                                      *
+!                                                                              *
+!        1997                                                                  *
+!                                                                              *
+!        Last update 15 August 2013 IP                                         *
+!                                                                              *
+!*******************************************************************************
+
+module par_mod
+
+  implicit none
+
+  !****************************************************************
+  ! Parameter defining KIND parameter for "double precision"
+  !****************************************************************
+
+  integer,parameter :: dp=selected_real_kind(P=15)
+
+
+  !***********************************************************
+  ! Number of directories/files used for FLEXPART input/output
+  !***********************************************************
+
+  integer,parameter :: numpath=4
+
+  ! numpath                 Number of different pathnames for input/output files
+
+
+  !*****************************
+  ! Physical and other constants
+  !*****************************
+
+  real,parameter :: pi=3.14159265, r_earth=6.371e6, r_air=287.05, ga=9.81
+  real,parameter :: cpa=1004.6, kappa=0.286, pi180=pi/180., vonkarman=0.4
+
+  ! pi                      number "pi"
+  ! pi180                   pi/180.
+  ! r_earth                 radius of earth [m]
+  ! r_air                   individual gas constant for dry air [J/kg/K]
+  ! ga                      gravity acceleration of earth [m/s**2]
+  ! cpa                     specific heat for dry air
+  ! kappa                   exponent of formula for potential temperature
+  ! vonkarman               von Karman constant
+
+  real,parameter :: karman=0.40, href=15., convke=2.0
+  real,parameter :: hmixmin=100., hmixmax=4500., turbmesoscale=0.16
+  real,parameter :: d_trop=50., d_strat=0.1
+
+  ! karman                  Karman's constant
+  ! href [m]                Reference height for dry deposition
+  ! konvke                  Relative share of kinetic energy used for parcel lifting
+  ! hmixmin,hmixmax         Minimum and maximum allowed PBL height
+  ! turbmesoscale           the factor by which standard deviations of winds at grid
+  !                    points surrounding the particle positions are scaled to
+  !                    yield the scales for the mesoscale wind velocity fluctuations
+  ! d_trop [m2/s]           Turbulent diffusivity for horizontal components in the troposphere
+  ! d_strat [m2/s]          Turbulent diffusivity for vertical component in the stratosphere
+
+  real,parameter :: xmwml=18.016/28.960
+
+  ! xmwml   ratio of molar weights of water vapor and dry air
+  !****************************************************
+  ! Constants related to the stratospheric ozone tracer
+  !****************************************************
+
+  real,parameter :: ozonescale=60., pvcrit=2.0
+
+  ! ozonescale              ppbv O3 per PV unit
+  ! pvcrit                  PV level of the tropopause
+
+
+
+  !********************
+  ! Some time constants
+  !********************
+
+  integer,parameter :: idiffnorm=10800, idiffmax=2*idiffnorm, minstep=1
+
+  ! idiffnorm [s]           normal time interval between two wind fields
+  ! idiffmax [s]            maximum time interval between two wind fields
+  ! minstep [s]             minimum time step to be used within FLEXPART
+
+
+  !*****************************************************************
+  ! Parameters for polar stereographic projection close to the poles
+  !*****************************************************************
+
+  real,parameter :: switchnorth=75., switchsouth=-75.
+
+  ! switchnorth    use polar stereographic grid north of switchnorth
+  ! switchsouth    use polar stereographic grid south of switchsouth
+
+
+  !*********************************************
+  ! Maximum dimensions of the input mother grids
+  !*********************************************
+  
+  !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=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
+
+  integer,parameter :: nxshift=359 ! for ECMWF
+  !integer,parameter :: nxshift=0     ! for GFS or FNL (XF)
+
+  integer,parameter :: nconvlevmax = nuvzmax-1
+  integer,parameter :: na = nconvlevmax+1
+
+
+  ! nxmax,nymax        maximum dimension of wind fields in x and y
+  !                    direction, respectively
+  ! nuvzmax,nwzmax     maximum dimension of (u,v) and (w) wind fields in z
+  !                    direction (for fields on eta levels)
+  ! nzmax              maximum dimension of wind fields in z direction
+  !                    for the transformed Cartesian coordinates
+  ! nxshift            for global grids (in x), the grid can be shifted by
+  !                    nxshift grid points, in order to accomodate nested
+  !                    grids, and output grids overlapping the domain "boundary"
+  !                    nxshift must not be negative; "normal" setting would be 0
+  ! ntracermax         maximum number of tracer species in convection
+  ! nconvlevmax        maximum number of levels for convection
+  ! na                 parameter used in Emanuel's convect subroutine
+
+
+  !*********************************************
+  ! Maximum dimensions of the nested input grids
+  !*********************************************
+
+  !integer,parameter :: maxnests=0, nxmaxn=0, nymaxn=0
+  integer,parameter :: maxnests=1,nxmaxn=351,nymaxn=351 !ECMWF
+  !integer,parameter :: maxnests=1, nxmaxn=201, nymaxn=161 ! FNL XF
+  ! maxnests                maximum number of nested grids
+  ! nxmaxn,nymaxn           maximum dimension of nested wind fields in
+  !                         x and y direction, respectively
+
+
+  !*********************************
+  ! Parmaters for GRIB file decoding
+  !*********************************
+
+  integer,parameter :: jpack=4*nxmax*nymax, jpunp=4*jpack
+
+  ! jpack,jpunp             maximum dimensions needed for GRIB file decoding
+
+
+  !**************************************
+  ! Maximum dimensions of the output grid
+  !**************************************
+
+  !integer,parameter :: maxageclass=1,maxzgrid=10,nclassunc=1
+  integer,parameter :: maxageclass=1,nclassunc=1
+
+  ! nclassunc               number of classes used to calculate the uncertainty
+  !                         of the output
+  ! maxageclass             maximum number of age classes used for output
+
+  ! Sabine Eckhardt, June, 2008
+  ! the dimensions of the OUTGRID are now set dynamically during runtime
+  ! maxxgrid,maxygrid,maxzgrid    maximum dimensions in x,y,z direction
+  ! maxxgridn,maxygridn           maximum dimension of the nested grid
+  !integer maxxgrid,maxygrid,maxzgrid,maxxgridn,maxygridn
+  !integer,parameter :: maxxgrid=361,maxygrid=181,maxxgridn=0,maxygridn=0)
+
+  integer,parameter :: maxreceptor=200
+
+  ! maxreceptor             maximum number of receptor points
+
+
+  !**************************************************
+  ! Maximum number of particles, species, and similar
+  !**************************************************
+
+  integer,parameter :: maxpart=15000000
+  integer,parameter :: maxspec=4
+
+
+  ! maxpart                 Maximum number of particles
+  ! maxspec                 Maximum number of chemical species per release
+
+  ! maxpoint is also set dynamically during runtime
+  ! maxpoint                Maximum number of release locations
+
+  ! ---------
+  ! Sabine Eckhardt: change of landuse inventary numclass=13
+  ! ---------
+  integer,parameter :: maxwf=50000, maxtable=1000, numclass=13, ni=11
+
+  ! maxwf                   maximum number of wind fields to be used for simulation
+  ! maxtable                Maximum number of chemical species that can be
+  !                         tabulated for FLEXPART
+  ! numclass                Number of landuse classes available to FLEXPART
+  ! ni                      Number of diameter classes of particles
+
+  !**************************************************************************
+  ! dimension of the OH field
+  !**************************************************************************
+  integer,parameter :: maxxOH=72, maxyOH=46, maxzOH=7
+
+  !**************************************************************************
+  ! Maximum number of particles to be released in a single atmospheric column
+  ! for the domain-filling trajectories option
+  !**************************************************************************
+
+  integer,parameter :: maxcolumn=3000
+
+
+  !*********************************
+  ! Dimension of random number field
+  !*********************************
+
+  integer,parameter :: maxrand=2000000
+
+  ! maxrand                 number of random numbers used
+
+
+  !*****************************************************
+  ! Number of clusters to be used for plume trajectories
+  !*****************************************************
+
+  integer,parameter :: ncluster=5
+
+  !************************************
+  ! Unit numbers for input/output files
+  !************************************
+
+  integer,parameter :: unitpath=1, unitcommand=1, unitageclasses=1, unitgrid=1
+  integer,parameter :: unitavailab=1, unitreleases=88, unitpartout=93
+  integer,parameter :: unitpartin=93, unitflux=98, unitouttraj=96
+  integer,parameter :: unitvert=1, unitoro=1, unitpoin=1, unitreceptor=1
+  integer,parameter :: unitoutgrid=97, unitoutgridppt=99, unitoutinfo=1
+  integer,parameter :: unitspecies=1, unitoutrecept=91, unitoutreceptppt=92
+  integer,parameter :: unitlsm=1, unitsurfdata=1, unitland=1, unitwesely=1
+  integer,parameter :: unitOH=1
+  integer,parameter :: unitdates=94, unitheader=90,unitheader_txt=100, unitshortpart=95
+  integer,parameter :: unitboundcond=89
+
+!******************************************************
+! integer code for missing values, used in wet scavenging (PS, 2012)
+!******************************************************
+
+    !  integer icmv
+    !  parameter(icmv=-9999)
+      integer,parameter ::  icmv=-9999
+
+! Parameters for testing
+!*******************************************
+!  integer :: verbosity=0
+
+end module par_mod
Index: /branches/FP_AI/src/part0.f90
===================================================================
--- /branches/FP_AI/src/part0.f90	(revision 23)
+++ /branches/FP_AI/src/part0.f90	(revision 23)
@@ -0,0 +1,136 @@
+!**********************************************************************
+! 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 part0(dquer,dsigma,density,fract,schmi,cun,vsh)
+  !                  i      i       i      o     o    o   o
+  !*****************************************************************************
+  !                                                                            *
+  !      Calculation of time independent factors of the dry deposition of      *
+  !      particles:                                                            *
+  !      Log-Normal-distribution of mass [dM/dlog(dp)], unimodal               *
+  !                                                                            *
+  !      AUTHOR: Matthias Langer, adapted by Andreas Stohl, 13 November 1993   *
+  !                                                                            *
+  !      Literature:                                                           *
+  !      [1]  Scire/Yamartino/Carmichael/Chang (1989),                         *
+  !             CALGRID: A Mesoscale Photochemical Grid Model.                 *
+  !             Vol II: User's Guide. (Report No.A049-1, June, 1989)           *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! alpha            help variable                                             *
+  ! cun              'slip-flow' correction after Cunningham                   *
+  ! d01 [um]         upper diameter                                            *
+  ! d02 [um]         lower diameter                                            *
+  ! dc [m2/s]        coefficient of Brownian diffusion                         *
+  ! delta            distance given in standard deviation units                *
+  ! density [kg/m3]  density of the particle                                   *
+  ! dmean            geometric mean diameter of interval                       *
+  ! dquer [um]       geometric mass mean particle diameter                     *
+  ! dsigma           e.g. dsigma=10 or dsigma=0.1 means that 68% of the mass   *
+  !                  are between 0.1*dquer and 10*dquer                        *
+  ! fract(ni)        mass fraction of each diameter interval                   *
+  ! kn               Knudsen number                                            *
+  ! ni               number of diameter intervals, for which deposition        *
+  !                  is calculated                                             *
+  ! schmidt          Schmidt number                                            *
+  ! schmi            schmidt**2/3                                              *
+  ! vsh [m/s]        gravitational settling velocity of the particle           *
+  ! x01              normalized upper diameter                                 *
+  ! x02              normalized lower diameter                                 *
+  !                                                                            *
+  ! Constants:                                                                 *
+  ! g [m/s2]         Acceleration of gravity                                   *
+  ! kb [J/K]         Stefan-Boltzmann constant                                 *
+  ! lam [m]          mean free path of air molecules                           *
+  ! myl [kg/m/s]     dynamical viscosity of air                                *
+  ! nyl [m2/s]       kinematic viscosity of air                                *
+  ! tr               reference temperature                                     *
+  !                                                                            *
+  ! Function:                                                                  *
+  ! erf              calculates the integral of the Gauss function             *
+  !                                                                            *
+  !*****************************************************************************
+
+  use par_mod
+
+  implicit none
+
+  real,parameter :: tr=293.15
+
+  integer :: i
+  real :: dquer,dsigma,density,xdummy,d01,d02,delta,x01,x02,fract(ni)
+  real :: dmean,alpha,cun,dc,schmidt,schmi(ni),vsh(ni),kn,erf
+  real,parameter :: myl=1.81e-5,nyl=0.15e-4
+  real,parameter :: lam=6.53e-8,kb=1.38e-23,eps=1.2e-38
+
+
+  ! xdummy constant for all intervals
+  !**********************************
+
+  xdummy=sqrt(2.)*alog(dsigma)
+
+
+  ! particles diameters are split up to ni intervals between
+  ! dquer-3*dsigma and dquer+3*dsigma
+  !*********************************************************
+
+  delta=6./real(ni)
+
+  d01=dquer*dsigma**(-3)
+  do i=1,ni
+    d02=d01
+    d01=dquer*dsigma**(-3.+delta*real(i))
+    x01=alog(d01/dquer)/xdummy
+    x02=alog(d02/dquer)/xdummy
+
+
+  ! Area under Gauss-function is calculated and gives mass fraction of interval
+  !****************************************************************************
+
+    fract(i)=0.5*(erf(x01)-erf(x02))
+
+
+  ! Geometric mean diameter of interval in [m]
+  !*******************************************
+
+    dmean=1.E-6*exp(0.5*alog(d01*d02))
+
+
+  ! Calculation of time independent parameters of each interval
+  !************************************************************
+
+    kn=2.*lam/dmean
+    if ((-1.1/kn).le.log10(eps)*log(10.)) then
+      alpha=1.257
+    else
+      alpha=1.257+0.4*exp(-1.1/kn)
+    endif
+    cun=1.+alpha*kn
+    dc=kb*tr*cun/(3.*pi*myl*dmean)
+    schmidt=nyl/dc
+    schmi(i)=schmidt**(-2./3.)
+    vsh(i)=ga*density*dmean*dmean*cun/(18.*myl)
+
+  end do
+
+end subroutine part0
Index: /branches/FP_AI/src/partdep.f90
===================================================================
--- /branches/FP_AI/src/partdep.f90	(revision 23)
+++ /branches/FP_AI/src/partdep.f90	(revision 23)
@@ -0,0 +1,116 @@
+!**********************************************************************
+! 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 partdep(nc,density,fract,schmi,vset,ra,ustar,nyl,vdep)
+  !                   i     i      i     i    i   i    i    i  i/o
+  !*****************************************************************************
+  !                                                                            *
+  !      Calculation of the dry deposition velocities of particles.            *
+  !      This routine is based on Stokes' law for considering settling and     *
+  !      assumes constant dynamic viscosity of the air.                        *
+  !                                                                            *
+  !     AUTHOR: Andreas Stohl, 12 November 1993                                *
+  !                            Update: 20 December 1996                        *
+  !                                                                            *
+  !     Literature:                                                            *
+  !     [1]  Hicks/Baldocchi/Meyers/Hosker/Matt (1987), A Preliminary          *
+  !             Multiple Resistance Routine for Deriving Dry Deposition        *
+  !             Velocities from Measured Quantities.                           *
+  !             Water, Air and Soil Pollution 36 (1987), pp.311-330.           *
+  !     [2]  Slinn (1982), Predictions for Particle Deposition to              *
+  !             Vegetative Canopies. Atm.Env.16-7 (1982), pp.1785-1794.        *
+  !     [3]  Slinn/Slinn (1980),  Predictions for Particle Deposition on       *
+  !             Natural Waters. Atm.Env.14 (1980), pp.1013-1016.               *
+  !     [4]  Scire/Yamartino/Carmichael/Chang (1989),                          *
+  !             CALGRID: A Mesoscale Photochemical Grid Model.                 *
+  !             Vol II: User's Guide. (Report No.A049-1, June, 1989)           *
+  !     [5]  Langer M. (1992): Ein einfaches Modell zur Abschaetzung der       *
+  !             Depositionsgeschwindigkeit von Teilchen und Gasen.             *
+  !             Internal report.                                               *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! alpha                help variable                                         *
+  ! fract(nc,ni)         mass fraction of each diameter interval               *
+  ! lpdep(nc)            1 for particle deposition, 0 else                     *
+  ! nc                   actual number of chemical components                  *
+  ! ni                   number of diameter intervals, for which vdepj is calc.*
+  ! rdp [s/m]            deposition layer resistance                           *
+  ! ra [s/m]             aerodynamical resistance                              *
+  ! schmi(nc,ni)         Schmidt number**2/3 of each diameter interval         *
+  ! stokes               Stokes number                                         *
+  ! ustar [m/s]          friction velocity                                     *
+  ! vdep(nc) [m/s]       deposition velocities of all components               *
+  ! vdepj [m/s]          help, deposition velocity of 1 interval               *
+  ! vset(nc,ni)          gravitational settling velocity of each interval      *
+  !                                                                            *
+  ! Constants:                                                                 *
+  ! nc                   number of chemical species                            *
+  ! ni                   number of diameter intervals, for which deposition    *
+  !                      is calculated                                         *
+  !                                                                            *
+  !*****************************************************************************
+
+  use par_mod
+
+  implicit none
+
+  real :: density(maxspec),schmi(maxspec,ni),fract(maxspec,ni)
+  real :: vset(maxspec,ni)
+  real :: vdep(maxspec),stokes,vdepj,rdp,ustar,alpha,ra,nyl
+  real,parameter :: eps=1.e-5
+  integer :: ic,j,nc
+
+
+  do ic=1,nc                  ! loop over all species
+    if (density(ic).gt.0.) then
+      do j=1,ni              ! loop over all diameter intervals
+        if (ustar.gt.eps) then
+
+  ! Stokes number for each diameter interval
+  !*****************************************
+
+          stokes=vset(ic,j)/ga*ustar*ustar/nyl
+          alpha=-3./stokes
+
+  ! Deposition layer resistance
+  !****************************
+
+          if (alpha.le.log10(eps)) then
+            rdp=1./(schmi(ic,j)*ustar)
+          else
+           	rdp=1./((schmi(ic,j)+10.**alpha)*ustar)
+          endif
+          vdepj=vset(ic,j)+1./(ra+rdp+ra*rdp*vset(ic,j))
+        else
+          vdepj=vset(ic,j)
+        endif
+
+  ! deposition velocities of each interval are weighted with mass fraction
+  !***********************************************************************
+
+        vdep(ic)=vdep(ic)+vdepj*fract(ic,j)
+      end do
+    endif
+  end do
+
+end subroutine partdep
Index: /branches/FP_AI/src/partoutput.f90
===================================================================
--- /branches/FP_AI/src/partoutput.f90	(revision 23)
+++ /branches/FP_AI/src/partoutput.f90	(revision 23)
@@ -0,0 +1,209 @@
+!**********************************************************************
+! 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 partoutput(itime)
+  !                        i
+  !*****************************************************************************
+  !                                                                            *
+  !     Dump all particle positions                                            *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     12 March 1999                                                          *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  !                                                                            *
+  !*****************************************************************************
+
+  use par_mod
+  use com_mod
+
+  implicit none
+
+  real(kind=dp) :: jul
+  integer :: itime,i,j,jjjjmmdd,ihmmss
+  integer :: ix,jy,ixp,jyp,indexh,m,il,ind,indz,indzp
+  real :: xlon,ylat
+  real :: dt1,dt2,dtt,ddx,ddy,rddx,rddy,p1,p2,p3,p4,dz1,dz2,dz
+  real :: topo,hm(2),hmixi,pv1(2),pvprof(2),pvi,qv1(2),qvprof(2),qvi
+  real :: tt1(2),ttprof(2),tti,rho1(2),rhoprof(2),rhoi
+  real :: tr(2),tri
+  character :: adate*8,atime*6
+
+
+  ! Determine current calendar date, needed for the file name
+  !**********************************************************
+
+  jul=bdate+real(itime,kind=dp)/86400._dp
+  call caldate(jul,jjjjmmdd,ihmmss)
+  write(adate,'(i8.8)') jjjjmmdd
+  write(atime,'(i6.6)') ihmmss
+
+
+  ! Some variables needed for temporal interpolation
+  !*************************************************
+
+  dt1=real(itime-memtime(1))
+  dt2=real(memtime(2)-itime)
+  dtt=1./(dt1+dt2)
+
+  ! Open output file and write the output
+  !**************************************
+
+  if (ipout.eq.1) then
+    open(unitpartout,file=path(2)(1:length(2))//'partposit_'//adate// &
+         atime,form='unformatted')
+  else
+    open(unitpartout,file=path(2)(1:length(2))//'partposit_end', &
+         form='unformatted')
+  endif
+
+  ! Write current time to file
+  !***************************
+
+  write(unitpartout) itime
+  do i=1,numpart
+
+  ! Take only valid particles
+  !**************************
+
+    if (itra1(i).eq.itime) then
+      xlon=xlon0+xtra1(i)*dx
+      ylat=ylat0+ytra1(i)*dy
+
+  !*****************************************************************************
+  ! Interpolate several variables (PV, specific humidity, etc.) to particle position
+  !*****************************************************************************
+
+      ix=xtra1(i)
+      jy=ytra1(i)
+      ixp=ix+1
+      jyp=jy+1
+      ddx=xtra1(i)-real(ix)
+      ddy=ytra1(i)-real(jy)
+      rddx=1.-ddx
+      rddy=1.-ddy
+      p1=rddx*rddy
+      p2=ddx*rddy
+      p3=rddx*ddy
+      p4=ddx*ddy
+
+  ! Topography
+  !***********
+
+      topo=p1*oro(ix ,jy) &
+           + p2*oro(ixp,jy) &
+           + p3*oro(ix ,jyp) &
+           + p4*oro(ixp,jyp)
+
+  ! Potential vorticity, specific humidity, temperature, and density
+  !*****************************************************************
+
+      do il=2,nz
+        if (height(il).gt.ztra1(i)) then
+          indz=il-1
+          indzp=il
+          goto 6
+        endif
+      end do
+6     continue
+
+      dz1=ztra1(i)-height(indz)
+      dz2=height(indzp)-ztra1(i)
+      dz=1./(dz1+dz2)
+
+
+      do ind=indz,indzp
+        do m=1,2
+          indexh=memind(m)
+
+  ! Potential vorticity
+          pv1(m)=p1*pv(ix ,jy ,ind,indexh) &
+               +p2*pv(ixp,jy ,ind,indexh) &
+               +p3*pv(ix ,jyp,ind,indexh) &
+               +p4*pv(ixp,jyp,ind,indexh)
+  ! Specific humidity
+          qv1(m)=p1*qv(ix ,jy ,ind,indexh) &
+               +p2*qv(ixp,jy ,ind,indexh) &
+               +p3*qv(ix ,jyp,ind,indexh) &
+               +p4*qv(ixp,jyp,ind,indexh)
+  ! Temperature
+          tt1(m)=p1*tt(ix ,jy ,ind,indexh) &
+               +p2*tt(ixp,jy ,ind,indexh) &
+               +p3*tt(ix ,jyp,ind,indexh) &
+               +p4*tt(ixp,jyp,ind,indexh)
+  ! Density
+          rho1(m)=p1*rho(ix ,jy ,ind,indexh) &
+               +p2*rho(ixp,jy ,ind,indexh) &
+               +p3*rho(ix ,jyp,ind,indexh) &
+               +p4*rho(ixp,jyp,ind,indexh)
+        end do
+        pvprof(ind-indz+1)=(pv1(1)*dt2+pv1(2)*dt1)*dtt
+        qvprof(ind-indz+1)=(qv1(1)*dt2+qv1(2)*dt1)*dtt
+        ttprof(ind-indz+1)=(tt1(1)*dt2+tt1(2)*dt1)*dtt
+        rhoprof(ind-indz+1)=(rho1(1)*dt2+rho1(2)*dt1)*dtt
+      end do
+      pvi=(dz1*pvprof(2)+dz2*pvprof(1))*dz
+      qvi=(dz1*qvprof(2)+dz2*qvprof(1))*dz
+      tti=(dz1*ttprof(2)+dz2*ttprof(1))*dz
+      rhoi=(dz1*rhoprof(2)+dz2*rhoprof(1))*dz
+
+  ! Tropopause and PBL height
+  !**************************
+
+      do m=1,2
+        indexh=memind(m)
+
+  ! Tropopause
+        tr(m)=p1*tropopause(ix ,jy ,1,indexh) &
+             + p2*tropopause(ixp,jy ,1,indexh) &
+             + p3*tropopause(ix ,jyp,1,indexh) &
+             + p4*tropopause(ixp,jyp,1,indexh)
+
+  ! PBL height
+        hm(m)=p1*hmix(ix ,jy ,1,indexh) &
+             + p2*hmix(ixp,jy ,1,indexh) &
+             + p3*hmix(ix ,jyp,1,indexh) &
+             + p4*hmix(ixp,jyp,1,indexh)
+      end do
+
+      hmixi=(hm(1)*dt2+hm(2)*dt1)*dtt
+      tri=(tr(1)*dt2+tr(2)*dt1)*dtt
+
+
+  ! Write the output
+  !*****************
+
+      write(unitpartout) npoint(i),xlon,ylat,ztra1(i), &
+           itramem(i),topo,pvi,qvi,rhoi,hmixi,tri,tti, &
+           (xmass1(i,j),j=1,nspec)
+    endif
+  end do
+  write(unitpartout) -99999,-9999.9,-9999.9,-9999.9,-99999, &
+       -9999.9,-9999.9,-9999.9,-9999.9,-9999.9,-9999.9,-9999.9, &
+       (-9999.9,j=1,nspec)
+
+
+  close(unitpartout)
+
+end subroutine partoutput
Index: /branches/FP_AI/src/partoutput_short.f90
===================================================================
--- /branches/FP_AI/src/partoutput_short.f90	(revision 23)
+++ /branches/FP_AI/src/partoutput_short.f90	(revision 23)
@@ -0,0 +1,152 @@
+!**********************************************************************
+! 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 partoutput_short(itime)
+  !                              i
+  !*****************************************************************************
+  !                                                                            *
+  !     Dump all particle positions                                            *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     12 March 1999                                                          *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  !                                                                            *
+  !*****************************************************************************
+
+  use par_mod
+  use com_mod
+
+  implicit none
+
+  real(kind=dp) :: jul
+  integer :: itime,i,j,jjjjmmdd,ihmmss,numshortout,numshortall
+  integer :: ix,jy,ixp,jyp
+  real :: xlon,ylat,zlim,dt1,dt2,dtt,ddx,ddy,rddx,rddy,p1,p2,p3,p4,topo
+  character :: adate*8,atime*6
+
+  integer(kind=2) :: idump(3,maxpart)
+  integer :: i4dump(maxpart)
+
+
+  ! Determine current calendar date, needed for the file name
+  !**********************************************************
+
+  jul=bdate+real(itime,kind=dp)/86400._dp
+  call caldate(jul,jjjjmmdd,ihmmss)
+  write(adate,'(i8.8)') jjjjmmdd
+  write(atime,'(i6.6)') ihmmss
+
+
+  ! Some variables needed for temporal interpolation
+  !*************************************************
+
+  dt1=real(itime-memtime(1))
+  dt2=real(memtime(2)-itime)
+  dtt=1./(dt1+dt2)
+
+
+  ! Loop about all particles
+  !*************************
+
+  numshortout=0
+  numshortall=0
+  do i=1,numpart
+
+  ! Take only valid particles
+  !**************************
+
+    if (itra1(i).eq.itime) then
+      xlon=xlon0+xtra1(i)*dx
+      ylat=ylat0+ytra1(i)*dy
+
+  !*****************************************************************************
+  ! Interpolate several variables (PV, specific humidity, etc.) to particle position
+  !*****************************************************************************
+
+      ix=xtra1(i)
+      jy=ytra1(i)
+      ixp=ix+1
+      jyp=jy+1
+      ddx=xtra1(i)-real(ix)
+      ddy=ytra1(i)-real(jy)
+      rddx=1.-ddx
+      rddy=1.-ddy
+      p1=rddx*rddy
+      p2=ddx*rddy
+      p3=rddx*ddy
+      p4=ddx*ddy
+
+  ! Topography
+  !***********
+
+      topo=p1*oro(ix ,jy) &
+           + p2*oro(ixp,jy) &
+           + p3*oro(ix ,jyp) &
+           + p4*oro(ixp,jyp)
+
+
+  ! Convert positions to integer*2 variables (from -32768 to 32767)
+  ! Do this only for region of main interest, i.e. extended North Atlantic region,
+  ! and for the tracer of interest, i.e. the North American one
+  !*****************************************************************************
+
+      if (xlon.gt.180.) xlon=xlon-360.
+      if (xlon.lt.-180.) xlon=xlon+360.
+
+      numshortall=numshortall+1
+      if ((xlon.gt.-140).and.(xlon.lt.60).and.(ylat.gt.10).and. &
+           (xmass1(i,1).gt.0.)) then
+        numshortout=numshortout+1
+        idump(1,numshortout)=nint(xlon*180.)
+        idump(2,numshortout)=nint(ylat*360.)
+        zlim=min(ztra1(i)+topo,32766.)
+        idump(3,numshortout)=nint(zlim)
+        i4dump(numshortout)=npoint(i)
+      endif
+
+    endif
+  end do
+
+
+  ! Open output file and write the output
+  !**************************************
+
+  open(unitshortpart,file=path(2)(1:length(2))//'shortposit_'//adate// &
+       atime,form='unformatted')
+
+  ! Write current time to file
+  !***************************
+
+  write(unitshortpart) itime
+  write(unitshortpart) numshortout
+  write(unitshortpart) &
+       (i4dump(i),(idump(j,i),j=1,3),i=1,numshortout)
+
+
+  write(*,*) numshortout,numshortall
+
+  close(unitshortpart)
+
+end subroutine partoutput_short
Index: /branches/FP_AI/src/pbl_profile.f90
===================================================================
--- /branches/FP_AI/src/pbl_profile.f90	(revision 23)
+++ /branches/FP_AI/src/pbl_profile.f90	(revision 23)
@@ -0,0 +1,132 @@
+!**********************************************************************
+! 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 pbl_profile(ps,td2m,zml1,t2m,tml1,u10m,uml1,stress,hf)
+
+  !********************************************************************
+  !                                                                   *
+  !                    G. WOTAWA, 1995-07-07                          *
+  !                                                                   *
+  !********************************************************************
+  !                                                                   *
+  ! DESCRIPTION: CALCULATION OF FRICTION VELOCITY AND SURFACE SENS-   *
+  !              IBLE HEAT FLUX USING THE PROFILE METHOD (BERKOVICZ   *
+  !              AND PRAHM, 1982)                                     *
+  !                                                                   *
+  ! Output now is surface stress instead of ustar                     *
+  !                                                                   *
+  !                                                                   *
+  !********************************************************************
+  !                                                                   *
+  ! INPUT:                                                            *
+  !                                                                   *
+  !                                                                   *
+  ! ps      surface pressure(Pa)                                      *
+  ! td2m    two metre dew point(K)                                    *
+  ! zml1    heigth of first model level (m)                           *
+  ! t2m     two metre temperature (K)                                 *
+  ! tml1    temperature first model level (K)                         *
+  ! u10m    ten metre wind speed (ms-1)                               *
+  ! uml1    wind speed first model level (ms-1)                       *
+  !                                                                   *
+  !********************************************************************
+  !                                                                   *
+  ! OUTPUT:                                                           *
+  !                                                                   *
+  ! stress  surface stress (i.e., friction velocity (ms-1) squared    *
+  !                         multiplied with air density)              *
+  ! hf      surface sensible heat flux (Wm-2)                         *
+  !                                                                   *
+  !********************************************************************
+  ! ustar   friction velocity (ms-1)                                  *
+  ! maxiter maximum number of iterations                              *
+  !********************************************************************
+
+  use par_mod
+
+  implicit none
+
+  integer :: iter
+  real :: ps,td2m,rhoa,zml1,t2m,tml1,u10m,uml1,ustar,hf
+  real :: al,alold,aldiff,tmean,crit
+  real :: deltau,deltat,thetastar,psim,psih,e,ew,tv,stress
+  integer,parameter :: maxiter=10
+  real,parameter    :: r1=0.74
+
+  e=ew(td2m)               ! vapor pressure
+  tv=t2m*(1.+0.378*e/ps)   ! virtual temperature
+  rhoa=ps/(r_air*tv)       ! air density
+
+  deltau=uml1-u10m         !! Wind Speed difference between
+                           !! Model level 1 and 10 m
+
+  if(deltau.le.0.001) then    !! Monin-Obukhov Theory not
+    al=9999.               !! applicable --> Set dummy values
+    ustar=0.01
+    stress=ustar*ustar*rhoa
+    hf=0.0
+    return
+  endif
+  deltat=tml1-t2m+0.0098*(zml1-2.)  !! Potential temperature difference
+                                    !! between model level 1 and 10 m
+
+  if(abs(deltat).le.0.03) then    !! Neutral conditions
+    hf=0.0
+    al=9999.
+    ustar=(vonkarman*deltau)/ &
+         (log(zml1/10.)-psim(zml1,al)+psim(10.,al))
+    stress=ustar*ustar*rhoa
+    return
+  endif
+
+  tmean=0.5*(t2m+tml1)
+  crit=(0.0219*tmean*(zml1-2.0)*deltau**2)/ &
+       (deltat*(zml1-10.0)**2)
+  if((deltat.gt.0).and.(crit.le.1.)) then
+                                    !! Successive approximation will
+    al=50.                          !! not converge
+    ustar=(vonkarman*deltau)/ &
+         (log(zml1/10.)-psim(zml1,al)+psim(10.,al))
+    thetastar=(vonkarman*deltat/r1)/ &
+         (log(zml1/2.)-psih(zml1,al)+psih(2.,al))
+    hf=rhoa*cpa*ustar*thetastar
+    stress=ustar*ustar*rhoa
+    return
+  endif
+
+  al=9999.                 ! Start iteration assuming neutral conditions
+  do iter=1,maxiter
+    alold=al
+    ustar=(vonkarman*deltau)/ &
+         (log(zml1/10.)-psim(zml1,al)+psim(10.,al))
+    thetastar=(vonkarman*deltat/r1)/ &
+         (log(zml1/2.)-psih(zml1,al)+psih(2.,al))
+    al=(tmean*ustar**2)/(ga*vonkarman*thetastar)
+    aldiff=abs((al-alold)/alold)
+    if(aldiff.lt.0.01) goto 30  !! Successive approximation successful
+  end do
+30   hf=rhoa*cpa*ustar*thetastar
+  if(al.gt.9999.) al=9999.
+  if(al.lt.-9999.) al=-9999.
+
+  stress=ustar*ustar*rhoa
+
+end subroutine pbl_profile
Index: /branches/FP_AI/src/plumetraj.f90
===================================================================
--- /branches/FP_AI/src/plumetraj.f90	(revision 23)
+++ /branches/FP_AI/src/plumetraj.f90	(revision 23)
@@ -0,0 +1,250 @@
+!**********************************************************************
+! 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 plumetraj(itime)
+  !                       i
+  !*****************************************************************************
+  !                                                                            *
+  ! Determines a plume centroid trajectory for each release site, and manages  *
+  ! clustering of particle locations. Certain parameters (average PV,          *
+  ! tropopause height, etc., are provided along the plume trajectories.        *
+  ! At the end, output is written to file 'trajectories.txt'.                  *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     24 January 2002                                                        *
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! fclust          fraction of particles belonging to each cluster            *
+  ! hmixcenter      mean mixing height for all particles                       *
+  ! ncluster        number of clusters to be used                              *
+  ! pvcenter        mean PV for all particles                                  *
+  ! pvfract         fraction of particles with PV<2pvu                         *
+  ! rms             total horizontal rms distance after clustering             *
+  ! rmsdist         total horizontal rms distance before clustering            *
+  ! rmsclust        horizontal rms distance for each individual cluster        *
+  ! topocenter      mean topography underlying all particles                   *
+  ! tropocenter     mean tropopause height at the positions of particles       *
+  ! tropofract      fraction of particles within the troposphere               *
+  ! zrms            total vertical rms distance after clustering               *
+  ! zrmsdist        total vertical rms distance before clustering              *
+  ! xclust,yclust,  Cluster centroid positions                                 *
+  ! zclust                                                                     *
+  !                                                                            *
+  !*****************************************************************************
+
+  use point_mod
+  use par_mod
+  use com_mod
+
+  implicit none
+
+  integer :: itime,ix,jy,ixp,jyp,indexh,i,j,k,m,n,il,ind,indz,indzp
+  real :: xl(maxpart),yl(maxpart),zl(maxpart)
+  real :: xcenter,ycenter,zcenter,dist,distance,rmsdist,zrmsdist
+
+  real :: xclust(ncluster),yclust(ncluster),zclust(ncluster)
+  real :: fclust(ncluster),rms,rmsclust(ncluster),zrms
+
+  real :: dt1,dt2,dtt,ddx,ddy,rddx,rddy,p1,p2,p3,p4,dz1,dz2,dz
+  real :: topo,topocenter,hm(2),hmixi,hmixfract,hmixcenter
+  real :: pv1(2),pvprof(2),pvi,pvcenter,pvfract,tr(2),tri,tropofract
+  real :: tropocenter
+
+
+  dt1=real(itime-memtime(1))
+  dt2=real(memtime(2)-itime)
+  dtt=1./(dt1+dt2)
+
+
+  ! Loop about all release points
+  !******************************
+
+  do j=1,numpoint
+    if (abs(ireleasestart(j)-itime).gt.lage(nageclass)) goto 10
+    topocenter=0.
+    hmixcenter=0.
+    hmixfract=0.
+    tropocenter=0.
+    tropofract=0.
+    pvfract=0.
+    pvcenter=0.
+    rmsdist=0.
+    zrmsdist=0.
+
+    n=0
+    do i=1,numpart
+      if (itra1(i).ne.itime) goto 20
+      if (npoint(i).ne.j) goto 20
+      n=n+1
+      xl(n)=xlon0+xtra1(i)*dx
+      yl(n)=ylat0+ytra1(i)*dy
+      zl(n)=ztra1(i)
+
+
+  ! Interpolate PBL height, PV, and tropopause height to each
+  ! particle position in order to determine fraction of particles
+  ! within the PBL, above tropopause height, and average PV.
+  ! Interpolate topography, too, and convert to altitude asl
+  !**************************************************************
+
+      ix=int(xtra1(i))
+      jy=int(ytra1(i))
+      ixp=ix+1
+      jyp=jy+1
+      ddx=xtra1(i)-real(ix)
+      ddy=ytra1(i)-real(jy)
+      rddx=1.-ddx
+      rddy=1.-ddy
+      p1=rddx*rddy
+      p2=ddx*rddy
+      p3=rddx*ddy
+      p4=ddx*ddy
+
+  ! Topography
+  !***********
+
+      topo=p1*oro(ix ,jy) &
+           + p2*oro(ixp,jy) &
+           + p3*oro(ix ,jyp) &
+           + p4*oro(ixp,jyp)
+      topocenter=topocenter+topo
+
+  ! Potential vorticity
+  !********************
+
+      do il=2,nz
+        if (height(il).gt.zl(n)) then
+          indz=il-1
+          indzp=il
+          goto 6
+        endif
+      end do
+6     continue
+
+      dz1=zl(n)-height(indz)
+      dz2=height(indzp)-zl(n)
+      dz=1./(dz1+dz2)
+
+
+      do ind=indz,indzp
+        do m=1,2
+          indexh=memind(m)
+          pv1(m)=p1*pv(ix ,jy ,ind,indexh) &
+               +p2*pv(ixp,jy ,ind,indexh) &
+               +p3*pv(ix ,jyp,ind,indexh) &
+               +p4*pv(ixp,jyp,ind,indexh)
+        end do
+        pvprof(ind-indz+1)=(pv1(1)*dt2+pv1(2)*dt1)*dtt
+      end do
+      pvi=(dz1*pvprof(2)+dz2*pvprof(1))*dz
+      pvcenter=pvcenter+pvi
+      if (yl(n).gt.0.) then
+        if (pvi.lt.2.) pvfract=pvfract+1.
+      else
+        if (pvi.gt.-2.) pvfract=pvfract+1.
+      endif
+
+
+  ! Tropopause and PBL height
+  !**************************
+
+      do m=1,2
+        indexh=memind(m)
+
+        tr(m)=p1*tropopause(ix ,jy ,1,indexh) &
+             + p2*tropopause(ixp,jy ,1,indexh) &
+             + p3*tropopause(ix ,jyp,1,indexh) &
+             + p4*tropopause(ixp,jyp,1,indexh)
+
+        hm(m)=p1*hmix(ix ,jy ,1,indexh) &
+             + p2*hmix(ixp,jy ,1,indexh) &
+             + p3*hmix(ix ,jyp,1,indexh) &
+             + p4*hmix(ixp,jyp,1,indexh)
+      end do
+
+      hmixi=(hm(1)*dt2+hm(2)*dt1)*dtt
+      tri=(tr(1)*dt2+tr(2)*dt1)*dtt
+      if (zl(n).lt.tri) tropofract=tropofract+1.
+      tropocenter=tropocenter+tri+topo
+      if (zl(n).lt.hmixi) hmixfract=hmixfract+1.
+      zl(n)=zl(n)+topo        ! convert to height asl
+      hmixcenter=hmixcenter+hmixi
+
+
+20    continue
+    end do
+
+
+  ! Make statistics for all plumes with n>0 particles
+  !**************************************************
+
+    if (n.gt.0) then
+      topocenter=topocenter/real(n)
+      hmixcenter=hmixcenter/real(n)
+      pvcenter=pvcenter/real(n)
+      tropocenter=tropocenter/real(n)
+      hmixfract=100.*hmixfract/real(n)
+      pvfract=100.*pvfract/real(n)
+      tropofract=100.*tropofract/real(n)
+
+  ! Cluster the particle positions
+  !*******************************
+
+      call clustering(xl,yl,zl,n,xclust,yclust,zclust,fclust,rms, &
+           rmsclust,zrms)
+
+
+  ! Determine center of mass position on earth and average height
+  !**************************************************************
+
+      call centerofmass(xl,yl,n,xcenter,ycenter)
+      call mean(zl,zcenter,zrmsdist,n)
+
+  ! Root mean square distance from center of mass
+  !**********************************************
+
+      do k=1,n
+        dist=distance(yl(k),xl(k),ycenter,xcenter)
+        rmsdist=rmsdist+dist*dist
+      end do
+      if (rmsdist.gt.0.) rmsdist=sqrt(rmsdist/real(n))
+      rmsdist=max(rmsdist,0.)
+
+  ! Write out results in trajectory data file
+  !******************************************
+
+      write(unitouttraj,'(i5,i8,2f9.4,4f8.1,f8.2,4f8.1,3f6.1,&
+           &5(2f8.3,f7.0,f6.1,f8.1))')&
+           &j,itime-(ireleasestart(j)+ireleaseend(j))/2, &
+           xcenter,ycenter,zcenter,topocenter,hmixcenter,tropocenter, &
+           pvcenter,rmsdist,rms,zrmsdist,zrms,hmixfract,pvfract, &
+           tropofract, &
+           (xclust(k),yclust(k),zclust(k),fclust(k),rmsclust(k), &
+           k=1,ncluster)
+    endif
+
+
+10  continue
+  end do
+
+
+end subroutine plumetraj
Index: /branches/FP_AI/src/point_mod.f90
===================================================================
--- /branches/FP_AI/src/point_mod.f90	(revision 23)
+++ /branches/FP_AI/src/point_mod.f90	(revision 23)
@@ -0,0 +1,41 @@
+!**********************************************************************
+! 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/>.   *
+!**********************************************************************
+
+module point_mod
+
+  implicit none
+
+  integer, allocatable, dimension (:) :: ireleasestart
+  integer, allocatable, dimension (:) :: ireleaseend
+  integer, allocatable, dimension (:) :: npart
+  integer*2, allocatable, dimension (:) :: kindz
+
+  real,allocatable, dimension (:) :: xpoint1
+  real,allocatable, dimension (:) :: xpoint2
+  real,allocatable, dimension (:) :: ypoint1
+  real,allocatable, dimension (:) :: ypoint2
+  real,allocatable, dimension (:) :: zpoint1
+  real,allocatable, dimension (:) :: zpoint2
+
+  real,allocatable, dimension (:,:) :: xmass
+  real,allocatable, dimension (:) :: rho_rel
+
+end module point_mod
Index: /branches/FP_AI/src/psih.f90
===================================================================
--- /branches/FP_AI/src/psih.f90	(revision 23)
+++ /branches/FP_AI/src/psih.f90	(revision 23)
@@ -0,0 +1,76 @@
+!**********************************************************************
+! 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/>.   *
+!**********************************************************************
+
+function psih (z,l)
+
+  !*****************************************************************************
+  !                                                                            *
+  !     Calculation of the stability correction term                           *
+  !                                                                            *
+  !     AUTHOR: Matthias Langer, adapted by Andreas Stohl (6 August 1993)      *
+  !             Update: G. Wotawa, 11 October 1994                             *
+  !                                                                            *
+  !     Literature:                                                            *
+  !     [1] C.A.Paulson (1970), A Mathematical Representation of Wind Speed    *
+  !           and Temperature Profiles in the Unstable Atmospheric Surface     *
+  !           Layer. J.Appl.Met.,Vol.9.(1970), pp.857-861.                     *
+  !                                                                            *
+  !     [2] A.C.M. Beljaars, A.A.M. Holtslag (1991), Flux Parameterization over*
+  !           Land Surfaces for Atmospheric Models. J.Appl.Met. Vol. 30,pp 327-*
+  !           341                                                              *
+  !                                                                            *
+  !     Variables:                                                             *
+  !     L     = Monin-Obukhov-length [m]                                       *
+  !     z     = height [m]                                                     *
+  !     zeta  = auxiliary variable                                             *
+  !                                                                            *
+  !     Constants:                                                             *
+  !     eps   = 1.2E-38, SUN-underflow: to avoid division by zero errors       *
+  !                                                                            *
+  !*****************************************************************************
+
+  use par_mod
+
+  implicit none
+
+  real :: psih,x,z,zeta,l
+  real,parameter :: a=1.,b=0.667,c=5.,d=0.35,eps=1.e-20
+
+  if ((l.ge.0).and.(l.lt.eps)) then
+    l=eps
+  else if ((l.lt.0).and.(l.gt.(-1.*eps))) then
+    l=-1.*eps
+  endif
+
+  if ((log10(z)-log10(abs(l))).lt.log10(eps)) then
+    psih=0.
+  else
+    zeta=z/l
+    if (zeta.gt.0.) then
+      psih = - (1.+0.667*a*zeta)**(1.5) - b*(zeta-c/d)*exp(-d*zeta) &
+           - b*c/d + 1.
+    else
+      x=(1.-16.*zeta)**(.25)
+      psih=2.*log((1.+x*x)/2.)
+    end if
+  end if
+
+end function psih
Index: /branches/FP_AI/src/psim.f90
===================================================================
--- /branches/FP_AI/src/psim.f90	(revision 23)
+++ /branches/FP_AI/src/psim.f90	(revision 23)
@@ -0,0 +1,50 @@
+!**********************************************************************
+! 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/>.   *
+!**********************************************************************
+
+real function psim(z,al)
+
+  !**********************************************************************
+  !                                                                     *
+  ! DESCRIPTION: CALCULATION OF THE STABILITY CORRECTION FUNCTION FOR   *
+  !              MOMENTUM AS FUNCTION OF HEIGHT Z AND OBUKHOV SCALE     *
+  !              HEIGHT L                                               *
+  !                                                                     *
+  !**********************************************************************
+
+  use par_mod
+
+  implicit none
+
+  real :: z,al,zeta,x,a1,a2
+
+  zeta=z/al
+  if(zeta.le.0.) then
+  ! UNSTABLE CASE
+    x=(1.-15.*zeta)**0.25
+    a1=((1.+x)/2.)**2
+    a2=(1.+x**2)/2.
+    psim=log(a1*a2)-2.*atan(x)+pi/2.
+  else
+  ! STABLE CASE
+    psim=-4.7*zeta
+  endif
+
+end function psim
Index: /branches/FP_AI/src/qvsat.f90
===================================================================
--- /branches/FP_AI/src/qvsat.f90	(revision 23)
+++ /branches/FP_AI/src/qvsat.f90	(revision 23)
@@ -0,0 +1,157 @@
+!**********************************************************************
+! 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/>.   *
+!**********************************************************************
+
+!##################################################################
+!##################################################################
+!######                                                      ######
+!######                     Developed by                     ######
+!######     Center for Analysis and Prediction of Storms     ######
+!######                University of Oklahoma                ######
+!######                                                      ######
+!##################################################################
+!##################################################################
+
+function f_qvsat( p, t )
+
+  !PURPOSE:
+  !
+  !Calculate the saturation specific humidity using enhanced Teten's
+  !formula.
+  !
+  !AUTHOR: Yuhe Liu
+  !01/08/1998
+  !
+  !MODIFICATION HISTORY:
+  !
+  !INPUT :
+  !  p        Pressure (Pascal)
+  !  t        Temperature (K)
+  !OUTPUT:
+  !  f_qvsat  Saturation water vapor specific humidity (kg/kg).
+  !
+  !Variable Declarations.
+  !
+
+  implicit none
+
+  real :: p         ! Pressure (Pascal)
+  real :: t         ! Temperature (K)
+  real :: f_qvsat   ! Saturation water vapor specific humidity (kg/kg)
+  real :: f_esl,f_esi,fespt
+
+  real,parameter ::  rd     = 287.0 ! Gas constant for dry air  (m**2/(s**2*K))
+  real,parameter ::  rv     = 461.0 ! Gas constant for water vapor  (m**2/(s**2*K)).
+  real,parameter ::  rddrv  = rd/rv
+
+
+  ! Change by A. Stohl to save computation time:
+  ! IF ( t.ge.273.15 ) THEN     ! for water
+  if ( t.ge.253.15 ) then      ! modification Petra Seibert
+                               ! (supercooled water may be present)
+    fespt=f_esl(p,t)
+  else
+    fespt=f_esi(p,t)
+  endif
+
+!!$  f_qvsat = rddrv * fespt / (p-(1.0-rddrv)*fespt)      !old
+  if (p-(1.0-rddrv)*fespt == 0.) then                     !bugfix
+     f_qvsat = 1.
+  else
+     f_qvsat = rddrv * fespt / (p-(1.0-rddrv)*fespt)
+  end if
+
+  return
+end function f_qvsat
+
+
+function f_esl( p, t )
+
+  implicit none
+
+  real :: p         ! Pressure (Pascal)
+  real :: t         ! Temperature (K)
+  real :: f_esl     ! Saturation water vapor pressure over liquid water
+
+  real :: f
+
+  !#######################################################################
+  !
+  !Saturation specific humidity parameters used in enhanced Teten's
+  !formula. (See A. Buck, JAM 1981)
+  !
+  !#######################################################################
+
+  real,parameter ::  satfwa = 1.0007
+  real,parameter ::  satfwb = 3.46e-8  ! for p in Pa
+
+  real,parameter ::  satewa = 611.21   ! es in Pa
+  real,parameter ::  satewb = 17.502
+  real,parameter ::  satewc = 32.18
+
+  real,parameter ::  satfia = 1.0003
+  real,parameter ::  satfib = 4.18e-8  ! for p in Pa
+
+  real,parameter ::  sateia = 611.15   ! es in Pa
+  real,parameter ::  sateib = 22.452
+  real,parameter ::  sateic = 0.6
+
+  f = satfwa + satfwb * p
+  f_esl = f * satewa * exp( satewb*(t-273.15)/(t-satewc) )
+
+  return
+end function f_esl
+
+function f_esi( p, t )
+
+  implicit none
+
+  real :: p         ! Pressure (Pascal)
+  real :: t         ! Temperature (K)
+  real :: f_esi     ! Saturation water vapor pressure over ice (Pa)
+
+  real :: f
+
+  !#######################################################################
+  !
+  !Saturation specific humidity parameters used in enhanced Teten's
+  !formula. (See A. Buck, JAM 1981)
+  !
+  !#######################################################################
+  !
+  real,parameter ::  satfwa = 1.0007
+  real,parameter ::  satfwb = 3.46e-8  ! for p in Pa
+
+  real,parameter ::  satewa = 611.21   ! es in Pa
+  real,parameter ::  satewb = 17.502
+  real,parameter ::  satewc = 32.18
+
+  real,parameter ::  satfia = 1.0003
+  real,parameter ::  satfib = 4.18e-8  ! for p in Pa
+
+  real,parameter ::  sateia = 611.15   ! es in Pa
+  real,parameter ::  sateib = 22.452
+  real,parameter ::  sateic = 0.6
+
+  f = satfia + satfib * p
+  f_esi = f * sateia * exp( sateib*(t-273.15)/(t-sateic) )
+
+  return
+end function f_esi
Index: /branches/FP_AI/src/raerod.f90
===================================================================
--- /branches/FP_AI/src/raerod.f90	(revision 23)
+++ /branches/FP_AI/src/raerod.f90	(revision 23)
@@ -0,0 +1,63 @@
+!**********************************************************************
+! 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/>.   *
+!**********************************************************************
+
+function raerod (l,ust,z0)
+
+  !*****************************************************************************
+  !                                                                            *
+  !     Calculation of the aerodynamical resistance ra from ground up to href  *
+  !                                                                            *
+  !     AUTHOR: Matthias Langer, modified by Andreas Stohl (6 August 1993)     *
+  !                                                                            *
+  !     Literature:                                                            *
+  !     [1]  Hicks/Baldocchi/Meyers/Hosker/Matt (1987), A Preliminary          *
+  !             Multiple Resistance Routine for Deriving Dry Deposition        *
+  !             Velocities from Measured Quantities.                           *
+  !             Water, Air and Soil Pollution 36 (1987), pp.311-330.           *
+  !     [2]  Scire/Yamartino/Carmichael/Chang (1989),                          *
+  !             CALGRID: A Mesoscale Photochemical Grid Model.                 *
+  !             Vol II: User's Guide. (Report No.A049-1, June, 1989)           *
+  !                                                                            *
+  !     Variable list:                                                         *
+  !     L     = Monin-Obukhov-length [m]                                       *
+  !     ust   = friction velocity [m/sec]                                      *
+  !     z0    = surface roughness length [m]                                   *
+  !     href  = reference height [m], for which deposition velocity is         *
+  !             calculated                                                     *
+  !                                                                            *
+  !     Constants:                                                             *
+  !     karman    = von Karman-constant (~0.4)                                 *
+  !     ramin = minimum resistence of ra (1 s/m)                               *
+  !                                                                            *
+  !     Subprograms and functions:                                             *
+  !     function psih (z/L)                                                    *
+  !                                                                            *
+  !*****************************************************************************
+
+  use par_mod
+
+  implicit none
+
+  real :: l,psih,raerod,ust,z0
+
+  raerod=(alog(href/z0)-psih(href,l)+psih(z0,l))/(karman*ust)
+
+end function raerod
Index: /branches/FP_AI/src/random.f90
===================================================================
--- /branches/FP_AI/src/random.f90	(revision 23)
+++ /branches/FP_AI/src/random.f90	(revision 23)
@@ -0,0 +1,154 @@
+!**********************************************************************
+! 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/>.   *
+!**********************************************************************
+
+!  Taken from Press et al., Numerical Recipes
+
+function ran1(idum)
+
+  implicit none
+
+  integer :: idum
+  real    :: ran1
+  integer,parameter :: ia=16807, im=2147483647, iq=127773, ir=2836
+  integer,parameter :: ntab=32, ndiv=1+(im-1)/ntab
+  real,parameter    :: am=1./im, eps=1.2e-7, rnmx=1.-eps
+  integer :: j, k
+  integer :: iv(ntab) = (/ (0,j=1,ntab) /)
+  integer :: iy=0
+
+  if (idum.le.0.or.iy.eq.0) then
+    idum=max(-idum,1)
+    do j=ntab+8,1,-1
+      k=idum/iq
+      idum=ia*(idum-k*iq)-ir*k
+      if (idum.lt.0) idum=idum+im
+      if (j.le.ntab) iv(j)=idum
+    enddo
+    iy=iv(1)
+  endif
+  k=idum/iq
+  idum=ia*(idum-k*iq)-ir*k
+  if (idum.lt.0) idum=idum+im
+  j=1+iy/ndiv
+  iy=iv(j)
+  iv(j)=idum
+  ran1=min(am*iy,rnmx)
+end function ran1
+
+
+function gasdev(idum)
+
+  implicit none
+
+  integer :: idum
+  real    :: gasdev, fac, r, v1, v2
+  integer :: iset = 0
+  real    :: gset = 0.
+  real, external :: ran3
+
+  if (iset.eq.0) then
+1   v1=2.*ran3(idum)-1.
+    v2=2.*ran3(idum)-1.
+    r=v1**2+v2**2
+    if(r.ge.1.0 .or. r.eq.0.0) go to 1
+    fac=sqrt(-2.*log(r)/r)
+    gset=v1*fac
+    gasdev=v2*fac
+    iset=1
+  else
+    gasdev=gset
+    iset=0
+  endif
+end function gasdev
+
+
+subroutine gasdev1(idum,random1,random2)
+
+  implicit none
+
+  integer :: idum
+  real :: random1, random2, fac, v1, v2, r
+  real, external :: ran3
+
+1   v1=2.*ran3(idum)-1.
+  v2=2.*ran3(idum)-1.
+  r=v1**2+v2**2
+  if(r.ge.1.0 .or. r.eq.0.0) go to 1
+  fac=sqrt(-2.*log(r)/r)
+  random1=v1*fac
+  random2=v2*fac
+  ! Limit the random numbers to lie within the interval -3 and +3
+  !**************************************************************
+  if (random1.lt.-3.) random1=-3.
+  if (random2.lt.-3.) random2=-3.
+  if (random1.gt.3.) random1=3.
+  if (random2.gt.3.) random2=3.
+end subroutine gasdev1
+
+
+function ran3(idum)
+
+  implicit none
+
+  integer :: idum
+  real :: ran3
+
+  integer,parameter :: mbig=1000000000, mseed=161803398, mz=0
+  real,parameter    :: fac=1./mbig
+  integer :: i,ii,inext,inextp,k
+  integer :: mj,mk,ma(55)
+
+  save inext,inextp,ma
+  integer :: iff = 0
+
+  if(idum.lt.0.or.iff.eq.0)then
+    iff=1
+    mj=mseed-iabs(idum)
+    mj=mod(mj,mbig)
+    ma(55)=mj
+    mk=1
+    do i=1,54
+      ii=mod(21*i,55)
+      ma(ii)=mk
+      mk=mj-mk
+      if(mk.lt.mz)mk=mk+mbig
+      mj=ma(ii)
+    end do
+    do k=1,4
+      do i=1,55
+        ma(i)=ma(i)-ma(1+mod(i+30,55))
+        if(ma(i).lt.mz)ma(i)=ma(i)+mbig
+      end do
+    end do
+    inext=0
+    inextp=31
+    idum=1
+  endif
+  inext=inext+1
+  if(inext.eq.56)inext=1
+  inextp=inextp+1
+  if(inextp.eq.56)inextp=1
+  mj=ma(inext)-ma(inextp)
+  if(mj.lt.mz)mj=mj+mbig
+  ma(inext)=mj
+  ran3=mj*fac
+end function ran3
+!  (C) Copr. 1986-92 Numerical Recipes Software US.
Index: /branches/FP_AI/src/readOHfield.f90
===================================================================
--- /branches/FP_AI/src/readOHfield.f90	(revision 23)
+++ /branches/FP_AI/src/readOHfield.f90	(revision 23)
@@ -0,0 +1,84 @@
+!**********************************************************************
+! 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 readOHfield
+
+  !*****************************************************************************
+  !                                                                            *
+  ! Reads the OH field into memory                                             *
+  !                                                                            *
+  ! AUTHOR: Sabine Eckhardt, June 2007                                         *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! i                       loop indices                                       *
+  ! LENGTH(numpath)         length of the path names                           *
+  ! PATH(numpath)           contains the path names                            *
+  ! unitoh                  unit connected with OH field                       *
+  !                                                                            *
+  ! -----                                                                      *
+  !                                                                            *
+  !*****************************************************************************
+
+  use oh_mod
+  use par_mod
+  use com_mod
+
+  implicit none
+
+  integer :: ix,jy,lev,m
+
+
+  ! Read OH field and level heights
+  !********************************
+
+! write (*,*) 'reading OH'
+  open(unitOH,file=path(1)(1:length(1))//'OH_7lev_agl.dat', &
+       status='old',form='UNFORMATTED', err=998)
+  do m=1,12
+    do lev=1,maxzOH
+      do ix=0,maxxOH-1
+  !      do 10 jy=0,maxyOH-1
+          read(unitOH) (OH_field(m,ix,jy,lev),jy=0,maxyOH-1)
+  !      if ((ix.eq.20).and.(lev.eq.1)) then
+  !          write(*,*) 'reading: ', m, OH_field(m,ix,20,lev)
+  !      endif
+      end do
+    end do
+  end do
+  close(unitOH)
+
+  do lev=1,7
+    OH_field_height(lev)=1000+real(lev-1)*2.*1000.
+  end do
+
+!  write (*,*) 'OH read'
+  return
+
+  ! Issue error messages
+  !*********************
+
+998   write(*,*) ' #### FLEXPART ERROR! FILE CONTAINING          ####'
+  write(*,*) ' #### OH FIELD DOES NOT EXIST                  ####'
+  stop
+
+end subroutine readohfield
Index: /branches/FP_AI/src/readageclasses.f90
===================================================================
--- /branches/FP_AI/src/readageclasses.f90	(revision 23)
+++ /branches/FP_AI/src/readageclasses.f90	(revision 23)
@@ -0,0 +1,107 @@
+!**********************************************************************
+! 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 readageclasses
+
+  !*****************************************************************************
+  !                                                                            *
+  !     This routine reads the age classes to be used for the current model    *
+  !     run.                                                                   *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     20 March 2000                                                          *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  !                                                                            *
+  ! Constants:                                                                 *
+  !                                                                            *
+  !*****************************************************************************
+
+  use par_mod
+  use com_mod
+
+  implicit none
+
+  integer :: i
+
+
+  ! If age spectra calculation is switched off, set number of age classes
+  ! to 1 and maximum age to a large number
+  !**********************************************************************
+
+  if (lagespectra.ne.1) then
+    nageclass=1
+    lage(nageclass)=999999999
+    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)
+
+  do i=1,13
+    read(unitageclasses,*)
+  end do
+  read(unitageclasses,*) nageclass
+
+
+  if (nageclass.gt.maxageclass) then
+    write(*,*) ' #### FLEXPART MODEL ERROR! NUMBER OF AGE     #### '
+    write(*,*) ' #### CLASSES GREATER THAN MAXIMUM ALLOWED.   #### '
+    write(*,*) ' #### CHANGE SETTINGS IN FILE AGECLASSES OR   #### '
+    write(*,*) ' #### RECOMPILE WITH LARGER MAXAGECLASS IN    #### '
+    write(*,*) ' #### FILE PAR_MOD.                        #### '
+    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 #### '
+    write(*,*) ' #### SETTINGS IN FILE AGECLASSES.            #### '
+    stop
+  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.      #### '
+      write(*,*) ' #### CHANGE SETTINGS IN FILE AGECLASSES.   #### '
+      stop
+    endif
+  end do
+
+  return
+
+999   write(*,*) ' #### FLEXPART MODEL ERROR! FILE "AGECLASSES" #### '
+  write(*,*) ' #### CANNOT BE OPENED IN THE DIRECTORY       #### '
+  write(*,'(a)') path(1)(1:length(1))
+  stop
+
+end subroutine readageclasses
Index: /branches/FP_AI/src/readavailable.f90
===================================================================
--- /branches/FP_AI/src/readavailable.f90	(revision 23)
+++ /branches/FP_AI/src/readavailable.f90	(revision 23)
@@ -0,0 +1,290 @@
+!**********************************************************************
+! 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 readavailable
+
+  !*****************************************************************************
+  !                                                                            *
+  !   This routine reads the dates and times for which windfields are          *
+  !   available.                                                               *
+  !                                                                            *
+  !     Authors: A. Stohl                                                      *
+  !                                                                            *
+  !     6 February 1994                                                        *
+  !     8 February 1999, Use of nested fields, A. Stohl                        *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! bdate                beginning date as Julian date                         *
+  ! beg                  beginning date for windfields                         *
+  ! end                  ending date for windfields                            *
+  ! fname                filename of wind field, help variable                 *
+  ! ideltas [s]          duration of modelling period                          *
+  ! idiff                time difference between 2 wind fields                 *
+  ! idiffnorm            normal time difference between 2 wind fields          *
+  ! idiffmax [s]         maximum allowable time between 2 wind fields          *
+  ! jul                  julian date, help variable                            *
+  ! numbwf               actual number of wind fields                          *
+  ! wfname(maxwf)        file names of needed wind fields                      *
+  ! wfspec(maxwf)        file specifications of wind fields (e.g., if on disc) *
+  ! wftime(maxwf) [s]times of wind fields relative to beginning time           *
+  ! wfname1,wfspec1,wftime1 = same as above, but only local (help variables)   *
+  !                                                                            *
+  ! Constants:                                                                 *
+  ! maxwf                maximum number of wind fields                         *
+  ! unitavailab          unit connected to file AVAILABLE                      *
+  !                                                                            *
+  !*****************************************************************************
+
+  use par_mod
+  use com_mod
+
+  implicit none
+
+  integer :: i,idiff,ldat,ltim,wftime1(maxwf),numbwfn(maxnests),k
+  integer :: wftime1n(maxnests,maxwf),wftimen(maxnests,maxwf)
+  real(kind=dp) :: juldate,jul,beg,end
+  character(len=255) :: fname,spec,wfname1(maxwf),wfspec1(maxwf)
+  character(len=255) :: wfname1n(maxnests,maxwf)
+  character(len=40) :: wfspec1n(maxnests,maxwf)
+
+
+  ! Windfields are only used, if they are within the modelling period.
+  ! However, 1 additional day at the beginning and at the end is used for
+  ! interpolation. -> Compute beginning and ending date for the windfields.
+  !************************************************************************
+
+  if (ideltas.gt.0) then         ! forward trajectories
+    beg=bdate-1._dp
+    end=bdate+real(ideltas,kind=dp)/86400._dp+real(idiffmax,kind=dp)/ &
+         86400._dp
+  else                           ! backward trajectories
+    beg=bdate+real(ideltas,kind=dp)/86400._dp-real(idiffmax,kind=dp)/ &
+         86400._dp
+    end=bdate+1._dp
+  endif
+
+  ! Open the wind field availability file and read available wind fields
+  ! within the modelling period.
+  !*********************************************************************
+
+  open(unitavailab,file=path(4)(1:length(4)),status='old', &
+       err=999)
+
+  do i=1,3
+    read(unitavailab,*)
+  end do
+
+  numbwf=0
+100   read(unitavailab,'(i8,1x,i6,2(6x,a255))',end=99) &
+           ldat,ltim,fname,spec
+    jul=juldate(ldat,ltim)
+    if ((jul.ge.beg).and.(jul.le.end)) then
+      numbwf=numbwf+1
+      if (numbwf.gt.maxwf) then      ! check exceedance of dimension
+       write(*,*) 'Number of wind fields needed is too great.'
+       write(*,*) 'Reduce modelling period (file "COMMAND") or'
+       write(*,*) 'reduce number of wind fields (file "AVAILABLE").'
+       stop
+      endif
+
+      wfname1(numbwf)=fname(1:index(fname,' '))
+      wfspec1(numbwf)=spec
+      wftime1(numbwf)=nint((jul-bdate)*86400._dp)
+    endif
+    goto 100       ! next wind field
+
+99   continue
+
+  close(unitavailab)
+
+  ! Open the wind field availability file and read available wind fields
+  ! within the modelling period (nested grids)
+  !*********************************************************************
+
+  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))
+    open(unitavailab,file=path(numpath+2*(k-1)+2) &
+         (1:length(numpath+2*(k-1)+2)),status='old',err=998)
+
+    do i=1,3
+      read(unitavailab,*)
+    end do
+
+    numbwfn(k)=0
+700   read(unitavailab,'(i8,1x,i6,2(6x,a255))',end=699) ldat, &
+           ltim,fname,spec
+      jul=juldate(ldat,ltim)
+      if ((jul.ge.beg).and.(jul.le.end)) then
+        numbwfn(k)=numbwfn(k)+1
+        if (numbwfn(k).gt.maxwf) then      ! check exceedance of dimension
+       write(*,*) 'Number of nested wind fields is too great.'
+       write(*,*) 'Reduce modelling period (file "COMMAND") or'
+       write(*,*) 'reduce number of wind fields (file "AVAILABLE").'
+          stop
+        endif
+
+        wfname1n(k,numbwfn(k))=fname
+        wfspec1n(k,numbwfn(k))=spec
+        wftime1n(k,numbwfn(k))=nint((jul-bdate)*86400._dp)
+      endif
+      goto 700       ! next wind field
+
+699   continue
+
+    close(unitavailab)
+  end do
+
+
+  ! Check wind field times of file AVAILABLE (expected to be in temporal order)
+  !****************************************************************************
+
+  if (numbwf.eq.0) then
+    write(*,*) ' #### FLEXPART MODEL ERROR! NO WIND FIELDS    #### '
+    write(*,*) ' #### AVAILABLE FOR SELECTED TIME PERIOD.     #### '
+    stop
+  endif
+
+  do i=2,numbwf
+    if (wftime1(i).le.wftime1(i-1)) then
+      write(*,*) 'FLEXPART ERROR: FILE AVAILABLE IS CORRUPT.'
+      write(*,*) 'THE WIND FIELDS ARE NOT IN TEMPORAL ORDER.'
+      write(*,*) 'PLEASE CHECK FIELD ',wfname1(i)
+      stop
+    endif
+  end do
+
+  ! Check wind field times of file AVAILABLE for the nested fields
+  ! (expected to be in temporal order)
+  !***************************************************************
+
+  do k=1,numbnests
+    if (numbwfn(k).eq.0) then
+      write(*,*) '#### FLEXPART MODEL ERROR! NO WIND FIELDS  ####'
+      write(*,*) '#### AVAILABLE FOR SELECTED TIME PERIOD.   ####'
+      stop
+    endif
+
+    do i=2,numbwfn(k)
+      if (wftime1n(k,i).le.wftime1n(k,i-1)) then
+      write(*,*) 'FLEXPART ERROR: FILE AVAILABLE IS CORRUPT. '
+      write(*,*) 'THE NESTED WIND FIELDS ARE NOT IN TEMPORAL ORDER.'
+      write(*,*) 'PLEASE CHECK FIELD ',wfname1n(k,i)
+      write(*,*) 'AT NESTING LEVEL ',k
+      stop
+      endif
+    end do
+
+  end do
+
+
+  ! For backward trajectories, reverse the order of the windfields
+  !***************************************************************
+
+  if (ideltas.ge.0) then
+    do i=1,numbwf
+      wfname(i)=wfname1(i)
+      wfspec(i)=wfspec1(i)
+      wftime(i)=wftime1(i)
+    end do
+    do k=1,numbnests
+      do i=1,numbwfn(k)
+        wfnamen(k,i)=wfname1n(k,i)
+        wfspecn(k,i)=wfspec1n(k,i)
+        wftimen(k,i)=wftime1n(k,i)
+      end do
+    end do
+  else
+    do i=1,numbwf
+      wfname(numbwf-i+1)=wfname1(i)
+      wfspec(numbwf-i+1)=wfspec1(i)
+      wftime(numbwf-i+1)=wftime1(i)
+    end do
+    do k=1,numbnests
+      do i=1,numbwfn(k)
+        wfnamen(k,numbwfn(k)-i+1)=wfname1n(k,i)
+        wfspecn(k,numbwfn(k)-i+1)=wfspec1n(k,i)
+        wftimen(k,numbwfn(k)-i+1)=wftime1n(k,i)
+      end do
+    end do
+  endif
+
+  ! Check the time difference between the wind fields. If it is big,
+  ! write a warning message. If it is too big, terminate the trajectory.
+  !*********************************************************************
+
+  do i=2,numbwf
+    idiff=abs(wftime(i)-wftime(i-1))
+    if (idiff.gt.idiffmax) then
+      write(*,*) 'FLEXPART WARNING: TIME DIFFERENCE BETWEEN TWO'
+      write(*,*) 'WIND FIELDS IS TOO BIG FOR TRANSPORT CALCULATION.&
+           &'
+      write(*,*) 'THEREFORE, TRAJECTORIES HAVE TO BE SKIPPED.'
+    else if (idiff.gt.idiffnorm) then
+      write(*,*) 'FLEXPART WARNING: TIME DIFFERENCE BETWEEN TWO'
+      write(*,*) 'WIND FIELDS IS BIG. THIS MAY CAUSE A DEGRADATION'
+      write(*,*) 'OF SIMULATION QUALITY.'
+    endif
+  end do
+
+  do k=1,numbnests
+    if (numbwfn(k).ne.numbwf) then
+      write(*,*) 'FLEXPART ERROR: THE AVAILABLE FILES FOR THE'
+      write(*,*) 'NESTED WIND FIELDS ARE NOT CONSISTENT WITH'
+      write(*,*) 'THE AVAILABLE FILE OF THE MOTHER DOMAIN.  '
+      write(*,*) 'ERROR AT NEST LEVEL: ',k
+      stop
+    endif
+    do i=1,numbwf
+      if (wftimen(k,i).ne.wftime(i)) then
+        write(*,*) 'FLEXPART ERROR: THE AVAILABLE FILES FOR THE'
+        write(*,*) 'NESTED WIND FIELDS ARE NOT CONSISTENT WITH'
+        write(*,*) 'THE AVAILABLE FILE OF THE MOTHER DOMAIN.  '
+        write(*,*) 'ERROR AT NEST LEVEL: ',k
+        stop
+      endif
+    end do
+  end do
+
+  ! Reset the times of the wind fields that are kept in memory to no time
+  !**********************************************************************
+
+  do i=1,2
+    memind(i)=i
+    memtime(i)=999999999
+  end do
+
+  return
+
+998   write(*,*) ' #### FLEXPART MODEL ERROR! AVAILABLE FILE   #### '
+  write(*,'(a)') '     '//path(numpath+2*(k-1)+2) &
+       (1:length(numpath+2*(k-1)+2))
+  write(*,*) ' #### CANNOT BE OPENED             #### '
+  stop
+
+999   write(*,*) ' #### FLEXPART MODEL ERROR! AVAILABLE IILE #### '
+  write(*,'(a)') '     '//path(4)(1:length(4))
+  write(*,*) ' #### CANNOT BE OPENED           #### '
+  stop
+
+end subroutine readavailable
Index: /branches/FP_AI/src/readcommand.f90
===================================================================
--- /branches/FP_AI/src/readcommand.f90	(revision 23)
+++ /branches/FP_AI/src/readcommand.f90	(revision 23)
@@ -0,0 +1,621 @@
+!**********************************************************************
+! 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 readcommand
+
+  !*****************************************************************************
+  !                                                                            *
+  !     This routine reads the user specifications for the current model run.  *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     18 May 1996                                                            *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! bdate                beginning date as Julian date                         *
+  ! ctl                  factor by which time step must be smaller than        *
+  !                      Lagrangian time scale                                 *
+  ! ibdate,ibtime        beginnning date and time (YYYYMMDD, HHMISS)           *
+  ! ideltas [s]          modelling period                                      *
+  ! iedate,ietime        ending date and time (YYYYMMDD, HHMISS)               *
+  ! ifine                reduction factor for vertical wind time step          *
+  ! outputforeachrel     for forward runs it is possible either to create      *
+  !                      one outputfield or several for each releasepoint      *
+  ! iflux                switch to turn on (1)/off (0) flux calculations       *
+  ! iout                 1 for conc. (residence time for backward runs) output,*
+  !                      2 for mixing ratio output, 3 both, 4 for plume        *
+  !                      trajectory output, 5 = options 1 and 4                *
+  ! ipin                 1 continue simulation with dumped particle data, 0 no *
+  ! ipout                0 no particle dump, 1 every output time, 3 only at end*
+  ! itsplit [s]          time constant for particle splitting                  *
+  ! loutaver [s]         concentration output is an average over loutaver      *
+  !                      seconds                                               *
+  ! loutsample [s]       average is computed from samples taken every [s]      *
+  !                      seconds                                               *
+  ! loutstep [s]         time interval of concentration output                 *
+  ! lsynctime [s]        synchronisation time interval for all particles       *
+  ! lagespectra          switch to turn on (1)/off (0) calculation of age      *
+  !                      spectra                                               *
+  ! lconvection          value of either 0 and 1 indicating mixing by          *
+  !                      convection                                            *
+  !                      = 0 .. no convection                                  *
+  !                      + 1 .. parameterisation of mixing by subgrid-scale    *
+  !                              convection = on                               *
+  ! lsubgrid             switch to turn on (1)/off (0) subgrid topography      *
+  !                      parameterization                                      *
+  ! method               method used to compute the particle pseudovelocities  *
+  ! mdomainfill          1 use domain-filling option, 0 not, 2 use strat. O3   *
+  !                                                                            *
+  ! Constants:                                                                 *
+  ! unitcommand          unit connected to file COMMAND                        *
+  !                                                                            *
+  !*****************************************************************************
+
+  use par_mod
+  use com_mod
+
+  implicit none
+
+  real(kind=dp) :: juldate
+  character(len=50) :: line
+  logical :: old
+  logical :: nml_COMMAND=.true. , nmlout=.true.  !.false.
+  integer :: readerror
+
+  namelist /command/ &
+  ldirect, &
+  ibdate,ibtime, &
+  iedate,ietime, &
+  loutstep, &
+  loutaver, &
+  loutsample, &
+  itsplit, &
+  lsynctime, &
+  ctl, &
+  ifine, &
+  iout, &
+  ipout, &
+  lsubgrid, &
+  lconvection, &
+  lagespectra, &
+  ipin, &
+  ioutputforeachrelease, &
+  iflux, &
+  mdomainfill, &
+  ind_source, &
+  ind_receptor, &
+  mquasilag, &
+  nested_output, &
+  linit_cond, &
+  surf_only    
+
+  ! Presetting namelist command
+  ldirect=1
+  ibdate=20000101
+  ibtime=0
+  iedate=20000102
+  ietime=0
+  loutstep=10800
+  loutaver=10800
+  loutsample=900
+  itsplit=999999999
+  lsynctime=900
+  ctl=-5.0
+  ifine=4
+  iout=3
+  ipout=0
+  lsubgrid=1
+  lconvection=1
+  lagespectra=0
+  ipin=1
+  ioutputforeachrelease=1
+  iflux=1
+  mdomainfill=0
+  ind_source=1
+  ind_receptor=1
+  mquasilag=0
+  nested_output=0
+  linit_cond=0
+  surf_only=0 
+
+  ! 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') 
+
+ 
+   !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)
+   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 
+
+    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)
+    ! Use of formatted mask is assumed if line 10 contains the word 'DIRECTION'
+    !**************************************************************************
+
+    call skplin(9,unitcommand)
+    read (unitcommand,901) line
+  901   format (a)
+    if (index(line,'LDIRECT') .eq. 0) then
+      old = .false.
+    write(*,*) 'readcommand old short'
+    else
+      old = .true.
+    write(*,*) 'readcommand old long'
+    endif
+    rewind(unitcommand)
+
+
+    ! Read parameters
+    !****************
+
+    call skplin(7,unitcommand)
+    if (old) call skplin(1,unitcommand)
+
+    read(unitcommand,*) ldirect
+    if (old) call skplin(3,unitcommand)
+    read(unitcommand,*) ibdate,ibtime
+    if (old) call skplin(3,unitcommand)
+    read(unitcommand,*) iedate,ietime
+    if (old) call skplin(3,unitcommand)
+    read(unitcommand,*) loutstep
+    if (old) call skplin(3,unitcommand)
+    read(unitcommand,*) loutaver
+    if (old) call skplin(3,unitcommand)
+    read(unitcommand,*) loutsample
+    if (old) call skplin(3,unitcommand)
+    read(unitcommand,*) itsplit
+    if (old) call skplin(3,unitcommand)
+    read(unitcommand,*) lsynctime
+    if (old) call skplin(3,unitcommand)
+    read(unitcommand,*) ctl
+    if (old) call skplin(3,unitcommand)
+    read(unitcommand,*) ifine
+    if (old) call skplin(3,unitcommand)
+    read(unitcommand,*) iout
+    if (old) call skplin(3,unitcommand)
+    read(unitcommand,*) ipout
+    if (old) call skplin(3,unitcommand)
+    read(unitcommand,*) lsubgrid
+    if (old) call skplin(3,unitcommand)
+    read(unitcommand,*) lconvection
+    if (old) call skplin(3,unitcommand)
+    read(unitcommand,*) lagespectra
+    if (old) call skplin(3,unitcommand)
+    read(unitcommand,*) ipin
+    if (old) call skplin(3,unitcommand)
+    read(unitcommand,*) ioutputforeachrelease
+    if (old) call skplin(3,unitcommand)
+    read(unitcommand,*) iflux
+    if (old) call skplin(3,unitcommand)
+    read(unitcommand,*) mdomainfill
+    if (old) call skplin(3,unitcommand)
+    read(unitcommand,*) ind_source
+    if (old) call skplin(3,unitcommand)
+    read(unitcommand,*) ind_receptor
+    if (old) call skplin(3,unitcommand)
+    read(unitcommand,*) mquasilag
+    if (old) call skplin(3,unitcommand)
+    read(unitcommand,*) nested_output
+    if (old) call skplin(3,unitcommand)
+    read(unitcommand,*) linit_cond
+    if (old) call skplin(3,unitcommand)
+    read(unitcommand,*) surf_only
+    close(unitcommand)
+
+  endif ! input format
+
+  ! write command file in namelist format to output directory if requested
+  if (nmlout.eqv..true.) then
+    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)
+
+  ! Determine how Markov chain is formulated (for w or for w/sigw)
+  !***************************************************************
+
+  if (ctl.ge.0.1) then
+    turbswitch=.true.
+  else
+    turbswitch=.false.
+    ifine=1
+  endif
+  fine=1./real(ifine)
+  ctl=1./ctl
+
+  ! Set the switches required for the various options for input/output units
+  !*************************************************************************
+  !AF Set the switches IND_REL and IND_SAMP for the release and sampling
+  !Af switches for the releasefile:
+  !Af IND_REL =  1 : xmass * rho
+  !Af IND_REL =  0 : xmass * 1
+
+  !Af switches for the conccalcfile:
+  !AF IND_SAMP =  0 : xmass * 1
+  !Af IND_SAMP = -1 : xmass / rho
+
+  !AF IND_SOURCE switches between different units for concentrations at the source
+  !Af   NOTE that in backward simulations the release of computational particles
+  !Af   takes place at the "receptor" and the sampling of p[articles at the "source".
+  !Af          1 = mass units
+  !Af          2 = mass mixing ratio units
+  !Af IND_RECEPTOR switches between different units for concentrations at the receptor
+  !Af          1 = mass units
+  !Af          2 = mass mixing ratio units
+
+  if ( ldirect .eq. 1 ) then  ! FWD-Run
+  !Af set release-switch
+     if (ind_source .eq. 1 ) then !mass
+        ind_rel = 0
+     else ! mass mix
+        ind_rel = 1
+     endif
+  !Af set sampling switch
+     if (ind_receptor .eq. 1) then !mass
+        ind_samp = 0
+     else ! mass mix
+        ind_samp = -1
+     endif
+  elseif (ldirect .eq. -1 ) then !BWD-Run
+  !Af set sampling switch
+     if (ind_source .eq. 1 ) then !mass
+        ind_samp = -1
+     else ! mass mix
+        ind_samp = 0
+     endif
+  !Af set release-switch
+     if (ind_receptor .eq. 1) then !mass
+        ind_rel = 1
+     else ! mass mix
+        ind_rel = 0
+     endif
+  endif
+
+  !*************************************************************
+  ! Check whether valid options have been chosen in file COMMAND
+  !*************************************************************
+
+  ! Check options for initial condition output: Switch off for forward runs
+  !************************************************************************
+
+  if (ldirect.eq.1) linit_cond=0
+  if ((linit_cond.lt.0).or.(linit_cond.gt.2)) then
+    write(*,*) ' #### FLEXPART MODEL ERROR! INVALID OPTION    #### '
+    write(*,*) ' #### FOR LINIT_COND IN FILE "COMMAND".       #### '
+    stop
+  endif
+
+  ! Check input dates
+  !******************
+
+  if (iedate.lt.ibdate) then
+    write(*,*) ' #### FLEXPART MODEL ERROR! BEGINNING DATE    #### '
+    write(*,*) ' #### IS LARGER THAN ENDING DATE. CHANGE      #### '
+    write(*,*) ' #### EITHER POINT 2 OR POINT 3 IN FILE       #### '
+    write(*,*) ' #### "COMMAND".                              #### '
+    stop
+  else if (iedate.eq.ibdate) then
+    if (ietime.lt.ibtime) then
+    write(*,*) ' #### FLEXPART MODEL ERROR! BEGINNING TIME    #### '
+    write(*,*) ' #### IS LARGER THAN ENDING TIME. CHANGE      #### '
+    write(*,*) ' #### EITHER POINT 2 OR POINT 3 IN FILE       #### '
+    write(*,*) ' #### "COMMAND".                              #### '
+    stop
+    endif
+  endif
+
+
+  ! Determine kind of dispersion method
+  !************************************
+
+  if (ctl.gt.0.) then
+    method=1
+    mintime=minstep
+  else
+    method=0
+    mintime=lsynctime
+  endif
+
+  ! Check whether a valid option for gridded model output has been chosen
+  !**********************************************************************
+
+  if ((iout.lt.1).or.(iout.gt.5)) then
+    write(*,*) ' #### FLEXPART MODEL ERROR! FILE COMMAND:     #### '
+    write(*,*) ' #### IOUT MUST BE 1, 2, 3, 4, OR 5!          #### '
+    stop
+  endif
+
+  !AF check consistency between units and volume mixing ratio
+  if ( ((iout.eq.2).or.(iout.eq.3)).and. &
+       (ind_source.gt.1 .or.ind_receptor.gt.1) ) then
+    write(*,*) ' #### FLEXPART MODEL ERROR! FILE COMMAND:     #### '
+    write(*,*) ' #### VOLUME MIXING RATIO ONLY SUPPORTED      #### '
+    write(*,*) ' #### FOR MASS UNITS (at the moment)          #### '
+    stop
+  endif
+
+
+
+  ! For quasilag output for each release is forbidden
+  !*****************************************************************************
+
+  if ((ioutputforeachrelease.eq.1).and.(mquasilag.eq.1)) then
+      write(*,*) '#### FLEXPART MODEL ERROR! FILE COMMAND:     ####'
+      write(*,*) '#### OUTPUTFOREACHRELEASE AND QUASILAGRANGIAN####'
+      write(*,*) '#### MODE IS NOT POSSIBLE   !                ####'
+      stop
+  endif
+
+
+  ! For quasilag backward is forbidden
+  !*****************************************************************************
+
+  if ((ldirect.lt.0).and.(mquasilag.eq.1)) then
+      write(*,*) '#### FLEXPART MODEL ERROR! FILE COMMAND:     ####'
+      write(*,*) '#### FOR BACKWARD RUNS, QUASILAGRANGIAN MODE ####'
+      write(*,*) '#### IS NOT POSSIBLE   !                     ####'
+      stop
+  endif
+
+
+  ! For backward runs one releasefield for all releases makes no sense,
+  ! For quasilag and domainfill ioutputforechrelease is forbidden
+  !*****************************************************************************
+
+  if ((ldirect.lt.0).and.(ioutputforeachrelease.eq.0)) then
+      write(*,*) '#### FLEXPART MODEL ERROR! FILE COMMAND:     ####'
+      write(*,*) '#### FOR BACKWARD RUNS, IOUTPUTFOREACHRLEASE ####'
+      write(*,*) '#### MUST BE SET TO ONE!                     ####'
+      stop
+  endif
+
+
+  ! For backward runs one releasefield for all releases makes no sense,
+  ! and is "forbidden"
+  !*****************************************************************************
+
+  if ((mdomainfill.eq.1).and.(ioutputforeachrelease.eq.1)) then
+      write(*,*) '#### FLEXPART MODEL ERROR! FILE COMMAND:     ####'
+      write(*,*) '#### FOR DOMAIN FILLING RUNS OUTPUT FOR      ####'
+      write(*,*) '#### EACH RELEASE IS FORBIDDEN !             ####'
+      stop
+  endif
+
+
+  ! For domain-filling trajectories, a plume centroid trajectory makes no sense,
+  ! For backward runs, only residence time output (iout=1) or plume trajectories (iout=4),
+  ! or both (iout=5) makes sense; other output options are "forbidden"
+  !*****************************************************************************
+
+  if (ldirect.lt.0) then
+    if ((iout.eq.2).or.(iout.eq.3)) then
+      write(*,*) '#### FLEXPART MODEL ERROR! FILE COMMAND:     ####'
+      write(*,*) '#### FOR BACKWARD RUNS, IOUT MUST BE 1,4,OR 5####'
+      stop
+    endif
+  endif
+
+
+  ! For domain-filling trajectories, a plume centroid trajectory makes no sense,
+  ! and is "forbidden"
+  !*****************************************************************************
+
+  if (mdomainfill.ge.1) then
+    if ((iout.eq.4).or.(iout.eq.5)) then
+      write(*,*) '#### FLEXPART MODEL ERROR! FILE COMMAND:     ####'
+      write(*,*) '#### FOR DOMAIN-FILLING TRAJECTORY OPTION,   ####'
+      write(*,*) '#### IOUT MUST NOT BE SET TO 4 OR 5.         ####'
+      stop
+    endif
+  endif
+
+
+
+  ! Check whether a valid options for particle dump has been chosen
+  !****************************************************************
+
+  if ((ipout.ne.0).and.(ipout.ne.1).and.(ipout.ne.2)) then
+    write(*,*) ' #### FLEXPART MODEL ERROR! FILE COMMAND:     #### '
+    write(*,*) ' #### IPOUT MUST BE 1, 2 OR 3!                #### '
+    stop
+  endif
+
+  if(lsubgrid.ne.1.and.verbosity.eq.0) then
+    write(*,*) '             ----------------               '
+    write(*,*) ' INFORMATION: SUBGRIDSCALE TERRAIN EFFECT IS'
+    write(*,*) ' NOT PARAMETERIZED DURING THIS SIMULATION.  '
+    write(*,*) '             ----------------               '
+  endif
+
+
+  ! Check whether convection scheme is either turned on or off
+  !***********************************************************
+
+  if ((lconvection.ne.0).and.(lconvection.ne.1)) then
+    write(*,*) ' #### FLEXPART MODEL ERROR! FILE COMMAND:     #### '
+    write(*,*) ' #### LCONVECTION MUST BE SET TO EITHER 1 OR 0#### '
+    stop
+  endif
+
+
+  ! Check whether synchronisation interval is sufficiently short
+  !*************************************************************
+
+  if (lsynctime.gt.(idiffnorm/2)) then
+    write(*,*) ' #### FLEXPART MODEL ERROR! SYNCHRONISATION   #### '
+    write(*,*) ' #### TIME IS TOO LONG. MAKE IT SHORTER.      #### '
+    write(*,*) ' #### MINIMUM HAS TO BE: ', idiffnorm/2
+    stop
+  endif
+
+
+  ! Check consistency of the intervals, sampling periods, etc., for model output
+  !*****************************************************************************
+
+  if (loutaver.eq.0) then
+    write(*,*) ' #### FLEXPART MODEL ERROR! TIME AVERAGE OF   #### '
+    write(*,*) ' #### CONCENTRATION FIELD OUTPUT MUST NOT BE  #### '
+    write(*,*) ' #### ZERO.                                   #### '
+    write(*,*) ' #### CHANGE INPUT IN FILE COMMAND.           #### '
+    stop
+  endif
+
+  if (loutaver.gt.loutstep) then
+    write(*,*) ' #### FLEXPART MODEL ERROR! TIME AVERAGE OF   #### '
+    write(*,*) ' #### CONCENTRATION FIELD OUTPUT MUST NOT BE  #### '
+    write(*,*) ' #### GREATER THAN INTERVAL OF OUTPUT.        #### '
+    write(*,*) ' #### CHANGE INPUT IN FILE COMMAND.           #### '
+    stop
+  endif
+
+  if (loutsample.gt.loutaver) then
+    write(*,*) ' #### FLEXPART MODEL ERROR! SAMPLING TIME OF  #### '
+    write(*,*) ' #### CONCENTRATION FIELD OUTPUT MUST NOT BE  #### '
+    write(*,*) ' #### GREATER THAN TIME AVERAGE OF OUTPUT.    #### '
+    write(*,*) ' #### CHANGE INPUT IN FILE COMMAND.           #### '
+    stop
+  endif
+
+  if (mod(loutaver,lsynctime).ne.0) then
+    write(*,*) ' #### FLEXPART MODEL ERROR! AVERAGING TIME OF #### '
+    write(*,*) ' #### CONCENTRATION FIELD MUST BE A MULTIPLE  #### '
+    write(*,*) ' #### OF THE SYNCHRONISATION INTERVAL         #### '
+    stop
+  endif
+
+  if ((loutaver/lsynctime).lt.2) then
+    write(*,*) ' #### FLEXPART MODEL ERROR! AVERAGING TIME OF #### '
+    write(*,*) ' #### CONCENTRATION FIELD MUST BE AT LEAST    #### '
+    write(*,*) ' #### TWICE THE SYNCHRONISATION INTERVAL      #### '
+    stop
+  endif
+
+  if (mod(loutstep,lsynctime).ne.0) then
+    write(*,*) ' #### FLEXPART MODEL ERROR! INTERVAL BETWEEN  #### '
+    write(*,*) ' #### CONCENTRATION FIELDS MUST BE A MULTIPLE #### '
+    write(*,*) ' #### OF THE SYNCHRONISATION INTERVAL         #### '
+    stop
+  endif
+
+  if ((loutstep/lsynctime).lt.2) then
+    write(*,*) ' #### FLEXPART MODEL ERROR! INTERVAL BETWEEN  #### '
+    write(*,*) ' #### CONCENTRATION FIELDS MUST BE AT LEAST   #### '
+    write(*,*) ' #### TWICE THE SYNCHRONISATION INTERVAL      #### '
+    stop
+  endif
+
+  if (mod(loutsample,lsynctime).ne.0) then
+    write(*,*) ' #### FLEXPART MODEL ERROR! SAMPLING TIME OF  #### '
+    write(*,*) ' #### CONCENTRATION FIELD MUST BE A MULTIPLE  #### '
+    write(*,*) ' #### OF THE SYNCHRONISATION INTERVAL         #### '
+    stop
+  endif
+
+  if (itsplit.lt.loutaver) then
+    write(*,*) ' #### FLEXPART MODEL ERROR! SPLITTING TIME FOR#### '
+    write(*,*) ' #### PARTICLES IS TOO SHORT. PLEASE INCREASE #### '
+    write(*,*) ' #### SPLITTING TIME CONSTANT.                #### '
+    stop
+  endif
+
+  if ((mquasilag.eq.1).and.(iout.ge.4)) then
+    write(*,*) ' #### FLEXPART MODEL ERROR! CONFLICTING       #### '
+    write(*,*) ' #### OPTIONS: IF MQUASILAG=1, PLUME          #### '
+    write(*,*) ' #### TRAJECTORY OUTPUT IS IMPOSSIBLE.        #### '
+    stop
+  endif
+
+  ! Compute modeling time in seconds and beginning date in Julian date
+  !*******************************************************************
+
+  outstep=real(abs(loutstep))
+  if (ldirect.eq.1) then
+    bdate=juldate(ibdate,ibtime)
+    edate=juldate(iedate,ietime)
+    ideltas=nint((edate-bdate)*86400.)
+  else if (ldirect.eq.-1) then
+    loutaver=-1*loutaver
+    loutstep=-1*loutstep
+    loutsample=-1*loutsample
+    lsynctime=-1*lsynctime
+    bdate=juldate(iedate,ietime)
+    edate=juldate(ibdate,ibtime)
+    ideltas=nint((edate-bdate)*86400.)
+  else
+    write(*,*) ' #### FLEXPART MODEL ERROR! DIRECTION IN      #### '
+    write(*,*) ' #### FILE "COMMAND" MUST BE EITHER -1 OR 1.  #### '
+    stop
+  endif
+
+  return
+
+999   write(*,*) ' #### FLEXPART MODEL ERROR! FILE "COMMAND"    #### '
+  write(*,*) ' #### CANNOT BE OPENED IN THE DIRECTORY       #### '
+  write(*,'(a)') path(1)(1:length(1))
+  stop
+
+1000   write(*,*) ' #### FLEXPART MODEL ERROR! FILE "COMMAND"    #### '
+       write(*,*) ' #### CANNOT BE OPENED IN THE DIRECTORY       #### '
+        write(*,'(a)') path(2)(1:length(1))
+        stop
+end subroutine readcommand
Index: /branches/FP_AI/src/readdepo.f90
===================================================================
--- /branches/FP_AI/src/readdepo.f90	(revision 23)
+++ /branches/FP_AI/src/readdepo.f90	(revision 23)
@@ -0,0 +1,145 @@
+!**********************************************************************
+! 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 readdepo
+
+  !*****************************************************************************
+  !                                                                            *
+  !  Reads dry deposition parameters needed by the procedure of Wesely (1989). *
+  !  Wesely (1989): Parameterization of surface resistances to gaseous         *
+  !  dry deposition in regional-scale numerical models.                        *
+  !  Atmos. Environ. 23, 1293-1304.                                            *
+  !                                                                            *
+  !                                                                            *
+  !      AUTHOR: Andreas Stohl, 19 May 1995                                    *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  !                                                                            *
+  ! rcl(maxspec,5,9) [s/m] Lower canopy resistance                             *
+  ! rgs(maxspec,5,9) [s/m] Ground resistance                                   *
+  ! rlu(maxspec,5,9) [s/m] Leaf cuticular resistance                           *
+  ! rm(maxspec) [s/m]      Mesophyll resistance, set in readreleases           *
+  ! ri(maxspec) [s/m]      Stomatal resistance                                 *
+  !                                                                            *
+  ! Constants:                                                                 *
+  !                                                                            *
+  !*****************************************************************************
+
+  use par_mod
+  use com_mod
+
+  implicit none
+
+  ! FOR THIS SUBROUTINE, numclass=9 IS ASSUMED
+  !*******************************************
+
+  real :: rluh(5,numclass),rgssh(5,numclass),rgsoh(5,numclass)
+  real :: rclsh(5,numclass),rcloh(5,numclass)
+  integer :: i,j,ic
+
+
+  ! Read deposition constants related with landuse and seasonal category
+  !*********************************************************************
+  open(unitwesely,file=path(1)(1:length(1))//'surfdepo.t', &
+       status='old',err=999)
+
+  do i=1,16
+    read(unitwesely,*)
+  end do
+  do i=1,5
+    read(unitwesely,*)
+    read(unitwesely,'(8x,13f8.0)') (ri(i,j),j=1,numclass)
+    read(unitwesely,'(8x,13f8.0)') (rluh(i,j),j=1,numclass)
+    read(unitwesely,'(8x,13f8.0)') (rac(i,j),j=1,numclass)
+    read(unitwesely,'(8x,13f8.0)') (rgssh(i,j),j=1,numclass)
+    read(unitwesely,'(8x,13f8.0)') (rgsoh(i,j),j=1,numclass)
+    read(unitwesely,'(8x,13f8.0)') (rclsh(i,j),j=1,numclass)
+    read(unitwesely,'(8x,13f8.0)') (rcloh(i,j),j=1,numclass)
+  end do
+
+  ! TEST
+  ! do 31 i=1,5
+  !   ri(i,13)=ri(i,5)
+  !   rluh(i,13)=rluh(i,5)
+  !   rac(i,13)=rac(i,5)
+  !   rgssh(i,13)=rgssh(i,5)
+  !   rgsoh(i,13)=rgsoh(i,5)
+  !   rclsh(i,13)=rclsh(i,5)
+  !   rcloh(i,13)=rcloh(i,5)
+  !31             continue
+  ! TEST
+  ! Sabine Eckhardt, Dec 06, set resistances of 9999 to 'infinite' (1E25)
+  do i=1,5
+    do j=1,numclass
+      if    (ri(i,j).eq.9999.)    ri(i,j)=1.E25
+      if  (rluh(i,j).eq.9999.)  rluh(i,j)=1.E25
+      if   (rac(i,j).eq.9999.)   rac(i,j)=1.E25
+      if (rgssh(i,j).eq.9999.) rgssh(i,j)=1.E25
+      if (rgsoh(i,j).eq.9999.) rgsoh(i,j)=1.E25
+      if (rclsh(i,j).eq.9999.) rclsh(i,j)=1.E25
+      if (rcloh(i,j).eq.9999.) rcloh(i,j)=1.E25
+    end do
+  end do
+
+
+
+  do i=1,5
+    do j=1,numclass
+      ri(i,j)=max(ri(i,j),0.001)
+      rluh(i,j)=max(rluh(i,j),0.001)
+      rac(i,j)=max(rac(i,j),0.001)
+      rgssh(i,j)=max(rgssh(i,j),0.001)
+      rgsoh(i,j)=max(rgsoh(i,j),0.001)
+      rclsh(i,j)=max(rclsh(i,j),0.001)
+      rcloh(i,j)=max(rcloh(i,j),0.001)
+    end do
+  end do
+  close(unitwesely)
+
+
+  ! Compute additional parameters
+  !******************************
+
+  do ic=1,nspec
+    if (reldiff(ic).gt.0.) then     ! gas is dry deposited
+      do i=1,5
+        do j=1,numclass
+          rlu(ic,i,j)=rluh(i,j)/(1.e-5*henry(ic)+f0(ic))
+          rgs(ic,i,j)=1./(henry(ic)/(10.e5*rgssh(i,j))+f0(ic)/ &
+               rgsoh(i,j))
+          rcl(ic,i,j)=1./(henry(ic)/(10.e5*rclsh(i,j))+f0(ic)/ &
+               rcloh(i,j))
+        end do
+      end do
+    endif
+  end do
+
+
+  return
+
+
+999   write(*,*) '### FLEXPART ERROR! FILE              ###'
+  write(*,*) '### surfdepo.t DOES NOT EXIST.        ###'
+  stop
+
+end subroutine readdepo
Index: /branches/FP_AI/src/readlanduse.f90
===================================================================
--- /branches/FP_AI/src/readlanduse.f90	(revision 23)
+++ /branches/FP_AI/src/readlanduse.f90	(revision 23)
@@ -0,0 +1,159 @@
+!**********************************************************************
+! 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 readlanduse
+
+  !*****************************************************************************
+  !                                                                            *
+  !      Reads the landuse inventory into memory and relates it to Leaf Area   *
+  !      Index and roughness length.                                           *
+  !                                                                            *
+  !      AUTHOR: Andreas Stohl, 10 January 1994                                *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! i                       loop indices                                       *
+  ! landinvent(1200,600,13) area fractions of 13 landuse categories            *
+  ! LENGTH(numpath)         length of the path names                           *
+  ! PATH(numpath)           contains the path names                            *
+  ! unitland                unit connected with landuse inventory              *
+  !                                                                            *
+  ! -----                                                                      *
+  ! Sabine Eckhardt, Dec 06 - new landuse inventary                            *
+  ! after                                                                      *
+  ! 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                                                 *
+  !                                                                            *
+  ! LANDUSE CATEGORIES:                                                        *
+  !                                                                            *
+  ! 1	Urban land                                                             *
+  ! 2	Agricultural land					               *
+  ! 3	Range land					                       *
+  ! 4	Deciduous forest			                               *
+  ! 5	Coniferous forest		                                       *
+  ! 6	Mixed forest including wetland                                         *
+  ! 7	water, both salt and fresh                                             *
+  ! 8	barren land mostly desert                                              *
+  ! 9	nonforested wetland	                                               *
+  ! 10 	mixed agricultural and range land		                       *
+  ! 11 	rocky open areas with low growing shrubs                               *
+  ! 12  ice                                                                    *
+  ! 13  rainforest                                                             *
+  !                                                                            *
+  !*****************************************************************************
+
+  use par_mod
+  use com_mod
+
+  implicit none
+
+  integer :: ix,jy,i,k,lu_cat,lu_perc
+  integer(kind=1) :: ilr
+  integer(kind=1) :: ilr_buffer(2160000)
+  integer :: il,irecread
+  real :: rlr, r2lr
+
+
+  ! Read landuse inventory
+  !***********************
+  ! The landuse information is saved in a compressed format and written
+  ! out by records of the length of 1 BYTE. Each grid cell consists of 3
+  ! Bytes, which include 3 landuse categories (val 1-13 and 16 percentage
+  ! categories) So one half byte is used to store the Landusecat the other
+  ! for the percentageclass in 6.25 steps (100/6.25=16)
+  ! e.g.
+  ! 4 3  percentage 4 = 4*6.25 => 25% landuse class 3
+  ! 2 1  percentage 2 = 2*6.25 => 13% landuse class 1
+  ! 1 12 percentage 1 = 1*6.26 => 6.25% landuse class 12
+
+  open(unitland,file=path(1)(1:length(1)) &
+       //'IGBP_int1.dat',status='old', &
+  !    +form='UNFORMATTED', err=998)
+       form='UNFORMATTED', err=998, convert='little_endian')
+!  print*,unitland
+  read (unitland) (ilr_buffer(i),i=1,2160000)
+  close(unitland)
+
+  irecread=1
+  do ix=1,1200
+    do jy=1,600
+  ! the 3 most abundant landuse categories in the inventory
+  ! first half byte contains the landuse class
+  ! second half byte contains the respective percentage
+      do k=1,3
+  ! 1 byte is read
+        ilr=ilr_buffer(irecread)
+  !      ilr=0
+        irecread=irecread+1
+  ! as only signed integer values exist an unsigned value is constructed
+        if (ilr.lt.0) then
+           il=ilr+256
+        else
+           il=ilr
+        endif
+  ! dividing by 16 has the effect to get rid of the right half of the byte
+  ! so just the left half remains, this corresponds to a shift right of 4
+  ! bits
+        rlr=real(il)/16.
+        lu_cat=int(rlr)
+  ! the left half of the byte is substracted from the whole in order to
+  ! get only the right half of the byte
+        r2lr=rlr-int(rlr)
+  ! shift left by 4
+        lu_perc=r2lr*16.
+        landinvent(ix,jy,k)=lu_cat
+        landinvent(ix,jy,k+3)=lu_perc
+  !       if ((jy.lt.10).and.(ix.lt.10)) write(*,*) 'reading: ' , ix, jy, lu_cat, lu_perc
+      end do
+    end do
+  end do
+
+  ! Read relation landuse,z0
+  !*****************************
+
+  open(unitsurfdata,file=path(1)(1:length(1))//'surfdata.t', &
+       status='old',err=999)
+
+  do i=1,4
+    read(unitsurfdata,*)
+  end do
+  do i=1,numclass
+    read(unitsurfdata,'(45x,f15.3)') z0(i)
+  end do
+  close(unitsurfdata)
+
+  return
+
+  ! Issue error messages
+  !*********************
+
+998   write(*,*) ' #### FLEXPART ERROR! FILE CONTAINING          ####'
+  write(*,*) ' #### LANDUSE INVENTORY DOES NOT EXIST         ####'
+  stop
+
+999   write(*,*) ' #### FLEXPART ERROR! FILE CONTAINING          ####'
+  write(*,*) ' #### RELATION LANDUSE,z0 DOES NOT EXIST       ####'
+  stop
+
+end subroutine readlanduse
Index: /branches/FP_AI/src/readlanduse_int1.f90
===================================================================
--- /branches/FP_AI/src/readlanduse_int1.f90	(revision 23)
+++ /branches/FP_AI/src/readlanduse_int1.f90	(revision 23)
@@ -0,0 +1,161 @@
+!**********************************************************************
+! 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 readlanduse
+
+  !*****************************************************************************
+  !                                                                            *
+  !      Reads the landuse inventory into memory and relates it to Leaf Area   *
+  !      Index and roughness length.                                           *
+  !                                                                            *
+  !      AUTHOR: Andreas Stohl, 10 January 1994                                *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! i                       loop indices                                       *
+  ! landinvent(1200,600,13) area fractions of 13 landuse categories            *
+  ! LENGTH(numpath)         length of the path names                           *
+  ! PATH(numpath)           contains the path names                            *
+  ! unitland                unit connected with landuse inventory              *
+  !                                                                            *
+  ! -----                                                                      *
+  ! Sabine Eckhardt, Dec 06 - new landuse inventary                            *
+  ! after                                                                      *
+  ! 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                                                 *
+  !                                                                            *
+  ! LANDUSE CATEGORIES:                                                        *
+  !                                                                            *
+  ! 1	Urban land                                                             *
+  ! 2	Agricultural land					               *
+  ! 3	Range land					                       *
+  ! 4	Deciduous forest			                               *
+  ! 5	Coniferous forest		                                       *
+  ! 6	Mixed forest including wetland                                         *
+  ! 7	water, both salt and fresh                                             *
+  ! 8	barren land mostly desert                                              *
+  ! 9	nonforested wetland	                                               *
+  ! 10 	mixed agricultural and range land		                       *
+  ! 11 	rocky open areas with low growing shrubs                               *
+  ! 12  ice                                                                    *
+  ! 13  rainforest                                                             *
+  !                                                                            *
+  !*****************************************************************************
+
+  use par_mod
+  use com_mod
+
+  implicit none
+
+  integer :: ix,jy,i,k,lu_cat,lu_perc
+  integer(kind=1) :: ilr
+  integer(kind=1) :: ilr_buffer(2160000)
+  integer :: il,irecread
+  real :: rlr, r2lr
+
+
+  ! Read landuse inventory
+  !***********************
+  ! The landuse information is saved in a compressed format and written
+  ! out by records of the length of 1 BYTE. Each grid cell consists of 3
+  ! Bytes, which include 3 landuse categories (val 1-13 and 16 percentage
+  ! categories) So one half byte is used to store the Landusecat the other
+  ! for the percentageclass in 6.25 steps (100/6.25=16)
+  ! e.g.
+  ! 4 3  percentage 4 = 4*6.25 => 25% landuse class 3
+  ! 2 1  percentage 2 = 2*6.25 => 13% landuse class 1
+  ! 1 12 percentage 1 = 1*6.26 => 6.25% landuse class 12
+
+
+  write (*,*) 'reading: ',path(1)(1:length(1))
+  open(unitland,file=path(1)(1:length(1)) &
+       //'IGBP_int1.dat',status='old', &
+       form='UNFORMATTED', err=998)
+  read (unitland) (ilr_buffer(i),i=1,2160000)
+  close(unitland)
+  write (*,*) 'reading: '
+
+  irecread=1
+  do ix=1,1200
+    do jy=1,600
+  ! the 3 most abundant landuse categories in the inventory
+  ! first half byte contains the landuse class
+  ! second half byte contains the respective percentage
+      do k=1,3
+  ! 1 byte is read
+        ilr=ilr_buffer(irecread)
+        irecread=irecread+1
+  ! as only signed integer values exist an unsigned value is constructed
+        if (ilr.lt.0) then
+           il=ilr+256
+        else
+           il=ilr
+        endif
+  ! dividing by 16 has the effect to get rid of the right half of the byte
+  ! so just the left half remains, this corresponds to a shift right of 4
+  ! bits
+        rlr=real(il)/16.
+        lu_cat=int(rlr)
+  ! the left half of the byte is substracted from the whole in order to
+  ! get only the right half of the byte
+        r2lr=rlr-int(rlr)
+  ! shift left by 4
+        lu_perc=r2lr*16.
+        landinvent(ix,jy,k)=lu_cat
+        landinvent(ix,jy,k+3)=lu_perc
+        if ((jy.lt.10).and.(ix.lt.10)) then
+            write(*,*) 'reading: ', ix, jy, lu_cat, lu_perc
+        endif
+      end do
+    end do
+  end do
+
+  ! Read relation landuse,z0
+  !*****************************
+
+  open(unitsurfdata,file=path(1)(1:length(1))//'surfdata.t', &
+       status='old',err=999)
+
+  do i=1,4
+    read(unitsurfdata,*)
+  end do
+  do i=1,numclass
+    read(unitsurfdata,'(45x,f15.3)') z0(i)
+  end do
+  close(unitsurfdata)
+
+  return
+
+  ! Issue error messages
+  !*********************
+
+998   write(*,*) ' #### FLEXPART ERROR! FILE CONTAINING          ####'
+  write(*,*) ' #### LANDUSE INVENTORY DOES NOT EXIST         ####'
+  stop
+
+999   write(*,*) ' #### FLEXPART ERROR! FILE CONTAINING          ####'
+  write(*,*) ' #### RELATION LANDUSE,z0 DOES NOT EXIST       ####'
+  stop
+
+end subroutine readlanduse
Index: /branches/FP_AI/src/readoutgrid.f90
===================================================================
--- /branches/FP_AI/src/readoutgrid.f90	(revision 23)
+++ /branches/FP_AI/src/readoutgrid.f90	(revision 23)
@@ -0,0 +1,190 @@
+!**********************************************************************
+! 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 readoutgrid
+
+  !*****************************************************************************
+  !                                                                            *
+  !     This routine reads the user specifications for the output grid.        *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     4 June 1996                                                            *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! dxout,dyout          grid distance                                         *
+  ! numxgrid,numygrid,numzgrid    grid dimensions                              *
+  ! outlon0,outlat0      lower left corner of grid                             *
+  ! outheight(maxzgrid)  height levels of output grid [m]                      *
+  !                                                                            *
+  ! Constants:                                                                 *
+  ! unitoutgrid          unit connected to file OUTGRID                        *
+  !                                                                            *
+  !*****************************************************************************
+
+  use outg_mod
+  use par_mod
+  use com_mod
+
+  implicit none
+
+  integer :: i,j,stat
+  real :: outhelp,xr,xr1,yr,yr1
+  real,parameter :: eps=1.e-4
+
+
+
+  ! Open the OUTGRID file and read output grid specifications
+  !**********************************************************
+
+  open(unitoutgrid,file=path(1)(1:length(1))//'OUTGRID',status='old', &
+       err=999)
+
+
+  call skplin(5,unitoutgrid)
+
+
+  ! 1.  Read horizontal grid specifications
+  !****************************************
+
+  call skplin(3,unitoutgrid)
+  read(unitoutgrid,'(4x,f11.4)') outlon0
+  call skplin(3,unitoutgrid)
+  read(unitoutgrid,'(4x,f11.4)') outlat0
+  call skplin(3,unitoutgrid)
+  read(unitoutgrid,'(4x,i5)') numxgrid
+  call skplin(3,unitoutgrid)
+  read(unitoutgrid,'(4x,i5)') numygrid
+  call skplin(3,unitoutgrid)
+  read(unitoutgrid,'(4x,f12.5)') dxout
+  call skplin(3,unitoutgrid)
+  read(unitoutgrid,'(4x,f12.5)') dyout
+
+
+  ! Check validity of output grid (shall be within model domain)
+  !*************************************************************
+
+  xr=outlon0+real(numxgrid)*dxout
+  yr=outlat0+real(numygrid)*dyout
+  xr1=xlon0+real(nxmin1)*dx
+  yr1=ylat0+real(nymin1)*dy
+  if ((outlon0+eps.lt.xlon0).or.(outlat0+eps.lt.ylat0) &
+       .or.(xr.gt.xr1+eps).or.(yr.gt.yr1+eps)) then
+    write(*,*) 'outlon0,outlat0:'
+    write(*,*) outlon0,outlat0
+    write(*,*) 'xr1,yr1,xlon0,ylat0,xr,yr,dxout,dyout:'
+    write(*,*) xr1,yr1,xlon0,ylat0,xr,yr,dxout,dyout
+    write(*,*) ' #### FLEXPART MODEL ERROR! PART OF OUTPUT    ####'
+    write(*,*) ' #### GRID IS OUTSIDE MODEL DOMAIN. CHANGE    ####'
+    write(*,*) ' #### FILE OUTGRID IN DIRECTORY               ####'
+    write(*,'(a)') path(1)(1:length(1))
+    stop
+  endif
+
+  ! 2. Count Vertical levels of output grid
+  !****************************************
+  j=0
+100   j=j+1
+    do i=1,3
+      read(unitoutgrid,*,end=99)
+    end do
+    read(unitoutgrid,'(4x,f7.1)',end=99) outhelp
+    if (outhelp.eq.0.) goto 99
+    goto 100
+99   numzgrid=j-1
+
+    allocate(outheight(numzgrid) &
+         ,stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not allocate outh'
+    allocate(outheighthalf(numzgrid) &
+         ,stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not allocate outh'
+
+
+  rewind(unitoutgrid)
+  call skplin(29,unitoutgrid)
+
+  ! 2. Vertical levels of output grid
+  !**********************************
+
+  j=0
+1000   j=j+1
+    do i=1,3
+      read(unitoutgrid,*,end=990)
+    end do
+    read(unitoutgrid,'(4x,f7.1)',end=990) outhelp
+    if (outhelp.eq.0.) goto 99
+    outheight(j)=outhelp
+    goto 1000
+990   numzgrid=j-1
+
+
+  ! Check whether vertical levels are specified in ascending order
+  !***************************************************************
+
+  do j=2,numzgrid
+    if (outheight(j).le.outheight(j-1)) then
+    write(*,*) ' #### FLEXPART MODEL ERROR! YOUR SPECIFICATION#### '
+    write(*,*) ' #### OF OUTPUT LEVELS IS CORRUPT AT LEVEL    #### '
+    write(*,*) ' #### ',j,'                              #### '
+    write(*,*) ' #### PLEASE MAKE CHANGES IN FILE OUTGRID.    #### '
+    endif
+  end do
+
+  ! Determine the half levels, i.e. middle levels of the output grid
+  !*****************************************************************
+
+  outheighthalf(1)=outheight(1)/2.
+  do j=2,numzgrid
+    outheighthalf(j)=(outheight(j-1)+outheight(j))/2.
+  end do
+
+
+  xoutshift=xlon0-outlon0
+  youtshift=ylat0-outlat0
+  close(unitoutgrid)
+
+    allocate(oroout(0:numxgrid-1,0:numygrid-1) &
+         ,stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not allocate outh'
+    allocate(area(0:numxgrid-1,0:numygrid-1) &
+         ,stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not allocate outh'
+    allocate(volume(0:numxgrid-1,0:numygrid-1,numzgrid) &
+         ,stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not allocate outh'
+    allocate(areaeast(0:numxgrid-1,0:numygrid-1,numzgrid) &
+         ,stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not allocate outh'
+    allocate(areanorth(0:numxgrid-1,0:numygrid-1,numzgrid) &
+         ,stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not allocate outh'
+  return
+
+
+999   write(*,*) ' #### FLEXPART MODEL ERROR! FILE "OUTGRID"    #### '
+  write(*,*) ' #### CANNOT BE OPENED IN THE DIRECTORY       #### '
+  write(*,*) ' #### xxx/flexpart/options                    #### '
+  stop
+
+end subroutine readoutgrid
Index: /branches/FP_AI/src/readoutgrid_nest.f90
===================================================================
--- /branches/FP_AI/src/readoutgrid_nest.f90	(revision 23)
+++ /branches/FP_AI/src/readoutgrid_nest.f90	(revision 23)
@@ -0,0 +1,121 @@
+!**********************************************************************
+! 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 readoutgrid_nest
+
+  !*****************************************************************************
+  !                                                                            *
+  !     This routine reads the user specifications for the output nest.        *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     4 June 1996                                                            *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! dxoutn,dyoutn        grid distances of output nest                         *
+  ! numxgridn,numygridn,numzgrid    nest dimensions                            *
+  ! outlon0n,outlat0n    lower left corner of nest                             *
+  ! outheight(maxzgrid)  height levels of output grid [m]                      *
+  !                                                                            *
+  ! Constants:                                                                 *
+  ! unitoutgrid          unit connected to file OUTGRID                        *
+  !                                                                            *
+  !*****************************************************************************
+
+  use outg_mod
+  use par_mod
+  use com_mod
+
+  implicit none
+
+  integer :: stat
+  real :: xr,xr1,yr,yr1
+  real,parameter :: eps=1.e-4
+
+
+
+  ! Open the OUTGRID file and read output grid specifications
+  !**********************************************************
+
+  open(unitoutgrid,file=path(1)(1:length(1))//'OUTGRID_NEST', &
+       status='old',err=999)
+
+
+  call skplin(5,unitoutgrid)
+
+
+  ! 1.  Read horizontal grid specifications
+  !****************************************
+
+  call skplin(3,unitoutgrid)
+  read(unitoutgrid,'(4x,f11.4)') outlon0n
+  call skplin(3,unitoutgrid)
+  read(unitoutgrid,'(4x,f11.4)') outlat0n
+  call skplin(3,unitoutgrid)
+  read(unitoutgrid,'(4x,i5)') numxgridn
+  call skplin(3,unitoutgrid)
+  read(unitoutgrid,'(4x,i5)') numygridn
+  call skplin(3,unitoutgrid)
+  read(unitoutgrid,'(4x,f12.5)') dxoutn
+  call skplin(3,unitoutgrid)
+  read(unitoutgrid,'(4x,f12.5)') dyoutn
+
+
+    allocate(orooutn(0:numxgridn-1,0:numygridn-1) &
+         ,stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not allocate outh'
+    allocate(arean(0:numxgridn-1,0:numygridn-1) &
+         ,stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not allocate outh'
+    allocate(volumen(0:numxgridn-1,0:numygridn-1,numzgrid) &
+         ,stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not allocate outh'
+
+  ! Check validity of output grid (shall be within model domain)
+  !*************************************************************
+
+  xr=outlon0n+real(numxgridn)*dxoutn
+  yr=outlat0n+real(numygridn)*dyoutn
+  xr1=xlon0+real(nxmin1)*dx
+  yr1=ylat0+real(nymin1)*dy
+  if ((outlon0n+eps.lt.xlon0).or.(outlat0n+eps.lt.ylat0) &
+       .or.(xr.gt.xr1+eps).or.(yr.gt.yr1+eps)) then
+    write(*,*) ' #### FLEXPART MODEL ERROR! PART OF OUTPUT    ####'
+    write(*,*) ' #### NEST IS OUTSIDE MODEL DOMAIN. CHANGE    ####'
+    write(*,*) ' #### FILE OUTGRID IN DIRECTORY               ####'
+    write(*,'(a)') path(1)(1:length(1))
+    stop
+  endif
+
+  xoutshiftn=xlon0-outlon0n
+  youtshiftn=ylat0-outlat0n
+  close(unitoutgrid)
+  return
+
+
+999   write(*,*) ' #### FLEXPART MODEL ERROR! FILE OUTGRID_NEST #### '
+  write(*,*) ' #### CANNOT BE OPENED IN THE DIRECTORY       #### '
+  write(*,*) ' #### xxx/flexpart/options                    #### '
+  stop
+
+end subroutine readoutgrid_nest
Index: /branches/FP_AI/src/readpartpositions.f90
===================================================================
--- /branches/FP_AI/src/readpartpositions.f90	(revision 23)
+++ /branches/FP_AI/src/readpartpositions.f90	(revision 23)
@@ -0,0 +1,173 @@
+!**********************************************************************
+! 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 readpartpositions
+
+  !*****************************************************************************
+  !                                                                            *
+  !   This routine opens the particle dump file and reads all the particle     *
+  !   positions from a previous run to initialize the current run.             *
+  !                                                                            *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     24 March 2000                                                          *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  !                                                                            *
+  !*****************************************************************************
+
+  use par_mod
+  use com_mod
+
+  implicit none
+
+  integer :: ibdatein,ibtimein,nspecin,itimein,numpointin,i,j,ix
+  integer :: id1,id2,it1,it2
+  real :: xlonin,ylatin,ran1,topo,hmixi,pvi,qvi,rhoi,tri,tti
+  character :: specin*7
+  real(kind=dp) :: julin,julpartin,juldate
+
+  integer :: idummy = -8
+
+  numparticlecount=0
+
+  ! Open header file of dumped particle data
+  !*****************************************
+
+  open(unitpartin,file=path(2)(1:length(2))//'header', &
+       form='unformatted',err=998)
+
+  read(unitpartin) ibdatein,ibtimein
+  read(unitpartin)
+  read(unitpartin)
+
+  read(unitpartin)
+  read(unitpartin)
+  read(unitpartin) nspecin
+  nspecin=nspecin/3
+  if ((ldirect.eq.1).and.(nspec.ne.nspecin)) goto 997
+
+  do i=1,nspecin
+    read(unitpartin)
+    read(unitpartin)
+    read(unitpartin) j,specin
+    if ((ldirect.eq.1).and.(species(i)(1:7).ne.specin)) goto 996
+  end do
+
+  read(unitpartin) numpointin
+  if (numpointin.ne.numpoint) goto 995
+999 continue 
+  do i=1,numpointin
+    read(unitpartin)
+    read(unitpartin)
+    read(unitpartin)
+    read(unitpartin)
+    do j=1,nspec
+      read(unitpartin)
+      read(unitpartin)
+      read(unitpartin)
+    end do
+  end do
+  read(unitpartin)
+  read(unitpartin)
+
+  do ix=0,numxgrid-1
+    read(unitpartin)
+  end do
+
+
+  ! Open data file of dumped particle data
+  !***************************************
+
+  close(unitpartin)
+  open(unitpartin,file=path(2)(1:length(2))//'partposit_end', &
+       form='unformatted',err=998)
+
+
+100   read(unitpartin,end=99) itimein
+    i=0
+200   i=i+1
+    read(unitpartin) npoint(i),xlonin,ylatin,ztra1(i),itramem(i), &
+         topo,pvi,qvi,rhoi,hmixi,tri,tti,(xmass1(i,j),j=1,nspec)
+
+    if (xlonin.eq.-9999.9) goto 100
+    xtra1(i)=(xlonin-xlon0)/dx
+    ytra1(i)=(ylatin-ylat0)/dy
+    numparticlecount=max(numparticlecount,npoint(i))
+    goto 200
+
+99   numpart=i-1
+
+  close(unitpartin)
+
+  julin=juldate(ibdatein,ibtimein)+real(itimein,kind=dp)/86400._dp
+  if (abs(julin-bdate).gt.1.e-5) goto 994
+  do i=1,numpart
+    julpartin=juldate(ibdatein,ibtimein)+ &
+         real(itramem(i),kind=dp)/86400._dp
+    nclass(i)=min(int(ran1(idummy)*real(nclassunc))+1, &
+         nclassunc)
+    idt(i)=mintime
+    itra1(i)=0
+    itramem(i)=nint((julpartin-bdate)*86400.)
+    itrasplit(i)=ldirect*itsplit
+  end do
+
+  return
+
+
+994   write(*,*) ' #### FLEXPART MODEL ERROR IN READPARTPOSITIONS#### '
+  write(*,*) ' #### ENDING TIME OF PREVIOUS MODEL RUN DOES   #### '
+  write(*,*) ' #### NOT AGREE WITH STARTING TIME OF THIS RUN.#### '
+  call caldate(julin,id1,it1)
+  call caldate(bdate,id2,it2)
+  write(*,*) 'julin: ',julin,id1,it1
+  write(*,*) 'bdate: ',bdate,id2,it2
+  stop
+
+!995   write(*,*) ' #### FLEXPART MODEL ERROR IN READPARTPOSITIONS#### '
+995   write(*,*) ' #### FLEXPART MODEL WARNING IN READPARTPOSITIONS#### '
+  write(*,*) ' #### NUMBER OF RELEASE LOCATIONS DOES NOT     #### '
+  write(*,*) ' #### AGREE WITH CURRENT SETTINGS!             #### '
+!  stop
+  goto 999 
+
+996   write(*,*) ' #### FLEXPART MODEL ERROR IN READPARTPOSITIONS#### '
+  write(*,*) ' #### SPECIES NAMES TO BE READ IN DO NOT       #### '
+  write(*,*) ' #### AGREE WITH CURRENT SETTINGS!             #### '
+  stop
+
+997   write(*,*) ' #### FLEXPART MODEL ERROR IN READPARTPOSITIONS#### '
+  write(*,*) ' #### THE NUMBER OF SPECIES TO BE READ IN DOES #### '
+  write(*,*) ' #### NOT AGREE WITH CURRENT SETTINGS!         #### '
+  stop
+
+998   write(*,*) ' #### FLEXPART MODEL ERROR!   THE FILE         #### '
+  write(*,*) ' #### '//path(2)(1:length(2))//'grid'//' #### '
+  write(*,*) ' #### CANNOT BE OPENED. IF A FILE WITH THIS    #### '
+  write(*,*) ' #### NAME ALREADY EXISTS, DELETE IT AND START #### '
+  write(*,*) ' #### THE PROGRAM AGAIN.                       #### '
+  stop
+
+end subroutine readpartpositions
Index: /branches/FP_AI/src/readpaths.f90
===================================================================
--- /branches/FP_AI/src/readpaths.f90	(revision 23)
+++ /branches/FP_AI/src/readpaths.f90	(revision 23)
@@ -0,0 +1,110 @@
+!**********************************************************************
+! 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 readpaths !(pathfile)
+
+  !*****************************************************************************
+  !                                                                            *
+  !     Reads the pathnames, where input/output files are expected to be.      *
+  !     The file pathnames must be available in the current working directory. *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     1 February 1994                                                        *
+  !     last modified                                                          *
+  !     HS, 7.9.2012                                                           *
+  !     option to give pathnames file as command line option                   *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! length(numpath)    lengths of the path names                               *
+  ! path(numpath)      pathnames of input/output files                         *
+  !                                                                            *
+  ! Constants:                                                                 *
+  ! numpath            number of pathnames to be read in                       *
+  !                                                                            *
+  !*****************************************************************************
+
+  use par_mod
+  use com_mod
+
+  implicit none
+
+  integer   :: i
+  character(256) :: string_test 
+  character(1) :: character_test 
+
+  ! Read the pathname information stored in unitpath
+  !*************************************************
+
+  open(unitpath,file=trim(pathfile),status='old',err=999)
+
+  do i=1,numpath
+    read(unitpath,'(a)',err=998) path(i)
+    length(i)=index(path(i),' ')-1
+
+    
+    string_test = path(i)
+    character_test = string_test(length(i):length(i))
+    !print*, 'character_test,  string_test ', character_test,  string_test 
+      if ((character_test .NE. '/') .AND. (i .LT. 4))  then
+         print*, 'WARNING: path not ending in /' 
+         print*, path(i)
+         path(i) = string_test(1:length(i)) // '/'
+         length(i)=length(i)+1
+         print*, 'fix: padded with /' 
+         print*, path(i)
+         print*, 'length(i) increased 1' 
+      endif
+  end do
+
+  ! Check whether any nested subdomains are to be used
+  !***************************************************
+
+  do i=1,maxnests
+    read(unitpath,'(a)') path(numpath+2*(i-1)+1)
+    read(unitpath,'(a)') path(numpath+2*(i-1)+2)
+    if (path(numpath+2*(i-1)+1)(1:5).eq.'=====') goto 30
+    length(numpath+2*(i-1)+1)=index(path(numpath+2*(i-1)+1),' ')-1
+    length(numpath+2*(i-1)+2)=index(path(numpath+2*(i-1)+2),' ')-1
+  end do
+  print*,length(5),length(6)
+
+
+  ! Determine number of available nested domains
+  !*********************************************
+
+30   numbnests=i-1
+
+  close(unitpath)
+  return
+
+998   write(*,*) ' #### TRAJECTORY MODEL ERROR! ERROR WHILE     #### '
+  write(*,*) ' #### READING FILE PATHNAMES.                 #### '
+  stop
+
+999   write(*,*) ' #### TRAJECTORY MODEL ERROR! FILE "pathnames"#### '
+  write(*,*) ' #### CANNOT BE OPENED IN THE CURRENT WORKING #### '
+  write(*,*) ' #### DIRECTORY.                              #### '
+  stop
+
+end subroutine readpaths
Index: /branches/FP_AI/src/readreceptors.f90
===================================================================
--- /branches/FP_AI/src/readreceptors.f90	(revision 23)
+++ /branches/FP_AI/src/readreceptors.f90	(revision 23)
@@ -0,0 +1,114 @@
+!**********************************************************************
+! 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 readreceptors
+
+  !*****************************************************************************
+  !                                                                            *
+  !     This routine reads the user specifications for the receptor points.    *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     1 August 1996                                                          *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! receptorarea(maxreceptor)  area of dx*dy at location of receptor           *
+  ! receptorname(maxreceptor)  names of receptors                              *
+  ! xreceptor,yreceptor  coordinates of receptor points                        *
+  !                                                                            *
+  ! Constants:                                                                 *
+  ! unitreceptor         unit connected to file RECEPTORS                      *
+  !                                                                            *
+  !*****************************************************************************
+
+  use par_mod
+  use com_mod
+
+  implicit none
+
+  integer :: j
+  real :: x,y,xm,ym
+  character(len=16) :: receptor
+
+
+  ! For backward runs, do not allow receptor output. Thus, set number of receptors to zero
+  !*****************************************************************************
+
+  if (ldirect.lt.0) then
+    numreceptor=0
+    return
+  endif
+
+
+  ! Open the RECEPTORS file and read output grid specifications
+  !************************************************************
+
+  open(unitreceptor,file=path(1)(1:length(1))//'RECEPTORS', &
+       status='old',err=999)
+
+  call skplin(5,unitreceptor)
+
+
+  ! Read the names and coordinates of the receptors
+  !************************************************
+
+  j=0
+100   j=j+1
+    read(unitreceptor,*,end=99)
+    read(unitreceptor,*,end=99)
+    read(unitreceptor,*,end=99)
+    read(unitreceptor,'(4x,a16)',end=99) receptor
+    call skplin(3,unitreceptor)
+    read(unitreceptor,'(4x,f11.4)',end=99) x
+    call skplin(3,unitreceptor)
+    read(unitreceptor,'(4x,f11.4)',end=99) y
+    if ((x.eq.0.).and.(y.eq.0.).and. &
+         (receptor.eq.'                ')) then
+      j=j-1
+      goto 100
+    endif
+    if (j.gt.maxreceptor) then
+    write(*,*) ' #### FLEXPART MODEL ERROR! TOO MANY RECEPTOR #### '
+    write(*,*) ' #### POINTS ARE GIVEN.                       #### '
+    write(*,*) ' #### MAXIMUM NUMBER IS ',maxreceptor,'       #### '
+    write(*,*) ' #### PLEASE MAKE CHANGES IN FILE RECEPTORS   #### '
+    endif
+    receptorname(j)=receptor
+    xreceptor(j)=(x-xlon0)/dx       ! transform to grid coordinates
+    yreceptor(j)=(y-ylat0)/dy
+    xm=r_earth*cos(y*pi/180.)*dx/180.*pi
+    ym=r_earth*dy/180.*pi
+    receptorarea(j)=xm*ym
+    goto 100
+
+99   numreceptor=j-1
+  close(unitreceptor)
+  return
+
+
+999   write(*,*) ' #### FLEXPART MODEL ERROR! FILE "RECEPTORS"  #### '
+  write(*,*) ' #### CANNOT BE OPENED IN THE DIRECTORY       #### '
+  write(*,'(a)') path(1)(1:length(1))
+  stop
+
+end subroutine readreceptors
Index: /branches/FP_AI/src/readreleases.f90
===================================================================
--- /branches/FP_AI/src/readreleases.f90	(revision 23)
+++ /branches/FP_AI/src/readreleases.f90	(revision 23)
@@ -0,0 +1,523 @@
+!**********************************************************************
+! 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 readreleases
+
+  !*****************************************************************************
+  !                                                                            *
+  !     This routine reads the release point specifications for the current    *
+  !     model run. Several release points can be used at the same time.        *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     18 May 1996                                                            *
+  !                                                                            *
+  !     Update: 29 January 2001                                                *
+  !     Release altitude can be either in magl or masl                         *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! decay               decay constant of species                              *
+  ! dquer [um]          mean particle diameters                                *
+  ! dsigma              e.g. dsigma=10 or dsigma=0.1 means that 68% of the mass*
+  !                     are between 0.1*dquer and 10*dquer                     *
+  ! ireleasestart, ireleaseend [s] starting time and ending time of each       *
+  !                     release                                                *
+  ! kindz               1: zpoint is in m agl, 2: zpoint is in m asl, 3: zpoint*
+  !                     is in hPa                                              *
+  ! npart               number of particles to be released                     *
+  ! nspec               number of species to be released                       *
+  ! density [kg/m3]     density of the particles                               *
+  ! rm [s/m]            Mesophyll resistance                                   *
+  ! species             name of species                                        *
+  ! xmass               total mass of each species                             *
+  ! xpoint1,ypoint1     geograf. coordinates of lower left corner of release   *
+  !                     area                                                   *
+  ! xpoint2,ypoint2     geograf. coordinates of upper right corner of release  *
+  !                     area                                                   *
+  ! weta, wetb          parameters to determine the below-cloud scavenging     *
+  ! weta_in, wetb_in    parameters to determine the in-cloud scavenging        *
+  ! wetc_in, wetd_in    parameters to determine the in-cloud scavenging        *
+  ! zpoint1,zpoint2     height range, over which release takes place           *
+  ! num_min_discrete    if less, release cannot be randomized and happens at   *
+  !                     time mid-point of release interval                     *
+  !                                                                            *
+  !*****************************************************************************
+
+  use point_mod
+  use xmass_mod
+  use par_mod
+  use com_mod
+
+  implicit none
+
+  integer :: numpartmax,i,j,id1,it1,id2,it2,specnum_rel,idum,stat
+  integer,parameter :: num_min_discrete=100
+  real :: vsh(ni),fracth(ni),schmih(ni),releaserate,xdum,cun
+  real(kind=dp) :: jul1,jul2,julm,juldate
+  character(len=50) :: line
+  logical :: old
+
+  !sec, read release to find how many releasepoints should be allocated
+
+  open(unitreleases,file=path(1)(1:length(1))//'RELEASES',status='old', &
+       err=999)
+
+  ! Check the format of the RELEASES file (either in free format,
+  ! or using a formatted mask)
+  ! Use of formatted mask is assumed if line 10 contains the word 'DIRECTION'
+  !**************************************************************************
+
+  call skplin(12,unitreleases)
+  read (unitreleases,901) line
+901   format (a)
+  if (index(line,'Total') .eq. 0) then
+    old = .false.
+  else
+    old = .true.
+  endif
+  rewind(unitreleases)
+
+
+  ! Skip first 11 lines (file header)
+  !**********************************
+
+  call skplin(11,unitreleases)
+
+
+  read(unitreleases,*,err=998) nspec
+  if (old) call skplin(2,unitreleases)
+  do i=1,nspec
+    read(unitreleases,*,err=998) specnum_rel
+    if (old) call skplin(2,unitreleases)
+  end do
+
+  numpoint=0
+100   numpoint=numpoint+1
+  read(unitreleases,*,end=25)
+  read(unitreleases,*,err=998,end=25) idum,idum
+  if (old) call skplin(2,unitreleases)
+  read(unitreleases,*,err=998) idum,idum
+  if (old) call skplin(2,unitreleases)
+  read(unitreleases,*,err=998) xdum
+  if (old) call skplin(2,unitreleases)
+  read(unitreleases,*,err=998) xdum
+  if (old) call skplin(2,unitreleases)
+  read(unitreleases,*,err=998) xdum
+  if (old) call skplin(2,unitreleases)
+  read(unitreleases,*,err=998) xdum
+  if (old) call skplin(2,unitreleases)
+  read(unitreleases,*,err=998) idum
+  if (old) call skplin(2,unitreleases)
+  read(unitreleases,*,err=998) xdum
+  if (old) call skplin(2,unitreleases)
+  read(unitreleases,*,err=998) xdum
+  if (old) call skplin(2,unitreleases)
+  read(unitreleases,*,err=998) idum
+  if (old) call skplin(2,unitreleases)
+  do i=1,nspec
+    read(unitreleases,*,err=998) xdum
+    if (old) call skplin(2,unitreleases)
+  end do
+  !save compoint only for the first 1000 release points
+  read(unitreleases,'(a40)',err=998) compoint(1)(1:40)
+  if (old) call skplin(1,unitreleases)
+
+  goto 100
+
+25   numpoint=numpoint-1
+
+  !allocate memory for numpoint releaspoint
+    allocate(ireleasestart(numpoint) &
+         ,stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not allocate RELEASPOINT'
+    allocate(ireleaseend(numpoint) &
+         ,stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not allocate RELEASPOINT'
+    allocate(xpoint1(numpoint) &
+         ,stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not allocate RELEASPOINT'
+    allocate(xpoint2(numpoint) &
+         ,stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not allocate RELEASPOINT'
+    allocate(ypoint1(numpoint) &
+         ,stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not allocate RELEASPOINT'
+    allocate(ypoint2(numpoint) &
+         ,stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not allocate RELEASPOINT'
+    allocate(zpoint1(numpoint) &
+         ,stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not allocate RELEASPOINT'
+    allocate(zpoint2(numpoint) &
+         ,stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not allocate RELEASPOINT'
+    allocate(kindz(numpoint) &
+         ,stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not allocate RELEASPOINT'
+    allocate(xmass(numpoint,maxspec) &
+         ,stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not allocate RELEASPOINT'
+    allocate(rho_rel(numpoint) &
+         ,stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not allocate RELEASPOINT'
+    allocate(npart(numpoint) &
+         ,stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not allocate RELEASPOINT'
+    allocate(xmasssave(numpoint) &
+         ,stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not allocate RELEASPOINT'
+
+   write (*,*) ' Releasepoints allocated: ', numpoint
+
+   do i=1,numpoint
+     xmasssave(i)=0.
+   end do
+
+  !now save the information
+  DEP=.false.
+  DRYDEP=.false.
+  WETDEP=.false.
+  OHREA=.false.
+  do i=1,maxspec
+    DRYDEPSPEC(i)=.false.
+  end do
+
+  rewind(unitreleases)
+
+
+  ! Skip first 11 lines (file header)
+  !**********************************
+
+  call skplin(11,unitreleases)
+
+
+  ! Assign species-specific parameters needed for physical processes
+  !*************************************************************************
+
+  read(unitreleases,*,err=998) nspec
+  if (nspec.gt.maxspec) goto 994
+  if (old) call skplin(2,unitreleases)
+  do i=1,nspec
+    read(unitreleases,*,err=998) specnum_rel
+    if (old) call skplin(2,unitreleases)
+    call readspecies(specnum_rel,i)
+
+  ! For backward runs, only 1 species is allowed
+  !*********************************************
+
+  !if ((ldirect.lt.0).and.(nspec.gt.1)) then
+  !write(*,*) '#####################################################'
+  !write(*,*) '#### FLEXPART MODEL SUBROUTINE READRELEASES:     ####'
+  !write(*,*) '#### FOR BACKWARD RUNS, ONLY 1 SPECIES IS ALLOWED####'
+  !write(*,*) '#####################################################'
+  !  stop
+  !endif
+
+  ! Molecular weight
+  !*****************
+
+    if (((iout.eq.2).or.(iout.eq.3)).and. &
+         (weightmolar(i).lt.0.)) then
+      write(*,*) 'For mixing ratio output, valid molar weight'
+      write(*,*) 'must be specified for all simulated species.'
+      write(*,*) 'Check table SPECIES or choose concentration'
+      write(*,*) 'output instead if molar weight is not known.'
+      stop
+    endif
+
+
+  ! Radioactive decay
+  !******************
+
+    decay(i)=0.693147/decay(i) !conversion half life to decay constant
+
+
+  ! Dry deposition of gases
+  !************************
+
+    if (reldiff(i).gt.0.) &
+         rm(i)=1./(henry(i)/3000.+100.*f0(i))    ! mesophyll resistance
+
+  ! Dry deposition of particles
+  !****************************
+
+    vsetaver(i)=0.
+    cunningham(i)=0.
+    dquer(i)=dquer(i)*1000000.         ! Conversion m to um
+    if (density(i).gt.0.) then                  ! Additional parameters
+     call part0(dquer(i),dsigma(i),density(i),fracth,schmih,cun,vsh)
+      do j=1,ni
+        fract(i,j)=fracth(j)
+        schmi(i,j)=schmih(j)
+        vset(i,j)=vsh(j)
+        cunningham(i)=cunningham(i)+cun*fract(i,j)
+        vsetaver(i)=vsetaver(i)-vset(i,j)*fract(i,j)
+      end do
+      write(*,*) 'Average settling velocity: ',i,vsetaver(i)
+    endif
+
+  ! Dry deposition for constant deposition velocity
+  !************************************************
+
+    dryvel(i)=dryvel(i)*0.01         ! conversion to m/s
+
+  ! Check if wet deposition or OH reaction shall be calculated
+  !***********************************************************
+    if (weta(i).gt.0.)  then
+      WETDEP=.true.
+      write (*,*) 'Below-cloud scavenging is switched on'
+      write (*,*) 'Below-cloud scavenging coefficients: ',weta(i),i
+    else
+      write (*,*) 'Below-cloud scavenging is switched OFF'
+    endif
+    
+! NIK 31.01.2013 + 10.12.2013
+    if (weta_in(i).gt.0.)  then
+      WETDEP=.true.
+      write (*,*) 'In-cloud scavenging is switched on'
+      write (*,*) 'In-cloud scavenging coefficients: ',weta_in(i),wetb_in(i), wetc_in(i), wetd_in(i),i
+    else
+      write (*,*) 'In-cloud scavenging is switched OFF' 
+    endif
+
+    if (ohreact(i).gt.0) then
+      OHREA=.true.
+      write (*,*) 'OHreaction switched on: ',ohreact(i),i
+    endif
+
+
+    if ((reldiff(i).gt.0.).or.(density(i).gt.0.).or. &
+         (dryvel(i).gt.0.)) then
+      DRYDEP=.true.
+      DRYDEPSPEC(i)=.true.
+    endif
+
+  end do
+
+    if (WETDEP.or.DRYDEP) DEP=.true.
+
+  ! Read specifications for each release point
+  !*******************************************
+
+  numpoint=0
+  numpartmax=0
+  releaserate=0.
+1000   numpoint=numpoint+1
+  read(unitreleases,*,end=250)
+  read(unitreleases,*,err=998,end=250) id1,it1
+  if (old) call skplin(2,unitreleases)
+  read(unitreleases,*,err=998) id2,it2
+  if (old) call skplin(2,unitreleases)
+  read(unitreleases,*,err=998) xpoint1(numpoint)
+  if (old) call skplin(2,unitreleases)
+  read(unitreleases,*,err=998) ypoint1(numpoint)
+  if (old) call skplin(2,unitreleases)
+  read(unitreleases,*,err=998) xpoint2(numpoint)
+  if (old) call skplin(2,unitreleases)
+  read(unitreleases,*,err=998) ypoint2(numpoint)
+  if (old) call skplin(2,unitreleases)
+  read(unitreleases,*,err=998) kindz(numpoint)
+  if (old) call skplin(2,unitreleases)
+  read(unitreleases,*,err=998) zpoint1(numpoint)
+  if (old) call skplin(2,unitreleases)
+  read(unitreleases,*,err=998) zpoint2(numpoint)
+  if (old) call skplin(2,unitreleases)
+  read(unitreleases,*,err=998) npart(numpoint)
+  if (old) call skplin(2,unitreleases)
+  do i=1,nspec
+    read(unitreleases,*,err=998) xmass(numpoint,i)
+    if (old) call skplin(2,unitreleases)
+  end do
+  !save compoint only for the first 1000 release points
+  if (numpoint.le.1000) then
+    read(unitreleases,'(a40)',err=998) compoint(numpoint)(1:40)
+  else
+    read(unitreleases,'(a40)',err=998) compoint(1001)(1:40)
+  endif
+  if (old) call skplin(1,unitreleases)
+  if (numpoint.le.1000) then
+    if((xpoint1(numpoint).eq.0.).and.(ypoint1(numpoint).eq.0.).and. &
+         (xpoint2(numpoint).eq.0.).and.(ypoint2(numpoint).eq.0.).and. &
+         (compoint(numpoint)(1:8).eq.'        ')) goto 250
+  else
+    if((xpoint1(numpoint).eq.0.).and.(ypoint1(numpoint).eq.0.).and. &
+         (xpoint2(numpoint).eq.0.).and.(ypoint2(numpoint).eq.0.)) goto 250
+  endif
+
+
+  ! If a release point contains no particles, stop and issue error message
+  !***********************************************************************
+
+  if (npart(numpoint).eq.0) then
+    write(*,*) 'FLEXPART MODEL ERROR'
+    write(*,*) 'RELEASES file is corrupt.'
+    write(*,*) 'At least for one release point, there are zero'
+    write(*,*) 'particles released. Make changes to RELEASES.'
+    stop
+  endif
+
+  ! Check whether x coordinates of release point are within model domain
+  !*********************************************************************
+
+   if (xpoint1(numpoint).lt.xlon0) &
+        xpoint1(numpoint)=xpoint1(numpoint)+360.
+   if (xpoint1(numpoint).gt.xlon0+(nxmin1)*dx) &
+        xpoint1(numpoint)=xpoint1(numpoint)-360.
+   if (xpoint2(numpoint).lt.xlon0) &
+        xpoint2(numpoint)=xpoint2(numpoint)+360.
+   if (xpoint2(numpoint).gt.xlon0+(nxmin1)*dx) &
+        xpoint2(numpoint)=xpoint2(numpoint)-360.
+
+  ! Determine relative beginning and ending times of particle release
+  !******************************************************************
+
+  jul1=juldate(id1,it1)
+  jul2=juldate(id2,it2)
+  julm=(jul1+jul2)/2.
+  if (jul1.gt.jul2) then
+    write(*,*) 'FLEXPART MODEL ERROR'
+    write(*,*) 'Release stops before it begins.'
+    write(*,*) 'Make changes to file RELEASES.'
+    stop
+  endif
+  if (mdomainfill.eq.0) then   ! no domain filling
+    if (ldirect.eq.1) then
+      if ((jul1.lt.bdate).or.(jul2.gt.edate)) then
+        write(*,*) 'FLEXPART MODEL ERROR'
+        write(*,*) 'Release starts before simulation begins or ends'
+        write(*,*) 'after simulation stops.'
+        write(*,*) 'Make files COMMAND and RELEASES consistent.'
+        stop
+      endif
+      if (npart(numpoint).gt.num_min_discrete) then
+        ireleasestart(numpoint)=int((jul1-bdate)*86400.)
+        ireleaseend(numpoint)=int((jul2-bdate)*86400.)
+      else
+        ireleasestart(numpoint)=int((julm-bdate)*86400.)
+        ireleaseend(numpoint)=int((julm-bdate)*86400.)
+      endif
+    else if (ldirect.eq.-1) then
+      if ((jul1.lt.edate).or.(jul2.gt.bdate)) then
+        write(*,*) 'FLEXPART MODEL ERROR'
+        write(*,*) 'Release starts before simulation begins or ends'
+        write(*,*) 'after simulation stops.'
+        write(*,*) 'Make files COMMAND and RELEASES consistent.'
+        stop
+      endif
+      if (npart(numpoint).gt.num_min_discrete) then
+        ireleasestart(numpoint)=int((jul1-bdate)*86400.)
+        ireleaseend(numpoint)=int((jul2-bdate)*86400.)
+      else
+        ireleasestart(numpoint)=int((julm-bdate)*86400.)
+        ireleaseend(numpoint)=int((julm-bdate)*86400.)
+      endif
+    endif
+  endif
+
+
+  ! Check, whether the total number of particles may exceed totally allowed
+  ! number of particles at some time during the simulation
+  !************************************************************************
+
+  ! Determine the release rate (particles per second) and total number
+  ! of particles released during the simulation
+  !*******************************************************************
+
+  if (ireleasestart(numpoint).ne.ireleaseend(numpoint)) then
+    releaserate=releaserate+real(npart(numpoint))/ &
+         real(ireleaseend(numpoint)-ireleasestart(numpoint))
+  else
+    releaserate=99999999
+  endif
+  numpartmax=numpartmax+npart(numpoint)
+  goto 1000
+
+
+250   close(unitreleases)
+
+  write (*,*) ' Particles allocated for this run: ',maxpart, ', released in simulation: ',  numpartmax
+  numpoint=numpoint-1
+
+  if (ioutputforeachrelease.eq.1) then
+    maxpointspec_act=numpoint
+  else
+    maxpointspec_act=1
+  endif
+
+  if (releaserate.gt. &
+       0.99*real(maxpart)/real(lage(nageclass))) then
+    if (numpartmax.gt.maxpart) then
+  write(*,*) '#####################################################'
+  write(*,*) '#### FLEXPART MODEL SUBROUTINE READRELEASES:     ####'
+  write(*,*) '####                                             ####'
+  write(*,*) '####WARNING - TOTAL NUMBER OF PARTICLES SPECIFIED####'
+  write(*,*) '#### IN FILE "RELEASES" MAY AT SOME POINT DURING ####'
+  write(*,*) '#### THE SIMULATION EXCEED THE MAXIMUM ALLOWED   ####'
+  write(*,*) '#### NUMBER (MAXPART).IF RELEASES DO NOT OVERLAP,####'
+  write(*,*) '#### FLEXPART CAN POSSIBLY COMPLETE SUCCESSFULLY.####'
+  write(*,*) '#### HOWEVER, FLEXPART MAY HAVE TO STOP          ####'
+  write(*,*) '#### AT SOME TIME DURING THE SIMULATION. PLEASE  ####'
+  write(*,*) '#### MAKE SURE THAT YOUR SETTINGS ARE CORRECT.   ####'
+  write(*,*) '#####################################################'
+      write(*,*) 'Maximum release rate may be: ',releaserate, &
+           ' particles per second'
+      write(*,*) 'Maximum allowed release rate is: ', &
+           real(maxpart)/real(lage(nageclass)),' particles per second'
+      write(*,*) &
+           'Total number of particles released during the simulation is: ', &
+           numpartmax
+      write(*,*) 'Maximum allowed number of particles is: ',maxpart
+    endif
+  endif
+
+  return
+
+994   write(*,*) '#####################################################'
+  write(*,*) '#### FLEXPART MODEL SUBROUTINE READRELEASES:     ####'
+  write(*,*) '####                                             ####'
+  write(*,*) '#### ERROR - MAXIMUM NUMBER OF EMITTED SPECIES IS####'
+  write(*,*) '#### TOO LARGE. PLEASE REDUCE NUMBER OF SPECIES. ####'
+  write(*,*) '#####################################################'
+  stop
+
+998   write(*,*) '#####################################################'
+  write(*,*) '#### FLEXPART MODEL SUBROUTINE READRELEASES:     ####'
+  write(*,*) '####                                             ####'
+  write(*,*) '#### FATAL ERROR - FILE "RELEASES" IS            ####'
+  write(*,*) '#### CORRUPT. PLEASE CHECK YOUR INPUTS FOR       ####'
+  write(*,*) '#### MISTAKES OR GET A NEW "RELEASES"-           ####'
+  write(*,*) '#### FILE ...                                    ####'
+  write(*,*) '#####################################################'
+  stop
+
+
+999   write(*,*) '#####################################################'
+  write(*,*) '   FLEXPART MODEL SUBROUTINE READRELEASES: '
+  write(*,*)
+  write(*,*) 'FATAL ERROR - FILE CONTAINING PARTICLE RELEASE POINTS'
+  write(*,*) 'POINTS IS NOT AVAILABLE OR YOU ARE NOT'
+  write(*,*) 'PERMITTED FOR ANY ACCESS'
+  write(*,*) '#####################################################'
+  stop
+
+end subroutine readreleases
Index: /branches/FP_AI/src/readspecies.f90
===================================================================
--- /branches/FP_AI/src/readspecies.f90	(revision 23)
+++ /branches/FP_AI/src/readspecies.f90	(revision 23)
@@ -0,0 +1,206 @@
+!**********************************************************************
+! 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 readspecies(id_spec,pos_spec)
+
+  !*****************************************************************************
+  !                                                                            *
+  !     This routine reads names and physical constants of chemical species/   *
+  !     radionuclides given in the parameter pos_spec                          *
+  !                                                                            *
+  !   Author: A. Stohl                                                         *
+  !                                                                            *
+  !   11 July 1996                                                             *
+  !                                                                            *
+  !   Changes:                                                                 *
+  !   N. Kristiansen, 31.01.2013: Including parameters for in-cloud scavenging *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! decaytime(maxtable)  half time for radiological decay                      *
+  ! specname(maxtable)   names of chemical species, radionuclides              *
+  ! weta, wetb           Parameters for determining below-cloud scavenging     *
+  ! weta_in              Parameter for determining in-cloud scavenging         *
+  ! wetb_in              Parameter for determining in-cloud scavenging         *
+  ! wetc_in              Parameter for determining in-cloud scavenging         *
+  ! wetd_in              Parameter for determining in-cloud scavenging         *
+  ! ohreact              OH reaction rate                                      *
+  ! id_spec              SPECIES number as referenced in RELEASE file          *
+  ! id_pos               position where SPECIES data shall be stored           *
+  !                                                                            *
+  ! Constants:                                                                 *
+  !                                                                            *
+  !*****************************************************************************
+
+  use par_mod
+  use com_mod
+
+  implicit none
+
+  integer :: i, pos_spec,j
+  integer :: idow,ihour,id_spec
+  character(len=3) :: aspecnumb
+  logical :: spec_found
+
+  ! Open the SPECIES file and read species names and properties
+  !************************************************************
+  specnum(pos_spec)=id_spec
+  write(aspecnumb,'(i3.3)') specnum(pos_spec)
+  open(unitspecies,file= &
+       path(1)(1:length(1))//'SPECIES/SPECIES_'//aspecnumb,status='old', &
+       err=998)
+  !write(*,*) 'reading SPECIES',specnum(pos_spec)
+
+  ASSSPEC=.FALSE.
+
+  do i=1,6
+    read(unitspecies,*)
+  end do
+
+    read(unitspecies,'(a10)',end=22) species(pos_spec)
+  !  write(*,*) species(pos_spec)
+    read(unitspecies,'(f18.1)',end=22) decay(pos_spec)
+  !  write(*,*) decay(pos_spec)
+    read(unitspecies,'(e18.1)',end=22) weta(pos_spec)
+  !  write(*,*) weta(pos_spec)
+    read(unitspecies,'(f18.2)',end=22) wetb(pos_spec)
+  !  write(*,*) wetb(pos_spec)
+
+!*** NIK 31.01.2013: including in-cloud scavening parameters
+   read(unitspecies,'(e18.1)',end=22) weta_in(pos_spec)
+  !  write(*,*) weta_in(pos_spec)
+   read(unitspecies,'(f18.2)',end=22) wetb_in(pos_spec)
+  !  write(*,*) wetb_in(pos_spec)
+   read(unitspecies,'(f18.2)',end=22) wetc_in(pos_spec)
+  !  write(*,*) wetc_in(pos_spec)
+   read(unitspecies,'(f18.2)',end=22) wetd_in(pos_spec)
+  !  write(*,*) wetd_in(pos_spec)
+
+    read(unitspecies,'(f18.1)',end=22) reldiff(pos_spec)
+  !  write(*,*) reldiff(pos_spec)
+    read(unitspecies,'(e18.1)',end=22) henry(pos_spec)
+  !  write(*,*) henry(pos_spec)
+    read(unitspecies,'(f18.1)',end=22) f0(pos_spec)
+  !  write(*,*) f0(pos_spec)
+    read(unitspecies,'(e18.1)',end=22) density(pos_spec)
+  !  write(*,*) density(pos_spec)
+    read(unitspecies,'(e18.1)',end=22) dquer(pos_spec)
+  !  write(*,*) dquer(pos_spec)
+    read(unitspecies,'(e18.1)',end=22) dsigma(pos_spec)
+  !  write(*,*) dsigma(pos_spec)
+    read(unitspecies,'(f18.2)',end=22) dryvel(pos_spec)
+  !  write(*,*) dryvel(pos_spec)
+    read(unitspecies,'(f18.2)',end=22) weightmolar(pos_spec)
+  !  write(*,*) weightmolar(pos_spec)
+    read(unitspecies,'(e18.1)',end=22) ohreact(pos_spec)
+  !  write(*,*) ohreact(pos_spec)
+    read(unitspecies,'(i18)',end=22) spec_ass(pos_spec)
+  !  write(*,*) spec_ass(pos_spec)
+    read(unitspecies,'(f18.2)',end=22) kao(pos_spec)
+  !       write(*,*) kao(pos_spec)
+    i=pos_spec
+
+    if ((weta(pos_spec).gt.0).and.(henry(pos_spec).le.0)) then
+       if (dquer(pos_spec).le.0) goto 996 ! no particle, no henry set
+    endif
+
+    if (spec_ass(pos_spec).gt.0) then
+       spec_found=.FALSE.
+       do j=1,pos_spec-1
+          if (spec_ass(pos_spec).eq.specnum(j)) then
+             spec_ass(pos_spec)=j
+             spec_found=.TRUE.
+             ASSSPEC=.TRUE.
+          endif
+       end do
+       if (spec_found.eqv..FALSE.) then
+          goto 997
+       endif
+    endif
+
+    if (dsigma(i).eq.1.) dsigma(i)=1.0001   ! avoid floating exception
+    if (dsigma(i).eq.0.) dsigma(i)=1.0001   ! avoid floating exception
+
+    if ((reldiff(i).gt.0.).and.(density(i).gt.0.)) then
+      write(*,*) '#### FLEXPART MODEL ERROR! FILE "SPECIES"    ####'
+      write(*,*) '#### IS CORRUPT. SPECIES CANNOT BE BOTH      ####'
+      write(*,*) '#### PARTICLE AND GAS.                       ####'
+      write(*,*) '#### SPECIES NUMBER',aspecnumb
+      stop
+    endif
+20   continue
+
+
+  ! Read in daily and day-of-week variation of emissions, if available
+  !*******************************************************************
+
+    do j=1,24           ! initialize everything to no variation
+      area_hour(i,j)=1.
+      point_hour(i,j)=1.
+    end do
+    do j=1,7
+      area_dow(i,j)=1.
+      point_dow(i,j)=1.
+    end do
+
+    read(unitspecies,*,end=22)
+    do j=1,24     ! 24 hours, starting with 0-1 local time
+      read(unitspecies,*) ihour,area_hour(i,j),point_hour(i,j)
+    end do
+    read(unitspecies,*)
+    do j=1,7      ! 7 days of the week, starting with Monday
+      read(unitspecies,*) idow,area_dow(i,j),point_dow(i,j)
+    end do
+
+22   close(unitspecies)
+
+   return
+
+996   write(*,*) '#####################################################'
+  write(*,*) '#### FLEXPART MODEL ERROR!                      #### '
+  write(*,*) '#### WET DEPOSITION SWITCHED ON, BUT NO HENRYS  #### '
+  write(*,*) '#### CONSTANT IS SET                            ####'
+  write(*,*) '#### PLEASE MODIFY SPECIES DESCR. FILE!        #### '
+  write(*,*) '#####################################################'
+  stop
+
+
+997   write(*,*) '#####################################################'
+  write(*,*) '#### FLEXPART MODEL ERROR!                      #### '
+  write(*,*) '#### THE ASSSOCIATED SPECIES HAS TO BE DEFINED  #### '
+  write(*,*) '#### BEFORE THE ONE WHICH POINTS AT IT          #### '
+  write(*,*) '#### PLEASE CHANGE ORDER IN RELEASES OR ADD     #### '
+  write(*,*) '#### THE ASSOCIATED SPECIES IN RELEASES         #### '
+  write(*,*) '#####################################################'
+  stop
+
+
+998   write(*,*) '#####################################################'
+  write(*,*) '#### FLEXPART MODEL ERROR!                      #### '
+  write(*,*) '#### THE SPECIES FILE FOR SPECIES ', id_spec
+  write(*,*) '#### CANNOT BE FOUND: CREATE FILE'
+  write(*,*) '#### ',path(1)(1:length(1)),'SPECIES/SPECIES_',aspecnumb
+  write(*,*) '#####################################################'
+  stop
+
+
+end subroutine readspecies
Index: /branches/FP_AI/src/readwind.f90
===================================================================
--- /branches/FP_AI/src/readwind.f90	(revision 23)
+++ /branches/FP_AI/src/readwind.f90	(revision 23)
@@ -0,0 +1,468 @@
+!**********************************************************************
+! 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 readwind(indj,n,uuh,vvh,wwh)
+
+  !**********************************************************************
+  !                                                                     *
+  !             TRAJECTORY MODEL SUBROUTINE READWIND                    *
+  !                                                                     *
+  !**********************************************************************
+  !                                                                     *
+  !             AUTHOR:      G. WOTAWA                                  *
+  !             DATE:        1997-08-05                                 *
+  !             LAST UPDATE: 2000-10-17, Andreas Stohl                  *
+  !             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                      *
+  !                                                                     *
+  !**********************************************************************
+  !  Changes, Bernd C. Krueger, Feb. 2001:
+  !   Variables tth and qvh (on eta coordinates) in common block
+  !**********************************************************************
+  !                                                                     *
+  ! DESCRIPTION:                                                        *
+  !                                                                     *
+  ! READING OF ECMWF METEOROLOGICAL FIELDS FROM INPUT DATA FILES. THE   *
+  ! INPUT DATA FILES ARE EXPECTED TO BE AVAILABLE IN GRIB CODE          *
+  !                                                                     *
+  ! INPUT:                                                              *
+  ! indj               indicates number of the wind field to be read in *
+  ! n                  temporal index for meteorological fields (1 to 3)*
+  !                                                                     *
+  ! IMPORTANT VARIABLES FROM COMMON BLOCK:                              *
+  !                                                                     *
+  ! wfname             File name of data to be read in                  *
+  ! nx,ny,nuvz,nwz     expected field dimensions                        *
+  ! nlev_ec            number of vertical levels ecmwf model            *
+  ! uu,vv,ww           wind fields                                      *
+  ! tt,qv              temperature and specific humidity                *
+  ! ps                 surface pressure                                 *
+  !                                                                     *
+  !**********************************************************************
+
+  use GRIB_API
+  use par_mod
+  use com_mod
+
+  implicit none
+
+  !HSO  parameters for grib_api
+  integer :: ifile
+  integer :: iret
+  integer :: igrib
+  integer :: gribVer,parCat,parNum,typSurf,valSurf,discipl,parId
+  integer :: gotGrid
+  !HSO  end
+
+  real(kind=4) :: uuh(0:nxmax-1,0:nymax-1,nuvzmax)
+  real(kind=4) :: vvh(0:nxmax-1,0:nymax-1,nuvzmax)
+  real(kind=4) :: wwh(0:nxmax-1,0:nymax-1,nwzmax)
+  integer :: indj,i,j,k,n,levdiff2,ifield,iumax,iwmax
+
+  ! VARIABLES AND ARRAYS NEEDED FOR GRIB DECODING
+
+  ! dimension of isec2 at least (22+n), where n is the number of parallels or
+  ! meridians in a quasi-regular (reduced) Gaussian or lat/long grid
+
+  ! dimension of zsec2 at least (10+nn), where nn is the number of vertical
+  ! coordinate parameters
+
+  integer :: isec1(56),isec2(22+nxmax+nymax)
+  real(kind=4) :: zsec4(jpunp)
+  real(kind=4) :: xaux,yaux
+  real(kind=8) :: xauxin,yauxin
+  real,parameter :: eps=1.e-4
+  real(kind=4) :: nsss(0:nxmax-1,0:nymax-1),ewss(0:nxmax-1,0:nymax-1)
+  real :: plev1,pmean,tv,fu,hlev1,ff10m,fflev1,conversion_factor
+
+  logical :: hflswitch,strswitch
+
+  !HSO  grib api error messages
+  character(len=24) :: gribErrorMsg = 'Error reading grib file'
+  character(len=20) :: gribFunction = 'readwind'
+
+  hflswitch=.false.
+  strswitch=.false.
+  levdiff2=nlev_ec-nwz+1
+  iumax=0
+  iwmax=0
+
+  !
+  ! OPENING OF DATA FILE (GRIB CODE)
+  !
+5   call grib_open_file(ifile,path(3)(1:length(3)) &
+         //trim(wfname(indj)),'r',iret)
+  if (iret.ne.GRIB_SUCCESS) then
+    goto 888   ! ERROR DETECTED
+  endif
+  !turn on support for multi fields messages */
+  !call grib_multi_support_on
+
+  gotGrid=0
+  ifield=0
+10   ifield=ifield+1
+  !
+  ! GET NEXT FIELDS
+  !
+  call grib_new_from_file(ifile,igrib,iret)
+  if (iret.eq.GRIB_END_OF_FILE)  then
+    goto 50    ! EOF DETECTED
+  elseif (iret.ne.GRIB_SUCCESS) then
+    goto 888   ! ERROR DETECTED
+  endif
+
+  !first see if we read GRIB1 or GRIB2
+  call grib_get_int(igrib,'editionNumber',gribVer,iret)
+  call grib_check(iret,gribFunction,gribErrorMsg)
+
+  if (gribVer.eq.1) then ! GRIB Edition 1
+
+  !print*,'GRiB Edition 1'
+  !read the grib2 identifiers
+  call grib_get_int(igrib,'indicatorOfParameter',isec1(6),iret)
+  call grib_check(iret,gribFunction,gribErrorMsg)
+  call grib_get_int(igrib,'level',isec1(8),iret)
+  call grib_check(iret,gribFunction,gribErrorMsg)
+
+  !change code for etadot to code for omega
+  if (isec1(6).eq.77) then
+    isec1(6)=135
+  endif
+
+  conversion_factor=1.
+
+  else
+
+  !print*,'GRiB Edition 2'
+  !read the grib2 identifiers
+  call grib_get_int(igrib,'discipline',discipl,iret)
+  call grib_check(iret,gribFunction,gribErrorMsg)
+  call grib_get_int(igrib,'parameterCategory',parCat,iret)
+  call grib_check(iret,gribFunction,gribErrorMsg)
+  call grib_get_int(igrib,'parameterNumber',parNum,iret)
+  call grib_check(iret,gribFunction,gribErrorMsg)
+  call grib_get_int(igrib,'typeOfFirstFixedSurface',typSurf,iret)
+  call grib_check(iret,gribFunction,gribErrorMsg)
+  call grib_get_int(igrib,'level',valSurf,iret)
+  call grib_check(iret,gribFunction,gribErrorMsg)
+  call grib_get_int(igrib,'paramId',parId,iret)
+  call grib_check(iret,gribFunction,gribErrorMsg)
+
+  !print*,discipl,parCat,parNum,typSurf,valSurf
+
+  !convert to grib1 identifiers
+  isec1(6)=-1
+  isec1(7)=-1
+  isec1(8)=-1
+  isec1(8)=valSurf     ! level
+  conversion_factor=1.
+  if ((parCat.eq.0).and.(parNum.eq.0).and.(typSurf.eq.105)) then ! T
+    isec1(6)=130         ! indicatorOfParameter
+  elseif ((parCat.eq.2).and.(parNum.eq.2).and.(typSurf.eq.105)) then ! U
+    isec1(6)=131         ! indicatorOfParameter
+  elseif ((parCat.eq.2).and.(parNum.eq.3).and.(typSurf.eq.105)) then ! V
+    isec1(6)=132         ! indicatorOfParameter
+  elseif ((parCat.eq.1).and.(parNum.eq.0).and.(typSurf.eq.105)) then ! Q
+    isec1(6)=133         ! indicatorOfParameter
+  elseif ((parCat.eq.3).and.(parNum.eq.0).and.(typSurf.eq.1)) then !SP
+    isec1(6)=134         ! indicatorOfParameter
+  elseif ((parCat.eq.2).and.(parNum.eq.32)) then ! W, actually eta dot
+    isec1(6)=135         ! indicatorOfParameter
+  elseif ((parCat.eq.128).and.(parNum.eq.77)) then ! W, actually eta dot
+    isec1(6)=135         ! indicatorOfParameter
+  elseif ((parCat.eq.3).and.(parNum.eq.0).and.(typSurf.eq.101)) then !SLP
+    isec1(6)=151         ! indicatorOfParameter
+  elseif ((parCat.eq.2).and.(parNum.eq.2).and.(typSurf.eq.103)) then ! 10U
+    isec1(6)=165         ! indicatorOfParameter
+  elseif ((parCat.eq.2).and.(parNum.eq.3).and.(typSurf.eq.103)) then ! 10V
+    isec1(6)=166         ! indicatorOfParameter
+  elseif ((parCat.eq.0).and.(parNum.eq.0).and.(typSurf.eq.103)) then ! 2T
+    isec1(6)=167         ! indicatorOfParameter
+  elseif ((parCat.eq.0).and.(parNum.eq.6).and.(typSurf.eq.103)) then ! 2D
+    isec1(6)=168         ! indicatorOfParameter
+  elseif ((parCat.eq.1).and.(parNum.eq.11).and.(typSurf.eq.1)) then ! SD
+    isec1(6)=141         ! indicatorOfParameter
+    conversion_factor=1000.
+  elseif ((parCat.eq.6).and.(parNum.eq.1) .or. parId .eq. 164) then ! CC
+    isec1(6)=164         ! indicatorOfParameter
+  elseif ((parCat.eq.1).and.(parNum.eq.9) .or. parId .eq. 142) then ! LSP
+    isec1(6)=142         ! indicatorOfParameter
+  elseif ((parCat.eq.1).and.(parNum.eq.10)) then ! CP
+    isec1(6)=143         ! indicatorOfParameter
+    conversion_factor=1000.
+  elseif ((parCat.eq.0).and.(parNum.eq.11).and.(typSurf.eq.1)) then ! SHF
+    isec1(6)=146         ! indicatorOfParameter
+  elseif ((parCat.eq.4).and.(parNum.eq.9).and.(typSurf.eq.1)) then ! SR
+    isec1(6)=176         ! indicatorOfParameter
+  elseif ((parCat.eq.2).and.(parNum.eq.17) .or. parId .eq. 180) then ! EWSS
+    isec1(6)=180         ! indicatorOfParameter
+  elseif ((parCat.eq.2).and.(parNum.eq.18) .or. parId .eq. 181) then ! NSSS
+    isec1(6)=181         ! indicatorOfParameter
+  elseif ((parCat.eq.3).and.(parNum.eq.4)) then ! ORO
+    isec1(6)=129         ! indicatorOfParameter
+  elseif ((parCat.eq.3).and.(parNum.eq.7) .or. parId .eq. 160) then ! SDO
+    isec1(6)=160         ! indicatorOfParameter
+  elseif ((discipl.eq.2).and.(parCat.eq.0).and.(parNum.eq.0).and. &
+       (typSurf.eq.1)) then ! LSM
+    isec1(6)=172         ! indicatorOfParameter
+  else
+    print*,'***ERROR: undefined GRiB2 message found!',discipl, &
+         parCat,parNum,typSurf
+  endif
+  if(parId .ne. isec1(6) .and. parId .ne. 77) then
+    write(*,*) 'parId',parId, 'isec1(6)',isec1(6)
+!    stop
+  endif
+
+  endif
+
+  !HSO  get the size and data of the values array
+  if (isec1(6).ne.-1) then
+    call grib_get_real4_array(igrib,'values',zsec4,iret)
+    call grib_check(iret,gribFunction,gribErrorMsg)
+  endif
+
+  !HSO  get the required fields from section 2 in a gribex compatible manner
+  if (ifield.eq.1) then
+  call grib_get_int(igrib,'numberOfPointsAlongAParallel',isec2(2),iret)
+  call grib_check(iret,gribFunction,gribErrorMsg)
+  call grib_get_int(igrib,'numberOfPointsAlongAMeridian',isec2(3),iret)
+  call grib_check(iret,gribFunction,gribErrorMsg)
+  call grib_get_int(igrib,'numberOfVerticalCoordinateValues',isec2(12))
+  call grib_check(iret,gribFunction,gribErrorMsg)
+  ! CHECK GRID SPECIFICATIONS
+  if(isec2(2).ne.nxfield) stop 'READWIND: NX NOT CONSISTENT'
+  if(isec2(3).ne.ny) stop 'READWIND: NY NOT CONSISTENT'
+  if(isec2(12)/2-1.ne.nlev_ec) &
+  stop 'READWIND: VERTICAL DISCRETIZATION NOT CONSISTENT'
+  endif ! ifield
+
+  !HSO  get the second part of the grid dimensions only from GRiB1 messages
+  if (isec1(6) .eq. 167 .and. (gotGrid.eq.0)) then
+    call grib_get_real8(igrib,'longitudeOfFirstGridPointInDegrees', &
+         xauxin,iret)
+    call grib_check(iret,gribFunction,gribErrorMsg)
+    call grib_get_real8(igrib,'latitudeOfLastGridPointInDegrees', &
+         yauxin,iret)
+    call grib_check(iret,gribFunction,gribErrorMsg)
+    if (xauxin.gt.180.) xauxin=xauxin-360.0
+    if (xauxin.lt.-180.) xauxin=xauxin+360.0
+
+    xaux=xauxin+real(nxshift)*dx
+    yaux=yauxin
+    if (xaux.gt.180.) xaux=xaux-360.0
+    if(abs(xaux-xlon0).gt.eps) &
+    stop 'READWIND: LOWER LEFT LONGITUDE NOT CONSISTENT'
+    if(abs(yaux-ylat0).gt.eps) &
+    stop 'READWIND: LOWER LEFT LATITUDE NOT CONSISTENT'
+    gotGrid=1
+  endif ! gotGrid
+
+  do j=0,nymin1
+    do i=0,nxfield-1
+      k=isec1(8)
+      if(isec1(6).eq.130) tth(i,j,nlev_ec-k+2,n)= &!! TEMPERATURE
+           zsec4(nxfield*(ny-j-1)+i+1)
+      if(isec1(6).eq.131) uuh(i,j,nlev_ec-k+2)= &!! U VELOCITY
+           zsec4(nxfield*(ny-j-1)+i+1)
+      if(isec1(6).eq.132) vvh(i,j,nlev_ec-k+2)= &!! V VELOCITY
+           zsec4(nxfield*(ny-j-1)+i+1)
+      if(isec1(6).eq.133) then                      !! SPEC. HUMIDITY
+        qvh(i,j,nlev_ec-k+2,n)=zsec4(nxfield*(ny-j-1)+i+1)
+        if (qvh(i,j,nlev_ec-k+2,n) .lt. 0.) &
+             qvh(i,j,nlev_ec-k+2,n) = 0.
+  !        this is necessary because the gridded data may contain
+  !        spurious negative values
+      endif
+      if(isec1(6).eq.134) ps(i,j,1,n)= &!! SURF. PRESS.
+           zsec4(nxfield*(ny-j-1)+i+1)
+
+      if(isec1(6).eq.135) wwh(i,j,nlev_ec-k+1)= &!! W VELOCITY
+           zsec4(nxfield*(ny-j-1)+i+1)
+      if(isec1(6).eq.141) sd(i,j,1,n)= &!! SNOW DEPTH
+           zsec4(nxfield*(ny-j-1)+i+1)/conversion_factor
+      if(isec1(6).eq.151) msl(i,j,1,n)= &!! SEA LEVEL PRESS.
+           zsec4(nxfield*(ny-j-1)+i+1)
+      if(isec1(6).eq.164) tcc(i,j,1,n)= &!! CLOUD COVER
+           zsec4(nxfield*(ny-j-1)+i+1)
+      if(isec1(6).eq.165) u10(i,j,1,n)= &!! 10 M U VELOCITY
+           zsec4(nxfield*(ny-j-1)+i+1)
+      if(isec1(6).eq.166) v10(i,j,1,n)= &!! 10 M V VELOCITY
+           zsec4(nxfield*(ny-j-1)+i+1)
+      if(isec1(6).eq.167) tt2(i,j,1,n)= &!! 2 M TEMPERATURE
+           zsec4(nxfield*(ny-j-1)+i+1)
+      if(isec1(6).eq.168) td2(i,j,1,n)= &!! 2 M DEW POINT
+           zsec4(nxfield*(ny-j-1)+i+1)
+      if(isec1(6).eq.142) then                      !! LARGE SCALE PREC.
+        lsprec(i,j,1,n)=zsec4(nxfield*(ny-j-1)+i+1)
+        if (lsprec(i,j,1,n).lt.0.) lsprec(i,j,1,n)=0.
+      endif
+      if(isec1(6).eq.143) then                      !! CONVECTIVE PREC.
+        convprec(i,j,1,n)=zsec4(nxfield*(ny-j-1)+i+1)/conversion_factor
+        if (convprec(i,j,1,n).lt.0.) convprec(i,j,1,n)=0.
+      endif
+      if(isec1(6).eq.146) sshf(i,j,1,n)= &!! SENS. HEAT FLUX
+           zsec4(nxfield*(ny-j-1)+i+1)
+      if((isec1(6).eq.146).and.(zsec4(nxfield*(ny-j-1)+i+1).ne.0.)) &
+           hflswitch=.true.    ! Heat flux available
+      if(isec1(6).eq.176) then                      !! SOLAR RADIATION
+        ssr(i,j,1,n)=zsec4(nxfield*(ny-j-1)+i+1)
+        if (ssr(i,j,1,n).lt.0.) ssr(i,j,1,n)=0.
+      endif
+      if(isec1(6).eq.180) ewss(i,j)= &!! EW SURFACE STRESS
+           zsec4(nxfield*(ny-j-1)+i+1)
+      if(isec1(6).eq.181) nsss(i,j)= &!! NS SURFACE STRESS
+           zsec4(nxfield*(ny-j-1)+i+1)
+      if(((isec1(6).eq.180).or.(isec1(6).eq.181)).and. &
+           (zsec4(nxfield*(ny-j-1)+i+1).ne.0.)) strswitch=.true.    ! stress available
+  !sec        strswitch=.true.
+      if(isec1(6).eq.129) oro(i,j)= &!! ECMWF OROGRAPHY
+           zsec4(nxfield*(ny-j-1)+i+1)/ga
+      if(isec1(6).eq.160) excessoro(i,j)= &!! STANDARD DEVIATION OF OROGRAPHY
+           zsec4(nxfield*(ny-j-1)+i+1)
+      if(isec1(6).eq.172) lsm(i,j)= &!! ECMWF LAND SEA MASK
+           zsec4(nxfield*(ny-j-1)+i+1)
+      if(isec1(6).eq.131) iumax=max(iumax,nlev_ec-k+1)
+      if(isec1(6).eq.135) iwmax=max(iwmax,nlev_ec-k+1)
+
+    end do
+  end do
+
+  call grib_release(igrib)
+  goto 10                      !! READ NEXT LEVEL OR PARAMETER
+  !
+  ! CLOSING OF INPUT DATA FILE
+  !
+
+50   call grib_close_file(ifile)
+
+  !error message if no fields found with correct first longitude in it
+  if (gotGrid.eq.0) then
+    print*,'***ERROR: input file needs to contain GRiB1 formatted'// &
+         'messages'
+    stop
+  endif
+
+  if(levdiff2.eq.0) then
+    iwmax=nlev_ec+1
+    do i=0,nxmin1
+      do j=0,nymin1
+        wwh(i,j,nlev_ec+1)=0.
+      end do
+    end do
+  endif
+
+  ! For global fields, assign the leftmost data column also to the rightmost
+  ! data column; if required, shift whole grid by nxshift grid points
+  !*************************************************************************
+
+  if (xglobal) then
+    call shift_field_0(ewss,nxfield,ny)
+    call shift_field_0(nsss,nxfield,ny)
+    call shift_field_0(oro,nxfield,ny)
+    call shift_field_0(excessoro,nxfield,ny)
+    call shift_field_0(lsm,nxfield,ny)
+    call shift_field(ps,nxfield,ny,1,1,2,n)
+    call shift_field(sd,nxfield,ny,1,1,2,n)
+    call shift_field(msl,nxfield,ny,1,1,2,n)
+    call shift_field(tcc,nxfield,ny,1,1,2,n)
+    call shift_field(u10,nxfield,ny,1,1,2,n)
+    call shift_field(v10,nxfield,ny,1,1,2,n)
+    call shift_field(tt2,nxfield,ny,1,1,2,n)
+    call shift_field(td2,nxfield,ny,1,1,2,n)
+    call shift_field(lsprec,nxfield,ny,1,1,2,n)
+    call shift_field(convprec,nxfield,ny,1,1,2,n)
+    call shift_field(sshf,nxfield,ny,1,1,2,n)
+    call shift_field(ssr,nxfield,ny,1,1,2,n)
+    call shift_field(tth,nxfield,ny,nuvzmax,nuvz,2,n)
+    call shift_field(qvh,nxfield,ny,nuvzmax,nuvz,2,n)
+    call shift_field(uuh,nxfield,ny,nuvzmax,nuvz,1,1)
+    call shift_field(vvh,nxfield,ny,nuvzmax,nuvz,1,1)
+    call shift_field(wwh,nxfield,ny,nwzmax,nwz,1,1)
+  endif
+
+  do i=0,nxmin1
+    do j=0,nymin1
+      surfstr(i,j,1,n)=sqrt(ewss(i,j)**2+nsss(i,j)**2)
+    end do
+  end do
+
+  if ((.not.hflswitch).or.(.not.strswitch)) then
+    write(*,*) 'WARNING: No flux data contained in GRIB file ', &
+         wfname(indj)
+
+  ! CALCULATE USTAR AND SSHF USING THE PROFILE METHOD
+  ! As ECMWF has increased the model resolution, such that now the first model
+  ! level is at about 10 m (where 10-m wind is given), use the 2nd ECMWF level
+  ! (3rd model level in FLEXPART) for the profile method
+  !***************************************************************************
+
+    do i=0,nxmin1
+      do j=0,nymin1
+        plev1=akz(3)+bkz(3)*ps(i,j,1,n)
+        pmean=0.5*(ps(i,j,1,n)+plev1)
+        tv=tth(i,j,3,n)*(1.+0.61*qvh(i,j,3,n))
+        fu=-r_air*tv/ga/pmean
+        hlev1=fu*(plev1-ps(i,j,1,n))   ! HEIGTH OF FIRST MODEL LAYER
+        ff10m= sqrt(u10(i,j,1,n)**2+v10(i,j,1,n)**2)
+        fflev1=sqrt(uuh(i,j,3)**2+vvh(i,j,3)**2)
+        call pbl_profile(ps(i,j,1,n),td2(i,j,1,n),hlev1, &
+             tt2(i,j,1,n),tth(i,j,3,n),ff10m,fflev1, &
+             surfstr(i,j,1,n),sshf(i,j,1,n))
+        if(sshf(i,j,1,n).gt.200.) sshf(i,j,1,n)=200.
+        if(sshf(i,j,1,n).lt.-400.) sshf(i,j,1,n)=-400.
+      end do
+    end do
+  endif
+
+
+  ! Assign 10 m wind to model level at eta=1.0 to have one additional model
+  ! level at the ground
+  ! Specific humidity is taken the same as at one level above
+  ! Temperature is taken as 2 m temperature
+  !**************************************************************************
+
+     do i=0,nxmin1
+        do j=0,nymin1
+           uuh(i,j,1)=u10(i,j,1,n)
+           vvh(i,j,1)=v10(i,j,1,n)
+           qvh(i,j,1,n)=qvh(i,j,2,n)
+           tth(i,j,1,n)=tt2(i,j,1,n)
+        end do
+     end do
+
+  if(iumax.ne.nuvz-1) stop 'READWIND: NUVZ NOT CONSISTENT'
+  if(iwmax.ne.nwz)    stop 'READWIND: NWZ NOT CONSISTENT'
+
+  return
+888   write(*,*) ' #### FLEXPART MODEL ERROR! WINDFIELD         #### '
+  write(*,*) ' #### ',wfname(indj),'                    #### '
+  write(*,*) ' #### IS NOT GRIB FORMAT !!!                  #### '
+  stop 'Execution terminated'
+999   write(*,*) ' #### FLEXPART MODEL ERROR! WINDFIELD         #### '
+  write(*,*) ' #### ',wfname(indj),'                    #### '
+  write(*,*) ' #### CANNOT BE OPENED !!!                    #### '
+  stop 'Execution terminated'
+
+end subroutine readwind
+
Index: /branches/FP_AI/src/readwind_gfs.f90
===================================================================
--- /branches/FP_AI/src/readwind_gfs.f90	(revision 23)
+++ /branches/FP_AI/src/readwind_gfs.f90	(revision 23)
@@ -0,0 +1,718 @@
+!**********************************************************************
+! 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 readwind(indj,n,uuh,vvh,wwh)
+
+  !***********************************************************************
+  !*                                                                     *
+  !*             TRAJECTORY MODEL SUBROUTINE READWIND                    *
+  !*                                                                     *
+  !***********************************************************************
+  !*                                                                     *
+  !*             AUTHOR:      G. WOTAWA                                  *
+  !*             DATE:        1997-08-05                                 *
+  !*             LAST UPDATE: 2000-10-17, Andreas Stohl                  *
+  !*             CHANGE: 01/02/2001, Bernd C. Krueger, Variables tth and *
+  !*                     qvh (on eta coordinates) in common block        *
+  !*             CHANGE: 16/11/2005, Caroline Forster, GFS data          *
+  !*             CHANGE: 11/01/2008, Harald Sodemann, Input of GRIB1/2   *
+  !*                     data with the ECMWF grib_api library            *
+  !*             CHANGE: 03/12/2008, Harald Sodemann, update to f90 with *
+  !*                                 ECMWF grib_api                      *
+  !*                                                                     *
+  !***********************************************************************
+  !*                                                                     *
+  !* DESCRIPTION:                                                        *
+  !*                                                                     *
+  !* READING OF ECMWF METEOROLOGICAL FIELDS FROM INPUT DATA FILES. THE   *
+  !* INPUT DATA FILES ARE EXPECTED TO BE AVAILABLE IN GRIB CODE          *
+  !*                                                                     *
+  !* INPUT:                                                              *
+  !* indj               indicates number of the wind field to be read in *
+  !* n                  temporal index for meteorological fields (1 to 3)*
+  !*                                                                     *
+  !* IMPORTANT VARIABLES FROM COMMON BLOCK:                              *
+  !*                                                                     *
+  !* wfname             File name of data to be read in                  *
+  !* nx,ny,nuvz,nwz     expected field dimensions                        *
+  !* nlev_ec            number of vertical levels ecmwf model            *
+  !* uu,vv,ww           wind fields                                      *
+  !* tt,qv              temperature and specific humidity                *
+  !* ps                 surface pressure                                 *
+  !*                                                                     *
+  !***********************************************************************
+
+  use grib_api
+  use par_mod
+  use com_mod
+
+  implicit none
+
+  !HSO  new parameters for grib_api
+  integer :: ifile
+  integer :: iret
+  integer :: igrib
+  integer :: gribVer,parCat,parNum,typSurf,valSurf,discipl
+  !HSO end edits
+  real :: uuh(0:nxmax-1,0:nymax-1,nuvzmax)
+  real :: vvh(0:nxmax-1,0:nymax-1,nuvzmax)
+  real :: wwh(0:nxmax-1,0:nymax-1,nwzmax)
+  integer :: ii,indj,i,j,k,n,levdiff2,ifield,iumax,iwmax
+
+  ! NCEP
+  integer :: numpt,numpu,numpv,numpw,numprh
+  real :: help, temp, ew
+  real :: elev
+  real :: ulev1(0:nxmax-1,0:nymax-1),vlev1(0:nxmax-1,0:nymax-1)
+  real :: tlev1(0:nxmax-1,0:nymax-1)
+  real :: qvh2(0:nxmax-1,0:nymax-1)
+
+  integer :: i179,i180,i181
+
+  ! VARIABLES AND ARRAYS NEEDED FOR GRIB DECODING
+  !HSO kept isec1, isec2 and zsec4 for consistency with gribex GRIB input
+
+  integer :: isec1(8),isec2(3)
+  real(kind=4) :: zsec4(jpunp)
+  real(kind=4) :: xaux,yaux,xaux0,yaux0
+  real(kind=8) :: xauxin,yauxin
+  real,parameter :: eps=1.e-4
+  real(kind=4) :: ewss(0:nxmax-1,0:nymax-1),nsss(0:nxmax-1,0:nymax-1)
+  real :: plev1,hlev1,ff10m,fflev1
+
+  logical :: hflswitch,strswitch
+
+  !HSO  for grib api error messages
+  character(len=24) :: gribErrorMsg = 'Error reading grib file'
+  character(len=20) :: gribFunction = 'readwind_gfs'
+
+
+  hflswitch=.false.
+  strswitch=.false.
+  levdiff2=nlev_ec-nwz+1
+  iumax=0
+  iwmax=0
+
+
+  ! OPENING OF DATA FILE (GRIB CODE)
+
+  !HSO
+5   call grib_open_file(ifile,path(3)(1:length(3)) &
+         //trim(wfname(indj)),'r',iret)
+  if (iret.ne.GRIB_SUCCESS) then
+    goto 888   ! ERROR DETECTED
+  endif
+  !turn on support for multi fields messages
+  call grib_multi_support_on
+
+  numpt=0
+  numpu=0
+  numpv=0
+  numpw=0
+  numprh=0
+  ifield=0
+10   ifield=ifield+1
+  !
+  ! GET NEXT FIELDS
+  !
+  call grib_new_from_file(ifile,igrib,iret)
+  if (iret.eq.GRIB_END_OF_FILE)  then
+    goto 50    ! EOF DETECTED
+  elseif (iret.ne.GRIB_SUCCESS) then
+    goto 888   ! ERROR DETECTED
+  endif
+
+  !first see if we read GRIB1 or GRIB2
+  call grib_get_int(igrib,'editionNumber',gribVer,iret)
+  call grib_check(iret,gribFunction,gribErrorMsg)
+
+  if (gribVer.eq.1) then ! GRIB Edition 1
+
+  !read the grib1 identifiers
+  call grib_get_int(igrib,'indicatorOfParameter',isec1(6),iret)
+  call grib_check(iret,gribFunction,gribErrorMsg)
+  call grib_get_int(igrib,'indicatorOfTypeOfLevel',isec1(7),iret)
+  call grib_check(iret,gribFunction,gribErrorMsg)
+  call grib_get_int(igrib,'level',isec1(8),iret)
+  call grib_check(iret,gribFunction,gribErrorMsg)
+
+  else ! GRIB Edition 2
+
+  !read the grib2 identifiers
+  call grib_get_int(igrib,'discipline',discipl,iret)
+  call grib_check(iret,gribFunction,gribErrorMsg)
+  call grib_get_int(igrib,'parameterCategory',parCat,iret)
+  call grib_check(iret,gribFunction,gribErrorMsg)
+  call grib_get_int(igrib,'parameterNumber',parNum,iret)
+  call grib_check(iret,gribFunction,gribErrorMsg)
+  call grib_get_int(igrib,'typeOfFirstFixedSurface',typSurf,iret)
+  call grib_check(iret,gribFunction,gribErrorMsg)
+  call grib_get_int(igrib,'scaledValueOfFirstFixedSurface', &
+       valSurf,iret)
+  call grib_check(iret,gribFunction,gribErrorMsg)
+
+  !convert to grib1 identifiers
+  isec1(6)=-1
+  isec1(7)=-1
+  isec1(8)=-1
+  if ((parCat.eq.0).and.(parNum.eq.0).and.(typSurf.eq.100)) then ! T
+    isec1(6)=11          ! indicatorOfParameter
+    isec1(7)=100         ! indicatorOfTypeOfLevel
+    isec1(8)=valSurf/100 ! level, convert to hPa
+  elseif ((parCat.eq.2).and.(parNum.eq.2).and.(typSurf.eq.100)) then ! U
+    isec1(6)=33          ! indicatorOfParameter
+    isec1(7)=100         ! indicatorOfTypeOfLevel
+    isec1(8)=valSurf/100 ! level, convert to hPa
+  elseif ((parCat.eq.2).and.(parNum.eq.3).and.(typSurf.eq.100)) then ! V
+    isec1(6)=34          ! indicatorOfParameter
+    isec1(7)=100         ! indicatorOfTypeOfLevel
+    isec1(8)=valSurf/100 ! level, convert to hPa
+  elseif ((parCat.eq.2).and.(parNum.eq.8).and.(typSurf.eq.100)) then ! W
+    isec1(6)=39          ! indicatorOfParameter
+    isec1(7)=100         ! indicatorOfTypeOfLevel
+    isec1(8)=valSurf/100 ! level, convert to hPa
+  elseif ((parCat.eq.1).and.(parNum.eq.1).and.(typSurf.eq.100)) then ! RH
+    isec1(6)=52          ! indicatorOfParameter
+    isec1(7)=100         ! indicatorOfTypeOfLevel
+    isec1(8)=valSurf/100 ! level, convert to hPa
+  elseif ((parCat.eq.1).and.(parNum.eq.1).and.(typSurf.eq.103)) then ! RH2
+    isec1(6)=52          ! indicatorOfParameter
+    isec1(7)=105         ! indicatorOfTypeOfLevel
+    isec1(8)=2
+  elseif ((parCat.eq.0).and.(parNum.eq.0).and.(typSurf.eq.103)) then ! T2
+    isec1(6)=11          ! indicatorOfParameter
+    isec1(7)=105         ! indicatorOfTypeOfLevel
+    isec1(8)=2
+  elseif ((parCat.eq.2).and.(parNum.eq.2).and.(typSurf.eq.103)) then ! U10
+    isec1(6)=33          ! indicatorOfParameter
+    isec1(7)=105         ! indicatorOfTypeOfLevel
+    isec1(8)=10
+  elseif ((parCat.eq.2).and.(parNum.eq.3).and.(typSurf.eq.103)) then ! V10
+    isec1(6)=34          ! indicatorOfParameter
+    isec1(7)=105         ! indicatorOfTypeOfLevel
+    isec1(8)=10
+  elseif ((parCat.eq.3).and.(parNum.eq.1).and.(typSurf.eq.101)) then ! SLP
+    isec1(6)=2           ! indicatorOfParameter
+    isec1(7)=102         ! indicatorOfTypeOfLevel
+    isec1(8)=0
+  elseif ((parCat.eq.3).and.(parNum.eq.0).and.(typSurf.eq.1)) then ! SP
+    isec1(6)=1           ! indicatorOfParameter
+    isec1(7)=1           ! indicatorOfTypeOfLevel
+    isec1(8)=0
+  elseif ((parCat.eq.1).and.(parNum.eq.13).and.(typSurf.eq.1)) then ! SNOW
+    isec1(6)=66          ! indicatorOfParameter
+    isec1(7)=1           ! indicatorOfTypeOfLevel
+    isec1(8)=0
+  elseif ((parCat.eq.0).and.(parNum.eq.0).and.(typSurf.eq.104)) then ! T sigma 0
+    isec1(6)=11          ! indicatorOfParameter
+    isec1(7)=107         ! indicatorOfTypeOfLevel
+    isec1(8)=0.995       ! lowest sigma level
+  elseif ((parCat.eq.2).and.(parNum.eq.2).and.(typSurf.eq.104)) then ! U sigma 0
+    isec1(6)=33          ! indicatorOfParameter
+    isec1(7)=107         ! indicatorOfTypeOfLevel
+    isec1(8)=0.995       ! lowest sigma level
+  elseif ((parCat.eq.2).and.(parNum.eq.3).and.(typSurf.eq.104)) then ! V sigma 0
+    isec1(6)=34          ! indicatorOfParameter
+    isec1(7)=107         ! indicatorOfTypeOfLevel
+    isec1(8)=0.995       ! lowest sigma level
+  elseif ((parCat.eq.3).and.(parNum.eq.5).and.(typSurf.eq.1)) then ! TOPO
+    isec1(6)=7           ! indicatorOfParameter
+    isec1(7)=1           ! indicatorOfTypeOfLevel
+    isec1(8)=0
+  elseif ((parCat.eq.0).and.(parNum.eq.0).and.(typSurf.eq.1) &
+       .and.(discipl.eq.2)) then ! LSM
+    isec1(6)=81          ! indicatorOfParameter
+    isec1(7)=1           ! indicatorOfTypeOfLevel
+    isec1(8)=0
+  elseif ((parCat.eq.3).and.(parNum.eq.196).and.(typSurf.eq.1)) then ! BLH
+    isec1(6)=221         ! indicatorOfParameter
+    isec1(7)=1           ! indicatorOfTypeOfLevel
+    isec1(8)=0
+  elseif ((parCat.eq.1).and.(parNum.eq.7).and.(typSurf.eq.1)) then ! LSP/TP
+    isec1(6)=62          ! indicatorOfParameter
+    isec1(7)=1           ! indicatorOfTypeOfLevel
+    isec1(8)=0
+  elseif ((parCat.eq.1).and.(parNum.eq.196).and.(typSurf.eq.1)) then ! CP
+    isec1(6)=63          ! indicatorOfParameter
+    isec1(7)=1           ! indicatorOfTypeOfLevel
+    isec1(8)=0
+  endif
+
+  endif ! gribVer
+
+  if (isec1(6).ne.-1) then
+  !  get the size and data of the values array
+    call grib_get_real4_array(igrib,'values',zsec4,iret)
+    call grib_check(iret,gribFunction,gribErrorMsg)
+  endif
+
+  if(ifield.eq.1) then
+
+  !get the required fields from section 2
+  !store compatible to gribex input
+  call grib_get_int(igrib,'numberOfPointsAlongAParallel', &
+       isec2(2),iret)
+  call grib_check(iret,gribFunction,gribErrorMsg)
+  call grib_get_int(igrib,'numberOfPointsAlongAMeridian', &
+       isec2(3),iret)
+  call grib_check(iret,gribFunction,gribErrorMsg)
+  call grib_get_real8(igrib,'longitudeOfFirstGridPointInDegrees', &
+       xauxin,iret)
+  call grib_check(iret,gribFunction,gribErrorMsg)
+  call grib_get_real8(igrib,'latitudeOfLastGridPointInDegrees', &
+       yauxin,iret)
+  call grib_check(iret,gribFunction,gribErrorMsg)
+  xaux=xauxin+real(nxshift)*dx
+  yaux=yauxin
+
+  ! CHECK GRID SPECIFICATIONS
+
+    if(isec2(2).ne.nxfield) stop 'READWIND: NX NOT CONSISTENT'
+    if(isec2(3).ne.ny) stop 'READWIND: NY NOT CONSISTENT'
+    if(xaux.eq.0.) xaux=-179.0     ! NCEP DATA
+    xaux0=xlon0
+    yaux0=ylat0
+    if(xaux.lt.0.) xaux=xaux+360.
+    if(yaux.lt.0.) yaux=yaux+360.
+    if(xaux0.lt.0.) xaux0=xaux0+360.
+    if(yaux0.lt.0.) yaux0=yaux0+360.
+    if(abs(xaux-xaux0).gt.eps) &
+         stop 'READWIND: LOWER LEFT LONGITUDE NOT CONSISTENT'
+    if(abs(yaux-yaux0).gt.eps) &
+         stop 'READWIND: LOWER LEFT LATITUDE NOT CONSISTENT'
+  endif
+  !HSO end of edits
+
+  i179=nint(179./dx)
+  if (dx.lt.0.7) then
+    i180=nint(180./dx)+1    ! 0.5 deg data
+  else
+    i180=nint(179./dx)+1    ! 1 deg data
+  endif
+  i181=i180+1
+
+  if (isec1(6).ne.-1) then
+
+  do j=0,nymin1
+    do i=0,nxfield-1
+      if((isec1(6).eq.011).and.(isec1(7).eq.100)) then
+  ! TEMPERATURE
+         if((i.eq.0).and.(j.eq.0)) then
+            do ii=1,nuvz
+              if ((isec1(8)*100.0).eq.akz(ii)) numpt=ii
+            end do
+        endif
+        help=zsec4(nxfield*(ny-j-1)+i+1)
+        if(i.le.i180) then
+          tth(i179+i,j,numpt,n)=help
+        else
+          tth(i-i181,j,numpt,n)=help
+        endif
+      endif
+      if((isec1(6).eq.033).and.(isec1(7).eq.100)) then
+  ! U VELOCITY
+         if((i.eq.0).and.(j.eq.0)) then
+            do ii=1,nuvz
+              if ((isec1(8)*100.0).eq.akz(ii)) numpu=ii
+            end do
+        endif
+        help=zsec4(nxfield*(ny-j-1)+i+1)
+        if(i.le.i180) then
+          uuh(i179+i,j,numpu)=help
+        else
+          uuh(i-i181,j,numpu)=help
+        endif
+      endif
+      if((isec1(6).eq.034).and.(isec1(7).eq.100)) then
+  ! V VELOCITY
+         if((i.eq.0).and.(j.eq.0)) then
+            do ii=1,nuvz
+              if ((isec1(8)*100.0).eq.akz(ii)) numpv=ii
+            end do
+        endif
+        help=zsec4(nxfield*(ny-j-1)+i+1)
+        if(i.le.i180) then
+          vvh(i179+i,j,numpv)=help
+        else
+          vvh(i-i181,j,numpv)=help
+        endif
+      endif
+      if((isec1(6).eq.052).and.(isec1(7).eq.100)) then
+  ! RELATIVE HUMIDITY -> CONVERT TO SPECIFIC HUMIDITY LATER
+         if((i.eq.0).and.(j.eq.0)) then
+            do ii=1,nuvz
+              if ((isec1(8)*100.0).eq.akz(ii)) numprh=ii
+            end do
+        endif
+        help=zsec4(nxfield*(ny-j-1)+i+1)
+        if(i.le.i180) then
+          qvh(i179+i,j,numprh,n)=help
+        else
+          qvh(i-i181,j,numprh,n)=help
+        endif
+      endif
+      if((isec1(6).eq.001).and.(isec1(7).eq.001)) then
+  ! SURFACE PRESSURE
+        help=zsec4(nxfield*(ny-j-1)+i+1)
+        if(i.le.i180) then
+          ps(i179+i,j,1,n)=help
+        else
+          ps(i-i181,j,1,n)=help
+        endif
+      endif
+      if((isec1(6).eq.039).and.(isec1(7).eq.100)) then
+  ! W VELOCITY
+         if((i.eq.0).and.(j.eq.0)) then
+            do ii=1,nuvz
+              if ((isec1(8)*100.0).eq.akz(ii)) numpw=ii
+            end do
+        endif
+        help=zsec4(nxfield*(ny-j-1)+i+1)
+        if(i.le.i180) then
+          wwh(i179+i,j,numpw)=help
+        else
+          wwh(i-i181,j,numpw)=help
+        endif
+      endif
+      if((isec1(6).eq.066).and.(isec1(7).eq.001)) then
+  ! SNOW DEPTH
+        help=zsec4(nxfield*(ny-j-1)+i+1)
+        if(i.le.i180) then
+          sd(i179+i,j,1,n)=help
+        else
+          sd(i-i181,j,1,n)=help
+        endif
+      endif
+      if((isec1(6).eq.002).and.(isec1(7).eq.102)) then
+  ! MEAN SEA LEVEL PRESSURE
+        help=zsec4(nxfield*(ny-j-1)+i+1)
+        if(i.le.i180) then
+          msl(i179+i,j,1,n)=help
+        else
+          msl(i-i181,j,1,n)=help
+        endif
+      endif
+      if((isec1(6).eq.071).and.(isec1(7).eq.244)) then
+  ! TOTAL CLOUD COVER
+        help=zsec4(nxfield*(ny-j-1)+i+1)
+        if(i.le.i180) then
+          tcc(i179+i,j,1,n)=help
+        else
+          tcc(i-i181,j,1,n)=help
+        endif
+      endif
+      if((isec1(6).eq.033).and.(isec1(7).eq.105).and. &
+           (isec1(8).eq.10)) then
+  ! 10 M U VELOCITY
+        help=zsec4(nxfield*(ny-j-1)+i+1)
+        if(i.le.i180) then
+          u10(i179+i,j,1,n)=help
+        else
+          u10(i-i181,j,1,n)=help
+        endif
+      endif
+      if((isec1(6).eq.034).and.(isec1(7).eq.105).and. &
+           (isec1(8).eq.10)) then
+  ! 10 M V VELOCITY
+        help=zsec4(nxfield*(ny-j-1)+i+1)
+        if(i.le.i180) then
+          v10(i179+i,j,1,n)=help
+        else
+          v10(i-i181,j,1,n)=help
+        endif
+      endif
+      if((isec1(6).eq.011).and.(isec1(7).eq.105).and. &
+           (isec1(8).eq.02)) then
+  ! 2 M TEMPERATURE
+        help=zsec4(nxfield*(ny-j-1)+i+1)
+        if(i.le.i180) then
+          tt2(i179+i,j,1,n)=help
+        else
+          tt2(i-i181,j,1,n)=help
+        endif
+      endif
+      if((isec1(6).eq.017).and.(isec1(7).eq.105).and. &
+           (isec1(8).eq.02)) then
+  ! 2 M DEW POINT TEMPERATURE
+        help=zsec4(nxfield*(ny-j-1)+i+1)
+        if(i.le.i180) then
+          td2(i179+i,j,1,n)=help
+        else
+          td2(i-i181,j,1,n)=help
+        endif
+      endif
+      if((isec1(6).eq.062).and.(isec1(7).eq.001)) then
+  ! LARGE SCALE PREC.
+        help=zsec4(nxfield*(ny-j-1)+i+1)
+        if(i.le.i180) then
+          lsprec(i179+i,j,1,n)=help
+        else
+          lsprec(i-i181,j,1,n)=help
+        endif
+      endif
+      if((isec1(6).eq.063).and.(isec1(7).eq.001)) then
+  ! CONVECTIVE PREC.
+        help=zsec4(nxfield*(ny-j-1)+i+1)
+        if(i.le.i180) then
+          convprec(i179+i,j,1,n)=help
+        else
+          convprec(i-i181,j,1,n)=help
+        endif
+      endif
+      if((isec1(6).eq.007).and.(isec1(7).eq.001)) then
+  ! TOPOGRAPHY
+        help=zsec4(nxfield*(ny-j-1)+i+1)
+        if(i.le.i180) then
+          oro(i179+i,j)=help
+          excessoro(i179+i,j)=0.0 ! ISOBARIC SURFACES: SUBGRID TERRAIN DISREGARDED
+        else
+          oro(i-i181,j)=help
+          excessoro(i-i181,j)=0.0 ! ISOBARIC SURFACES: SUBGRID TERRAIN DISREGARDED
+        endif
+      endif
+      if((isec1(6).eq.081).and.(isec1(7).eq.001)) then
+  ! LAND SEA MASK
+        help=zsec4(nxfield*(ny-j-1)+i+1)
+        if(i.le.i180) then
+          lsm(i179+i,j)=help
+        else
+          lsm(i-i181,j)=help
+        endif
+      endif
+      if((isec1(6).eq.221).and.(isec1(7).eq.001)) then
+  ! MIXING HEIGHT
+        help=zsec4(nxfield*(ny-j-1)+i+1)
+        if(i.le.i180) then
+          hmix(i179+i,j,1,n)=help
+        else
+          hmix(i-i181,j,1,n)=help
+        endif
+      endif
+      if((isec1(6).eq.052).and.(isec1(7).eq.105).and. &
+           (isec1(8).eq.02)) then
+  ! 2 M RELATIVE HUMIDITY
+        help=zsec4(nxfield*(ny-j-1)+i+1)
+        if(i.le.i180) then
+          qvh2(i179+i,j)=help
+        else
+          qvh2(i-i181,j)=help
+        endif
+      endif
+      if((isec1(6).eq.011).and.(isec1(7).eq.107)) then
+  ! TEMPERATURE LOWEST SIGMA LEVEL
+        help=zsec4(nxfield*(ny-j-1)+i+1)
+        if(i.le.i180) then
+          tlev1(i179+i,j)=help
+        else
+          tlev1(i-i181,j)=help
+        endif
+      endif
+      if((isec1(6).eq.033).and.(isec1(7).eq.107)) then
+  ! U VELOCITY LOWEST SIGMA LEVEL
+        help=zsec4(nxfield*(ny-j-1)+i+1)
+        if(i.le.i180) then
+          ulev1(i179+i,j)=help
+        else
+          ulev1(i-i181,j)=help
+        endif
+      endif
+      if((isec1(6).eq.034).and.(isec1(7).eq.107)) then
+  ! V VELOCITY LOWEST SIGMA LEVEL
+        help=zsec4(nxfield*(ny-j-1)+i+1)
+        if(i.le.i180) then
+          vlev1(i179+i,j)=help
+        else
+          vlev1(i-i181,j)=help
+        endif
+      endif
+
+    end do
+  end do
+
+  endif
+
+  if((isec1(6).eq.33).and.(isec1(7).eq.100)) then
+  ! NCEP ISOBARIC LEVELS
+    iumax=iumax+1
+  endif
+
+  call grib_release(igrib)
+  goto 10                      !! READ NEXT LEVEL OR PARAMETER
+  !
+  ! CLOSING OF INPUT DATA FILE
+  !
+
+  !HSO close grib file
+50   continue
+  call grib_close_file(ifile)
+
+  ! SENS. HEAT FLUX
+  sshf(:,:,1,n)=0.0     ! not available from gfs.tccz.pgrbfxx files
+  hflswitch=.false.    ! Heat flux not available
+  ! SOLAR RADIATIVE FLUXES
+  ssr(:,:,1,n)=0.0      ! not available from gfs.tccz.pgrbfxx files
+  ! EW SURFACE STRESS
+  ewss=0.0         ! not available from gfs.tccz.pgrbfxx files
+  ! NS SURFACE STRESS
+  nsss=0.0         ! not available from gfs.tccz.pgrbfxx files
+  strswitch=.false.    ! stress not available
+
+  ! CONVERT TP TO LSP (GRIB2 only)
+  if (gribVer.eq.2) then
+    do j=0,nymin1
+    do i=0,nxfield-1
+     if(i.le.i180) then
+     if (convprec(i179+i,j,1,n).lt.lsprec(i179+i,j,1,n)) then ! neg precip would occur
+         lsprec(i179+i,j,1,n)= &
+              lsprec(i179+i,j,1,n)-convprec(i179+i,j,1,n)
+     else
+         lsprec(i179+i,j,1,n)=0
+     endif
+     else
+     if (convprec(i-i181,j,1,n).lt.lsprec(i-i181,j,1,n)) then
+          lsprec(i-i181,j,1,n)= &
+               lsprec(i-i181,j,1,n)-convprec(i-i181,j,1,n)
+     else
+          lsprec(i-i181,j,1,n)=0
+     endif
+     endif
+    enddo
+    enddo
+  endif
+  !HSO end edits
+
+
+  ! TRANSFORM RH TO SPECIFIC HUMIDITY
+
+  do j=0,ny-1
+    do i=0,nxfield-1
+      do k=1,nuvz
+        help=qvh(i,j,k,n)
+        temp=tth(i,j,k,n)
+        plev1=akm(k)+bkm(k)*ps(i,j,1,n)
+        elev=ew(temp)*help/100.0
+        qvh(i,j,k,n)=xmwml*(elev/(plev1-((1.0-xmwml)*elev)))
+      end do
+    end do
+  end do
+
+  ! CALCULATE 2 M DEW POINT FROM 2 M RELATIVE HUMIDITY
+  ! USING BOLTON'S (1980) FORMULA
+  ! BECAUSE td2 IS NOT AVAILABLE FROM NCEP GFS DATA
+
+  do j=0,ny-1
+    do i=0,nxfield-1
+        help=qvh2(i,j)
+        temp=tt2(i,j,1,n)
+        elev=ew(temp)/100.*help/100.   !vapour pressure in hPa
+        td2(i,j,1,n)=243.5/(17.67/log(elev/6.112)-1)+273.
+        if (help.le.0.) td2(i,j,1,n)=tt2(i,j,1,n)
+    end do
+  end do
+
+  if(levdiff2.eq.0) then
+    iwmax=nlev_ec+1
+    do i=0,nxmin1
+      do j=0,nymin1
+        wwh(i,j,nlev_ec+1)=0.
+      end do
+    end do
+  endif
+
+
+  ! For global fields, assign the leftmost data column also to the rightmost
+  ! data column; if required, shift whole grid by nxshift grid points
+  !*************************************************************************
+
+  if (xglobal) then
+    call shift_field_0(ewss,nxfield,ny)
+    call shift_field_0(nsss,nxfield,ny)
+    call shift_field_0(oro,nxfield,ny)
+    call shift_field_0(excessoro,nxfield,ny)
+    call shift_field_0(lsm,nxfield,ny)
+    call shift_field_0(ulev1,nxfield,ny)
+    call shift_field_0(vlev1,nxfield,ny)
+    call shift_field_0(tlev1,nxfield,ny)
+    call shift_field_0(qvh2,nxfield,ny)
+    call shift_field(ps,nxfield,ny,1,1,2,n)
+    call shift_field(sd,nxfield,ny,1,1,2,n)
+    call shift_field(msl,nxfield,ny,1,1,2,n)
+    call shift_field(tcc,nxfield,ny,1,1,2,n)
+    call shift_field(u10,nxfield,ny,1,1,2,n)
+    call shift_field(v10,nxfield,ny,1,1,2,n)
+    call shift_field(tt2,nxfield,ny,1,1,2,n)
+    call shift_field(td2,nxfield,ny,1,1,2,n)
+    call shift_field(lsprec,nxfield,ny,1,1,2,n)
+    call shift_field(convprec,nxfield,ny,1,1,2,n)
+    call shift_field(sshf,nxfield,ny,1,1,2,n)
+    call shift_field(ssr,nxfield,ny,1,1,2,n)
+    call shift_field(hmix,nxfield,ny,1,1,2,n)
+    call shift_field(tth,nxfield,ny,nuvzmax,nuvz,2,n)
+    call shift_field(qvh,nxfield,ny,nuvzmax,nuvz,2,n)
+    call shift_field(uuh,nxfield,ny,nuvzmax,nuvz,1,1)
+    call shift_field(vvh,nxfield,ny,nuvzmax,nuvz,1,1)
+    call shift_field(wwh,nxfield,ny,nwzmax,nwz,1,1)
+  endif
+
+  do i=0,nxmin1
+    do j=0,nymin1
+  ! Convert precip. from mm/s -> mm/hour
+      convprec(i,j,1,n)=convprec(i,j,1,n)*3600.
+      lsprec(i,j,1,n)=lsprec(i,j,1,n)*3600.
+      surfstr(i,j,1,n)=sqrt(ewss(i,j)**2+nsss(i,j)**2)
+    end do
+  end do
+
+  if ((.not.hflswitch).or.(.not.strswitch)) then
+  !  write(*,*) 'WARNING: No flux data contained in GRIB file ',
+  !    +  wfname(indj)
+
+  ! CALCULATE USTAR AND SSHF USING THE PROFILE METHOD
+  !***************************************************************************
+
+    do i=0,nxmin1
+      do j=0,nymin1
+        hlev1=30.0                     ! HEIGHT OF FIRST MODEL SIGMA LAYER
+        ff10m= sqrt(u10(i,j,1,n)**2+v10(i,j,1,n)**2)
+        fflev1=sqrt(ulev1(i,j)**2+vlev1(i,j)**2)
+        call pbl_profile(ps(i,j,1,n),td2(i,j,1,n),hlev1, &
+             tt2(i,j,1,n),tlev1(i,j),ff10m,fflev1, &
+             surfstr(i,j,1,n),sshf(i,j,1,n))
+        if(sshf(i,j,1,n).gt.200.) sshf(i,j,1,n)=200.
+        if(sshf(i,j,1,n).lt.-400.) sshf(i,j,1,n)=-400.
+      end do
+    end do
+  endif
+
+  if(iumax.ne.nuvz) stop 'READWIND: NUVZ NOT CONSISTENT'
+  if(iumax.ne.nwz)    stop 'READWIND: NWZ NOT CONSISTENT'
+
+  return
+888   write(*,*) ' #### FLEXPART MODEL ERROR! WINDFIELD         #### '
+  write(*,*) ' #### ',wfname(indj),'                    #### '
+  write(*,*) ' #### IS NOT GRIB FORMAT !!!                  #### '
+  stop 'Execution terminated'
+999   write(*,*) ' #### FLEXPART MODEL ERROR! WINDFIELD         #### '
+  write(*,*) ' #### ',wfname(indj),'                    #### '
+  write(*,*) ' #### CANNOT BE OPENED !!!                    #### '
+  stop 'Execution terminated'
+
+end subroutine readwind
Index: /branches/FP_AI/src/readwind_nests.f90
===================================================================
--- /branches/FP_AI/src/readwind_nests.f90	(revision 23)
+++ /branches/FP_AI/src/readwind_nests.f90	(revision 23)
@@ -0,0 +1,432 @@
+!**********************************************************************
+! 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 readwind_nests(indj,n,uuhn,vvhn,wwhn)
+  !                           i   i  o    o    o
+  !*****************************************************************************
+  !                                                                            *
+  !     This routine reads the wind fields for the nested model domains.       *
+  !     It is similar to subroutine readwind, which reads the mother domain.   *
+  !                                                                            *
+  !     Authors: A. Stohl, G. Wotawa                                           *
+  !                                                                            *
+  !     8 February 1999                                                        *
+  !                                                                            *
+  !     Last update: 17 October 2000, A. Stohl                                 *
+  !                                                                            *
+  !*****************************************************************************
+  !  Changes, Bernd C. Krueger, Feb. 2001:                                     *
+  !        Variables tthn and qvhn (on eta coordinates) in common block        *
+  !  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    *
+  !*****************************************************************************
+
+  use grib_api
+  use par_mod
+  use com_mod
+
+  implicit none
+
+  !HSO  parameters for grib_api
+  integer :: ifile
+  integer :: iret
+  integer :: igrib
+  integer :: gribVer,parCat,parNum,typSurf,valSurf,discipl
+  integer :: parId !!added by mc for making it consistent with new readwind.f90
+  integer :: gotGrid
+  !HSO  end
+
+  real :: uuhn(0:nxmaxn-1,0:nymaxn-1,nuvzmax,maxnests)
+  real :: vvhn(0:nxmaxn-1,0:nymaxn-1,nuvzmax,maxnests)
+  real :: wwhn(0:nxmaxn-1,0:nymaxn-1,nwzmax,maxnests)
+  integer :: indj,i,j,k,n,levdiff2,ifield,iumax,iwmax,l
+
+  ! VARIABLES AND ARRAYS NEEDED FOR GRIB DECODING
+
+  ! dimension of isec2 at least (22+n), where n is the number of parallels or
+  ! meridians in a quasi-regular (reduced) Gaussian or lat/long grid
+
+  ! dimension of zsec2 at least (10+nn), where nn is the number of vertical
+  ! coordinate parameters
+
+  integer :: isec1(56),isec2(22+nxmaxn+nymaxn)
+  real(kind=4) :: zsec4(jpunp)
+  real(kind=4) :: xaux,yaux
+  real(kind=8) :: xauxin,yauxin
+  real,parameter :: eps=1.e-4
+  real :: ewss(0:nxmaxn-1,0:nymaxn-1),nsss(0:nxmaxn-1,0:nymaxn-1)
+  real :: plev1,pmean,tv,fu,hlev1,ff10m,fflev1
+  real :: conversion_factor !added by mc to make it consistent with new gridchek.f90
+
+  logical :: hflswitch,strswitch
+
+  !HSO  grib api error messages
+  character(len=24) :: gribErrorMsg = 'Error reading grib file'
+  character(len=20) :: gribFunction = 'readwind_nests'
+
+  do l=1,numbnests
+    hflswitch=.false.
+    strswitch=.false.
+    levdiff2=nlev_ec-nwz+1
+    iumax=0
+    iwmax=0
+
+    ifile=0
+    igrib=0
+    iret=0
+
+  !
+  ! OPENING OF DATA FILE (GRIB CODE)
+  !
+
+5   call grib_open_file(ifile,path(numpath+2*(l-1)+1) &
+         (1:length(numpath+2*(l-1)+1))//trim(wfnamen(l,indj)),'r')
+  if (iret.ne.GRIB_SUCCESS) then
+    goto 888   ! ERROR DETECTED
+  endif
+  !turn on support for multi fields messages */
+  !call grib_multi_support_on
+
+    gotGrid=0
+    ifield=0
+10   ifield=ifield+1
+  !
+  ! GET NEXT FIELDS
+  !
+  call grib_new_from_file(ifile,igrib,iret)
+  if (iret.eq.GRIB_END_OF_FILE)  then
+    goto 50    ! EOF DETECTED
+  elseif (iret.ne.GRIB_SUCCESS) then
+    goto 888   ! ERROR DETECTED
+  endif
+
+  !first see if we read GRIB1 or GRIB2
+  call grib_get_int(igrib,'editionNumber',gribVer,iret)
+  call grib_check(iret,gribFunction,gribErrorMsg)
+
+  if (gribVer.eq.1) then ! GRIB Edition 1
+
+  !print*,'GRiB Edition 1'
+  !read the grib2 identifiers
+  call grib_get_int(igrib,'indicatorOfParameter',isec1(6),iret)
+  call grib_check(iret,gribFunction,gribErrorMsg)
+  call grib_get_int(igrib,'level',isec1(8),iret)
+  call grib_check(iret,gribFunction,gribErrorMsg)
+
+  !change code for etadot to code for omega
+  if (isec1(6).eq.77) then
+    isec1(6)=135
+  endif
+
+  conversion_factor=1.
+
+
+  else
+
+  !print*,'GRiB Edition 2'
+  !read the grib2 identifiers
+  call grib_get_int(igrib,'discipline',discipl,iret)
+  call grib_check(iret,gribFunction,gribErrorMsg)
+  call grib_get_int(igrib,'parameterCategory',parCat,iret)
+  call grib_check(iret,gribFunction,gribErrorMsg)
+  call grib_get_int(igrib,'parameterNumber',parNum,iret)
+  call grib_check(iret,gribFunction,gribErrorMsg)
+  call grib_get_int(igrib,'typeOfFirstFixedSurface',typSurf,iret)
+  call grib_check(iret,gribFunction,gribErrorMsg)
+  call grib_get_int(igrib,'level',valSurf,iret)
+  call grib_check(iret,gribFunction,gribErrorMsg)
+  call grib_get_int(igrib,'paramId',parId,iret) !added by mc to make it consisitent with new readwind.f90
+  call grib_check(iret,gribFunction,gribErrorMsg) !added by mc to make it consisitent with new readwind.f90
+
+  !print*,discipl,parCat,parNum,typSurf,valSurf
+
+  !convert to grib1 identifiers
+  isec1(6)=-1
+  isec1(7)=-1
+  isec1(8)=-1
+  isec1(8)=valSurf     ! level
+   conversion_factor=1.
+  if ((parCat.eq.0).and.(parNum.eq.0).and.(typSurf.eq.105)) then ! T
+    isec1(6)=130         ! indicatorOfParameter
+  elseif ((parCat.eq.2).and.(parNum.eq.2).and.(typSurf.eq.105)) then ! U
+    isec1(6)=131         ! indicatorOfParameter
+  elseif ((parCat.eq.2).and.(parNum.eq.3).and.(typSurf.eq.105)) then ! V
+    isec1(6)=132         ! indicatorOfParameter
+  elseif ((parCat.eq.1).and.(parNum.eq.0).and.(typSurf.eq.105)) then ! Q
+    isec1(6)=133         ! indicatorOfParameter
+  elseif ((parCat.eq.3).and.(parNum.eq.0).and.(typSurf.eq.1)) then !SP
+    isec1(6)=134         ! indicatorOfParameter
+  elseif ((parCat.eq.2).and.(parNum.eq.32)) then ! W, actually eta dot !
+    isec1(6)=135         ! indicatorOfParameter
+  elseif ((parCat.eq.128).and.(parNum.eq.77)) then ! W, actually eta dot !added by mc to make it consisitent with new readwind.f90
+    isec1(6)=135         ! indicatorOfParameter    !added by mc to make it consisitent with new readwind.f90
+  elseif ((parCat.eq.3).and.(parNum.eq.0).and.(typSurf.eq.101)) then !SLP
+    isec1(6)=151         ! indicatorOfParameter
+  elseif ((parCat.eq.2).and.(parNum.eq.2).and.(typSurf.eq.103)) then ! 10U
+    isec1(6)=165         ! indicatorOfParameter
+  elseif ((parCat.eq.2).and.(parNum.eq.3).and.(typSurf.eq.103)) then ! 10V
+    isec1(6)=166         ! indicatorOfParameter
+  elseif ((parCat.eq.0).and.(parNum.eq.0).and.(typSurf.eq.103)) then ! 2T
+    isec1(6)=167         ! indicatorOfParameter
+  elseif ((parCat.eq.0).and.(parNum.eq.6).and.(typSurf.eq.103)) then ! 2D
+    isec1(6)=168         ! indicatorOfParameter
+  elseif ((parCat.eq.1).and.(parNum.eq.11).and.(typSurf.eq.1)) then ! SD
+    isec1(6)=141         ! indicatorOfParameter
+    conversion_factor=1000. !added by mc to make it consisitent with new readwind.f90
+  elseif ((parCat.eq.6).and.(parNum.eq.1) .or. parId .eq. 164) then ! CC !added by mc to make it consisitent with new readwind.f90
+    isec1(6)=164         ! indicatorOfParameter
+  elseif ((parCat.eq.1).and.(parNum.eq.9) .or. parId .eq. 142) then ! LSP !added by mc to make it consisitent with new readwind.f90
+    isec1(6)=142         ! indicatorOfParameter
+  elseif ((parCat.eq.1).and.(parNum.eq.10)) then ! CP
+    isec1(6)=143         ! indicatorOfParameter
+    conversion_factor=1000. !added by mc to make it consisitent with new readwind.f90
+  elseif ((parCat.eq.0).and.(parNum.eq.11).and.(typSurf.eq.1)) then ! SHF
+    isec1(6)=146         ! indicatorOfParameter
+  elseif ((parCat.eq.4).and.(parNum.eq.9).and.(typSurf.eq.1)) then ! SR
+    isec1(6)=176         ! indicatorOfParameter
+  elseif ((parCat.eq.2).and.(parNum.eq.17) .or. parId .eq. 180) then ! EWSS !added by mc to make it consisitent with new readwind.f90
+    isec1(6)=180         ! indicatorOfParameter
+  elseif ((parCat.eq.2).and.(parNum.eq.18) .or. parId .eq. 181) then ! NSSS !added by mc to make it consisitent with new readwind.f90
+    isec1(6)=181         ! indicatorOfParameter
+  elseif ((parCat.eq.3).and.(parNum.eq.4)) then ! ORO
+    isec1(6)=129         ! indicatorOfParameter
+   elseif ((parCat.eq.3).and.(parNum.eq.7) .or. parId .eq. 160) then ! SDO !added by mc to make it consisitent with new readwind.f90
+    isec1(6)=160         ! indicatorOfParameter
+  elseif ((discipl.eq.2).and.(parCat.eq.0).and.(parNum.eq.0).and. &
+       (typSurf.eq.1)) then ! LSM
+    isec1(6)=172         ! indicatorOfParameter
+  else
+    print*,'***ERROR: undefined GRiB2 message found!',discipl, &
+         parCat,parNum,typSurf
+  endif
+  if(parId .ne. isec1(6) .and. parId .ne. 77) then !added by mc to make it consisitent with new readwind.f90
+    write(*,*) 'parId',parId, 'isec1(6)',isec1(6)  !
+!    stop
+  endif
+
+  endif
+
+  !HSO  get the size and data of the values array
+  if (isec1(6).ne.-1) then
+    call grib_get_real4_array(igrib,'values',zsec4,iret)
+    call grib_check(iret,gribFunction,gribErrorMsg)
+  endif
+
+  !HSO  get the required fields from section 2 in a gribex compatible manner
+  if(ifield.eq.1) then
+  call grib_get_int(igrib,'numberOfPointsAlongAParallel', &
+       isec2(2),iret)
+  call grib_check(iret,gribFunction,gribErrorMsg)
+  call grib_get_int(igrib,'numberOfPointsAlongAMeridian', &
+       isec2(3),iret)
+  call grib_check(iret,gribFunction,gribErrorMsg)
+  call grib_get_int(igrib,'numberOfVerticalCoordinateValues', &
+       isec2(12))
+  call grib_check(iret,gribFunction,gribErrorMsg)
+  ! CHECK GRID SPECIFICATIONS
+  if(isec2(2).ne.nxn(l)) stop &
+  'READWIND: NX NOT CONSISTENT FOR A NESTING LEVEL'
+  if(isec2(3).ne.nyn(l)) stop &
+  'READWIND: NY NOT CONSISTENT FOR A NESTING LEVEL'
+  if(isec2(12)/2-1.ne.nlev_ec) stop 'READWIND: VERTICAL DISCRET&
+  IZATION NOT CONSISTENT FOR A NESTING LEVEL'
+  endif ! ifield
+
+  !HSO  get the second part of the grid dimensions only from GRiB1 messages
+ if (isec1(6) .eq. 167 .and. (gotGrid.eq.0)) then ! !added by mc to make it consisitent with new readwind.f90
+    call grib_get_real8(igrib,'longitudeOfFirstGridPointInDegrees', &
+         xauxin,iret)
+    call grib_check(iret,gribFunction,gribErrorMsg)
+    call grib_get_real8(igrib,'latitudeOfLastGridPointInDegrees', &
+         yauxin,iret)
+    call grib_check(iret,gribFunction,gribErrorMsg)
+    if (xauxin.gt.180.) xauxin=xauxin-360.0
+    if (xauxin.lt.-180.) xauxin=xauxin+360.0
+
+    xaux=xauxin
+    yaux=yauxin
+    if (abs(xaux-xlon0n(l)).gt.eps) &
+    stop 'READWIND: LOWER LEFT LONGITUDE NOT CONSISTENT FOR A NESTING LEVEL'
+    if (abs(yaux-ylat0n(l)).gt.eps) &
+    stop 'READWIND: LOWER LEFT LATITUDE NOT CONSISTENT FOR A NESTING LEVEL'
+    gotGrid=1
+  endif
+
+    do j=0,nyn(l)-1
+      do i=0,nxn(l)-1
+        k=isec1(8)
+        if(isec1(6).eq.130) tthn(i,j,nlev_ec-k+2,n,l)= &!! TEMPERATURE
+             zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
+        if(isec1(6).eq.131) uuhn(i,j,nlev_ec-k+2,l)= &!! U VELOCITY
+             zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
+        if(isec1(6).eq.132) vvhn(i,j,nlev_ec-k+2,l)= &!! V VELOCITY
+             zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
+        if(isec1(6).eq.133) then                         !! SPEC. HUMIDITY
+          qvhn(i,j,nlev_ec-k+2,n,l)=zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
+          if (qvhn(i,j,nlev_ec-k+2,n,l) .lt. 0.) &
+               qvhn(i,j,nlev_ec-k+2,n,l) = 0.
+  !          this is necessary because the gridded data may contain
+  !          spurious negative values
+        endif
+        if(isec1(6).eq.134) psn(i,j,1,n,l)= &!! SURF. PRESS.
+             zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
+        if(isec1(6).eq.135) wwhn(i,j,nlev_ec-k+1,l)= &!! W VELOCITY
+             zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
+        if(isec1(6).eq.141) sdn(i,j,1,n,l)= &!! SNOW DEPTH
+             zsec4(nxn(l)*(nyn(l)-j-1)+i+1)/conversion_factor !added by mc to make it consisitent with new readwind.f90!
+        if(isec1(6).eq.151) msln(i,j,1,n,l)= &!! SEA LEVEL PRESS.
+             zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
+        if(isec1(6).eq.164) tccn(i,j,1,n,l)= &!! CLOUD COVER
+             zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
+        if(isec1(6).eq.165) u10n(i,j,1,n,l)= &!! 10 M U VELOCITY
+             zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
+        if(isec1(6).eq.166) v10n(i,j,1,n,l)= &!! 10 M V VELOCITY
+             zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
+        if(isec1(6).eq.167) tt2n(i,j,1,n,l)= &!! 2 M TEMPERATURE
+             zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
+        if(isec1(6).eq.168) td2n(i,j,1,n,l)= &!! 2 M DEW POINT
+             zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
+        if(isec1(6).eq.142) then                         !! LARGE SCALE PREC.
+          lsprecn(i,j,1,n,l)=zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
+          if (lsprecn(i,j,1,n,l).lt.0.) lsprecn(i,j,1,n,l)=0.
+        endif
+        if(isec1(6).eq.143) then                         !! CONVECTIVE PREC.
+          convprecn(i,j,1,n,l)=zsec4(nxn(l)*(nyn(l)-j-1)+i+1)/conversion_factor !added by mc to make it consisitent with new readwind.f90
+          if (convprecn(i,j,1,n,l).lt.0.) convprecn(i,j,1,n,l)=0.
+        endif
+        if(isec1(6).eq.146) sshfn(i,j,1,n,l)= &!! SENS. HEAT FLUX
+             zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
+        if((isec1(6).eq.146).and. &
+             (zsec4(nxn(l)*(nyn(l)-j-1)+i+1).ne.0.)) hflswitch=.true.    ! Heat flux available
+        if(isec1(6).eq.176) then                         !! SOLAR RADIATION
+          ssrn(i,j,1,n,l)=zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
+          if (ssrn(i,j,1,n,l).lt.0.) ssrn(i,j,1,n,l)=0.
+        endif
+        if(isec1(6).eq.180) ewss(i,j)= &!! EW SURFACE STRESS
+             zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
+        if(isec1(6).eq.181) nsss(i,j)= &!! NS SURFACE STRESS
+             zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
+        if(((isec1(6).eq.180).or.(isec1(6).eq.181)).and. &
+             (zsec4(nxn(l)*(nyn(l)-j-1)+i+1).ne.0.)) strswitch=.true.    ! stress available
+        if(isec1(6).eq.129) oron(i,j,l)= &!! ECMWF OROGRAPHY
+             zsec4(nxn(l)*(nyn(l)-j-1)+i+1)/ga
+        if(isec1(6).eq.160) excessoron(i,j,l)= &!! STANDARD DEVIATION OF OROGRAPHY
+             zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
+        if(isec1(6).eq.172) lsmn(i,j,l)= &!! ECMWF LAND SEA MASK
+             zsec4(nxn(l)*(nyn(l)-j-1)+i+1)
+        if(isec1(6).eq.131) iumax=max(iumax,nlev_ec-k+1)
+        if(isec1(6).eq.135) iwmax=max(iwmax,nlev_ec-k+1)
+
+      end do
+    end do
+
+  call grib_release(igrib)
+  goto 10                      !! READ NEXT LEVEL OR PARAMETER
+  !
+  ! CLOSING OF INPUT DATA FILE
+  !
+50   call grib_close_file(ifile)
+
+  !error message if no fields found with correct first longitude in it
+  if (gotGrid.eq.0) then
+    print*,'***ERROR: input file needs to contain GRiB1 formatted'// &
+         'messages'
+    stop
+  endif
+
+  if(levdiff2.eq.0) then
+    iwmax=nlev_ec+1
+    do i=0,nxn(l)-1
+      do j=0,nyn(l)-1
+        wwhn(i,j,nlev_ec+1,l)=0.
+      end do
+    end do
+  endif
+
+  do i=0,nxn(l)-1
+    do j=0,nyn(l)-1
+      surfstrn(i,j,1,n,l)=sqrt(ewss(i,j)**2+nsss(i,j)**2)
+    end do
+  end do
+
+  if ((.not.hflswitch).or.(.not.strswitch)) then
+    write(*,*) 'WARNING: No flux data contained in GRIB file ', &
+         wfnamen(l,indj)
+
+  ! CALCULATE USTAR AND SSHF USING THE PROFILE METHOD
+  ! As ECMWF has increased the model resolution, such that now the first model
+  ! level is at about 10 m (where 10-m wind is given), use the 2nd ECMWF level
+  ! (3rd model level in FLEXPART) for the profile method
+  !***************************************************************************
+
+    do i=0,nxn(l)-1
+      do j=0,nyn(l)-1
+        plev1=akz(3)+bkz(3)*psn(i,j,1,n,l)
+        pmean=0.5*(psn(i,j,1,n,l)+plev1)
+        tv=tthn(i,j,3,n,l)*(1.+0.61*qvhn(i,j,3,n,l))
+        fu=-r_air*tv/ga/pmean
+        hlev1=fu*(plev1-psn(i,j,1,n,l))   ! HEIGTH OF FIRST MODEL LAYER
+        ff10m= sqrt(u10n(i,j,1,n,l)**2+v10n(i,j,1,n,l)**2)
+        fflev1=sqrt(uuhn(i,j,3,l)**2+vvhn(i,j,3,l)**2)
+        call pbl_profile(psn(i,j,1,n,l),td2n(i,j,1,n,l),hlev1, &
+             tt2n(i,j,1,n,l),tthn(i,j,3,n,l),ff10m,fflev1, &
+             surfstrn(i,j,1,n,l),sshfn(i,j,1,n,l))
+        if(sshfn(i,j,1,n,l).gt.200.) sshfn(i,j,1,n,l)=200.
+        if(sshfn(i,j,1,n,l).lt.-400.) sshfn(i,j,1,n,l)=-400.
+      end do
+    end do
+  endif
+
+
+  ! Assign 10 m wind to model level at eta=1.0 to have one additional model
+  ! level at the ground
+  ! Specific humidity is taken the same as at one level above
+  ! Temperature is taken as 2 m temperature
+  !**************************************************************************
+
+    do i=0,nxn(l)-1
+      do j=0,nyn(l)-1
+        uuhn(i,j,1,l)=u10n(i,j,1,n,l)
+        vvhn(i,j,1,l)=v10n(i,j,1,n,l)
+        qvhn(i,j,1,n,l)=qvhn(i,j,2,n,l)
+        tthn(i,j,1,n,l)=tt2n(i,j,1,n,l)
+      end do
+    end do
+
+    if(iumax.ne.nuvz-1) stop &
+         'READWIND: NUVZ NOT CONSISTENT FOR A NESTING LEVEL'
+    if(iwmax.ne.nwz) stop &
+         'READWIND: NWZ NOT CONSISTENT FOR A NESTING LEVEL'
+
+  end do
+
+  return
+888   write(*,*) ' #### FLEXPART MODEL ERROR! WINDFIELD         #### '
+  write(*,*) ' #### ',wfnamen(l,indj),' FOR NESTING LEVEL  #### '
+  write(*,*) ' #### ',l,' IS NOT GRIB FORMAT !!!           #### '
+  stop 'Execution terminated'
+
+
+999   write(*,*) ' #### FLEXPART MODEL ERROR! WINDFIELD         #### '
+  write(*,*) ' #### ',wfnamen(l,indj),'                    #### '
+  write(*,*) ' #### CANNOT BE OPENED FOR NESTING LEVEL ',l,'####'
+
+end subroutine readwind_nests
Index: /branches/FP_AI/src/redist.f90
===================================================================
--- /branches/FP_AI/src/redist.f90	(revision 23)
+++ /branches/FP_AI/src/redist.f90	(revision 23)
@@ -0,0 +1,253 @@
+!**********************************************************************
+! 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 redist (ipart,ktop,ipconv)
+
+  !**************************************************************************
+  ! Do the redistribution of particles due to convection
+  ! This subroutine is called for each particle which is assigned
+  ! a new vertical position randomly, based on the convective redistribution
+  ! matrix
+  !**************************************************************************
+
+  ! Petra Seibert, Feb 2001, Apr 2001, May 2001, Jan 2002, Nov 2002 and
+  ! Andreas Frank, Nov 2002
+
+  ! Caroline Forster:  November 2004 - February 2005
+
+  use par_mod
+  use com_mod
+  use conv_mod
+
+  implicit none
+
+  real,parameter :: const=r_air/ga
+  integer :: ipart, ktop,ipconv
+  integer :: k, kz, levnew, levold
+  real,save :: uvzlev(nuvzmax)
+  real :: wsub(nuvzmax)
+  real :: totlevmass, wsubpart
+  real :: temp_levold,temp_levold1
+  real :: sub_levold,sub_levold1
+  real :: pint, pold, rn, tv, tvold, dlevfrac
+  real :: ew,ran3, ztold,ffraction
+  real :: tv1, tv2, dlogp, dz, dz1, dz2
+  integer :: iseed = -88
+
+  ! ipart   ... number of particle to be treated
+
+  ipconv=1
+
+  ! determine height of the eta half-levels (uvzlev)
+  ! do that only once for each grid column
+  ! i.e. when ktop.eq.1
+  !**************************************************************
+
+  if (ktop .le. 1) then
+
+    tvold=tt2conv*(1.+0.378*ew(td2conv)/psconv)
+    pold=psconv
+    uvzlev(1)=0.
+
+    pint = phconv(2)
+  !  determine next virtual temperatures
+    tv1 = tconv(1)*(1.+0.608*qconv(1))
+    tv2 = tconv(2)*(1.+0.608*qconv(2))
+  !  interpolate virtual temperature to half-level
+    tv = tv1 + (tv2-tv1)*(pconv(1)-phconv(2))/(pconv(1)-pconv(2))
+    if (abs(tv-tvold).gt.0.2) then
+      uvzlev(2) = uvzlev(1) + &
+           const*log(pold/pint)* &
+           (tv-tvold)/log(tv/tvold)
+    else
+      uvzlev(2) = uvzlev(1)+ &
+           const*log(pold/pint)*tv
+    endif
+    tvold=tv
+    tv1=tv2
+    pold=pint
+
+  ! integrate profile (calculation of height agl of eta layers) as required
+    do kz = 3, nconvtop+1
+  !    note that variables defined in calcmatrix.f (pconv,tconv,qconv)
+  !    start at the first real ECMWF model level whereas kz and
+  !    thus uvzlev(kz) starts at the surface. uvzlev is defined at the
+  !    half-levels (between the tconv, qconv etc. values !)
+  !    Thus, uvzlev(kz) is the lower boundary of the tconv(kz) cell.
+      pint = phconv(kz)
+  !    determine next virtual temperatures
+      tv2 = tconv(kz)*(1.+0.608*qconv(kz))
+  !    interpolate virtual temperature to half-level
+      tv = tv1 + (tv2-tv1)*(pconv(kz-1)-phconv(kz))/ &
+           (pconv(kz-1)-pconv(kz))
+      if (abs(tv-tvold).gt.0.2) then
+        uvzlev(kz) = uvzlev(kz-1) + &
+             const*log(pold/pint)* &
+             (tv-tvold)/log(tv/tvold)
+      else
+        uvzlev(kz) = uvzlev(kz-1)+ &
+             const*log(pold/pint)*tv
+      endif
+      tvold=tv
+      tv1=tv2
+      pold=pint
+
+    end do
+
+    ktop = 2
+
+  endif ! (if ktop .le. 1) then
+
+  !  determine vertical grid position of particle in the eta system
+  !****************************************************************
+
+  ztold = ztra1(abs(ipart))
+  ! find old particle grid position
+  do kz = 2, nconvtop
+    if (uvzlev(kz) .ge. ztold ) then
+      levold = kz-1
+      goto 30
+    endif
+  end do
+
+  ! Particle is above the potentially convective domain. Skip it.
+  goto 90
+
+30   continue
+
+  ! now redistribute particles
+  !****************************
+
+  !  Choose a random number and find corresponding level of destination
+  !  Random numbers to be evenly distributed in [0,1]
+
+  rn = ran3(iseed)
+
+  ! initialize levnew
+
+  levnew = levold
+
+  ffraction = 0.
+  totlevmass=dpr(levold)/ga
+  do k = 1,nconvtop
+  ! for backward runs use the transposed matrix
+   if (ldirect.eq.1) then
+     ffraction=ffraction+fmassfrac(levold,k) &
+          /totlevmass
+   else
+     ffraction=ffraction+fmassfrac(k,levold) &
+          /totlevmass
+   endif
+   if (rn.le.ffraction) then
+     levnew=k
+  ! avoid division by zero or a too small number
+  ! if division by zero or a too small number happens the
+  ! particle is assigned to the center of the grid cell
+     if (ffraction.gt.1.e-20) then
+      if (ldirect.eq.1) then
+        dlevfrac = (ffraction-rn) / fmassfrac(levold,k) * totlevmass
+      else
+        dlevfrac = (ffraction-rn) / fmassfrac(k,levold) * totlevmass
+      endif
+     else
+       dlevfrac = 0.5
+     endif
+     goto 40
+   endif
+  end do
+
+40   continue
+
+  ! now assign new position to particle
+
+  if (levnew.le.nconvtop) then
+   if (levnew.eq.levold) then
+      ztra1(abs(ipart)) = ztold
+   else
+    dlogp = (1.-dlevfrac)* &
+         (log(phconv(levnew+1))-log(phconv(levnew)))
+    pint = log(phconv(levnew))+dlogp
+    dz1 = pint - log(phconv(levnew))
+    dz2 = log(phconv(levnew+1)) - pint
+    dz = dz1 + dz2
+    ztra1(abs(ipart)) = (uvzlev(levnew)*dz2+uvzlev(levnew+1)*dz1)/dz
+     if (ztra1(abs(ipart)).lt.0.) &
+          ztra1(abs(ipart))=-1.*ztra1(abs(ipart))
+     if (ipconv.gt.0) ipconv=-1
+   endif
+  endif
+
+  ! displace particle according to compensating subsidence
+  ! this is done to those particles, that were not redistributed
+  ! by the matrix
+  !**************************************************************
+
+  if (levnew.le.nconvtop.and.levnew.eq.levold) then
+
+  ztold = ztra1(abs(ipart))
+
+  ! determine compensating vertical velocity at the levels
+  ! above and below the particel position
+  ! increase compensating subsidence by the fraction that
+  ! is displaced by convection to this level
+
+    if (levold.gt.1) then
+     temp_levold = tconv(levold-1) + &
+          (tconv(levold)-tconv(levold-1)) &
+          *(pconv(levold-1)-phconv(levold))/ &
+          (pconv(levold-1)-pconv(levold))
+     sub_levold = sub(levold)/(1.-sub(levold)/dpr(levold)*ga)
+     wsub(levold)=-1.*sub_levold*r_air*temp_levold/(phconv(levold))
+    else
+     wsub(levold)=0.
+    endif
+
+     temp_levold1 = tconv(levold) + &
+          (tconv(levold+1)-tconv(levold)) &
+          *(pconv(levold)-phconv(levold+1))/ &
+          (pconv(levold)-pconv(levold+1))
+     sub_levold1 = sub(levold+1)/(1.-sub(levold+1)/dpr(levold+1)*ga)
+     wsub(levold+1)=-1.*sub_levold1*r_air*temp_levold1/ &
+          (phconv(levold+1))
+
+  ! interpolate wsub to the vertical particle position
+
+  dz1 = ztold - uvzlev(levold)
+  dz2 = uvzlev(levold+1) - ztold
+  dz = dz1 + dz2
+
+  wsubpart = (dz2*wsub(levold)+dz1*wsub(levold+1))/dz
+  ztra1(abs(ipart)) = ztold+wsubpart*real(lsynctime)
+  if (ztra1(abs(ipart)).lt.0.) then
+     ztra1(abs(ipart))=-1.*ztra1(abs(ipart))
+  endif
+
+  endif      !(levnew.le.nconvtop.and.levnew.eq.levold)
+
+  ! Maximum altitude .5 meter below uppermost model level
+  !*******************************************************
+
+ 90   continue
+
+  if (ztra1(abs(ipart)) .gt. height(nz)-0.5) &
+       ztra1(abs(ipart)) = height(nz)-0.5
+
+end subroutine redist
Index: /branches/FP_AI/src/releaseparticles.f90
===================================================================
--- /branches/FP_AI/src/releaseparticles.f90	(revision 23)
+++ /branches/FP_AI/src/releaseparticles.f90	(revision 23)
@@ -0,0 +1,401 @@
+!**********************************************************************
+! 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 releaseparticles(itime)
+  !                              o
+  !*****************************************************************************
+  !                                                                            *
+  !     This subroutine releases particles from the release locations.         *
+  !                                                                            *
+  !     It searches for a "vacant" storage space and assigns all particle      *
+  !     information to that space. A space is vacant either when no particle   *
+  !     is yet assigned to it, or when it's particle is expired and, thus,     *
+  !     the storage space is made available to a new particle.                 *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     29 June 2002                                                           *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! itime [s]            current time                                          *
+  ! ireleasestart, ireleaseend          start and end times of all releases    *
+  ! npart(maxpoint)      number of particles to be released in total           *
+  ! numrel               number of particles to be released during this time   *
+  !                      step                                                  *
+  !                                                                            *
+  !*****************************************************************************
+
+  use point_mod
+  use xmass_mod
+  use par_mod
+  use com_mod
+
+  implicit none
+
+  !real xaux,yaux,zaux,ran1,rfraction,xmasssave(maxpoint)
+  real :: xaux,yaux,zaux,ran1,rfraction
+  real :: topo,rhoaux(2),r,t,rhoout,ddx,ddy,rddx,rddy,p1,p2,p3,p4
+  real :: dz1,dz2,dz,xtn,ytn,xlonav,timecorrect(maxspec),press,pressold
+  real :: presspart,average_timecorrect
+  integer :: itime,numrel,i,j,k,n,ix,jy,ixp,jyp,ipart,minpart,ii
+  integer :: indz,indzp,kz,ngrid
+  integer :: nweeks,ndayofweek,nhour,jjjjmmdd,ihmmss,mm
+  real(kind=dp) :: juldate,julmonday,jul,jullocal,juldiff
+  real,parameter :: eps=nxmax/3.e5,eps2=1.e-6
+
+  integer :: idummy = -7
+  !save idummy,xmasssave
+  !data idummy/-7/,xmasssave/maxpoint*0./
+
+
+  ! Determine the actual date and time in Greenwich (i.e., UTC + correction for daylight savings time)
+  !*****************************************************************************
+
+  julmonday=juldate(19000101,0)          ! this is a Monday
+  jul=bdate+real(itime,kind=dp)/86400._dp    ! this is the current day
+  call caldate(jul,jjjjmmdd,ihmmss)
+  mm=(jjjjmmdd-10000*(jjjjmmdd/10000))/100
+  if ((mm.ge.4).and.(mm.le.9)) jul=jul+1._dp/24._dp   ! daylight savings time in summer
+
+
+  ! For every release point, check whether we are in the release time interval
+  !***************************************************************************
+
+  minpart=1
+  do i=1,numpoint
+    if ((itime.ge.ireleasestart(i)).and. &! are we within release interval?
+         (itime.le.ireleaseend(i))) then
+
+  ! Determine the local day and time
+  !*********************************
+
+      xlonav=xlon0+(xpoint2(i)+xpoint1(i))/2.*dx  ! longitude needed to determine local time
+      if (xlonav.lt.-180.) xlonav=xlonav+360.
+      if (xlonav.gt.180.) xlonav=xlonav-360.
+      jullocal=jul+real(xlonav,kind=dp)/360._dp   ! correct approximately for time zone to obtain local time
+
+      juldiff=jullocal-julmonday
+      nweeks=int(juldiff/7._dp)
+      juldiff=juldiff-real(nweeks,kind=dp)*7._dp
+      ndayofweek=int(juldiff)+1              ! this is the current day of week, starting with Monday
+      nhour=nint((juldiff-real(ndayofweek-1,kind=dp))*24._dp)    ! this is the current hour
+      if (nhour.eq.0) then
+        nhour=24
+        ndayofweek=ndayofweek-1
+        if (ndayofweek.eq.0) ndayofweek=7
+      endif
+
+  ! Calculate a species- and time-dependent correction factor, distinguishing between
+  ! area (those with release starting at surface) and point (release starting above surface) sources
+  ! Also, calculate an average time correction factor (species independent)
+  !*****************************************************************************
+      average_timecorrect=0.
+      do k=1,nspec
+        if (zpoint1(i).gt.0.5) then      ! point source
+          timecorrect(k)=point_hour(k,nhour)*point_dow(k,ndayofweek)
+        else                             ! area source
+          timecorrect(k)=area_hour(k,nhour)*area_dow(k,ndayofweek)
+        endif
+        average_timecorrect=average_timecorrect+timecorrect(k)
+      end do
+      average_timecorrect=average_timecorrect/real(nspec)
+
+  ! Determine number of particles to be released this time; at start and at end of release,
+  ! only half the particles are released
+  !*****************************************************************************
+
+      if (ireleasestart(i).ne.ireleaseend(i)) then
+        rfraction=abs(real(npart(i))*real(lsynctime)/ &
+             real(ireleaseend(i)-ireleasestart(i)))
+        if ((itime.eq.ireleasestart(i)).or. &
+             (itime.eq.ireleaseend(i))) rfraction=rfraction/2.
+
+  ! Take the species-average time correction factor in order to scale the
+  ! number of particles released this time
+  !**********************************************************************
+        rfraction=rfraction*average_timecorrect
+
+        rfraction=rfraction+xmasssave(i)  ! number to be released at this time
+        numrel=int(rfraction)
+        xmasssave(i)=rfraction-real(numrel)
+      else
+        numrel=npart(i)
+      endif
+
+      xaux=xpoint2(i)-xpoint1(i)
+      yaux=ypoint2(i)-ypoint1(i)
+      zaux=zpoint2(i)-zpoint1(i)
+      do j=1,numrel                       ! loop over particles to be released this time
+        do ipart=minpart,maxpart          ! search for free storage space
+
+  ! If a free storage space is found, attribute everything to this array element
+  !*****************************************************************************
+
+          if (itra1(ipart).ne.itime) then
+
+  ! Particle coordinates are determined by using a random position within the release volume
+  !*****************************************************************************
+
+  ! Determine horizontal particle position
+  !***************************************
+
+            xtra1(ipart)=xpoint1(i)+ran1(idummy)*xaux
+            if (xglobal) then
+              if (xtra1(ipart).gt.real(nxmin1)) xtra1(ipart)= &
+                   xtra1(ipart)-real(nxmin1)
+              if (xtra1(ipart).lt.0.) xtra1(ipart)= &
+                   xtra1(ipart)+real(nxmin1)
+            endif
+            ytra1(ipart)=ypoint1(i)+ran1(idummy)*yaux
+
+  ! Assign mass to particle: Total mass divided by total number of particles.
+  ! Time variation has partly been taken into account already by a species-average
+  ! correction factor, by which the number of particles released this time has been
+  ! scaled. Adjust the mass per particle by the species-dependent time correction factor
+  ! divided by the species-average one
+  !*****************************************************************************
+            do k=1,nspec
+               xmass1(ipart,k)=xmass(i,k)/real(npart(i)) &
+                    *timecorrect(k)/average_timecorrect
+  !            write (*,*) 'xmass1: ',xmass1(ipart,k),ipart,k
+  ! Assign certain properties to particle
+  !**************************************
+            end do
+            nclass(ipart)=min(int(ran1(idummy)*real(nclassunc))+1, &
+                 nclassunc)
+            numparticlecount=numparticlecount+1
+            if (mquasilag.eq.0) then
+              npoint(ipart)=i
+            else
+              npoint(ipart)=numparticlecount
+            endif
+            idt(ipart)=mintime               ! first time step
+            itra1(ipart)=itime
+            itramem(ipart)=itra1(ipart)
+            itrasplit(ipart)=itra1(ipart)+ldirect*itsplit
+
+
+  ! Determine vertical particle position
+  !*************************************
+
+            ztra1(ipart)=zpoint1(i)+ran1(idummy)*zaux
+
+  ! Interpolation of topography and density
+  !****************************************
+
+  ! Determine the nest we are in
+  !*****************************
+
+            ngrid=0
+            do k=numbnests,1,-1
+              if ((xtra1(ipart).gt.xln(k)+eps).and. &
+                   (xtra1(ipart).lt.xrn(k)-eps).and. &
+                   (ytra1(ipart).gt.yln(k)+eps).and. &
+                   (ytra1(ipart).lt.yrn(k)-eps)) then
+                ngrid=k
+                goto 43
+              endif
+            end do
+43          continue
+
+  ! Determine (nested) grid coordinates and auxiliary parameters used for interpolation
+  !*****************************************************************************
+
+            if (ngrid.gt.0) then
+              xtn=(xtra1(ipart)-xln(ngrid))*xresoln(ngrid)
+              ytn=(ytra1(ipart)-yln(ngrid))*yresoln(ngrid)
+              ix=int(xtn)
+              jy=int(ytn)
+              ddy=ytn-real(jy)
+              ddx=xtn-real(ix)
+            else
+              ix=int(xtra1(ipart))
+              jy=int(ytra1(ipart))
+              ddy=ytra1(ipart)-real(jy)
+              ddx=xtra1(ipart)-real(ix)
+            endif
+            ixp=ix+1
+            jyp=jy+1
+            rddx=1.-ddx
+            rddy=1.-ddy
+            p1=rddx*rddy
+            p2=ddx*rddy
+            p3=rddx*ddy
+            p4=ddx*ddy
+
+            if (ngrid.gt.0) then
+              topo=p1*oron(ix ,jy ,ngrid) &
+                   + p2*oron(ixp,jy ,ngrid) &
+                   + p3*oron(ix ,jyp,ngrid) &
+                   + p4*oron(ixp,jyp,ngrid)
+            else
+              topo=p1*oro(ix ,jy) &
+                   + p2*oro(ixp,jy) &
+                   + p3*oro(ix ,jyp) &
+                   + p4*oro(ixp,jyp)
+            endif
+
+  ! If starting height is in pressure coordinates, retrieve pressure profile and convert zpart1 to meters
+  !*****************************************************************************
+            if (kindz(i).eq.3) then
+              presspart=ztra1(ipart)
+              do kz=1,nz
+                if (ngrid.gt.0) then
+                  r=p1*rhon(ix ,jy ,kz,2,ngrid) &
+                       +p2*rhon(ixp,jy ,kz,2,ngrid) &
+                       +p3*rhon(ix ,jyp,kz,2,ngrid) &
+                       +p4*rhon(ixp,jyp,kz,2,ngrid)
+                  t=p1*ttn(ix ,jy ,kz,2,ngrid) &
+                       +p2*ttn(ixp,jy ,kz,2,ngrid) &
+                       +p3*ttn(ix ,jyp,kz,2,ngrid) &
+                       +p4*ttn(ixp,jyp,kz,2,ngrid)
+                else
+                  r=p1*rho(ix ,jy ,kz,2) &
+                       +p2*rho(ixp,jy ,kz,2) &
+                       +p3*rho(ix ,jyp,kz,2) &
+                       +p4*rho(ixp,jyp,kz,2)
+                  t=p1*tt(ix ,jy ,kz,2) &
+                       +p2*tt(ixp,jy ,kz,2) &
+                       +p3*tt(ix ,jyp,kz,2) &
+                       +p4*tt(ixp,jyp,kz,2)
+                endif
+                press=r*r_air*t/100.
+                if (kz.eq.1) pressold=press
+
+                if (press.lt.presspart) then
+                  if (kz.eq.1) then
+                    ztra1(ipart)=height(1)/2.
+                  else
+                    dz1=pressold-presspart
+                    dz2=presspart-press
+                    ztra1(ipart)=(height(kz-1)*dz2+height(kz)*dz1) &
+                         /(dz1+dz2)
+                  endif
+                  goto 71
+                endif
+                pressold=press
+              end do
+71            continue
+            endif
+
+  ! If release positions are given in meters above sea level, subtract the
+  ! topography from the starting height
+  !***********************************************************************
+
+            if (kindz(i).eq.2) ztra1(ipart)=ztra1(ipart)-topo
+            if (ztra1(ipart).lt.eps2) ztra1(ipart)=eps2   ! Minimum starting height is eps2
+            if (ztra1(ipart).gt.height(nz)-0.5) ztra1(ipart)= &
+                 height(nz)-0.5 ! Maximum starting height is uppermost level - 0.5 meters
+
+
+
+  ! For special simulations, multiply particle concentration air density;
+  ! Simply take the 2nd field in memory to do this (accurate enough)
+  !***********************************************************************
+  !AF IND_SOURCE switches between different units for concentrations at the source
+  !Af    NOTE that in backward simulations the release of particles takes place at the
+  !Af         receptor and the sampling at the source.
+  !Af          1="mass"
+  !Af          2="mass mixing ratio"
+  !Af IND_RECEPTOR switches between different units for concentrations at the receptor
+  !Af          1="mass"
+  !Af          2="mass mixing ratio"
+
+  !Af switches for the releasefile:
+  !Af IND_REL =  1 : xmass * rho
+  !Af IND_REL =  0 : xmass * 1
+
+  !Af ind_rel is defined in readcommand.f
+
+            if (ind_rel .eq. 1) then
+
+  ! Interpolate the air density
+  !****************************
+
+              do ii=2,nz
+                if (height(ii).gt.ztra1(ipart)) then
+                  indz=ii-1
+                  indzp=ii
+                  goto 6
+                endif
+              end do
+6             continue
+
+              dz1=ztra1(ipart)-height(indz)
+              dz2=height(indzp)-ztra1(ipart)
+              dz=1./(dz1+dz2)
+
+              if (ngrid.gt.0) then
+                do n=1,2
+                  rhoaux(n)=p1*rhon(ix ,jy ,indz+n-1,2,ngrid) &
+                       +p2*rhon(ixp,jy ,indz+n-1,2,ngrid) &
+                       +p3*rhon(ix ,jyp,indz+n-1,2,ngrid) &
+                       +p4*rhon(ixp,jyp,indz+n-1,2,ngrid)
+                end do
+              else
+                do n=1,2
+                  rhoaux(n)=p1*rho(ix ,jy ,indz+n-1,2) &
+                       +p2*rho(ixp,jy ,indz+n-1,2) &
+                       +p3*rho(ix ,jyp,indz+n-1,2) &
+                       +p4*rho(ixp,jyp,indz+n-1,2)
+                end do
+              endif
+              rhoout=(dz2*rhoaux(1)+dz1*rhoaux(2))*dz
+              rho_rel(i)=rhoout
+
+
+  ! Multiply "mass" (i.e., mass mixing ratio in forward runs) with density
+  !********************************************************************
+
+              do k=1,nspec
+                xmass1(ipart,k)=xmass1(ipart,k)*rhoout
+              end do
+            endif
+
+
+            numpart=max(numpart,ipart)
+            goto 34      ! Storage space has been found, stop searching
+          endif
+        end do
+        if (ipart.gt.maxpart) goto 996
+
+34      minpart=ipart+1
+      end do
+      endif
+  end do
+
+
+  return
+
+996   continue
+  write(*,*) '#####################################################'
+  write(*,*) '#### FLEXPART MODEL SUBROUTINE RELEASEPARTICLES: ####'
+  write(*,*) '####                                             ####'
+  write(*,*) '#### ERROR - TOTAL NUMBER OF PARTICLES REQUIRED  ####'
+  write(*,*) '#### EXCEEDS THE MAXIMUM ALLOWED NUMBER. REDUCE  ####'
+  write(*,*) '#### EITHER NUMBER OF PARTICLES PER RELEASE POINT####'
+  write(*,*) '#### OR REDUCE NUMBER OF RELEASE POINTS.         ####'
+  write(*,*) '#####################################################'
+  stop
+
+end subroutine releaseparticles
Index: /branches/FP_AI/src/richardson.f90
===================================================================
--- /branches/FP_AI/src/richardson.f90	(revision 23)
+++ /branches/FP_AI/src/richardson.f90	(revision 23)
@@ -0,0 +1,182 @@
+!**********************************************************************
+! 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 richardson(psurf,ust,ttlev,qvlev,ulev,vlev,nuvz, &
+       akz,bkz,hf,tt2,td2,h,wst,hmixplus)
+  !                        i    i    i     i    i    i    i
+  ! i   i  i   i   i  o  o     o
+  !****************************************************************************
+  !                                                                           *
+  !     Calculation of mixing height based on the critical Richardson number. *
+  !     Calculation of convective time scale.                                 *
+  !     For unstable conditions, one iteration is performed. An excess        *
+  !     temperature (dependent on hf and wst) is calculated, added to the     *
+  !     temperature at the lowest model level. Then the procedure is repeated.*
+  !                                                                           *
+  !     Author: A. Stohl                                                      *
+  !                                                                           *
+  !     22 August 1996                                                        *
+  !                                                                           *
+  !     Literature:                                                           *
+  !     Vogelezang DHP and Holtslag AAM (1996): Evaluation and model impacts  *
+  !     of alternative boundary-layer height formulations. Boundary-Layer     *
+  !     Meteor. 81, 245-269.                                                  *
+  !                                                                           *
+  !     Update: 1999-02-01 by G. Wotawa                                       *
+  !                                                                           *
+  !     Two meter level (temperature, humidity) is taken as reference level   *
+  !     instead of first model level.                                         *
+  !     New input variables tt2, td2 introduced.                              *
+  !                                                                           *
+  !****************************************************************************
+  !                                                                           *
+  ! Variables:                                                                *
+  ! h                          mixing height [m]                              *
+  ! hf                         sensible heat flux                             *
+  ! psurf                      surface pressure at point (xt,yt) [Pa]         *
+  ! tv                         virtual temperature                            *
+  ! wst                        convective velocity scale                      *
+  !                                                                           *
+  ! Constants:                                                                *
+  ! ric                        critical Richardson number                     *
+  !                                                                           *
+  !****************************************************************************
+
+  use par_mod
+
+  implicit none
+
+  integer :: i,k,nuvz,iter
+  real :: tv,tvold,zref,z,zold,pint,pold,theta,thetaref,ri
+  real :: akz(nuvz),bkz(nuvz),ulev(nuvz),vlev(nuvz),hf,wst,tt2,td2,ew
+  real :: psurf,ust,ttlev(nuvz),qvlev(nuvz),h,excess
+  real :: thetaold,zl,ul,vl,thetal,ril,hmixplus,wspeed,bvfsq,bvf
+  real :: f_qvsat,rh,rhold,rhl,theta1,theta2,zl1,zl2,thetam
+  real,parameter    :: const=r_air/ga, ric=0.25, b=100., bs=8.5
+  integer,parameter :: itmax=3
+
+  excess=0.0
+  iter=0
+
+  ! Compute virtual temperature and virtual potential temperature at
+  ! reference level (2 m)
+  !*****************************************************************
+
+30   iter=iter+1
+
+  pold=psurf
+  tvold=tt2*(1.+0.378*ew(td2)/psurf)
+  zold=2.0
+  zref=zold
+  rhold=ew(td2)/ew(tt2)
+
+  thetaref=tvold*(100000./pold)**(r_air/cpa)+excess
+  thetaold=thetaref
+
+
+  ! Integrate z up to one level above zt
+  !*************************************
+
+  do k=2,nuvz
+    pint=akz(k)+bkz(k)*psurf  ! pressure on model layers
+    tv=ttlev(k)*(1.+0.608*qvlev(k))
+
+    if (abs(tv-tvold).gt.0.2) then
+      z=zold+const*log(pold/pint)*(tv-tvold)/log(tv/tvold)
+    else
+      z=zold+const*log(pold/pint)*tv
+    endif
+
+    theta=tv*(100000./pint)**(r_air/cpa)
+  ! Petra
+    rh = qvlev(k) / f_qvsat( pint, ttlev(k) )
+
+
+  !alculate Richardson number at each level
+  !****************************************
+
+    ri=ga/thetaref*(theta-thetaref)*(z-zref)/ &
+         max(((ulev(k)-ulev(2))**2+(vlev(k)-vlev(2))**2+b*ust**2),0.1)
+
+  !  addition of second condition: MH should not be placed in an
+  !  unstable layer (PS / Feb 2000)
+    if (ri.gt.ric .and. thetaold.lt.theta) goto 20
+
+    tvold=tv
+    pold=pint
+    rhold=rh
+    thetaold=theta
+    zold=z
+  end do
+
+20   continue
+
+  ! Determine Richardson number between the critical levels
+  !********************************************************
+
+  zl1=zold
+  theta1=thetaold
+  do i=1,20
+    zl=zold+real(i)/20.*(z-zold)
+    ul=ulev(k-1)+real(i)/20.*(ulev(k)-ulev(k-1))
+    vl=vlev(k-1)+real(i)/20.*(vlev(k)-vlev(k-1))
+    thetal=thetaold+real(i)/20.*(theta-thetaold)
+    rhl=rhold+real(i)/20.*(rh-rhold)
+    ril=ga/thetaref*(thetal-thetaref)*(zl-zref)/ &
+         max(((ul-ulev(2))**2+(vl-vlev(2))**2+b*ust**2),0.1)
+    zl2=zl
+    theta2=thetal
+    if (ril.gt.ric) goto 25
+    zl1=zl
+    theta1=thetal
+  end do
+
+25   continue
+  h=zl
+  thetam=0.5*(theta1+theta2)
+  wspeed=sqrt(ul**2+vl**2)                    ! Wind speed at z=hmix
+  bvfsq=(ga/thetam)*(theta2-theta1)/(zl2-zl1) ! Brunt-Vaisala frequency
+                                              ! at z=hmix
+
+  ! Under stable conditions, limit the maximum effect of the subgrid-scale topography
+  ! by the maximum lifting possible from the available kinetic energy
+  !*****************************************************************************
+
+  if(bvfsq.le.0.) then
+    hmixplus=9999.
+  else
+    bvf=sqrt(bvfsq)
+    hmixplus=wspeed/bvf*convke
+  endif
+
+
+  ! Calculate convective velocity scale
+  !************************************
+
+  if (hf.lt.0.) then
+    wst=(-h*ga/thetaref*hf/cpa)**0.333
+    excess=-bs*hf/cpa/wst
+    if (iter.lt.itmax) goto 30
+  else
+    wst=0.
+  endif
+
+end subroutine richardson
Index: /branches/FP_AI/src/richardson_gfs.f90
===================================================================
--- /branches/FP_AI/src/richardson_gfs.f90	(revision 23)
+++ /branches/FP_AI/src/richardson_gfs.f90	(revision 23)
@@ -0,0 +1,196 @@
+!**********************************************************************
+! 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 richardson(psurf,ust,ttlev,qvlev,ulev,vlev,nuvz, &
+       akz,bkz,hf,tt2,td2,h,wst,hmixplus)
+  !                        i    i    i     i    i    i    i
+  ! i   i  i   i   i  o  o     o
+  !****************************************************************************
+  !                                                                           *
+  !     Calculation of mixing height based on the critical Richardson number. *
+  !     Calculation of convective time scale.                                 *
+  !     For unstable conditions, one iteration is performed. An excess        *
+  !     temperature (dependent on hf and wst) is calculated, added to the     *
+  !     temperature at the lowest model level. Then the procedure is repeated.*
+  !                                                                           *
+  !     Author: A. Stohl                                                      *
+  !                                                                           *
+  !     22 August 1996                                                        *
+  !                                                                           *
+  !     Literature:                                                           *
+  !     Vogelezang DHP and Holtslag AAM (1996): Evaluation and model impacts  *
+  !     of alternative boundary-layer height formulations. Boundary-Layer     *
+  !     Meteor. 81, 245-269.                                                  *
+  !                                                                           *
+  !     Update: 1999-02-01 by G. Wotawa                                       *
+  !     CHANGE: 17/11/2005 Caroline Forster NCEP GFS version                  *
+  !                                                                           *
+  !     Two meter level (temperature, humidity) is taken as reference level   *
+  !     instead of first model level.                                         *
+  !     New input variables tt2, td2 introduced.                              *
+  !                                                                           *
+  !****************************************************************************
+  !                                                                           *
+  ! Variables:                                                                *
+  ! h                          mixing height [m]                              *
+  ! hf                         sensible heat flux                             *
+  ! psurf                      surface pressure at point (xt,yt) [Pa]         *
+  ! tv                         virtual temperature                            *
+  ! wst                        convective velocity scale                      *
+  !                                                                           *
+  ! Constants:                                                                *
+  ! ric                        critical Richardson number                     *
+  !                                                                           *
+  !****************************************************************************
+
+  use par_mod
+
+  implicit none
+
+  integer :: i,k,nuvz,iter,llev
+  real :: tv,tvold,zref,z,zold,pint,pold,theta,thetaref,ri
+  real :: akz(nuvz),bkz(nuvz),ulev(nuvz),vlev(nuvz),hf,wst,tt2,td2,ew
+  real :: psurf,ust,ttlev(nuvz),qvlev(nuvz),h,excess
+  real :: thetaold,zl,ul,vl,thetal,ril,hmixplus,wspeed,bvfsq,bvf
+  real :: f_qvsat,rh,rhold,rhl,theta1,theta2,zl1,zl2,thetam
+  real,parameter :: const=r_air/ga, ric=0.25, b=100., bs=8.5
+  integer,parameter :: itmax=3
+
+  excess=0.0
+  iter=0
+
+  ! NCEP version: find first model level above ground
+  !**************************************************
+
+      llev = 0
+      do i=1,nuvz
+       if (psurf.lt.akz(i)) llev=i
+      end do
+       llev = llev+1
+  ! sec llev should not be 1!
+       if (llev.eq.1) llev = 2
+       if (llev.gt.nuvz) llev = nuvz-1
+  ! NCEP version
+
+
+  ! Compute virtual temperature and virtual potential temperature at
+  ! reference level (2 m)
+  !*****************************************************************
+
+30   iter=iter+1
+
+  pold=psurf
+  tvold=tt2*(1.+0.378*ew(td2)/psurf)
+  zold=2.0
+  zref=zold
+  rhold=ew(td2)/ew(tt2)
+
+  thetaref=tvold*(100000./pold)**(r_air/cpa)+excess
+  thetaold=thetaref
+
+  ! Integrate z up to one level above zt
+  !*************************************
+
+  do k=llev,nuvz
+    pint=akz(k)+bkz(k)*psurf  ! pressure on model layers
+    tv=ttlev(k)*(1.+0.608*qvlev(k))
+
+    if (abs(tv-tvold).gt.0.2) then
+      z=zold+const*log(pold/pint)*(tv-tvold)/log(tv/tvold)
+    else
+      z=zold+const*log(pold/pint)*tv
+    endif
+
+    theta=tv*(100000./pint)**(r_air/cpa)
+  ! Petra
+    rh = qvlev(k) / f_qvsat( pint, ttlev(k) )
+
+
+  !alculate Richardson number at each level
+  !****************************************
+
+    ri=ga/thetaref*(theta-thetaref)*(z-zref)/ &
+         max(((ulev(k)-ulev(2))**2+(vlev(k)-vlev(2))**2+b*ust**2),0.1)
+
+  !  addition of second condition: MH should not be placed in an
+  !  unstable layer (PS / Feb 2000)
+    if (ri.gt.ric .and. thetaold.lt.theta) goto 20
+
+    tvold=tv
+    pold=pint
+    rhold=rh
+    thetaold=theta
+    zold=z
+  end do
+
+20   continue
+
+  ! Determine Richardson number between the critical levels
+  !********************************************************
+
+  zl1=zold
+  theta1=thetaold
+  do i=1,20
+    zl=zold+real(i)/20.*(z-zold)
+    ul=ulev(k-1)+real(i)/20.*(ulev(k)-ulev(k-1))
+    vl=vlev(k-1)+real(i)/20.*(vlev(k)-vlev(k-1))
+    thetal=thetaold+real(i)/20.*(theta-thetaold)
+    rhl=rhold+real(i)/20.*(rh-rhold)
+    ril=ga/thetaref*(thetal-thetaref)*(zl-zref)/ &
+         max(((ul-ulev(2))**2+(vl-vlev(2))**2+b*ust**2),0.1)
+    zl2=zl
+    theta2=thetal
+    if (ril.gt.ric) goto 25
+    zl1=zl
+    theta1=thetal
+  end do
+
+25   continue
+  h=zl
+  thetam=0.5*(theta1+theta2)
+  wspeed=sqrt(ul**2+vl**2)                    ! Wind speed at z=hmix
+  bvfsq=(ga/thetam)*(theta2-theta1)/(zl2-zl1) ! Brunt-Vaisala frequency
+                                              ! at z=hmix
+
+  ! Under stable conditions, limit the maximum effect of the subgrid-scale topography
+  ! by the maximum lifting possible from the available kinetic energy
+  !*****************************************************************************
+
+  if(bvfsq.le.0.) then
+    hmixplus=9999.
+  else
+    bvf=sqrt(bvfsq)
+    hmixplus=wspeed/bvf*convke
+  endif
+
+
+  ! Calculate convective velocity scale
+  !************************************
+
+  if (hf.lt.0.) then
+    wst=(-h*ga/thetaref*hf/cpa)**0.333
+    excess=-bs*hf/cpa/wst
+    if (iter.lt.itmax) goto 30
+  else
+    wst=0.
+  endif
+
+end subroutine richardson
Index: /branches/FP_AI/src/scalev.f90
===================================================================
--- /branches/FP_AI/src/scalev.f90	(revision 23)
+++ /branches/FP_AI/src/scalev.f90	(revision 23)
@@ -0,0 +1,57 @@
+!**********************************************************************
+! 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/>.   *
+!**********************************************************************
+
+real function scalev(ps,t,td,stress)
+
+  !********************************************************************
+  !                                                                   *
+  !                       Author: G. WOTAWA                           *
+  !                       Date:   1994-06-27                          *
+  !                       Update: 1996-05-21 A. Stohl                 *
+  !                                                                   *
+  !********************************************************************
+  !                                                                   *
+  !     This Programm calculates scale velocity ustar from surface    *
+  !     stress and air density.                                       *
+  !                                                                   *
+  !********************************************************************
+  !                                                                   *
+  !     INPUT:                                                        *
+  !                                                                   *
+  !     ps      surface pressure [Pa]                                 *
+  !     t       surface temperature [K]                               *
+  !     td      surface dew point [K]                                 *
+  !     stress  surface stress [N/m2]                                 *
+  !                                                                   *
+  !********************************************************************
+  
+  use par_mod
+
+  implicit none
+
+  real :: ps,t,td,e,ew,tv,rhoa,stress
+
+  e=ew(td)                       ! vapor pressure
+  tv=t*(1.+0.378*e/ps)           ! virtual temperature
+  rhoa=ps/(r_air*tv)              ! air density
+  scalev=sqrt(abs(stress)/rhoa)
+
+end function scalev
Index: /branches/FP_AI/src/shift_field.f90
===================================================================
--- /branches/FP_AI/src/shift_field.f90	(revision 23)
+++ /branches/FP_AI/src/shift_field.f90	(revision 23)
@@ -0,0 +1,79 @@
+!**********************************************************************
+! 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 shift_field(field,nxf,nyf,nzfmax,nzf,nmax,n)
+  !                        i/o   i   i    i     i   i   i
+  !*****************************************************************************
+  !                                                                            *
+  !  This subroutine shifts global fields by nxshift grid cells, in order to   *
+  !  facilitate all sorts of nested wind fields, or output grids, which,       *
+  !  without shifting, would overlap with the domain "boundary".               *
+  !                                                                            *
+  !    Author: A. Stohl                                                        *
+  !                                                                            *
+  !    3 July 2002                                                             *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  !                                                                            *
+  ! Constants:                                                                 *
+  !                                                                            *
+  !*****************************************************************************
+
+  use par_mod
+
+  implicit none
+
+  integer :: nxf,nyf,nzf,n,ix,jy,kz,ixs,nzfmax,nmax
+  real :: field(0:nxmax-1,0:nymax-1,nzfmax,nmax),xshiftaux(0:nxmax-1)
+
+  ! Loop over y and z
+  !******************
+
+  do kz=1,nzf
+    do jy=0,nyf-1
+
+  ! Shift the data
+  !***************
+
+      if (nxshift.ne.0) then
+        do ix=0,nxf-1
+          if (ix.ge.nxshift) then
+            ixs=ix-nxshift
+          else
+            ixs=nxf-nxshift+ix
+          endif
+          xshiftaux(ixs)=field(ix,jy,kz,n)
+        end do
+        do ix=0,nxf-1
+          field(ix,jy,kz,n)=xshiftaux(ix)
+        end do
+      endif
+
+  ! Repeat the westernmost grid cells at the easternmost domain "boundary"
+  !***********************************************************************
+
+      field(nxf,jy,kz,n)=field(0,jy,kz,n)
+    end do
+  end do
+
+end subroutine shift_field
Index: /branches/FP_AI/src/shift_field_0.f90
===================================================================
--- /branches/FP_AI/src/shift_field_0.f90	(revision 23)
+++ /branches/FP_AI/src/shift_field_0.f90	(revision 23)
@@ -0,0 +1,78 @@
+!**********************************************************************
+! 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 shift_field_0(field,nxf,nyf)
+  !                          i/o   i   i
+  !*****************************************************************************
+  !                                                                            *
+  !  This subroutine shifts global fields by nxshift grid cells, in order to   *
+  !  facilitate all sorts of nested wind fields, or output grids, which,       *
+  !  without shifting, would overlap with the domain "boundary".               *
+  !                                                                            *
+  !    Author: A. Stohl                                                        *
+  !                                                                            *
+  !    3 July 2002                                                             *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  !                                                                            *
+  ! Constants:                                                                 *
+  !                                                                            *
+  !*****************************************************************************
+
+  use par_mod
+
+  implicit none
+
+  integer :: nxf,nyf,ix,jy,ixs
+  real :: field(0:nxmax-1,0:nymax-1),xshiftaux(0:nxmax-1)
+
+  ! Loop over y and z
+  !******************
+
+  do jy=0,nyf-1
+
+  ! Shift the data
+  !***************
+
+    if (nxshift.ne.0) then
+      do ix=0,nxf-1
+        if (ix.ge.nxshift) then
+          ixs=ix-nxshift
+        else
+          ixs=nxf-nxshift+ix
+        endif
+        xshiftaux(ixs)=field(ix,jy)
+      end do
+      do ix=0,nxf-1
+        field(ix,jy)=xshiftaux(ix)
+      end do
+    endif
+
+  ! Repeat the westernmost grid cells at the easternmost domain "boundary"
+  !***********************************************************************
+
+    field(nxf,jy)=field(0,jy)
+  end do
+
+  return
+end subroutine shift_field_0
Index: /branches/FP_AI/src/skplin.f90
===================================================================
--- /branches/FP_AI/src/skplin.f90	(revision 23)
+++ /branches/FP_AI/src/skplin.f90	(revision 23)
@@ -0,0 +1,49 @@
+!**********************************************************************
+! 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 skplin(nlines,iunit)
+  !                    i      i
+  !*****************************************************************************
+  !                                                                            *
+  !   This routine reads nlines from unit iunit and discards them              *
+  !                                                                            *
+  !   Authors: Petra Seibert                                                   *
+  !                                                                            *
+  !   31 Dec 1998                                                              *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  !                                                                            *
+  ! iunit   unit number from which lines are to be skipped                     *
+  ! nlines  number of lines to be skipped                                      *
+  !                                                                            *
+  !*****************************************************************************
+
+  implicit none
+
+  integer :: i,iunit, nlines
+
+  do i=1,nlines
+    read(iunit,*)
+  end do
+
+end subroutine skplin
Index: /branches/FP_AI/src/sort2.f90
===================================================================
--- /branches/FP_AI/src/sort2.f90	(revision 23)
+++ /branches/FP_AI/src/sort2.f90	(revision 23)
@@ -0,0 +1,125 @@
+!**********************************************************************
+! 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/>.   *
+!**********************************************************************
+
+! From numerical recipes
+! Change by A. Stohl: Use of integer instead of real values
+
+subroutine sort2(n,arr,brr)
+
+  implicit none
+
+  integer :: n
+  integer :: arr(n),brr(n)
+  integer,parameter :: m=7,nstack=50
+  integer :: i,ir,j,jstack,k,l,istack(nstack)
+  integer :: a,b,temp
+  jstack=0
+  l=1
+  ir=n
+1   if(ir-l.lt.m)then
+    do j=l+1,ir
+      a=arr(j)
+      b=brr(j)
+      do i=j-1,1,-1
+        if(arr(i).le.a)goto 2
+        arr(i+1)=arr(i)
+        brr(i+1)=brr(i)
+      end do
+      i=0
+2     arr(i+1)=a
+      brr(i+1)=b
+    end do
+    if(jstack.eq.0)return
+    ir=istack(jstack)
+    l=istack(jstack-1)
+    jstack=jstack-2
+  else
+    k=(l+ir)/2
+    temp=arr(k)
+    arr(k)=arr(l+1)
+    arr(l+1)=temp
+    temp=brr(k)
+    brr(k)=brr(l+1)
+    brr(l+1)=temp
+    if(arr(l+1).gt.arr(ir))then
+      temp=arr(l+1)
+      arr(l+1)=arr(ir)
+      arr(ir)=temp
+      temp=brr(l+1)
+      brr(l+1)=brr(ir)
+      brr(ir)=temp
+    endif
+    if(arr(l).gt.arr(ir))then
+      temp=arr(l)
+      arr(l)=arr(ir)
+      arr(ir)=temp
+      temp=brr(l)
+      brr(l)=brr(ir)
+      brr(ir)=temp
+    endif
+    if(arr(l+1).gt.arr(l))then
+      temp=arr(l+1)
+      arr(l+1)=arr(l)
+      arr(l)=temp
+      temp=brr(l+1)
+      brr(l+1)=brr(l)
+      brr(l)=temp
+    endif
+    i=l+1
+    j=ir
+    a=arr(l)
+    b=brr(l)
+3   continue
+      i=i+1
+    if(arr(i).lt.a)goto 3
+4   continue
+      j=j-1
+    if(arr(j).gt.a)goto 4
+    if(j.lt.i)goto 5
+    temp=arr(i)
+    arr(i)=arr(j)
+    arr(j)=temp
+    temp=brr(i)
+    brr(i)=brr(j)
+    brr(j)=temp
+    goto 3
+5   arr(l)=arr(j)
+    arr(j)=a
+    brr(l)=brr(j)
+    brr(j)=b
+    jstack=jstack+2
+    if(jstack.gt.nstack) then
+       print*, 'nstack too small in sort2'
+       stop
+    end if
+    if(ir-i+1.ge.j-l)then
+      istack(jstack)=ir
+      istack(jstack-1)=i
+      ir=j-1
+    else
+      istack(jstack)=j-1
+      istack(jstack-1)=l
+      l=i
+    endif
+  endif
+  goto 1
+end subroutine sort2
+!  (C) Copr. 1986-92 Numerical Recipes Software us.
Index: /branches/FP_AI/src/timemanager.f90
===================================================================
--- /branches/FP_AI/src/timemanager.f90	(revision 23)
+++ /branches/FP_AI/src/timemanager.f90	(revision 23)
@@ -0,0 +1,606 @@
+!**********************************************************************
+! 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 timemanager
+
+  !*****************************************************************************
+  !                                                                            *
+  ! Handles the computation of trajectories, i.e. determines which             *
+  ! trajectories have to be computed at what time.                             *
+  ! Manages dry+wet deposition routines, radioactive decay and the computation *
+  ! of concentrations.                                                         *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     20 May 1996                                                            *
+  !                                                                            *
+  !*****************************************************************************
+  !  Changes, Bernd C. Krueger, Feb. 2001:                                     *
+  !        Call of convmix when new windfield is read                          *
+  !------------------------------------                                        *
+  !  Changes Petra Seibert, Sept 2002                                          *
+  !     fix wet scavenging problem                                             *
+  !     Code may not be correct for decay of deposition!                       *
+  !  Changes Petra Seibert, Nov 2002                                           *
+  !     call convection BEFORE new fields are read in BWD mode                 *
+  !  Changes Caroline Forster, Feb 2005                                        *
+  !new interface between flexpart and convection scheme                        *
+  !Emanuel's latest subroutine convect43c.f is used                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! DEP                .true. if either wet or dry deposition is switched on   *
+  ! decay(maxspec) [1/s] decay constant for radioactive decay                  *
+  ! DRYDEP             .true. if dry deposition is switched on                 *
+  ! ideltas [s]        modelling period                                        *
+  ! itime [s]          actual temporal position of calculation                 *
+  ! ldeltat [s]        time since computation of radioact. decay of depositions*
+  ! loutaver [s]       averaging period for concentration calculations         *
+  ! loutend [s]        end of averaging for concentration calculations         *
+  ! loutnext [s]       next time at which output fields shall be centered      *
+  ! loutsample [s]     sampling interval for averaging of concentrations       *
+  ! loutstart [s]      start of averaging for concentration calculations       *
+  ! loutstep [s]       time interval for which concentrations shall be         *
+  !                    calculated                                              *
+  ! npoint(maxpart)    index, which starting point the trajectory has          *
+  !                    starting positions of trajectories                      *
+  ! nstop              serves as indicator for fate of particles               *
+  !                    in the particle loop                                    *
+  ! nstop1             serves as indicator for wind fields (see getfields)     *
+  ! outnum             number of samples for each concentration calculation    *
+  ! outnum             number of samples for each concentration calculation    *
+  ! prob               probability of absorption at ground due to dry          *
+  !                    deposition                                              *
+  ! WETDEP             .true. if wet deposition is switched on                 *
+  ! weight             weight for each concentration sample (1/2 or 1)         *
+  ! uap(maxpart),ucp(maxpart),uzp(maxpart) = random velocities due to          *
+  !                    turbulence                                              *
+  ! us(maxpart),vs(maxpart),ws(maxpart) = random velocities due to inter-      *
+  !                    polation                                                *
+  ! xtra1(maxpart), ytra1(maxpart), ztra1(maxpart) =                           *
+  !                    spatial positions of trajectories                       *
+  !                                                                            *
+  ! Constants:                                                                 *
+  ! maxpart            maximum number of trajectories                          *
+  !                                                                            *
+  !*****************************************************************************
+
+  use unc_mod
+  use point_mod
+  use xmass_mod
+  use flux_mod
+  use outg_mod
+  use oh_mod
+  use par_mod
+  use com_mod
+
+  implicit none
+
+  integer :: j,ks,kp,l,n,itime,nstop,nstop1
+! integer :: ksp
+  integer :: loutnext,loutstart,loutend
+  integer :: ix,jy,ldeltat,itage,nage
+  real :: outnum,weight,prob(maxspec)
+  real :: uap(maxpart),ucp(maxpart),uzp(maxpart),decfact
+  real :: us(maxpart),vs(maxpart),ws(maxpart)
+  integer(kind=2) :: cbt(maxpart)
+  real :: drydeposit(maxspec),gridtotalunc,wetgridtotalunc
+  real :: drygridtotalunc,xold,yold,zold,xmassfract
+  !double precision xm(maxspec,maxpointspec_act),
+  !    +                 xm_depw(maxspec,maxpointspec_act),
+  !    +                 xm_depd(maxspec,maxpointspec_act)
+
+
+  !open(88,file='TEST.dat')
+
+  ! First output for time 0
+  !************************
+
+  loutnext=loutstep/2
+  outnum=0.
+  loutstart=loutnext-loutaver/2
+  loutend=loutnext+loutaver/2
+
+  !  open(127,file=path(2)(1:length(2))//'depostat.dat'
+  !    +  ,form='unformatted')
+  !write (*,*) 'writing deposition statistics depostat.dat!'
+
+  !**********************************************************************
+  ! Loop over the whole modelling period in time steps of mintime seconds
+  !**********************************************************************
+
+
+  if (verbosity.gt.0) then
+    write (*,*) 'timemanager> starting simulation'
+    if (verbosity.gt.1) then
+      CALL SYSTEM_CLOCK(count_clock)
+      WRITE(*,*) 'timemanager> SYSTEM CLOCK',(count_clock - count_clock0)/real(count_rate)
+    endif     
+  endif
+
+  do itime=0,ideltas,lsynctime
+
+
+  ! Computation of wet deposition, OH reaction and mass transfer
+  ! between two species every lsynctime seconds
+  ! maybe wet depo frequency can be relaxed later but better be on safe side
+  ! wetdepo must be called BEFORE new fields are read in but should not
+  ! be called in the very beginning before any fields are loaded, or
+  ! before particles are in the system
+  ! Code may not be correct for decay of deposition
+  ! changed by Petra Seibert 9/02
+  !********************************************************************
+
+    if (WETDEP .and. itime .ne. 0 .and. numpart .gt. 0) then
+        if (verbosity.gt.0) then
+           write (*,*) 'timemanager> call wetdepo'
+        endif     
+         call wetdepo(itime,lsynctime,loutnext)
+    endif
+
+    if (OHREA .and. itime .ne. 0 .and. numpart .gt. 0) &
+         call ohreaction(itime,lsynctime,loutnext)
+
+    if (ASSSPEC .and. itime .ne. 0 .and. numpart .gt. 0) then
+       stop 'associated species not yet implemented!'
+  !     call transferspec(itime,lsynctime,loutnext)
+    endif
+
+  ! compute convection for backward runs
+  !*************************************
+
+   if ((ldirect.eq.-1).and.(lconvection.eq.1).and.(itime.lt.0)) then
+        if (verbosity.gt.0) then
+           write (*,*) 'timemanager> call convmix -- backward'
+        endif         
+      call convmix(itime)
+        if (verbosity.gt.1) then
+          !CALL SYSTEM_CLOCK(count_clock, count_rate, count_max)
+          CALL SYSTEM_CLOCK(count_clock)
+          WRITE(*,*) 'timemanager> SYSTEM CLOCK',(count_clock - count_clock0)/real(count_rate)
+        endif 
+   endif
+
+  ! Get necessary wind fields if not available
+  !*******************************************
+    if (verbosity.gt.0) then
+           write (*,*) 'timemanager> call getfields'
+    endif 
+    call getfields(itime,nstop1)
+        if (verbosity.gt.1) then
+          CALL SYSTEM_CLOCK(count_clock)
+          WRITE(*,*) 'timemanager> SYSTEM CLOCK',(count_clock - count_clock0)/real(count_rate)
+        endif 
+    if (nstop1.gt.1) stop 'NO METEO FIELDS AVAILABLE'
+
+  ! Release particles
+  !******************
+
+    if (verbosity.gt.0) then
+           write (*,*) 'timemanager>  Release particles'
+    endif 
+
+    if (mdomainfill.ge.1) then
+      if (itime.eq.0) then
+        if (verbosity.gt.0) then
+          write (*,*) 'timemanager>  call init_domainfill'
+        endif       
+        call init_domainfill
+      else
+        if (verbosity.gt.0) then
+          write (*,*) 'timemanager>  call boundcond_domainfill'
+        endif   
+        call boundcond_domainfill(itime,loutend)
+      endif
+    else
+      if (verbosity.gt.0) then
+        print*,'call releaseparticles'  
+      endif
+      call releaseparticles(itime)
+      if (verbosity.gt.1) then
+        CALL SYSTEM_CLOCK(count_clock)
+        WRITE(*,*) 'timemanager> SYSTEM CLOCK',(count_clock - count_clock0)/real(count_rate)
+      endif 
+    endif
+
+
+  ! Compute convective mixing for forward runs
+  ! for backward runs it is done before next windfield is read in
+  !**************************************************************
+
+   if ((ldirect.eq.1).and.(lconvection.eq.1)) then
+     if (verbosity.gt.0) then
+       write (*,*) 'timemanager> call convmix -- forward'
+     endif    
+     call convmix(itime)
+   endif
+
+  ! If middle of averaging period of output fields is reached, accumulated
+  ! deposited mass radioactively decays
+  !***********************************************************************
+
+    if (DEP.and.(itime.eq.loutnext).and.(ldirect.gt.0)) then
+      do ks=1,nspec
+      do kp=1,maxpointspec_act
+        if (decay(ks).gt.0.) then
+          do nage=1,nageclass
+            do l=1,nclassunc
+  ! Mother output grid
+              do jy=0,numygrid-1
+                do ix=0,numxgrid-1
+                  wetgridunc(ix,jy,ks,kp,l,nage)= &
+                       wetgridunc(ix,jy,ks,kp,l,nage)* &
+                       exp(-1.*outstep*decay(ks))
+                  drygridunc(ix,jy,ks,kp,l,nage)= &
+                       drygridunc(ix,jy,ks,kp,l,nage)* &
+                       exp(-1.*outstep*decay(ks))
+                end do
+              end do
+  ! Nested output grid
+              if (nested_output.eq.1) then
+                do jy=0,numygridn-1
+                  do ix=0,numxgridn-1
+                    wetgriduncn(ix,jy,ks,kp,l,nage)= &
+                         wetgriduncn(ix,jy,ks,kp,l,nage)* &
+                         exp(-1.*outstep*decay(ks))
+                    drygriduncn(ix,jy,ks,kp,l,nage)= &
+                         drygriduncn(ix,jy,ks,kp,l,nage)* &
+                         exp(-1.*outstep*decay(ks))
+                  end do
+                end do
+              endif
+            end do
+          end do
+        endif
+      end do
+      end do
+    endif
+
+  !!! CHANGE: These lines may be switched on to check the conservation
+  !!! of mass within FLEXPART
+  !   if (itime.eq.loutnext) then
+  !   do 247 ksp=1, nspec
+  !   do 247 kp=1, maxpointspec_act
+  !47         xm(ksp,kp)=0.
+
+  !   do 249 ksp=1, nspec
+  !     do 249 j=1,numpart
+  !          if (ioutputforeachrelease.eq.1) then
+  !            kp=npoint(j)
+  !          else
+  !            kp=1
+  !          endif
+  !       if (itra1(j).eq.itime) then
+  !          xm(ksp,kp)=xm(ksp,kp)+xmass1(j,ksp)
+  !         write(*,*) 'xmass: ',xmass1(j,ksp),j,ksp,nspec
+  !       endif
+  !49     continue
+  !  do 248 ksp=1,nspec
+  !  do 248 kp=1,maxpointspec_act
+  !  xm_depw(ksp,kp)=0.
+  !  xm_depd(ksp,kp)=0.
+  !     do 248 nage=1,nageclass
+  !       do 248 ix=0,numxgrid-1
+  !         do 248 jy=0,numygrid-1
+  !           do 248 l=1,nclassunc
+  !              xm_depw(ksp,kp)=xm_depw(ksp,kp)
+  !    +                  +wetgridunc(ix,jy,ksp,kp,l,nage)
+  !48                 xm_depd(ksp,kp)=xm_depd(ksp,kp)
+  !    +                  +drygridunc(ix,jy,ksp,kp,l,nage)
+  !             do 246 ksp=1,nspec
+  !46                    write(88,'(2i10,3e12.3)')
+  !    +              itime,ksp,(xm(ksp,kp),kp=1,maxpointspec_act),
+  !    +                (xm_depw(ksp,kp),kp=1,maxpointspec_act),
+  !    +                (xm_depd(ksp,kp),kp=1,maxpointspec_act)
+  !  endif
+  !!! CHANGE
+
+
+
+  ! Check whether concentrations are to be calculated
+  !**************************************************
+
+    if ((ldirect*itime.ge.ldirect*loutstart).and. &
+         (ldirect*itime.le.ldirect*loutend)) then ! add to grid
+      if (mod(itime-loutstart,loutsample).eq.0) then
+
+  ! If we are exactly at the start or end of the concentration averaging interval,
+  ! give only half the weight to this sample
+  !*****************************************************************************
+
+        if ((itime.eq.loutstart).or.(itime.eq.loutend)) then
+          weight=0.5
+        else
+          weight=1.0
+        endif
+        outnum=outnum+weight
+        call conccalc(itime,weight)
+      endif
+
+
+      if ((mquasilag.eq.1).and.(itime.eq.(loutstart+loutend)/2)) &
+           call partoutput_short(itime)    ! dump particle positions in extremely compressed format
+
+
+  ! Output and reinitialization of grid
+  ! If necessary, first sample of new grid is also taken
+  !*****************************************************
+
+      if ((itime.eq.loutend).and.(outnum.gt.0.)) then
+        if ((iout.le.3.).or.(iout.eq.5)) then
+          if (surf_only.ne.1) then 
+          call concoutput(itime,outnum,gridtotalunc, &
+               wetgridtotalunc,drygridtotalunc)
+          else  
+  if (verbosity.eq.1) then
+     print*,'call concoutput_surf '
+     CALL SYSTEM_CLOCK(count_clock)
+     WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0   
+  endif
+          call concoutput_surf(itime,outnum,gridtotalunc, &
+               wetgridtotalunc,drygridtotalunc)
+  if (verbosity.eq.1) then
+     print*,'called concoutput_surf '
+     CALL SYSTEM_CLOCK(count_clock)
+     WRITE(*,*) 'SYSTEM_CLOCK',count_clock - count_clock0   
+  endif
+          endif
+
+          if ((nested_output.eq.1).and.(surf_only.ne.1)) call concoutput_nest(itime,outnum)
+          if ((nested_output.eq.1).and.(surf_only.eq.1)) call concoutput_surf_nest(itime,outnum)
+          outnum=0.
+        endif
+        if ((iout.eq.4).or.(iout.eq.5)) call plumetraj(itime)
+        if (iflux.eq.1) call fluxoutput(itime)
+        write(*,45) itime,numpart,gridtotalunc,wetgridtotalunc, &
+             drygridtotalunc
+45      format(i9,' SECONDS SIMULATED: ',i8, &
+             ' PARTICLES:    Uncertainty: ',3f7.3)
+        if (ipout.ge.1) call partoutput(itime)    ! dump particle positions
+        loutnext=loutnext+loutstep
+        loutstart=loutnext-loutaver/2
+        loutend=loutnext+loutaver/2
+        if (itime.eq.loutstart) then
+          weight=0.5
+          outnum=outnum+weight
+          call conccalc(itime,weight)
+        endif
+
+
+  ! Check, whether particles are to be split:
+  ! If so, create new particles and attribute all information from the old
+  ! particles also to the new ones; old and new particles both get half the
+  ! mass of the old ones
+  !************************************************************************
+
+        if (ldirect*itime.ge.ldirect*itsplit) then
+          n=numpart
+          do j=1,numpart
+            if (ldirect*itime.ge.ldirect*itrasplit(j)) then
+              if (n.lt.maxpart) then
+                n=n+1
+                itrasplit(j)=2*(itrasplit(j)-itramem(j))+itramem(j)
+                itrasplit(n)=itrasplit(j)
+                itramem(n)=itramem(j)
+                itra1(n)=itra1(j)
+                idt(n)=idt(j)
+                npoint(n)=npoint(j)
+                nclass(n)=nclass(j)
+                xtra1(n)=xtra1(j)
+                ytra1(n)=ytra1(j)
+                ztra1(n)=ztra1(j)
+                uap(n)=uap(j)
+                ucp(n)=ucp(j)
+                uzp(n)=uzp(j)
+                us(n)=us(j)
+                vs(n)=vs(j)
+                ws(n)=ws(j)
+                cbt(n)=cbt(j)
+                do ks=1,nspec
+                  xmass1(j,ks)=xmass1(j,ks)/2.
+                  xmass1(n,ks)=xmass1(j,ks)
+                end do
+              endif
+            endif
+          end do
+          numpart=n
+        endif
+      endif
+    endif
+
+
+    if (itime.eq.ideltas) exit         ! almost finished
+
+  ! Compute interval since radioactive decay of deposited mass was computed
+  !************************************************************************
+
+    if (itime.lt.loutnext) then
+      ldeltat=itime-(loutnext-loutstep)
+    else                                  ! first half of next interval
+      ldeltat=itime-loutnext
+    endif
+
+
+  ! Loop over all particles
+  !************************
+
+    do j=1,numpart
+
+
+  ! If integration step is due, do it
+  !**********************************
+
+      if (itra1(j).eq.itime) then
+
+        if (ioutputforeachrelease.eq.1) then
+            kp=npoint(j)
+        else
+            kp=1
+        endif
+  ! Determine age class of the particle
+        itage=abs(itra1(j)-itramem(j))
+        do nage=1,nageclass
+          if (itage.lt.lage(nage)) exit
+        end do
+
+  ! Initialize newly released particle
+  !***********************************
+
+        if ((itramem(j).eq.itime).or.(itime.eq.0)) &
+             call initialize(itime,idt(j),uap(j),ucp(j),uzp(j), &
+             us(j),vs(j),ws(j),xtra1(j),ytra1(j),ztra1(j),cbt(j))
+
+  ! Memorize particle positions
+  !****************************
+
+        xold=xtra1(j)
+        yold=ytra1(j)
+        zold=ztra1(j)
+
+  ! Integrate Lagevin equation for lsynctime seconds
+  !*************************************************
+
+        call advance(itime,npoint(j),idt(j),uap(j),ucp(j),uzp(j), &
+             us(j),vs(j),ws(j),nstop,xtra1(j),ytra1(j),ztra1(j),prob, &
+             cbt(j))
+
+  ! Calculate the gross fluxes across layer interfaces
+  !***************************************************
+
+        if (iflux.eq.1) call calcfluxes(nage,j,xold,yold,zold)
+
+
+  ! Determine, when next time step is due
+  ! If trajectory is terminated, mark it
+  !**************************************
+
+        if (nstop.gt.1) then
+          if (linit_cond.ge.1) call initial_cond_calc(itime,j)
+          itra1(j)=-999999999
+        else
+          itra1(j)=itime+lsynctime
+
+
+  ! Dry deposition and radioactive decay for each species
+  ! Also check maximum (of all species) of initial mass remaining on the particle;
+  ! if it is below a threshold value, terminate particle
+  !*****************************************************************************
+
+          xmassfract=0.
+          do ks=1,nspec
+            if (decay(ks).gt.0.) then             ! radioactive decay
+              decfact=exp(-real(abs(lsynctime))*decay(ks))
+            else
+              decfact=1.
+            endif
+
+            if (DRYDEPSPEC(ks)) then        ! dry deposition
+              drydeposit(ks)=xmass1(j,ks)*prob(ks)*decfact
+              xmass1(j,ks)=xmass1(j,ks)*(1.-prob(ks))*decfact
+              if (decay(ks).gt.0.) then   ! correct for decay (see wetdepo)
+                drydeposit(ks)=drydeposit(ks)* &
+                     exp(real(abs(ldeltat))*decay(ks))
+              endif
+            else                           ! no dry deposition
+              xmass1(j,ks)=xmass1(j,ks)*decfact
+            endif
+
+
+            if (mdomainfill.eq.0) then
+              if (xmass(npoint(j),ks).gt.0.) &
+                   xmassfract=max(xmassfract,real(npart(npoint(j)))* &
+                   xmass1(j,ks)/xmass(npoint(j),ks))
+            else
+              xmassfract=1.
+            endif
+          end do
+
+          if (xmassfract.lt.0.0001) then   ! terminate all particles carrying less mass
+            itra1(j)=-999999999
+          endif
+
+  !        Sabine Eckhardt, June 2008
+  !        don't create depofield for backward runs
+          if (DRYDEP.AND.(ldirect.eq.1)) then
+            call drydepokernel(nclass(j),drydeposit,real(xtra1(j)), &
+                 real(ytra1(j)),nage,kp)
+            if (nested_output.eq.1) call drydepokernel_nest( &
+                 nclass(j),drydeposit,real(xtra1(j)),real(ytra1(j)), &
+                 nage,kp)
+          endif
+
+  ! Terminate trajectories that are older than maximum allowed age
+  !***************************************************************
+
+          if (abs(itra1(j)-itramem(j)).ge.lage(nageclass)) then
+            if (linit_cond.ge.1) &
+                 call initial_cond_calc(itime+lsynctime,j)
+            itra1(j)=-999999999
+          endif
+        endif
+
+      endif
+
+    end do
+
+  end do
+
+
+  ! Complete the calculation of initial conditions for particles not yet terminated
+  !*****************************************************************************
+
+  do j=1,numpart
+    if (linit_cond.ge.1) call initial_cond_calc(itime,j)
+  end do
+
+  if (ipout.eq.2) call partoutput(itime)     ! dump particle positions
+
+  if (linit_cond.ge.1) call initial_cond_output(itime)   ! dump initial cond. field
+
+  close(104)
+
+  ! De-allocate memory and end
+  !***************************
+
+  if (iflux.eq.1) then
+      deallocate(flux)
+  endif
+  if (OHREA.eqv..TRUE.) then
+      deallocate(OH_field,OH_field_height)
+  endif
+  if (ldirect.gt.0) then
+  deallocate(drygridunc,wetgridunc)
+  endif
+  deallocate(gridunc)
+  deallocate(xpoint1,xpoint2,ypoint1,ypoint2,zpoint1,zpoint2,xmass)
+  deallocate(ireleasestart,ireleaseend,npart,kindz)
+  deallocate(xmasssave)
+  if (nested_output.eq.1) then
+     deallocate(orooutn, arean, volumen)
+     if (ldirect.gt.0) then
+     deallocate(griduncn,drygriduncn,wetgriduncn)
+     endif
+  endif
+  deallocate(outheight,outheighthalf)
+  deallocate(oroout, area, volume)
+
+end subroutine timemanager
+
Index: /branches/FP_AI/src/unc_mod.f90
===================================================================
--- /branches/FP_AI/src/unc_mod.f90	(revision 23)
+++ /branches/FP_AI/src/unc_mod.f90	(revision 23)
@@ -0,0 +1,35 @@
+!**********************************************************************
+! 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/>.   *
+!**********************************************************************
+
+module unc_mod
+
+  implicit none
+
+  real,allocatable, dimension (:,:,:,:,:,:,:) :: gridunc
+  real,allocatable, dimension (:,:,:,:,:,:,:) :: griduncn
+  real,allocatable, dimension (:,:,:,:,:,:) :: drygridunc
+  real,allocatable, dimension (:,:,:,:,:,:) :: drygriduncn
+  real,allocatable, dimension (:,:,:,:,:,:) :: wetgridunc
+  real,allocatable, dimension (:,:,:,:,:,:) :: wetgriduncn
+
+  real,allocatable, dimension (:,:,:,:,:) :: init_cond
+
+end module unc_mod
Index: /branches/FP_AI/src/verttransform.f90
===================================================================
--- /branches/FP_AI/src/verttransform.f90	(revision 23)
+++ /branches/FP_AI/src/verttransform.f90	(revision 23)
@@ -0,0 +1,519 @@
+!**********************************************************************
+! 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 verttransform(n,uuh,vvh,wwh,pvh)
+  !                      i  i   i   i   i
+  !*****************************************************************************
+  !                                                                            *
+  !     This subroutine transforms temperature, dew point temperature and      *
+  !     wind components from eta to meter coordinates.                         *
+  !     The vertical wind component is transformed from Pa/s to m/s using      *
+  !     the conversion factor pinmconv.                                        *
+  !     In addition, this routine calculates vertical density gradients        *
+  !     needed for the parameterization of the turbulent velocities.           *
+  !                                                                            *
+  !     Author: A. Stohl, G. Wotawa                                            *
+  !                                                                            *
+  !     12 August 1996                                                         *
+  !     Update: 16 January 1998                                                *
+  !                                                                            *
+  !     Major update: 17 February 1999                                         *
+  !     by G. Wotawa                                                           *
+  !                                                                            *
+  !     - Vertical levels for u, v and w are put together                      *
+  !     - Slope correction for vertical velocity: Modification of calculation  *
+  !       procedure                                                            *
+  !                                                                            *
+  !*****************************************************************************
+  !  Changes, Bernd C. Krueger, Feb. 2001:
+  !   Variables tth and qvh (on eta coordinates) from common block
+  !*****************************************************************************
+  ! Sabine Eckhardt, March 2007
+  ! added the variable cloud for use with scavenging - descr. in com_mod
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! nx,ny,nz                        field dimensions in x,y and z direction    *
+  ! clouds(0:nxmax,0:nymax,0:nzmax,2) cloud field for wet deposition           *
+  ! uu(0:nxmax,0:nymax,nzmax,2)     wind components in x-direction [m/s]       *
+  ! vv(0:nxmax,0:nymax,nzmax,2)     wind components in y-direction [m/s]       *
+  ! ww(0:nxmax,0:nymax,nzmax,2)     wind components in z-direction [deltaeta/s]*
+  ! tt(0:nxmax,0:nymax,nzmax,2)     temperature [K]                            *
+  ! pv(0:nxmax,0:nymax,nzmax,2)     potential voriticity (pvu)                 *
+  ! ps(0:nxmax,0:nymax,2)           surface pressure [Pa]                      *
+  !                                                                            *
+  !*****************************************************************************
+
+  use par_mod
+  use com_mod
+  use cmapf_mod, only: cc2gll
+
+  implicit none
+
+  integer :: ix,jy,kz,iz,n,kmin,kl,klp,ix1,jy1,ixp,jyp,ixm,jym
+  integer :: rain_cloud_above,kz_inv
+  real :: f_qvsat,pressure
+  real :: rh,lsp,convp
+  real :: rhoh(nuvzmax),pinmconv(nzmax)
+  real :: ew,pint,tv,tvold,pold,dz1,dz2,dz,ui,vi
+  real :: xlon,ylat,xlonr,dzdx,dzdy
+  real :: dzdx1,dzdx2,dzdy1,dzdy2,cosf
+  real :: uuaux,vvaux,uupolaux,vvpolaux,ddpol,ffpol,wdummy
+  real :: uuh(0:nxmax-1,0:nymax-1,nuvzmax)
+  real :: vvh(0:nxmax-1,0:nymax-1,nuvzmax)
+  real :: pvh(0:nxmax-1,0:nymax-1,nuvzmax)
+  real :: wwh(0:nxmax-1,0:nymax-1,nwzmax)
+  real :: wzlev(nwzmax),uvwzlev(0:nxmax-1,0:nymax-1,nzmax)
+  real,parameter :: const=r_air/ga
+
+  logical :: init = .true.
+
+
+  !*************************************************************************
+  ! If verttransform is called the first time, initialize heights of the   *
+  ! z levels in meter. The heights are the heights of model levels, where  *
+  ! u,v,T and qv are given.                                                *
+  !*************************************************************************
+
+  if (init) then
+
+  ! Search for a point with high surface pressure (i.e. not above significant topography)
+  ! Then, use this point to construct a reference z profile, to be used at all times
+  !**************************************************************************************
+
+    do jy=0,nymin1
+      do ix=0,nxmin1
+        if (ps(ix,jy,1,n).gt.100000.) then
+          ixm=ix
+          jym=jy
+          goto 3
+        endif
+      end do
+    end do
+3   continue
+
+
+    tvold=tt2(ixm,jym,1,n)*(1.+0.378*ew(td2(ixm,jym,1,n))/ &
+    ps(ixm,jym,1,n))
+    pold=ps(ixm,jym,1,n)
+    height(1)=0.
+
+    do kz=2,nuvz
+      pint=akz(kz)+bkz(kz)*ps(ixm,jym,1,n)
+      tv=tth(ixm,jym,kz,n)*(1.+0.608*qvh(ixm,jym,kz,n))
+
+      if (abs(tv-tvold).gt.0.2) then
+        height(kz)=height(kz-1)+const*log(pold/pint)* &
+        (tv-tvold)/log(tv/tvold)
+      else
+        height(kz)=height(kz-1)+const*log(pold/pint)*tv
+      endif
+
+      tvold=tv
+      pold=pint
+    end do
+
+
+  ! Determine highest levels that can be within PBL
+  !************************************************
+
+    do kz=1,nz
+      if (height(kz).gt.hmixmax) then
+        nmixz=kz
+        goto 9
+      endif
+    end do
+9   continue
+
+  ! Do not repeat initialization of the Cartesian z grid
+  !*****************************************************
+
+    init=.false.
+
+  endif
+
+
+  ! Loop over the whole grid
+  !*************************
+
+  do jy=0,nymin1
+    do ix=0,nxmin1
+      tvold=tt2(ix,jy,1,n)*(1.+0.378*ew(td2(ix,jy,1,n))/ps(ix,jy,1,n))
+      pold=ps(ix,jy,1,n)
+      uvwzlev(ix,jy,1)=0.
+      wzlev(1)=0.
+      rhoh(1)=pold/(r_air*tvold)
+
+
+  ! Compute heights of eta levels
+  !******************************
+
+      do kz=2,nuvz
+        pint=akz(kz)+bkz(kz)*ps(ix,jy,1,n)
+        tv=tth(ix,jy,kz,n)*(1.+0.608*qvh(ix,jy,kz,n))
+        rhoh(kz)=pint/(r_air*tv)
+
+        if (abs(tv-tvold).gt.0.2) then
+          uvwzlev(ix,jy,kz)=uvwzlev(ix,jy,kz-1)+const*log(pold/pint)* &
+          (tv-tvold)/log(tv/tvold)
+        else
+          uvwzlev(ix,jy,kz)=uvwzlev(ix,jy,kz-1)+const*log(pold/pint)*tv
+        endif
+
+        tvold=tv
+        pold=pint
+      end do
+
+
+      do kz=2,nwz-1
+        wzlev(kz)=(uvwzlev(ix,jy,kz+1)+uvwzlev(ix,jy,kz))/2.
+      end do
+      wzlev(nwz)=wzlev(nwz-1)+uvwzlev(ix,jy,nuvz)-uvwzlev(ix,jy,nuvz-1)
+
+  ! pinmconv=(h2-h1)/(p2-p1)
+
+      pinmconv(1)=(uvwzlev(ix,jy,2)-uvwzlev(ix,jy,1))/ &
+      ((aknew(2)+bknew(2)*ps(ix,jy,1,n))- &
+      (aknew(1)+bknew(1)*ps(ix,jy,1,n)))
+      do kz=2,nz-1
+        pinmconv(kz)=(uvwzlev(ix,jy,kz+1)-uvwzlev(ix,jy,kz-1))/ &
+        ((aknew(kz+1)+bknew(kz+1)*ps(ix,jy,1,n))- &
+        (aknew(kz-1)+bknew(kz-1)*ps(ix,jy,1,n)))
+      end do
+      pinmconv(nz)=(uvwzlev(ix,jy,nz)-uvwzlev(ix,jy,nz-1))/ &
+      ((aknew(nz)+bknew(nz)*ps(ix,jy,1,n))- &
+      (aknew(nz-1)+bknew(nz-1)*ps(ix,jy,1,n)))
+
+  ! Levels, where u,v,t and q are given
+  !************************************
+
+      uu(ix,jy,1,n)=uuh(ix,jy,1)
+      vv(ix,jy,1,n)=vvh(ix,jy,1)
+      tt(ix,jy,1,n)=tth(ix,jy,1,n)
+      qv(ix,jy,1,n)=qvh(ix,jy,1,n)
+      pv(ix,jy,1,n)=pvh(ix,jy,1)
+      rho(ix,jy,1,n)=rhoh(1)
+      uu(ix,jy,nz,n)=uuh(ix,jy,nuvz)
+      vv(ix,jy,nz,n)=vvh(ix,jy,nuvz)
+      tt(ix,jy,nz,n)=tth(ix,jy,nuvz,n)
+      qv(ix,jy,nz,n)=qvh(ix,jy,nuvz,n)
+      pv(ix,jy,nz,n)=pvh(ix,jy,nuvz)
+      rho(ix,jy,nz,n)=rhoh(nuvz)
+      kmin=2
+      do iz=2,nz-1
+        do kz=kmin,nuvz
+          if(height(iz).gt.uvwzlev(ix,jy,nuvz)) then
+            uu(ix,jy,iz,n)=uu(ix,jy,nz,n)
+            vv(ix,jy,iz,n)=vv(ix,jy,nz,n)
+            tt(ix,jy,iz,n)=tt(ix,jy,nz,n)
+            qv(ix,jy,iz,n)=qv(ix,jy,nz,n)
+            pv(ix,jy,iz,n)=pv(ix,jy,nz,n)
+            rho(ix,jy,iz,n)=rho(ix,jy,nz,n)
+            goto 30
+          endif
+          if ((height(iz).gt.uvwzlev(ix,jy,kz-1)).and. &
+          (height(iz).le.uvwzlev(ix,jy,kz))) then
+           dz1=height(iz)-uvwzlev(ix,jy,kz-1)
+           dz2=uvwzlev(ix,jy,kz)-height(iz)
+           dz=dz1+dz2
+           uu(ix,jy,iz,n)=(uuh(ix,jy,kz-1)*dz2+uuh(ix,jy,kz)*dz1)/dz
+           vv(ix,jy,iz,n)=(vvh(ix,jy,kz-1)*dz2+vvh(ix,jy,kz)*dz1)/dz
+           tt(ix,jy,iz,n)=(tth(ix,jy,kz-1,n)*dz2 &
+                +tth(ix,jy,kz,n)*dz1)/dz
+           qv(ix,jy,iz,n)=(qvh(ix,jy,kz-1,n)*dz2 &
+                +qvh(ix,jy,kz,n)*dz1)/dz
+           pv(ix,jy,iz,n)=(pvh(ix,jy,kz-1)*dz2+pvh(ix,jy,kz)*dz1)/dz
+           rho(ix,jy,iz,n)=(rhoh(kz-1)*dz2+rhoh(kz)*dz1)/dz
+           kmin=kz
+           goto 30
+          endif
+        end do
+30      continue
+      end do
+
+
+  ! Levels, where w is given
+  !*************************
+
+      ww(ix,jy,1,n)=wwh(ix,jy,1)*pinmconv(1)
+      ww(ix,jy,nz,n)=wwh(ix,jy,nwz)*pinmconv(nz)
+      kmin=2
+      do iz=2,nz
+        do kz=kmin,nwz
+          if ((height(iz).gt.wzlev(kz-1)).and. &
+               (height(iz).le.wzlev(kz))) then
+           dz1=height(iz)-wzlev(kz-1)
+           dz2=wzlev(kz)-height(iz)
+           dz=dz1+dz2
+           ww(ix,jy,iz,n)=(wwh(ix,jy,kz-1)*pinmconv(kz-1)*dz2 &
+                +wwh(ix,jy,kz)*pinmconv(kz)*dz1)/dz
+           kmin=kz
+           goto 40
+          endif
+        end do
+40      continue
+      end do
+
+  ! Compute density gradients at intermediate levels
+  !*************************************************
+
+      drhodz(ix,jy,1,n)=(rho(ix,jy,2,n)-rho(ix,jy,1,n))/ &
+      (height(2)-height(1))
+      do kz=2,nz-1
+        drhodz(ix,jy,kz,n)=(rho(ix,jy,kz+1,n)-rho(ix,jy,kz-1,n))/ &
+        (height(kz+1)-height(kz-1))
+      end do
+      drhodz(ix,jy,nz,n)=drhodz(ix,jy,nz-1,n)
+
+    end do
+  end do
+
+
+  !****************************************************************
+  ! Compute slope of eta levels in windward direction and resulting
+  ! vertical wind correction
+  !****************************************************************
+
+  do jy=1,ny-2
+    cosf=cos((real(jy)*dy+ylat0)*pi180)
+    do ix=1,nx-2
+
+      kmin=2
+      do iz=2,nz-1
+
+        ui=uu(ix,jy,iz,n)*dxconst/cosf
+        vi=vv(ix,jy,iz,n)*dyconst
+
+        do kz=kmin,nz
+          if ((height(iz).gt.uvwzlev(ix,jy,kz-1)).and. &
+          (height(iz).le.uvwzlev(ix,jy,kz))) then
+            dz1=height(iz)-uvwzlev(ix,jy,kz-1)
+            dz2=uvwzlev(ix,jy,kz)-height(iz)
+            dz=dz1+dz2
+            kl=kz-1
+            klp=kz
+            kmin=kz
+            goto 47
+          endif
+        end do
+
+47      ix1=ix-1
+        jy1=jy-1
+        ixp=ix+1
+        jyp=jy+1
+
+        dzdx1=(uvwzlev(ixp,jy,kl)-uvwzlev(ix1,jy,kl))/2.
+        dzdx2=(uvwzlev(ixp,jy,klp)-uvwzlev(ix1,jy,klp))/2.
+        dzdx=(dzdx1*dz2+dzdx2*dz1)/dz
+
+        dzdy1=(uvwzlev(ix,jyp,kl)-uvwzlev(ix,jy1,kl))/2.
+        dzdy2=(uvwzlev(ix,jyp,klp)-uvwzlev(ix,jy1,klp))/2.
+        dzdy=(dzdy1*dz2+dzdy2*dz1)/dz
+
+        ww(ix,jy,iz,n)=ww(ix,jy,iz,n)+(dzdx*ui+dzdy*vi)
+
+      end do
+
+    end do
+  end do
+
+
+  ! If north pole is in the domain, calculate wind velocities in polar
+  ! stereographic coordinates
+  !*******************************************************************
+
+  if (nglobal) then
+    do jy=int(switchnorthg)-2,nymin1
+      ylat=ylat0+real(jy)*dy
+      do ix=0,nxmin1
+        xlon=xlon0+real(ix)*dx
+        do iz=1,nz
+          call cc2gll(northpolemap,ylat,xlon,uu(ix,jy,iz,n), &
+          vv(ix,jy,iz,n),uupol(ix,jy,iz,n),vvpol(ix,jy,iz,n))
+        end do
+      end do
+    end do
+
+
+    do iz=1,nz
+
+  ! CALCULATE FFPOL, DDPOL FOR CENTRAL GRID POINT
+  !
+  !   AMSnauffer Nov 18 2004 Added check for case vv=0
+  !
+      xlon=xlon0+real(nx/2-1)*dx
+      xlonr=xlon*pi/180.
+      ffpol=sqrt(uu(nx/2-1,nymin1,iz,n)**2+vv(nx/2-1,nymin1,iz,n)**2)
+      if (vv(nx/2-1,nymin1,iz,n).lt.0.) then
+        ddpol=atan(uu(nx/2-1,nymin1,iz,n)/vv(nx/2-1,nymin1,iz,n))-xlonr
+      else if (vv(nx/2-1,nymin1,iz,n).gt.0.) then
+        ddpol=pi+atan(uu(nx/2-1,nymin1,iz,n)/ &
+        vv(nx/2-1,nymin1,iz,n))-xlonr
+      else
+        ddpol=pi/2-xlonr
+      endif
+      if(ddpol.lt.0.) ddpol=2.0*pi+ddpol
+      if(ddpol.gt.2.0*pi) ddpol=ddpol-2.0*pi
+
+  ! CALCULATE U,V FOR 180 DEG, TRANSFORM TO POLAR STEREOGRAPHIC GRID
+      xlon=180.0
+      xlonr=xlon*pi/180.
+      ylat=90.0
+      uuaux=-ffpol*sin(xlonr+ddpol)
+      vvaux=-ffpol*cos(xlonr+ddpol)
+      call cc2gll(northpolemap,ylat,xlon,uuaux,vvaux,uupolaux,vvpolaux)
+      jy=nymin1
+      do ix=0,nxmin1
+        uupol(ix,jy,iz,n)=uupolaux
+        vvpol(ix,jy,iz,n)=vvpolaux
+      end do
+    end do
+
+
+  ! Fix: Set W at pole to the zonally averaged W of the next equator-
+  ! ward parallel of latitude
+
+  do iz=1,nz
+      wdummy=0.
+      jy=ny-2
+      do ix=0,nxmin1
+        wdummy=wdummy+ww(ix,jy,iz,n)
+      end do
+      wdummy=wdummy/real(nx)
+      jy=nymin1
+      do ix=0,nxmin1
+        ww(ix,jy,iz,n)=wdummy
+      end do
+  end do
+
+  endif
+
+
+  ! If south pole is in the domain, calculate wind velocities in polar
+  ! stereographic coordinates
+  !*******************************************************************
+
+  if (sglobal) then
+    do jy=0,int(switchsouthg)+3
+      ylat=ylat0+real(jy)*dy
+      do ix=0,nxmin1
+        xlon=xlon0+real(ix)*dx
+        do iz=1,nz
+          call cc2gll(southpolemap,ylat,xlon,uu(ix,jy,iz,n), &
+          vv(ix,jy,iz,n),uupol(ix,jy,iz,n),vvpol(ix,jy,iz,n))
+        end do
+      end do
+    end do
+
+    do iz=1,nz
+
+  ! CALCULATE FFPOL, DDPOL FOR CENTRAL GRID POINT
+  !
+  !   AMSnauffer Nov 18 2004 Added check for case vv=0
+  !
+      xlon=xlon0+real(nx/2-1)*dx
+      xlonr=xlon*pi/180.
+      ffpol=sqrt(uu(nx/2-1,0,iz,n)**2+vv(nx/2-1,0,iz,n)**2)
+      if (vv(nx/2-1,0,iz,n).lt.0.) then
+        ddpol=atan(uu(nx/2-1,0,iz,n)/vv(nx/2-1,0,iz,n))+xlonr
+      else if (vv(nx/2-1,0,iz,n).gt.0.) then
+        ddpol=pi+atan(uu(nx/2-1,0,iz,n)/vv(nx/2-1,0,iz,n))+xlonr
+      else
+        ddpol=pi/2-xlonr
+      endif
+      if(ddpol.lt.0.) ddpol=2.0*pi+ddpol
+      if(ddpol.gt.2.0*pi) ddpol=ddpol-2.0*pi
+
+  ! CALCULATE U,V FOR 180 DEG, TRANSFORM TO POLAR STEREOGRAPHIC GRID
+      xlon=180.0
+      xlonr=xlon*pi/180.
+      ylat=-90.0
+      uuaux=+ffpol*sin(xlonr-ddpol)
+      vvaux=-ffpol*cos(xlonr-ddpol)
+      call cc2gll(northpolemap,ylat,xlon,uuaux,vvaux,uupolaux,vvpolaux)
+
+      jy=0
+      do ix=0,nxmin1
+        uupol(ix,jy,iz,n)=uupolaux
+        vvpol(ix,jy,iz,n)=vvpolaux
+      end do
+    end do
+
+
+  ! Fix: Set W at pole to the zonally averaged W of the next equator-
+  ! ward parallel of latitude
+
+    do iz=1,nz
+      wdummy=0.
+      jy=1
+      do ix=0,nxmin1
+        wdummy=wdummy+ww(ix,jy,iz,n)
+      end do
+      wdummy=wdummy/real(nx)
+      jy=0
+      do ix=0,nxmin1
+        ww(ix,jy,iz,n)=wdummy
+      end do
+    end do
+  endif
+
+
+  !write (*,*) 'initializing clouds, n:',n,nymin1,nxmin1,nz
+  !   create a cloud and rainout/washout field, clouds occur where rh>80%
+  !   total cloudheight is stored at level 0
+  do jy=0,nymin1
+    do ix=0,nxmin1
+      rain_cloud_above=0
+      lsp=lsprec(ix,jy,1,n)
+      convp=convprec(ix,jy,1,n)
+      cloudsh(ix,jy,n)=0
+      do kz_inv=1,nz-1
+         kz=nz-kz_inv+1
+         pressure=rho(ix,jy,kz,n)*r_air*tt(ix,jy,kz,n)
+         rh=qv(ix,jy,kz,n)/f_qvsat(pressure,tt(ix,jy,kz,n))
+         clouds(ix,jy,kz,n)=0
+         if (rh.gt.0.8) then ! in cloud
+            if ((lsp.gt.0.01).or.(convp.gt.0.01)) then ! cloud and precipitation
+               rain_cloud_above=1
+               cloudsh(ix,jy,n)=cloudsh(ix,jy,n)+ &
+               height(kz)-height(kz-1)
+               if (lsp.ge.convp) then
+                  clouds(ix,jy,kz,n)=3 ! lsp dominated rainout
+               else
+                  clouds(ix,jy,kz,n)=2 ! convp dominated rainout
+               endif
+            else ! no precipitation
+                  clouds(ix,jy,kz,n)=1 ! cloud
+            endif
+         else ! no cloud
+            if (rain_cloud_above.eq.1) then ! scavenging
+               if (lsp.ge.convp) then
+                  clouds(ix,jy,kz,n)=5 ! lsp dominated washout
+               else
+                  clouds(ix,jy,kz,n)=4 ! convp dominated washout
+               endif
+            endif
+         endif
+      end do
+    end do
+  end do
+
+end subroutine verttransform
Index: /branches/FP_AI/src/verttransform_gfs.f90
===================================================================
--- /branches/FP_AI/src/verttransform_gfs.f90	(revision 23)
+++ /branches/FP_AI/src/verttransform_gfs.f90	(revision 23)
@@ -0,0 +1,533 @@
+!**********************************************************************
+! 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 verttransform(n,uuh,vvh,wwh,pvh)
+  !                      i  i   i   i   i
+  !*****************************************************************************
+  !                                                                            *
+  !     This subroutine transforms temperature, dew point temperature and      *
+  !     wind components from eta to meter coordinates.                         *
+  !     The vertical wind component is transformed from Pa/s to m/s using      *
+  !     the conversion factor pinmconv.                                        *
+  !     In addition, this routine calculates vertical density gradients        *
+  !     needed for the parameterization of the turbulent velocities.           *
+  !                                                                            *
+  !     Author: A. Stohl, G. Wotawa                                            *
+  !                                                                            *
+  !     12 August 1996                                                         *
+  !     Update: 16 January 1998                                                *
+  !                                                                            *
+  !     Major update: 17 February 1999                                         *
+  !     by G. Wotawa                                                           *
+  !     CHANGE 17/11/2005 Caroline Forster, NCEP GFS version                   *
+  !                                                                            *
+  !   - Vertical levels for u, v and w are put together                        *
+  !   - Slope correction for vertical velocity: Modification of calculation    *
+  !     procedure                                                              *
+  !                                                                            *
+  !*****************************************************************************
+  !  Changes, Bernd C. Krueger, Feb. 2001:
+  !   Variables tth and qvh (on eta coordinates) from common block
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! nx,ny,nz                        field dimensions in x,y and z direction    *
+  ! uu(0:nxmax,0:nymax,nzmax,2)     wind components in x-direction [m/s]       *
+  ! vv(0:nxmax,0:nymax,nzmax,2)     wind components in y-direction [m/s]       *
+  ! ww(0:nxmax,0:nymax,nzmax,2)     wind components in z-direction [deltaeta/s]*
+  ! tt(0:nxmax,0:nymax,nzmax,2)     temperature [K]                            *
+  ! pv(0:nxmax,0:nymax,nzmax,2)     potential voriticity (pvu)                 *
+  ! ps(0:nxmax,0:nymax,2)           surface pressure [Pa]                      *
+  ! clouds(0:nxmax,0:nymax,0:nzmax,2) cloud field for wet deposition           *
+  !                                                                            *
+  !*****************************************************************************
+
+  use par_mod
+  use com_mod
+  use cmapf_mod
+
+  implicit none
+
+  integer :: ix,jy,kz,iz,n,kmin,kl,klp,ix1,jy1,ixp,jyp,ixm,jym
+  integer :: rain_cloud_above,kz_inv
+  real :: f_qvsat,pressure
+  real :: rh,lsp,convp
+  real :: rhoh(nuvzmax),pinmconv(nzmax)
+  real :: ew,pint,tv,tvold,pold,dz1,dz2,dz,ui,vi
+  real :: xlon,ylat,xlonr,dzdx,dzdy
+  real :: dzdx1,dzdx2,dzdy1,dzdy2,cosf
+  real :: uuaux,vvaux,uupolaux,vvpolaux,ddpol,ffpol,wdummy
+  real :: uuh(0:nxmax-1,0:nymax-1,nuvzmax)
+  real :: vvh(0:nxmax-1,0:nymax-1,nuvzmax)
+  real :: pvh(0:nxmax-1,0:nymax-1,nuvzmax)
+  real :: wwh(0:nxmax-1,0:nymax-1,nwzmax)
+  real :: wzlev(nwzmax),uvwzlev(0:nxmax-1,0:nymax-1,nzmax)
+  real,parameter :: const=r_air/ga
+
+  ! NCEP version
+  integer :: llev, i
+
+  logical :: init = .true.
+
+
+  !*************************************************************************
+  ! If verttransform is called the first time, initialize heights of the   *
+  ! z levels in meter. The heights are the heights of model levels, where  *
+  ! u,v,T and qv are given.                                                *
+  !*************************************************************************
+
+  if (init) then
+
+  ! Search for a point with high surface pressure (i.e. not above significant topography)
+  ! Then, use this point to construct a reference z profile, to be used at all times
+  !*****************************************************************************
+
+    do jy=0,nymin1
+      do ix=0,nxmin1
+        if (ps(ix,jy,1,n).gt.100000.) then
+          ixm=ix
+          jym=jy
+          goto 3
+        endif
+      end do
+    end do
+3   continue
+
+
+    tvold=tt2(ixm,jym,1,n)*(1.+0.378*ew(td2(ixm,jym,1,n))/ &
+    ps(ixm,jym,1,n))
+    pold=ps(ixm,jym,1,n)
+    height(1)=0.
+
+    do kz=2,nuvz
+      pint=akz(kz)+bkz(kz)*ps(ixm,jym,1,n)
+      tv=tth(ixm,jym,kz,n)*(1.+0.608*qvh(ixm,jym,kz,n))
+
+      if (abs(tv-tvold).gt.0.2) then
+        height(kz)=height(kz-1)+const*log(pold/pint)* &
+        (tv-tvold)/log(tv/tvold)
+      else
+        height(kz)=height(kz-1)+const*log(pold/pint)*tv
+      endif
+
+      tvold=tv
+      pold=pint
+    end do
+
+
+  ! Determine highest levels that can be within PBL
+  !************************************************
+
+    do kz=1,nz
+      if (height(kz).gt.hmixmax) then
+        nmixz=kz
+        goto 9
+      endif
+    end do
+9   continue
+
+  ! Do not repeat initialization of the Cartesian z grid
+  !*****************************************************
+
+    init=.false.
+
+  endif
+
+
+  ! Loop over the whole grid
+  !*************************
+
+  do jy=0,nymin1
+    do ix=0,nxmin1
+
+  ! NCEP version: find first level above ground
+      llev = 0
+      do i=1,nuvz
+        if (ps(ix,jy,1,n).lt.akz(i)) llev=i
+      end do
+       llev = llev+1
+       if (llev.gt.nuvz-2) llev = nuvz-2
+  !     if (llev.eq.nuvz-2) write(*,*) 'verttransform
+  !    +WARNING: LLEV eq NUZV-2'
+  ! NCEP version
+
+
+  ! compute height of pressure levels above ground
+  !***********************************************
+
+      tvold=tth(ix,jy,llev,n)*(1.+0.608*qvh(ix,jy,llev,n))
+      pold=akz(llev)
+      wzlev(llev)=0.
+      uvwzlev(ix,jy,llev)=0.
+      rhoh(llev)=pold/(r_air*tvold)
+
+      do kz=llev+1,nuvz
+        pint=akz(kz)+bkz(kz)*ps(ix,jy,1,n)
+        tv=tth(ix,jy,kz,n)*(1.+0.608*qvh(ix,jy,kz,n))
+        rhoh(kz)=pint/(r_air*tv)
+
+        if (abs(tv-tvold).gt.0.2) then
+          uvwzlev(ix,jy,kz)=uvwzlev(ix,jy,kz-1)+const*log(pold/pint)* &
+          (tv-tvold)/log(tv/tvold)
+        else
+          uvwzlev(ix,jy,kz)=uvwzlev(ix,jy,kz-1)+const*log(pold/pint)*tv
+        endif
+        wzlev(kz)=uvwzlev(ix,jy,kz)
+
+        tvold=tv
+        pold=pint
+      end do
+
+  ! pinmconv=(h2-h1)/(p2-p1)
+
+      pinmconv(llev)=(uvwzlev(ix,jy,llev+1)-uvwzlev(ix,jy,llev))/ &
+           ((aknew(llev+1)+bknew(llev+1)*ps(ix,jy,1,n))- &
+           (aknew(llev)+bknew(llev)*ps(ix,jy,1,n)))
+      do kz=llev+1,nz-1
+        pinmconv(kz)=(uvwzlev(ix,jy,kz+1)-uvwzlev(ix,jy,kz-1))/ &
+             ((aknew(kz+1)+bknew(kz+1)*ps(ix,jy,1,n))- &
+             (aknew(kz-1)+bknew(kz-1)*ps(ix,jy,1,n)))
+      end do
+      pinmconv(nz)=(uvwzlev(ix,jy,nz)-uvwzlev(ix,jy,nz-1))/ &
+           ((aknew(nz)+bknew(nz)*ps(ix,jy,1,n))- &
+           (aknew(nz-1)+bknew(nz-1)*ps(ix,jy,1,n)))
+
+
+  ! Levels, where u,v,t and q are given
+  !************************************
+
+      uu(ix,jy,1,n)=uuh(ix,jy,llev)
+      vv(ix,jy,1,n)=vvh(ix,jy,llev)
+      tt(ix,jy,1,n)=tth(ix,jy,llev,n)
+      qv(ix,jy,1,n)=qvh(ix,jy,llev,n)
+      pv(ix,jy,1,n)=pvh(ix,jy,llev)
+      rho(ix,jy,1,n)=rhoh(llev)
+      pplev(ix,jy,1,n)=akz(llev)
+      uu(ix,jy,nz,n)=uuh(ix,jy,nuvz)
+      vv(ix,jy,nz,n)=vvh(ix,jy,nuvz)
+      tt(ix,jy,nz,n)=tth(ix,jy,nuvz,n)
+      qv(ix,jy,nz,n)=qvh(ix,jy,nuvz,n)
+      pv(ix,jy,nz,n)=pvh(ix,jy,nuvz)
+      rho(ix,jy,nz,n)=rhoh(nuvz)
+      pplev(ix,jy,nz,n)=akz(nuvz)
+      kmin=llev+1
+      do iz=2,nz-1
+        do kz=kmin,nuvz
+          if(height(iz).gt.uvwzlev(ix,jy,nuvz)) then
+            uu(ix,jy,iz,n)=uu(ix,jy,nz,n)
+            vv(ix,jy,iz,n)=vv(ix,jy,nz,n)
+            tt(ix,jy,iz,n)=tt(ix,jy,nz,n)
+            qv(ix,jy,iz,n)=qv(ix,jy,nz,n)
+            pv(ix,jy,iz,n)=pv(ix,jy,nz,n)
+            rho(ix,jy,iz,n)=rho(ix,jy,nz,n)
+            pplev(ix,jy,iz,n)=pplev(ix,jy,nz,n)
+            goto 30
+          endif
+          if ((height(iz).gt.uvwzlev(ix,jy,kz-1)).and. &
+          (height(iz).le.uvwzlev(ix,jy,kz))) then
+            dz1=height(iz)-uvwzlev(ix,jy,kz-1)
+            dz2=uvwzlev(ix,jy,kz)-height(iz)
+            dz=dz1+dz2
+            uu(ix,jy,iz,n)=(uuh(ix,jy,kz-1)*dz2+uuh(ix,jy,kz)*dz1)/dz
+            vv(ix,jy,iz,n)=(vvh(ix,jy,kz-1)*dz2+vvh(ix,jy,kz)*dz1)/dz
+            tt(ix,jy,iz,n)=(tth(ix,jy,kz-1,n)*dz2 &
+            +tth(ix,jy,kz,n)*dz1)/dz
+            qv(ix,jy,iz,n)=(qvh(ix,jy,kz-1,n)*dz2 &
+            +qvh(ix,jy,kz,n)*dz1)/dz
+            pv(ix,jy,iz,n)=(pvh(ix,jy,kz-1)*dz2+pvh(ix,jy,kz)*dz1)/dz
+            rho(ix,jy,iz,n)=(rhoh(kz-1)*dz2+rhoh(kz)*dz1)/dz
+            pplev(ix,jy,iz,n)=(akz(kz-1)*dz2+akz(kz)*dz1)/dz
+          endif
+        end do
+30      continue
+      end do
+
+
+  ! Levels, where w is given
+  !*************************
+
+      ww(ix,jy,1,n)=wwh(ix,jy,llev)*pinmconv(llev)
+      ww(ix,jy,nz,n)=wwh(ix,jy,nwz)*pinmconv(nz)
+      kmin=llev+1
+      do iz=2,nz
+        do kz=kmin,nwz
+          if ((height(iz).gt.wzlev(kz-1)).and. &
+          (height(iz).le.wzlev(kz))) then
+            dz1=height(iz)-wzlev(kz-1)
+            dz2=wzlev(kz)-height(iz)
+            dz=dz1+dz2
+            ww(ix,jy,iz,n)=(wwh(ix,jy,kz-1)*pinmconv(kz-1)*dz2 &
+            +wwh(ix,jy,kz)*pinmconv(kz)*dz1)/dz
+          endif
+        end do
+      end do
+
+
+  ! Compute density gradients at intermediate levels
+  !*************************************************
+
+      drhodz(ix,jy,1,n)=(rho(ix,jy,2,n)-rho(ix,jy,1,n))/ &
+           (height(2)-height(1))
+      do kz=2,nz-1
+        drhodz(ix,jy,kz,n)=(rho(ix,jy,kz+1,n)-rho(ix,jy,kz-1,n))/ &
+        (height(kz+1)-height(kz-1))
+      end do
+      drhodz(ix,jy,nz,n)=drhodz(ix,jy,nz-1,n)
+
+    end do
+  end do
+
+
+  !****************************************************************
+  ! Compute slope of eta levels in windward direction and resulting
+  ! vertical wind correction
+  !****************************************************************
+
+  do jy=1,ny-2
+    cosf=cos((real(jy)*dy+ylat0)*pi180)
+    do ix=1,nx-2
+
+  ! NCEP version: find first level above ground
+      llev = 0
+      do i=1,nuvz
+       if (ps(ix,jy,1,n).lt.akz(i)) llev=i
+      end do
+       llev = llev+1
+       if (llev.gt.nuvz-2) llev = nuvz-2
+  !     if (llev.eq.nuvz-2) write(*,*) 'verttransform
+  !    +WARNING: LLEV eq NUZV-2'
+  ! NCEP version
+
+      kmin=llev+1
+      do iz=2,nz-1
+
+        ui=uu(ix,jy,iz,n)*dxconst/cosf
+        vi=vv(ix,jy,iz,n)*dyconst
+
+        do kz=kmin,nz
+          if ((height(iz).gt.uvwzlev(ix,jy,kz-1)).and. &
+          (height(iz).le.uvwzlev(ix,jy,kz))) then
+            dz1=height(iz)-uvwzlev(ix,jy,kz-1)
+            dz2=uvwzlev(ix,jy,kz)-height(iz)
+            dz=dz1+dz2
+            kl=kz-1
+            klp=kz
+            goto 47
+          endif
+        end do
+
+47      ix1=ix-1
+        jy1=jy-1
+        ixp=ix+1
+        jyp=jy+1
+
+        dzdx1=(uvwzlev(ixp,jy,kl)-uvwzlev(ix1,jy,kl))/2.
+        dzdx2=(uvwzlev(ixp,jy,klp)-uvwzlev(ix1,jy,klp))/2.
+        dzdx=(dzdx1*dz2+dzdx2*dz1)/dz
+
+        dzdy1=(uvwzlev(ix,jyp,kl)-uvwzlev(ix,jy1,kl))/2.
+        dzdy2=(uvwzlev(ix,jyp,klp)-uvwzlev(ix,jy1,klp))/2.
+        dzdy=(dzdy1*dz2+dzdy2*dz1)/dz
+
+        ww(ix,jy,iz,n)=ww(ix,jy,iz,n)+(dzdx*ui+dzdy*vi)
+
+      end do
+
+    end do
+  end do
+
+
+  ! If north pole is in the domain, calculate wind velocities in polar
+  ! stereographic coordinates
+  !*******************************************************************
+
+  if (nglobal) then
+    do jy=int(switchnorthg)-2,nymin1
+      ylat=ylat0+real(jy)*dy
+      do ix=0,nxmin1
+        xlon=xlon0+real(ix)*dx
+        do iz=1,nz
+          call cc2gll(northpolemap,ylat,xlon,uu(ix,jy,iz,n), &
+               vv(ix,jy,iz,n),uupol(ix,jy,iz,n), &
+               vvpol(ix,jy,iz,n))
+        end do
+      end do
+    end do
+
+
+    do iz=1,nz
+
+  ! CALCULATE FFPOL, DDPOL FOR CENTRAL GRID POINT
+      xlon=xlon0+real(nx/2-1)*dx
+      xlonr=xlon*pi/180.
+      ffpol=sqrt(uu(nx/2-1,nymin1,iz,n)**2+vv(nx/2-1,nymin1,iz,n)**2)
+      if (vv(nx/2-1,nymin1,iz,n).lt.0.) then
+        ddpol=atan(uu(nx/2-1,nymin1,iz,n)/vv(nx/2-1,nymin1,iz,n))-xlonr
+      elseif (vv(nx/2-1,nymin1,iz,n).gt.0.) then
+        ddpol=pi+atan(uu(nx/2-1,nymin1,iz,n)/ &
+        vv(nx/2-1,nymin1,iz,n))-xlonr
+      else
+        ddpol=pi/2-xlonr
+      endif
+      if(ddpol.lt.0.) ddpol=2.0*pi+ddpol
+      if(ddpol.gt.2.0*pi) ddpol=ddpol-2.0*pi
+
+  ! CALCULATE U,V FOR 180 DEG, TRANSFORM TO POLAR STEREOGRAPHIC GRID
+      xlon=180.0
+      xlonr=xlon*pi/180.
+      ylat=90.0
+      uuaux=-ffpol*sin(xlonr+ddpol)
+      vvaux=-ffpol*cos(xlonr+ddpol)
+      call cc2gll(northpolemap,ylat,xlon,uuaux,vvaux,uupolaux,vvpolaux)
+      jy=nymin1
+      do ix=0,nxmin1
+        uupol(ix,jy,iz,n)=uupolaux
+        vvpol(ix,jy,iz,n)=vvpolaux
+      end do
+    end do
+
+
+  ! Fix: Set W at pole to the zonally averaged W of the next equator-
+  ! ward parallel of latitude
+
+    do iz=1,nz
+      wdummy=0.
+      jy=ny-2
+      do ix=0,nxmin1
+        wdummy=wdummy+ww(ix,jy,iz,n)
+      end do
+      wdummy=wdummy/real(nx)
+      jy=nymin1
+      do ix=0,nxmin1
+        ww(ix,jy,iz,n)=wdummy
+      end do
+    end do
+
+  endif
+
+
+  ! If south pole is in the domain, calculate wind velocities in polar
+  ! stereographic coordinates
+  !*******************************************************************
+
+  if (sglobal) then
+    do jy=0,int(switchsouthg)+3
+      ylat=ylat0+real(jy)*dy
+      do ix=0,nxmin1
+        xlon=xlon0+real(ix)*dx
+        do iz=1,nz
+          call cc2gll(southpolemap,ylat,xlon,uu(ix,jy,iz,n), &
+          vv(ix,jy,iz,n),uupol(ix,jy,iz,n),vvpol(ix,jy,iz,n))
+        end do
+      end do
+    end do
+
+    do iz=1,nz
+
+  ! CALCULATE FFPOL, DDPOL FOR CENTRAL GRID POINT
+      xlon=xlon0+real(nx/2-1)*dx
+      xlonr=xlon*pi/180.
+      ffpol=sqrt(uu(nx/2-1,0,iz,n)**2+vv(nx/2-1,0,iz,n)**2)
+      if(vv(nx/2-1,0,iz,n).lt.0.) then
+        ddpol=atan(uu(nx/2-1,0,iz,n)/vv(nx/2-1,0,iz,n))+xlonr
+      elseif (vv(nx/2-1,0,iz,n).gt.0.) then
+        ddpol=pi+atan(uu(nx/2-1,0,iz,n)/vv(nx/2-1,0,iz,n))-xlonr
+      else
+        ddpol=pi/2-xlonr
+      endif
+      if(ddpol.lt.0.) ddpol=2.0*pi+ddpol
+      if(ddpol.gt.2.0*pi) ddpol=ddpol-2.0*pi
+
+  ! CALCULATE U,V FOR 180 DEG, TRANSFORM TO POLAR STEREOGRAPHIC GRID
+      xlon=180.0
+      xlonr=xlon*pi/180.
+      ylat=-90.0
+      uuaux=+ffpol*sin(xlonr-ddpol)
+      vvaux=-ffpol*cos(xlonr-ddpol)
+      call cc2gll(northpolemap,ylat,xlon,uuaux,vvaux,uupolaux,vvpolaux)
+
+      jy=0
+      do ix=0,nxmin1
+        uupol(ix,jy,iz,n)=uupolaux
+        vvpol(ix,jy,iz,n)=vvpolaux
+      end do
+    end do
+
+
+  ! Fix: Set W at pole to the zonally averaged W of the next equator-
+  ! ward parallel of latitude
+
+    do iz=1,nz
+      wdummy=0.
+      jy=1
+      do ix=0,nxmin1
+        wdummy=wdummy+ww(ix,jy,iz,n)
+      end do
+      wdummy=wdummy/real(nx)
+      jy=0
+      do ix=0,nxmin1
+        ww(ix,jy,iz,n)=wdummy
+      end do
+    end do
+  endif
+
+
+  !   write (*,*) 'initializing clouds, n:',n,nymin1,nxmin1,nz
+  !   create a cloud and rainout/washout field, clouds occur where rh>80%
+  !   total cloudheight is stored at level 0
+  do jy=0,nymin1
+    do ix=0,nxmin1
+      rain_cloud_above=0
+      lsp=lsprec(ix,jy,1,n)
+      convp=convprec(ix,jy,1,n)
+      cloudsh(ix,jy,n)=0
+      do kz_inv=1,nz-1
+         kz=nz-kz_inv+1
+         pressure=rho(ix,jy,kz,n)*r_air*tt(ix,jy,kz,n)
+         rh=qv(ix,jy,kz,n)/f_qvsat(pressure,tt(ix,jy,kz,n))
+         clouds(ix,jy,kz,n)=0
+         if (rh.gt.0.8) then ! in cloud
+           if ((lsp.gt.0.01).or.(convp.gt.0.01)) then ! cloud and precipitation
+              rain_cloud_above=1
+              cloudsh(ix,jy,n)=cloudsh(ix,jy,n)+height(kz)-height(kz-1)
+              if (lsp.ge.convp) then
+                 clouds(ix,jy,kz,n)=3 ! lsp dominated rainout
+              else
+                 clouds(ix,jy,kz,n)=2 ! convp dominated rainout
+              endif
+           else ! no precipitation
+             clouds(ix,jy,kz,n)=1 ! cloud
+           endif
+         else ! no cloud
+           if (rain_cloud_above.eq.1) then ! scavenging
+             if (lsp.ge.convp) then
+               clouds(ix,jy,kz,n)=5 ! lsp dominated washout
+             else
+               clouds(ix,jy,kz,n)=4 ! convp dominated washout
+             endif
+           endif
+         endif
+      end do
+    end do
+  end do
+
+
+end subroutine verttransform
Index: /branches/FP_AI/src/verttransform_nests.f90
===================================================================
--- /branches/FP_AI/src/verttransform_nests.f90	(revision 23)
+++ /branches/FP_AI/src/verttransform_nests.f90	(revision 23)
@@ -0,0 +1,323 @@
+!**********************************************************************
+! 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 verttransform_nests(n,uuhn,vvhn,wwhn,pvhn)
+  !                            i   i    i    i   i
+  !*****************************************************************************
+  !                                                                            *
+  !     This subroutine transforms temperature, dew point temperature and      *
+  !     wind components from eta to meter coordinates.                         *
+  !     The vertical wind component is transformed from Pa/s to m/s using      *
+  !     the conversion factor pinmconv.                                        *
+  !     In addition, this routine calculates vertical density gradients        *
+  !     needed for the parameterization of the turbulent velocities.           *
+  !     It is similar to verttransform, but makes the transformations for      *
+  !     the nested grids.                                                      *
+  !                                                                            *
+  !     Author: A. Stohl, G. Wotawa                                            *
+  !                                                                            *
+  !     12 August 1996                                                         *
+  !     Update: 16 January 1998                                                *
+  !                                                                            *
+  !     Major update: 17 February 1999                                         *
+  !     by G. Wotawa                                                           *
+  !                                                                            *
+  !     - Vertical levels for u, v and w are put together                      *
+  !     - Slope correction for vertical velocity: Modification of calculation  *
+  !       procedure                                                            *
+  !                                                                            *
+  !*****************************************************************************
+  !  Changes, Bernd C. Krueger, Feb. 2001:       (marked "C-cv")
+  !   Variables tthn and qvhn (on eta coordinates) from common block
+  !*****************************************************************************
+  ! Sabine Eckhardt, March 2007
+  ! add the variable cloud for use with scavenging - descr. in com_mod
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! nxn,nyn,nuvz,nwz                field dimensions in x,y and z direction    *
+  ! uun                             wind components in x-direction [m/s]       *
+  ! vvn                             wind components in y-direction [m/s]       *
+  ! wwn                             wind components in z-direction [deltaeta/s]*
+  ! ttn                             temperature [K]                            *
+  ! pvn                             potential vorticity (pvu)                  *
+  ! psn                             surface pressure [Pa]                      *
+  !                                                                            *
+  !*****************************************************************************
+
+  use par_mod
+  use com_mod
+
+  implicit none
+
+  integer :: ix,jy,kz,iz,n,l,kmin,kl,klp,ix1,jy1,ixp,jyp
+  integer :: rain_cloud_above,kz_inv
+  real :: f_qvsat,pressure,rh,lsp,convp
+  real :: wzlev(nwzmax),rhoh(nuvzmax),pinmconv(nzmax)
+  real :: uvwzlev(0:nxmaxn-1,0:nymaxn-1,nzmax)
+  real :: ew,pint,tv,tvold,pold,dz1,dz2,dz,ui,vi,cosf
+  real :: dzdx,dzdy
+  real :: dzdx1,dzdx2,dzdy1,dzdy2
+  real :: uuhn(0:nxmaxn-1,0:nymaxn-1,nuvzmax,maxnests)
+  real :: vvhn(0:nxmaxn-1,0:nymaxn-1,nuvzmax,maxnests)
+  real :: pvhn(0:nxmaxn-1,0:nymaxn-1,nuvzmax,maxnests)
+  real :: wwhn(0:nxmaxn-1,0:nymaxn-1,nwzmax,maxnests)
+  real,parameter :: const=r_air/ga
+
+
+  ! Loop over all nests
+  !********************
+
+  do l=1,numbnests
+
+  ! Loop over the whole grid
+  !*************************
+
+  do jy=0,nyn(l)-1
+    do ix=0,nxn(l)-1
+
+      tvold=tt2n(ix,jy,1,n,l)*(1.+0.378*ew(td2n(ix,jy,1,n,l))/ &
+      psn(ix,jy,1,n,l))
+      pold=psn(ix,jy,1,n,l)
+      uvwzlev(ix,jy,1)=0.
+      wzlev(1)=0.
+      rhoh(1)=pold/(r_air*tvold)
+
+
+  ! Compute heights of eta levels
+  !******************************
+
+      do kz=2,nuvz
+        pint=akz(kz)+bkz(kz)*psn(ix,jy,1,n,l)
+        tv=tthn(ix,jy,kz,n,l)*(1.+0.608*qvhn(ix,jy,kz,n,l))
+        rhoh(kz)=pint/(r_air*tv)
+
+        if (abs(tv-tvold).gt.0.2) then
+          uvwzlev(ix,jy,kz)=uvwzlev(ix,jy,kz-1)+const*log(pold/pint)* &
+          (tv-tvold)/log(tv/tvold)
+        else
+          uvwzlev(ix,jy,kz)=uvwzlev(ix,jy,kz-1)+const*log(pold/pint)*tv
+        endif
+
+        tvold=tv
+        pold=pint
+      end do
+
+
+      do kz=2,nwz-1
+        wzlev(kz)=(uvwzlev(ix,jy,kz+1)+uvwzlev(ix,jy,kz))/2.
+      end do
+      wzlev(nwz)=wzlev(nwz-1)+uvwzlev(ix,jy,nuvz)-uvwzlev(ix,jy,nuvz-1)
+
+  ! pinmconv=(h2-h1)/(p2-p1)
+
+      pinmconv(1)=(uvwzlev(ix,jy,2)-uvwzlev(ix,jy,1))/ &
+      ((aknew(2)+bknew(2)*psn(ix,jy,1,n,l))- &
+      (aknew(1)+bknew(1)*psn(ix,jy,1,n,l)))
+      do kz=2,nz-1
+        pinmconv(kz)=(uvwzlev(ix,jy,kz+1)-uvwzlev(ix,jy,kz-1))/ &
+        ((aknew(kz+1)+bknew(kz+1)*psn(ix,jy,1,n,l))- &
+        (aknew(kz-1)+bknew(kz-1)*psn(ix,jy,1,n,l)))
+      end do
+      pinmconv(nz)=(uvwzlev(ix,jy,nz)-uvwzlev(ix,jy,nz-1))/ &
+      ((aknew(nz)+bknew(nz)*psn(ix,jy,1,n,l))- &
+      (aknew(nz-1)+bknew(nz-1)*psn(ix,jy,1,n,l)))
+
+
+  ! Levels, where u,v,t and q are given
+  !************************************
+
+      uun(ix,jy,1,n,l)=uuhn(ix,jy,1,l)
+      vvn(ix,jy,1,n,l)=vvhn(ix,jy,1,l)
+      ttn(ix,jy,1,n,l)=tthn(ix,jy,1,n,l)
+      qvn(ix,jy,1,n,l)=qvhn(ix,jy,1,n,l)
+      pvn(ix,jy,1,n,l)=pvhn(ix,jy,1,l)
+      rhon(ix,jy,1,n,l)=rhoh(1)
+      uun(ix,jy,nz,n,l)=uuhn(ix,jy,nuvz,l)
+      vvn(ix,jy,nz,n,l)=vvhn(ix,jy,nuvz,l)
+      ttn(ix,jy,nz,n,l)=tthn(ix,jy,nuvz,n,l)
+      qvn(ix,jy,nz,n,l)=qvhn(ix,jy,nuvz,n,l)
+      pvn(ix,jy,nz,n,l)=pvhn(ix,jy,nuvz,l)
+      rhon(ix,jy,nz,n,l)=rhoh(nuvz)
+      kmin=2
+      do iz=2,nz-1
+        do kz=kmin,nuvz
+          if(height(iz).gt.uvwzlev(ix,jy,nuvz)) then
+            uun(ix,jy,iz,n,l)=uun(ix,jy,nz,n,l)
+            vvn(ix,jy,iz,n,l)=vvn(ix,jy,nz,n,l)
+            ttn(ix,jy,iz,n,l)=ttn(ix,jy,nz,n,l)
+            qvn(ix,jy,iz,n,l)=qvn(ix,jy,nz,n,l)
+            pvn(ix,jy,iz,n,l)=pvn(ix,jy,nz,n,l)
+            rhon(ix,jy,iz,n,l)=rhon(ix,jy,nz,n,l)
+            goto 30
+          endif
+          if ((height(iz).gt.uvwzlev(ix,jy,kz-1)).and. &
+          (height(iz).le.uvwzlev(ix,jy,kz))) then
+           dz1=height(iz)-uvwzlev(ix,jy,kz-1)
+           dz2=uvwzlev(ix,jy,kz)-height(iz)
+           dz=dz1+dz2
+           uun(ix,jy,iz,n,l)=(uuhn(ix,jy,kz-1,l)*dz2+ &
+           uuhn(ix,jy,kz,l)*dz1)/dz
+           vvn(ix,jy,iz,n,l)=(vvhn(ix,jy,kz-1,l)*dz2+ &
+           vvhn(ix,jy,kz,l)*dz1)/dz
+           ttn(ix,jy,iz,n,l)=(tthn(ix,jy,kz-1,n,l)*dz2+ &
+           tthn(ix,jy,kz,n,l)*dz1)/dz
+           qvn(ix,jy,iz,n,l)=(qvhn(ix,jy,kz-1,n,l)*dz2+ &
+           qvhn(ix,jy,kz,n,l)*dz1)/dz
+           pvn(ix,jy,iz,n,l)=(pvhn(ix,jy,kz-1,l)*dz2+ &
+           pvhn(ix,jy,kz,l)*dz1)/dz
+           rhon(ix,jy,iz,n,l)=(rhoh(kz-1)*dz2+rhoh(kz)*dz1)/dz
+           kmin=kz
+           goto 30
+          endif
+        end do
+30      continue
+      end do
+
+
+  ! Levels, where w is given
+  !*************************
+
+      wwn(ix,jy,1,n,l)=wwhn(ix,jy,1,l)*pinmconv(1)
+      wwn(ix,jy,nz,n,l)=wwhn(ix,jy,nwz,l)*pinmconv(nz)
+      kmin=2
+      do iz=2,nz
+        do kz=kmin,nwz
+          if ((height(iz).gt.wzlev(kz-1)).and. &
+          (height(iz).le.wzlev(kz))) then
+            dz1=height(iz)-wzlev(kz-1)
+            dz2=wzlev(kz)-height(iz)
+            dz=dz1+dz2
+            wwn(ix,jy,iz,n,l)=(wwhn(ix,jy,kz-1,l)*pinmconv(kz-1)*dz2 &
+            +wwhn(ix,jy,kz,l)*pinmconv(kz)*dz1)/dz
+            kmin=kz
+            goto 40
+          endif
+        end do
+40      continue
+      end do
+
+  ! Compute density gradients at intermediate levels
+  !*************************************************
+
+      drhodzn(ix,jy,1,n,l)=(rhon(ix,jy,2,n,l)-rhon(ix,jy,1,n,l))/ &
+      (height(2)-height(1))
+      do kz=2,nz-1
+        drhodzn(ix,jy,kz,n,l)=(rhon(ix,jy,kz+1,n,l)- &
+        rhon(ix,jy,kz-1,n,l))/(height(kz+1)-height(kz-1))
+      end do
+      drhodzn(ix,jy,nz,n,l)=drhodzn(ix,jy,nz-1,n,l)
+
+    end do
+  end do
+
+
+  !****************************************************************
+  ! Compute slope of eta levels in windward direction and resulting
+  ! vertical wind correction
+  !****************************************************************
+
+  do jy=1,nyn(l)-2
+    cosf=cos((real(jy)*dyn(l)+ylat0n(l))*pi180)
+    do ix=1,nxn(l)-2
+
+      kmin=2
+      do iz=2,nz-1
+
+        ui=uun(ix,jy,iz,n,l)*dxconst*xresoln(l)/cosf
+        vi=vvn(ix,jy,iz,n,l)*dyconst*yresoln(l)
+
+        do kz=kmin,nz
+          if ((height(iz).gt.uvwzlev(ix,jy,kz-1)).and. &
+               (height(iz).le.uvwzlev(ix,jy,kz))) then
+            dz1=height(iz)-uvwzlev(ix,jy,kz-1)
+            dz2=uvwzlev(ix,jy,kz)-height(iz)
+            dz=dz1+dz2
+            kl=kz-1
+            klp=kz
+            kmin=kz
+            goto 47
+          endif
+        end do
+
+47      ix1=ix-1
+        jy1=jy-1
+        ixp=ix+1
+        jyp=jy+1
+
+        dzdx1=(uvwzlev(ixp,jy,kl)-uvwzlev(ix1,jy,kl))/2.
+        dzdx2=(uvwzlev(ixp,jy,klp)-uvwzlev(ix1,jy,klp))/2.
+        dzdx=(dzdx1*dz2+dzdx2*dz1)/dz
+
+        dzdy1=(uvwzlev(ix,jyp,kl)-uvwzlev(ix,jy1,kl))/2.
+        dzdy2=(uvwzlev(ix,jyp,klp)-uvwzlev(ix,jy1,klp))/2.
+        dzdy=(dzdy1*dz2+dzdy2*dz1)/dz
+
+        wwn(ix,jy,iz,n,l)=wwn(ix,jy,iz,n,l)+(dzdx*ui+dzdy*vi)
+
+      end do
+
+    end do
+  end do
+
+
+  !write (*,*) 'initializing nested cloudsn, n:',n
+  !   create a cloud and rainout/washout field, cloudsn occur where rh>80%
+  do jy=0,nyn(l)-1
+    do ix=0,nxn(l)-1
+      rain_cloud_above=0
+      lsp=lsprecn(ix,jy,1,n,l)
+      convp=convprecn(ix,jy,1,n,l)
+      cloudsnh(ix,jy,n,l)=0
+      do kz_inv=1,nz-1
+         kz=nz-kz_inv+1
+         pressure=rhon(ix,jy,kz,n,l)*r_air*ttn(ix,jy,kz,n,l)
+         rh=qvn(ix,jy,kz,n,l)/f_qvsat(pressure,ttn(ix,jy,kz,n,l))
+         cloudsn(ix,jy,kz,n,l)=0
+         if (rh.gt.0.8) then ! in cloud
+            if ((lsp.gt.0.01).or.(convp.gt.0.01)) then
+               rain_cloud_above=1
+               cloudsnh(ix,jy,n,l)=cloudsnh(ix,jy,n,l)+ &
+               height(kz)-height(kz-1)
+               if (lsp.ge.convp) then
+                  cloudsn(ix,jy,kz,n,l)=3 ! lsp dominated rainout
+               else
+                  cloudsn(ix,jy,kz,n,l)=2 ! convp dominated rainout
+               endif
+            else ! no precipitation
+                  cloudsn(ix,jy,kz,n,l)=1 ! cloud
+            endif
+         else ! no cloud
+            if (rain_cloud_above.eq.1) then ! scavenging
+               if (lsp.ge.convp) then
+                  cloudsn(ix,jy,kz,n,l)=5 ! lsp dominated washout
+               else
+                  cloudsn(ix,jy,kz,n,l)=4 ! convp dominated washout
+               endif
+            endif
+         endif
+      end do
+    end do
+  end do
+
+  end do
+
+end subroutine verttransform_nests
Index: /branches/FP_AI/src/wetdepo.f90
===================================================================
--- /branches/FP_AI/src/wetdepo.f90	(revision 23)
+++ /branches/FP_AI/src/wetdepo.f90	(revision 23)
@@ -0,0 +1,329 @@
+!**********************************************************************
+! 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 wetdepo(itime,ltsample,loutnext)
+  !                  i      i        i
+  !*****************************************************************************
+  !                                                                            *
+  ! Calculation of wet deposition using the concept of scavenging coefficients.*
+  ! For lack of detailed information, washout and rainout are jointly treated. *
+  ! It is assumed that precipitation does not occur uniformly within the whole *
+  ! grid cell, but that only a fraction of the grid cell experiences rainfall. *
+  ! This fraction is parameterized from total cloud cover and rates of large   *
+  ! scale and convective precipitation.                                        *
+  !                                                                            *
+  !    Author: A. Stohl                                                        *
+  !                                                                            *
+  !    1 December 1996                                                         *
+  !                                                                            *
+  ! Correction by Petra Seibert, Sept 2002:                                    *
+  ! use centred precipitation data for integration                             *
+  ! Code may not be correct for decay of deposition!                           *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! cc [0-1]           total cloud cover                                       *
+  ! convp [mm/h]       convective precipitation rate                           *
+  ! grfraction [0-1]   fraction of grid, for which precipitation occurs        *
+  ! ix,jy              indices of output grid cell for each particle           *
+  ! itime [s]          actual simulation time [s]                              *
+  ! jpart              particle index                                          *
+  ! ldeltat [s]        interval since radioactive decay was computed           *
+  ! lfr, cfr           area fraction covered by precipitation for large scale  *
+  !                    and convective precipitation (dependent on prec. rate)  *
+  ! loutnext [s]       time for which gridded deposition is next output        *
+  ! loutstep [s]       interval at which gridded deposition is output          *
+  ! lsp [mm/h]         large scale precipitation rate                          *
+  ! ltsample [s]       interval over which mass is deposited                   *
+  ! prec [mm/h]        precipitation rate in subgrid, where precipitation occurs*
+  ! wetdeposit         mass that is wet deposited                              *
+  ! wetgrid            accumulated deposited mass on output grid               *
+  ! wetscav            scavenging coefficient                                  *
+  !                                                                            *
+  ! Constants:                                                                 *
+  !                                                                            *
+  !*****************************************************************************
+
+  use point_mod
+  use par_mod
+  use com_mod
+
+  implicit none
+
+  integer :: jpart,itime,ltsample,loutnext,ldeltat,i,j,ix,jy
+  integer :: ngrid,itage,nage,hz,il,interp_time, n, clouds_v
+  integer :: ks, kp
+  real :: S_i, act_temp, cl, cle ! in cloud scavenging
+  real :: clouds_h ! cloud height for the specific grid point
+  real :: xtn,ytn,lsp,convp,cc,grfraction,prec,wetscav
+  real :: wetdeposit(maxspec),restmass
+  real,parameter :: smallnum = tiny(0.0) ! smallest number that can be handled
+  save lfr,cfr
+
+
+  real :: lfr(5) = (/ 0.5,0.65,0.8,0.9,0.95/)
+  real :: cfr(5) = (/ 0.4,0.55,0.7,0.8,0.9 /)
+
+  ! Compute interval since radioactive decay of deposited mass was computed
+  !************************************************************************
+
+  if (itime.le.loutnext) then
+    ldeltat=itime-(loutnext-loutstep)
+  else                                  ! first half of next interval
+    ldeltat=itime-loutnext
+  endif
+
+
+  ! Loop over all particles
+  !************************
+
+  do jpart=1,numpart
+
+    if (itra1(jpart).eq.-999999999) goto 20
+    if(ldirect.eq.1)then
+      if (itra1(jpart).gt.itime) goto 20
+    else
+      if (itra1(jpart).lt.itime) goto 20
+    endif
+  ! Determine age class of the particle
+    itage=abs(itra1(jpart)-itramem(jpart))
+    do nage=1,nageclass
+      if (itage.lt.lage(nage)) goto 33
+    end do
+33  continue
+
+
+  ! Determine which nesting level to be used
+  !*****************************************
+
+    ngrid=0
+    do j=numbnests,1,-1
+      if ((xtra1(jpart).gt.xln(j)).and.(xtra1(jpart).lt.xrn(j)).and. &
+      (ytra1(jpart).gt.yln(j)).and.(ytra1(jpart).lt.yrn(j))) then
+        ngrid=j
+        goto 23
+      endif
+    end do
+23  continue
+
+
+  ! Determine nested grid coordinates
+  !**********************************
+
+    if (ngrid.gt.0) then
+      xtn=(xtra1(jpart)-xln(ngrid))*xresoln(ngrid)
+      ytn=(ytra1(jpart)-yln(ngrid))*yresoln(ngrid)
+      ix=int(xtn)
+      jy=int(ytn)
+    else
+      ix=int(xtra1(jpart))
+      jy=int(ytra1(jpart))
+    endif
+
+
+  ! Interpolate large scale precipitation, convective precipitation and
+  ! total cloud cover
+  ! Note that interpolated time refers to itime-0.5*ltsample [PS]
+  !********************************************************************
+    interp_time=nint(itime-0.5*ltsample)
+
+    if (ngrid.eq.0) then
+      call interpol_rain(lsprec,convprec,tcc,nxmax,nymax, &
+      1,nx,ny,memind,real(xtra1(jpart)),real(ytra1(jpart)),1, &
+      memtime(1),memtime(2),interp_time,lsp,convp,cc)
+    else
+      call interpol_rain_nests(lsprecn,convprecn,tccn, &
+      nxmaxn,nymaxn,1,maxnests,ngrid,nxn,nyn,memind,xtn,ytn,1, &
+      memtime(1),memtime(2),interp_time,lsp,convp,cc)
+    endif
+
+    if ((lsp.lt.0.01).and.(convp.lt.0.01)) goto 20
+  ! get the level were the actual particle is in
+    do il=2,nz
+      if (height(il).gt.ztra1(jpart)) then
+        hz=il-1
+        goto 26
+      endif
+    end do
+26  continue
+
+    n=memind(2)
+    if (abs(memtime(1)-interp_time).lt.abs(memtime(2)-interp_time)) &
+    n=memind(1)
+
+  ! if there is no precipitation or the particle is above the clouds no
+  ! scavenging is done
+
+    if (ngrid.eq.0) then
+      clouds_v=clouds(ix,jy,hz,n)
+      clouds_h=cloudsh(ix,jy,n)
+    else
+      clouds_v=cloudsn(ix,jy,hz,n,ngrid)
+      clouds_h=cloudsnh(ix,jy,n,ngrid)
+    endif
+  !write(*,*) 'there is
+  !    + precipitation',(clouds(ix,jy,ihz,n),ihz=1,20),lsp,convp,hz
+    if (clouds_v.le.1) goto 20
+  !write (*,*) 'there is scavenging'
+
+  ! 1) Parameterization of the the area fraction of the grid cell where the
+  !    precipitation occurs: the absolute limit is the total cloud cover, but
+  !    for low precipitation rates, an even smaller fraction of the grid cell
+  !    is used. Large scale precipitation occurs over larger areas than
+  !    convective precipitation.
+  !**************************************************************************
+
+    if (lsp.gt.20.) then
+      i=5
+    else if (lsp.gt.8.) then
+      i=4
+    else if (lsp.gt.3.) then
+      i=3
+    else if (lsp.gt.1.) then
+      i=2
+    else
+      i=1
+    endif
+
+    if (convp.gt.20.) then
+      j=5
+    else if (convp.gt.8.) then
+      j=4
+    else if (convp.gt.3.) then
+      j=3
+    else if (convp.gt.1.) then
+      j=2
+    else
+      j=1
+    endif
+
+    grfraction=max(0.05,cc*(lsp*lfr(i)+convp*cfr(j))/(lsp+convp))
+
+  ! 2) Computation of precipitation rate in sub-grid cell
+  !******************************************************
+
+    prec=(lsp+convp)/grfraction
+
+  ! 3) Computation of scavenging coefficients for all species
+  !    Computation of wet deposition
+  !**********************************************************
+
+    do ks=1,nspec      ! loop over species
+      wetdeposit(ks)=0. 
+      wetscav=0.   
+
+  ! NIK 09.12.13: allowed to turn off either below cloud or in-cloud by including TWO separate blocks of if tests
+
+
+  !****i*******************
+  ! BELOW CLOUD SCAVENGING
+  !***********************  
+      if (weta(ks).gt.0. .and. clouds_v.ge.4) then !if positive below-cloud coefficient given in SPECIES file, and if in below cloud regime
+ !       for aerosols and not highliy soluble substances weta=5E-6
+        wetscav=weta(ks)*prec**wetb(ks)  ! scavenging coefficient 
+      endif !end below-cloud
+
+
+  !********************
+  ! IN CLOUD SCAVENGING
+  !********************
+      if (weta_in(ks).gt.0. .and. clouds_v.lt.4) then !if positive in-cloud coefficient given in SPECIES file, and if in in-cloud regime
+
+        if (ngrid.gt.0) then
+          act_temp=ttn(ix,jy,hz,n,ngrid)
+        else
+          act_temp=tt(ix,jy,hz,n)
+        endif
+
+! NIK 31.01.2013: SPECIES defined parameters for the in-cloud scavening 
+! weta_in=2.0E-07 (default)
+! wetb_in=0.36 (default)
+! wetc_in=0.9 (default)
+! wetd_in: Scaling factor for the total in-cloud scavenging (default 1.0-no scaling)
+        cl=weta_in(ks)*prec**wetb_in(ks)
+        if (dquer(ks).gt.0) then ! is particle
+          S_i=wetc_in(ks)/cl
+        else ! is gas
+          cle=(1-cl)/(henry(ks)*(r_air/3500.)*act_temp)+cl
+          S_i=1/cle
+        endif
+        wetscav=S_i*prec/3.6E6/clouds_h/wetd_in(ks)
+  !     write(*,*) 'in. wetscav:'
+  !     +  ,wetscav,cle,cl,act_temp,prec,clouds_h
+       
+      endif ! end in-cloud
+
+
+      
+  !**************************************************
+  ! CALCULATE DEPOSITION 
+  !**************************************************
+  !     if (wetscav.le.0) write (*,*) 'neg, or 0 wetscav!'
+  !     +          ,wetscav,cle,cl,act_temp,prec,clouds_h,clouds_v
+
+      if (wetscav.gt.0.) then
+        wetdeposit(ks)=xmass1(jpart,ks)* &
+        (1.-exp(-wetscav*abs(ltsample)))*grfraction  ! wet deposition
+      else ! if no scavenging
+        wetdeposit(ks)=0.
+      endif
+
+
+      restmass = xmass1(jpart,ks)-wetdeposit(ks)
+      if (ioutputforeachrelease.eq.1) then
+        kp=npoint(jpart)
+      else
+        kp=1
+      endif
+      if (restmass .gt. smallnum) then
+        xmass1(jpart,ks)=restmass
+  !   depostatistic
+  !   wetdepo_sum(ks,kp)=wetdepo_sum(ks,kp)+wetdeposit(ks)
+  !   depostatistic
+      else
+        xmass1(jpart,ks)=0.
+      endif
+  !   Correct deposited mass to the last time step when radioactive decay of
+  !   gridded deposited mass was calculated
+      if (decay(ks).gt.0.) then
+        wetdeposit(ks)=wetdeposit(ks)*exp(abs(ldeltat)*decay(ks))
+      endif
+
+
+
+    end do !all species
+
+  ! Sabine Eckhardt, June 2008 create deposition runs only for forward runs
+  ! Add the wet deposition to accumulated amount on output grid and nested output grid
+  !*****************************************************************************
+
+    if (ldirect.eq.1) then
+      call wetdepokernel(nclass(jpart),wetdeposit,real(xtra1(jpart)), &
+      real(ytra1(jpart)),nage,kp)
+      if (nested_output.eq.1) call wetdepokernel_nest(nclass(jpart), &
+        wetdeposit,real(xtra1(jpart)),real(ytra1(jpart)),nage,kp)
+    endif
+
+20  continue
+  end do ! all particles
+
+end subroutine wetdepo
Index: /branches/FP_AI/src/wetdepokernel.f90
===================================================================
--- /branches/FP_AI/src/wetdepokernel.f90	(revision 23)
+++ /branches/FP_AI/src/wetdepokernel.f90	(revision 23)
@@ -0,0 +1,110 @@
+!**********************************************************************
+! 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 wetdepokernel(nunc,deposit,x,y,nage,kp)
+  !                          i      i    i i  i
+  !*****************************************************************************
+  !                                                                            *
+  !     Attribution of the deposition from an individual particle to the       *
+  !     deposition fields using a uniform kernel with bandwidths dxout and dyout.*
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     26 December 1996                                                       *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  !                                                                            *
+  ! nunc             uncertainty class of the respective particle              *
+  ! nage             age class of the respective particle                      *
+  ! deposit          amount (kg) to be deposited                               *
+  !                                                                            *
+  !*****************************************************************************
+
+  use unc_mod
+  use par_mod
+  use com_mod
+
+  implicit none
+
+  real :: x,y,deposit(maxspec),ddx,ddy,xl,yl,wx,wy,w
+  integer :: ix,jy,ixp,jyp,nunc,nage,ks,kp
+
+  xl=(x*dx+xoutshift)/dxout
+  yl=(y*dy+youtshift)/dyout
+  ix=int(xl)
+  jy=int(yl)
+  ddx=xl-real(ix)                   ! distance to left cell border
+  ddy=yl-real(jy)                   ! distance to lower cell border
+
+  if (ddx.gt.0.5) then
+    ixp=ix+1
+    wx=1.5-ddx
+  else
+    ixp=ix-1
+    wx=0.5+ddx
+  endif
+
+  if (ddy.gt.0.5) then
+    jyp=jy+1
+    wy=1.5-ddy
+  else
+    jyp=jy-1
+    wy=0.5+ddy
+  endif
+
+
+  ! Determine mass fractions for four grid points
+  !**********************************************
+
+  do ks=1,nspec
+
+  if ((ix.ge.0).and.(jy.ge.0).and.(ix.le.numxgrid-1).and. &
+       (jy.le.numygrid-1)) then
+    w=wx*wy
+      wetgridunc(ix,jy,ks,kp,nunc,nage)= &
+           wetgridunc(ix,jy,ks,kp,nunc,nage)+deposit(ks)*w
+  endif
+
+  if ((ixp.ge.0).and.(jyp.ge.0).and.(ixp.le.numxgrid-1).and. &
+       (jyp.le.numygrid-1)) then
+    w=(1.-wx)*(1.-wy)
+      wetgridunc(ixp,jyp,ks,kp,nunc,nage)= &
+           wetgridunc(ixp,jyp,ks,kp,nunc,nage)+deposit(ks)*w
+  endif
+
+  if ((ixp.ge.0).and.(jy.ge.0).and.(ixp.le.numxgrid-1).and. &
+       (jy.le.numygrid-1)) then
+    w=(1.-wx)*wy
+      wetgridunc(ixp,jy,ks,kp,nunc,nage)= &
+           wetgridunc(ixp,jy,ks,kp,nunc,nage)+deposit(ks)*w
+  endif
+
+  if ((ix.ge.0).and.(jyp.ge.0).and.(ix.le.numxgrid-1).and. &
+       (jyp.le.numygrid-1)) then
+    w=wx*(1.-wy)
+      wetgridunc(ix,jyp,ks,kp,nunc,nage)= &
+           wetgridunc(ix,jyp,ks,kp,nunc,nage)+deposit(ks)*w
+  endif
+  end do
+
+end subroutine wetdepokernel
Index: /branches/FP_AI/src/wetdepokernel_nest.f90
===================================================================
--- /branches/FP_AI/src/wetdepokernel_nest.f90	(revision 23)
+++ /branches/FP_AI/src/wetdepokernel_nest.f90	(revision 23)
@@ -0,0 +1,117 @@
+!**********************************************************************
+! 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 wetdepokernel_nest &
+       (nunc,deposit,x,y,nage,kp)
+  !        i      i    i i  i    i
+  !*****************************************************************************
+  !                                                                            *
+  !     Attribution of the deposition from an individual particle to the       *
+  !     nested deposition fields using a uniform kernel with bandwidths        *
+  !     dxoutn and dyoutn.                                                     *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     26 December 1996                                                       *
+  !                                                                            *
+  !      2 September 2004: Adaptation from wetdepokernel.                      *
+  !                                                                            *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  !                                                                            *
+  ! nunc             uncertainty class of the respective particle              *
+  ! nage             age class of the respective particle                      *
+  ! deposit          amount (kg) to be deposited                               *
+  !                                                                            *
+  !*****************************************************************************
+
+  use unc_mod
+  use par_mod
+  use com_mod
+
+  implicit none
+
+  real :: x,y,deposit(maxspec),ddx,ddy,xl,yl,wx,wy,w
+  integer :: ix,jy,ixp,jyp,ks,kp,nunc,nage
+
+
+
+  xl=(x*dx+xoutshiftn)/dxoutn
+  yl=(y*dy+youtshiftn)/dyoutn
+  ix=int(xl)
+  jy=int(yl)
+  ddx=xl-real(ix)                   ! distance to left cell border
+  ddy=yl-real(jy)                   ! distance to lower cell border
+
+  if (ddx.gt.0.5) then
+    ixp=ix+1
+    wx=1.5-ddx
+  else
+    ixp=ix-1
+    wx=0.5+ddx
+  endif
+
+  if (ddy.gt.0.5) then
+    jyp=jy+1
+    wy=1.5-ddy
+  else
+    jyp=jy-1
+    wy=0.5+ddy
+  endif
+
+
+  ! Determine mass fractions for four grid points
+  !**********************************************
+
+  do ks=1,nspec
+
+  if ((ix.ge.0).and.(jy.ge.0).and.(ix.le.numxgridn-1).and. &
+       (jy.le.numygridn-1)) then
+    w=wx*wy
+      wetgriduncn(ix,jy,ks,kp,nunc,nage)= &
+           wetgriduncn(ix,jy,ks,kp,nunc,nage)+deposit(ks)*w
+  endif
+
+  if ((ixp.ge.0).and.(jyp.ge.0).and.(ixp.le.numxgridn-1).and. &
+       (jyp.le.numygridn-1)) then
+    w=(1.-wx)*(1.-wy)
+      wetgriduncn(ixp,jyp,ks,kp,nunc,nage)= &
+           wetgriduncn(ixp,jyp,ks,kp,nunc,nage)+deposit(ks)*w
+  endif
+
+  if ((ixp.ge.0).and.(jy.ge.0).and.(ixp.le.numxgridn-1).and. &
+       (jy.le.numygridn-1)) then
+    w=(1.-wx)*wy
+      wetgriduncn(ixp,jy,ks,kp,nunc,nage)= &
+           wetgriduncn(ixp,jy,ks,kp,nunc,nage)+deposit(ks)*w
+  endif
+
+  if ((ix.ge.0).and.(jyp.ge.0).and.(ix.le.numxgridn-1).and. &
+       (jyp.le.numygridn-1)) then
+    w=wx*(1.-wy)
+      wetgriduncn(ix,jyp,ks,kp,nunc,nage)= &
+           wetgriduncn(ix,jyp,ks,kp,nunc,nage)+deposit(ks)*w
+  endif
+
+  end do
+end subroutine wetdepokernel_nest
Index: /branches/FP_AI/src/windalign.f90
===================================================================
--- /branches/FP_AI/src/windalign.f90	(revision 23)
+++ /branches/FP_AI/src/windalign.f90	(revision 23)
@@ -0,0 +1,74 @@
+!**********************************************************************
+! 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 windalign(u,v,ffap,ffcp,ux,vy)
+  !                     i i  i    i   o  o
+  !*****************************************************************************
+  !                                                                            *
+  !  Transformation from along- and cross-wind components to u and v           *
+  !  components.                                                               *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     3 June 1996                                                            *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  ! ffap  turbulent wind in along wind direction                               *
+  ! ffcp  turbulent wind in cross wind direction                               *
+  ! u     main wind component in x direction                                   *
+  ! ux    turbulent wind in x direction                                        *
+  ! v     main wind component in y direction                                   *
+  ! vy    turbulent wind in y direction                                        *
+  !                                                                            *
+  !*****************************************************************************
+
+  implicit none
+
+  real :: u,v,ffap,ffcp,ux,vy,ffinv,ux1,ux2,vy1,vy2,sinphi,cosphi
+  real,parameter :: eps=1.e-30
+
+
+  ! Transform along wind components
+  !********************************
+
+  ffinv=1./max(sqrt(u*u+v*v),eps)
+  sinphi=v*ffinv
+  vy1=sinphi*ffap
+  cosphi=u*ffinv
+  ux1=cosphi*ffap
+
+
+  ! Transform cross wind components
+  !********************************
+
+  ux2=-sinphi*ffcp
+  vy2=cosphi*ffcp
+
+
+  ! Add contributions from along and cross wind components
+  !*******************************************************
+
+  ux=ux1+ux2
+  vy=vy1+vy2
+
+end subroutine windalign
Index: /branches/FP_AI/src/writeheader.f90
===================================================================
--- /branches/FP_AI/src/writeheader.f90	(revision 23)
+++ /branches/FP_AI/src/writeheader.f90	(revision 23)
@@ -0,0 +1,156 @@
+!**********************************************************************
+! 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 writeheader
+
+  !*****************************************************************************
+  !                                                                            *
+  !  This routine produces a file header containing basic information on the   *
+  !  settings of the FLEXPART run.                                             *
+  !  The header file is essential and must be read in by any postprocessing    *
+  !  program before reading in the output data.                                *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     7 August 2002                                                          *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  !                                                                            *
+  ! xlon                   longitude                                           *
+  ! xl                     model x coordinate                                  *
+  ! ylat                   latitude                                            *
+  ! yl                     model y coordinate                                  *
+  !                                                                            *
+  !*****************************************************************************
+
+  use point_mod
+  use outg_mod
+  use par_mod
+  use com_mod
+
+  implicit none
+
+  integer :: jjjjmmdd,ihmmss,i,ix,jy,j
+  real :: xp1,yp1,xp2,yp2
+
+
+  !************************
+  ! Open header output file
+  !************************
+
+  open(unitheader,file=path(2)(1:length(2))//'header', &
+       form='unformatted',err=998)
+
+
+  ! Write the header information
+  !*****************************
+
+  if (ldirect.eq.1) then
+    write(unitheader) ibdate,ibtime, trim(flexversion)
+  else
+    write(unitheader) iedate,ietime, trim(flexversion)
+  endif
+
+  ! Write info on output interval, averaging time, sampling time
+  !*************************************************************
+
+  write(unitheader) loutstep,loutaver,loutsample
+
+  ! Write information on output grid setup
+  !***************************************
+
+  write(unitheader) outlon0,outlat0,numxgrid,numygrid, &
+       dxout,dyout
+  write(unitheader) numzgrid,(outheight(i),i=1,numzgrid)
+
+  call caldate(bdate,jjjjmmdd,ihmmss)
+  write(unitheader) jjjjmmdd,ihmmss
+
+  ! Write number of species, and name for each species (+extra name for depositions)
+  ! Indicate the dimension of the fields (i.e., 1 for deposition fields, numzgrid for
+  ! concentration fields
+  !*****************************************************************************
+
+  write(unitheader) 3*nspec,maxpointspec_act
+  do i=1,nspec
+    write(unitheader) 1,'WD_'//species(i)(1:7)
+    write(unitheader) 1,'DD_'//species(i)(1:7)
+    write(unitheader) numzgrid,species(i)
+  end do
+
+  ! Write information on release points: total number, then for each point:
+  ! start, end, coordinates, # of particles, name, mass
+  !************************************************************************
+
+  write(unitheader) numpoint
+  do i=1,numpoint
+    write(unitheader) ireleasestart(i),ireleaseend(i),kindz(i)
+    xp1=xpoint1(i)*dx+xlon0
+    yp1=ypoint1(i)*dy+ylat0
+    xp2=xpoint2(i)*dx+xlon0
+    yp2=ypoint2(i)*dy+ylat0
+    write(unitheader) xp1,yp1,xp2,yp2,zpoint1(i),zpoint2(i)
+    write(unitheader) npart(i),1
+    if (numpoint.le.1000) then
+      write(unitheader) compoint(i)
+    else
+      write(unitheader) compoint(1001)
+    endif
+    do j=1,nspec
+      write(unitheader) xmass(i,j)
+      write(unitheader) xmass(i,j)
+      write(unitheader) xmass(i,j)
+    end do
+  end do
+
+  ! Write information on some model switches
+  !*****************************************
+
+  write(unitheader) method,lsubgrid,lconvection, &
+       ind_source,ind_receptor
+
+  ! Write age class information
+  !****************************
+
+  write(unitheader) nageclass,(lage(i),i=1,nageclass)
+
+
+  ! Write topography to output file
+  !********************************
+
+  do ix=0,numxgrid-1
+    write(unitheader) (oroout(ix,jy),jy=0,numygrid-1)
+  end do
+  close(unitheader)
+
+  return
+
+
+998   write(*,*) ' #### FLEXPART MODEL ERROR!   THE FILE         #### '
+  write(*,*) ' #### '//path(2)(1:length(2))//'header'//' #### '
+  write(*,*) ' #### CANNOT BE OPENED. IF A FILE WITH THIS    #### '
+  write(*,*) ' #### NAME ALREADY EXISTS, DELETE IT AND START #### '
+  write(*,*) ' #### THE PROGRAM AGAIN.                       #### '
+  stop
+
+end subroutine writeheader
Index: /branches/FP_AI/src/writeheader_nest.f90
===================================================================
--- /branches/FP_AI/src/writeheader_nest.f90	(revision 23)
+++ /branches/FP_AI/src/writeheader_nest.f90	(revision 23)
@@ -0,0 +1,156 @@
+!**********************************************************************
+! 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 writeheader_nest
+
+  !*****************************************************************************
+  !                                                                            *
+  !  This routine produces a file header containing basic information on the   *
+  !  settings of the FLEXPART run.                                             *
+  !  The header file is essential and must be read in by any postprocessing    *
+  !  program before reading in the output data.                                *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     7 August 2002                                                          *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  !                                                                            *
+  ! xlon                   longitude                                           *
+  ! xl                     model x coordinate                                  *
+  ! ylat                   latitude                                            *
+  ! yl                     model y coordinate                                  *
+  !                                                                            *
+  !*****************************************************************************
+
+  use point_mod
+  use outg_mod
+  use par_mod
+  use com_mod
+
+  implicit none
+
+  integer :: jjjjmmdd,ihmmss,i,ix,jy,j
+  real :: xp1,yp1,xp2,yp2
+
+
+  !************************
+  ! Open header output file
+  !************************
+
+  open(unitheader,file=path(2)(1:length(2))//'header_nest', &
+       form='unformatted',err=998)
+
+
+  ! Write the header information
+  !*****************************
+
+  if (ldirect.eq.1) then
+    write(unitheader) ibdate,ibtime,'FLEXPART V8.2'
+  else
+    write(unitheader) iedate,ietime,'FLEXPART V8.2'
+  endif
+
+  ! Write info on output interval, averaging time, sampling time
+  !*************************************************************
+
+  write(unitheader) loutstep,loutaver,loutsample
+
+  ! Write information on output grid setup
+  !***************************************
+
+  write(unitheader) outlon0n,outlat0n,numxgridn,numygridn, &
+       dxoutn,dyoutn
+  write(unitheader) numzgrid,(outheight(i),i=1,numzgrid)
+
+  call caldate(bdate,jjjjmmdd,ihmmss)
+  write(unitheader) jjjjmmdd,ihmmss
+
+  ! Write number of species, and name for each species (+extra name for depositions)
+  ! Indicate the dimension of the fields (i.e., 1 for deposition fields, numzgrid for
+  ! concentration fields
+  !*****************************************************************************
+
+  write(unitheader) 3*nspec,maxpointspec_act
+  do i=1,nspec
+    write(unitheader) 1,'WD_'//species(i)(1:7)
+    write(unitheader) 1,'DD_'//species(i)(1:7)
+    write(unitheader) numzgrid,species(i)
+  end do
+
+  ! Write information on release points: total number, then for each point:
+  ! start, end, coordinates, # of particles, name, mass
+  !************************************************************************
+
+  write(unitheader) numpoint
+  do i=1,numpoint
+    write(unitheader) ireleasestart(i),ireleaseend(i),kindz(i)
+    xp1=xpoint1(i)*dx+xlon0
+    yp1=ypoint1(i)*dy+ylat0
+    xp2=xpoint2(i)*dx+xlon0
+    yp2=ypoint2(i)*dy+ylat0
+    write(unitheader) xp1,yp1,xp2,yp2,zpoint1(i),zpoint2(i)
+    write(unitheader) npart(i),1
+    if (numpoint.le.1000) then
+      write(unitheader) compoint(i)
+    else
+      write(unitheader) compoint(1001)
+   endif
+    do j=1,nspec
+      write(unitheader) xmass(i,j)
+      write(unitheader) xmass(i,j)
+      write(unitheader) xmass(i,j)
+    end do
+  end do
+
+  ! Write information on some model switches
+  !*****************************************
+
+  write(unitheader) method,lsubgrid,lconvection, &
+       ind_source,ind_receptor
+
+  ! Write age class information
+  !****************************
+
+  write(unitheader) nageclass,(lage(i),i=1,nageclass)
+
+
+  ! Write topography to output file
+  !********************************
+
+  do ix=0,numxgridn-1
+    write(unitheader) (orooutn(ix,jy),jy=0,numygridn-1)
+  end do
+  close(unitheader)
+
+  return
+
+
+998   write(*,*) ' #### FLEXPART MODEL ERROR!   THE FILE         #### '
+  write(*,*) ' #### '//path(2)(1:length(2))//'header'//' #### '
+  write(*,*) ' #### CANNOT BE OPENED. IF A FILE WITH THIS    #### '
+  write(*,*) ' #### NAME ALREADY EXISTS, DELETE IT AND START #### '
+  write(*,*) ' #### THE PROGRAM AGAIN.                       #### '
+  stop
+
+end subroutine writeheader_nest
Index: /branches/FP_AI/src/writeheader_nest_surf.f90
===================================================================
--- /branches/FP_AI/src/writeheader_nest_surf.f90	(revision 23)
+++ /branches/FP_AI/src/writeheader_nest_surf.f90	(revision 23)
@@ -0,0 +1,156 @@
+!**********************************************************************
+! 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 writeheader_nest_surf
+
+  !*****************************************************************************
+  !                                                                            *
+  !  This routine produces a file header containing basic information on the   *
+  !  settings of the FLEXPART run.                                             *
+  !  The header file is essential and must be read in by any postprocessing    *
+  !  program before reading in the output data.                                *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     7 August 2002                                                          *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  !                                                                            *
+  ! xlon                   longitude                                           *
+  ! xl                     model x coordinate                                  *
+  ! ylat                   latitude                                            *
+  ! yl                     model y coordinate                                  *
+  !                                                                            *
+  !*****************************************************************************
+
+  use point_mod
+  use outg_mod
+  use par_mod
+  use com_mod
+
+  implicit none
+
+  integer :: jjjjmmdd,ihmmss,i,ix,jy,j
+  real :: xp1,yp1,xp2,yp2
+
+
+  !************************
+  ! Open header output file
+  !************************
+
+  open(unitheader,file=path(2)(1:length(2))//'header_nest_grid_time', &
+       form='unformatted',err=998)
+
+
+  ! Write the header information
+  !*****************************
+
+  if (ldirect.eq.1) then
+    write(unitheader) ibdate,ibtime,trim(flexversion)
+  else
+    write(unitheader) iedate,ietime,trim(flexversion)
+  endif
+
+  ! Write info on output interval, averaging time, sampling time
+  !*************************************************************
+
+  write(unitheader) loutstep,loutaver,loutsample
+
+  ! Write information on output grid setup
+  !***************************************
+
+  write(unitheader) outlon0n,outlat0n,numxgridn,numygridn, &
+       dxoutn,dyoutn
+  write(unitheader) 1,(outheight(1),i=1,1)
+
+  call caldate(bdate,jjjjmmdd,ihmmss)
+  write(unitheader) jjjjmmdd,ihmmss
+
+  ! Write number of species, and name for each species (+extra name for depositions)
+  ! Indicate the dimension of the fields (i.e., 1 for deposition fields, numzgrid for
+  ! concentration fields
+  !*****************************************************************************
+
+  write(unitheader) 3*nspec,maxpointspec_act
+  do i=1,nspec
+    write(unitheader) 1,'WD_'//species(i)(1:7)
+    write(unitheader) 1,'DD_'//species(i)(1:7)
+    write(unitheader) 1,species(i)
+  end do
+
+  ! Write information on release points: total number, then for each point:
+  ! start, end, coordinates, # of particles, name, mass
+  !************************************************************************
+
+  write(unitheader) numpoint
+  do i=1,numpoint
+    write(unitheader) ireleasestart(i),ireleaseend(i),kindz(i)
+    xp1=xpoint1(i)*dx+xlon0
+    yp1=ypoint1(i)*dy+ylat0
+    xp2=xpoint2(i)*dx+xlon0
+    yp2=ypoint2(i)*dy+ylat0
+    write(unitheader) xp1,yp1,xp2,yp2,zpoint1(i),zpoint2(i)
+    write(unitheader) npart(i),1
+    if (numpoint.le.1000) then
+      write(unitheader) compoint(i)
+    else
+      write(unitheader) compoint(1001)
+   endif
+    do j=1,nspec
+      write(unitheader) xmass(i,j)
+      write(unitheader) xmass(i,j)
+      write(unitheader) xmass(i,j)
+    end do
+  end do
+
+  ! Write information on some model switches
+  !*****************************************
+
+  write(unitheader) method,lsubgrid,lconvection, &
+       ind_source,ind_receptor
+
+  ! Write age class information
+  !****************************
+
+  write(unitheader) nageclass,(lage(i),i=1,nageclass)
+
+
+  ! Write topography to output file
+  !********************************
+
+  do ix=0,numxgridn-1
+    write(unitheader) (orooutn(ix,jy),jy=0,numygridn-1)
+  end do
+  close(unitheader)
+
+  return
+
+
+998   write(*,*) ' #### FLEXPART MODEL ERROR!   THE FILE         #### '
+  write(*,*) ' #### '//path(2)(1:length(2))//'header'//' #### '
+  write(*,*) ' #### CANNOT BE OPENED. IF A FILE WITH THIS    #### '
+  write(*,*) ' #### NAME ALREADY EXISTS, DELETE IT AND START #### '
+  write(*,*) ' #### THE PROGRAM AGAIN.                       #### '
+  stop
+
+end subroutine writeheader_nest_surf
Index: /branches/FP_AI/src/writeheader_surf.f90
===================================================================
--- /branches/FP_AI/src/writeheader_surf.f90	(revision 23)
+++ /branches/FP_AI/src/writeheader_surf.f90	(revision 23)
@@ -0,0 +1,156 @@
+!**********************************************************************
+! 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 writeheader_surf
+
+  !*****************************************************************************
+  !                                                                            *
+  !  This routine produces a file header containing basic information on the   *
+  !  settings of the FLEXPART run.                                             *
+  !  The header file is essential and must be read in by any postprocessing    *
+  !  program before reading in the output data.                                *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     7 August 2002                                                          *
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  !                                                                            *
+  ! xlon                   longitude                                           *
+  ! xl                     model x coordinate                                  *
+  ! ylat                   latitude                                            *
+  ! yl                     model y coordinate                                  *
+  !                                                                            *
+  !*****************************************************************************
+
+  use point_mod
+  use outg_mod
+  use par_mod
+  use com_mod
+
+  implicit none
+
+  integer :: jjjjmmdd,ihmmss,i,ix,jy,j
+  real :: xp1,yp1,xp2,yp2
+
+
+  !************************
+  ! Open header output file
+  !************************
+
+  open(unitheader,file=path(2)(1:length(2))//'header_grid_time', &
+       form='unformatted',err=998)
+
+
+  ! Write the header information
+  !*****************************
+
+  if (ldirect.eq.1) then
+    write(unitheader) ibdate,ibtime, trim(flexversion)
+  else
+    write(unitheader) iedate,ietime, trim(flexversion)
+  endif
+
+  ! Write info on output interval, averaging time, sampling time
+  !*************************************************************
+
+  write(unitheader) loutstep,loutaver,loutsample
+
+  ! Write information on output grid setup
+  !***************************************
+
+  write(unitheader) outlon0,outlat0,numxgrid,numygrid, &
+       dxout,dyout
+  write(unitheader) 1,(outheight(1),i=1,1)
+
+  call caldate(bdate,jjjjmmdd,ihmmss)
+  write(unitheader) jjjjmmdd,ihmmss
+
+  ! Write number of species, and name for each species (+extra name for depositions)
+  ! Indicate the dimension of the fields (i.e., 1 for deposition fields, numzgrid for
+  ! concentration fields
+  !*****************************************************************************
+
+  write(unitheader) 3*nspec,maxpointspec_act
+  do i=1,nspec
+    write(unitheader) 1,'WD_'//species(i)(1:7)
+    write(unitheader) 1,'DD_'//species(i)(1:7)
+    write(unitheader) 1,species(i)
+  end do
+
+  ! Write information on release points: total number, then for each point:
+  ! start, end, coordinates, # of particles, name, mass
+  !************************************************************************
+
+  write(unitheader) numpoint
+  do i=1,numpoint
+    write(unitheader) ireleasestart(i),ireleaseend(i),kindz(i)
+    xp1=xpoint1(i)*dx+xlon0
+    yp1=ypoint1(i)*dy+ylat0
+    xp2=xpoint2(i)*dx+xlon0
+    yp2=ypoint2(i)*dy+ylat0
+    write(unitheader) xp1,yp1,xp2,yp2,zpoint1(i),zpoint2(i)
+    write(unitheader) npart(i),1
+    if (numpoint.le.1000) then
+      write(unitheader) compoint(i)
+    else
+      write(unitheader) compoint(1001)
+    endif
+    do j=1,nspec
+      write(unitheader) xmass(i,j)
+      write(unitheader) xmass(i,j)
+      write(unitheader) xmass(i,j)
+    end do
+  end do
+
+  ! Write information on some model switches
+  !*****************************************
+
+  write(unitheader) method,lsubgrid,lconvection, &
+       ind_source,ind_receptor
+
+  ! Write age class information
+  !****************************
+
+  write(unitheader) nageclass,(lage(i),i=1,nageclass)
+
+
+  ! Write topography to output file
+  !********************************
+
+  do ix=0,numxgrid-1
+    write(unitheader) (oroout(ix,jy),jy=0,numygrid-1)
+  end do
+  close(unitheader)
+
+  return
+
+
+998   write(*,*) ' #### FLEXPART MODEL ERROR!   THE FILE         #### '
+  write(*,*) ' #### '//path(2)(1:length(2))//'header'//' #### '
+  write(*,*) ' #### CANNOT BE OPENED. IF A FILE WITH THIS    #### '
+  write(*,*) ' #### NAME ALREADY EXISTS, DELETE IT AND START #### '
+  write(*,*) ' #### THE PROGRAM AGAIN.                       #### '
+  stop
+
+end subroutine writeheader_surf
Index: /branches/FP_AI/src/writeheader_txt.f90
===================================================================
--- /branches/FP_AI/src/writeheader_txt.f90	(revision 23)
+++ /branches/FP_AI/src/writeheader_txt.f90	(revision 23)
@@ -0,0 +1,190 @@
+!**********************************************************************
+! 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 writeheader_txt
+
+  !*****************************************************************************
+  !                                                                            *
+  !  This routine produces a file header containing basic information on the   *
+  !  settings of the FLEXPART run.                                             *
+  !  The header file is essential and must be read in by any postprocessing    *
+  !  program before reading in the output data.                                *
+  !                                                                            *
+  !     Author: A. Stohl                                                       *
+  !                                                                            *
+  !     7 August 2002                                                          *
+  !     modified IP 2013 for text output                                       *
+  !*****************************************************************************
+  !                                                                            *
+  ! Variables:                                                                 *
+  !                                                                            *
+  ! xlon                   longitude                                           *
+  ! xl                     model x coordinate                                  *
+  ! ylat                   latitude                                            *
+  ! yl                     model y coordinate                                  *
+  !                                                                            *
+  !*****************************************************************************
+
+  use point_mod
+  use outg_mod
+  use par_mod
+  use com_mod
+
+  implicit none
+
+  integer :: jjjjmmdd,ihmmss,i,ix,jy,j
+  real :: xp1,yp1,xp2,yp2
+
+
+  !************************
+  ! Open header output file
+  !************************
+
+  open(unitheader,file=path(2)(1:length(2))//'header_txt', &
+       form='formatted',err=998)
+  open(unitheader_txt,file=path(2)(1:length(2))//'header_txt_releases', &
+       form='formatted',err=998)
+
+
+  ! Write the header information
+  !*****************************
+  
+  write(unitheader,*) '# ibdate,ibtime, iedate, ietime, flexversion'
+  write(unitheader,*) ibdate, ibtime, iedate, ietime, trim(flexversion) !  'FLEXPART V9.0'
+  !if (ldirect.eq.1) then
+  !  write(unitheader,*) ibdate,ibtime,trim(flexversion) !  'FLEXPART V9.0'
+  !else
+  !  write(unitheader,*) iedate,ietime,trim(flexversion) ! 'FLEXPART V9.0'
+  !endif
+
+  ! Write info on output interval, averaging time, sampling time
+  !*************************************************************
+  
+  write(unitheader,*) '# interval, averaging time, sampling time'
+  write(unitheader,*) loutstep,loutaver,loutsample
+
+  ! Write information on output grid setup
+  !***************************************
+  
+  write(unitheader,*) '# information on grid setup    '
+  write(unitheader,*) '#outlon0,outlat0,numxgrid,numygrid,dxout,dyout'
+  write(unitheader,*) outlon0,outlat0,numxgrid,numygrid, &
+       dxout,dyout  
+  write(unitheader,*) '# numzgrid, outheight(.) '
+  write(unitheader,*) numzgrid,(outheight(i),i=1,numzgrid)
+
+  write(unitheader,*) '# jjjjmmdd,ihmmss'
+  call caldate(bdate,jjjjmmdd,ihmmss)
+  write(unitheader,*) jjjjmmdd,ihmmss
+
+  ! Write number of species, and name for each species (+extra name for depositions)
+  ! Indicate the vertical dimension of the fields (i.e., 1 for deposition fields, numzgrid for
+  ! concentration fields
+  !*****************************************************************************
+
+  write(unitheader,*) '# information on species'
+  write(unitheader,*) '# 3*nspec,maxpointspec_act'
+  write(unitheader,*) 3*nspec,maxpointspec_act
+  write(unitheader,*) '# for nspec:'
+  write(unitheader,*) '# 1, WD_ '
+  write(unitheader,*) '# 1, DD_ '
+  write(unitheader,*) '# numzgrid,species'
+  do i=1,nspec
+    write(unitheader,*) 1,'WD_'//species(i)(1:7)
+    write(unitheader,*) 1,'DD_'//species(i)(1:7)
+    write(unitheader,*) numzgrid,species(i)
+  end do
+
+  ! Write information on release points: total number, then for each point:
+  ! start, end, coordinates, # of particles, name, mass
+  !************************************************************************
+
+
+  write(unitheader_txt,*) '# information on release points'
+  write(unitheader_txt,*) '# numpoint'
+  write(unitheader_txt,*) numpoint
+  write(unitheader_txt,*) '# for numpoint:'
+  do i=1,numpoint
+    write(unitheader_txt,*) ireleasestart(i),ireleaseend(i),kindz(i)
+    xp1=xpoint1(i)*dx+xlon0
+    yp1=ypoint1(i)*dy+ylat0
+    xp2=xpoint2(i)*dx+xlon0
+    yp2=ypoint2(i)*dy+ylat0
+    write(unitheader_txt,*) xp1,yp1,xp2,yp2,zpoint1(i),zpoint2(i)
+    write(unitheader_txt,*) npart(i),1
+    if (numpoint.le.1000) then
+      write(unitheader_txt,*) compoint(i)
+    else
+      write(unitheader_txt,*) compoint(1001)
+    endif
+    do j=1,nspec
+      write(unitheader_txt,*) xmass(i,j)
+      write(unitheader_txt,*) xmass(i,j)
+      write(unitheader_txt,*) xmass(i,j)
+    end do
+  end do
+
+  ! Write information on model switches
+  !*****************************************
+
+  write(unitheader,*) '# information on model switches'
+  write(unitheader,*) '# method,lsubgrid,lconvection, ind_source,ind_receptor'
+  write(unitheader,*) method,lsubgrid,lconvection, &
+       ind_source,ind_receptor
+
+  ! Write age class information
+  !****************************
+  
+  write(unitheader,*) '# information on age class     '
+  write(unitheader,*) nageclass,(lage(i),i=1,nageclass)
+
+
+  !Do not write topography to text output file. Keep it on the binary one
+  !********************************
+
+  !do ix=0,numxgrid-1
+  !  write(unitheader,*) (oroout(ix,jy),jy=0,numygrid-1)
+  !end do
+
+
+  
+
+
+  close(unitheader)
+  close(unitheader_txt)
+
+
+!  open(unitheader,file=path(2)(1:length(2))//'header_nml', &
+!        form='formatted',err=998)
+!  write(unitheader,NML=COMMAND) 
+!  close(unitheader)
+
+  return
+
+
+998   write(*,*) ' #### FLEXPART MODEL ERROR!   THE FILE         #### '
+  write(*,*) ' #### '//path(2)(1:length(2))//'header_txt'//' #### '
+  write(*,*) ' #### CANNOT BE OPENED. IF A FILE WITH THIS    #### '
+  write(*,*) ' #### NAME ALREADY EXISTS, DELETE IT AND START #### '
+  write(*,*) ' #### THE PROGRAM AGAIN.                       #### '
+  stop
+
+end subroutine writeheader_txt
Index: /branches/FP_AI/src/xmass_mod.f90
===================================================================
--- /branches/FP_AI/src/xmass_mod.f90	(revision 23)
+++ /branches/FP_AI/src/xmass_mod.f90	(revision 23)
@@ -0,0 +1,28 @@
+!**********************************************************************
+! 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/>.   *
+!**********************************************************************
+
+module xmass_mod
+  
+  implicit none
+  
+  real,allocatable, dimension (:) :: xmasssave
+  
+end module xmass_mod
Index: /branches/FP_AI/src/zenithangle.f90
===================================================================
--- /branches/FP_AI/src/zenithangle.f90	(revision 23)
+++ /branches/FP_AI/src/zenithangle.f90	(revision 23)
@@ -0,0 +1,95 @@
+!**********************************************************************
+! 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/>.   *
+!**********************************************************************
+
+real function zenithangle(ylat,xlon,jul)
+
+  !*********************************************************************
+  !                                                                    *
+  !                      Author: G. WOTAWA                             *
+  !                      Date: 1993-11-17                              *
+  !                      Project: POP-M                                *
+  !                      Last update:                                  *
+  !                                                                    *
+  !*********************************************************************
+  !                                                                    *
+  !     DESCRIPTION: This function returns the sinus of solar          *
+  !                  elevation as a function of geographic longitude,  *
+  !                  latitude and GMT-Time.                            *
+  !                                                                    *
+  !*********************************************************************
+  !                                                                    *
+  !     INPUT:                                                         *
+  !                                                                    *
+  !            ylat          geographical latitude  [DEG]              *
+  !            xlon          geographical longitude [DEG]              *
+  !            jjjj          Year                                      *
+  !            mm            Month                                     *
+  !            dd            Day                                       *
+  !            hh            Hour                                      *
+  !            minute        Minute                                    *
+  !                                                                    *
+  !*********************************************************************
+
+  use par_mod, only: dp
+
+  implicit none
+
+  integer :: jjjj,mm,id,iu,minute,yyyymmdd,hhmmss
+  integer :: ndaynum
+  real :: sinsol,solelev,ylat,xlon
+  real :: rnum,rylat,ttime,dekl,rdekl,eq
+  real,parameter :: pi=3.1415927
+  real(kind=dp)  :: jul
+
+  call caldate(jul,yyyymmdd,hhmmss)
+  jjjj=yyyymmdd/10000
+  mm=yyyymmdd/100-jjjj*100
+  id=yyyymmdd-jjjj*10000-mm*100
+  iu=hhmmss/10000
+  minute=hhmmss/100-100*iu
+
+  ndaynum=31*(mm-1)+id
+  if(mm.gt.2) ndaynum=ndaynum-int(0.4*mm+2.3)
+  if((mm.gt.2).and.(jjjj/4*4.eq.jjjj)) ndaynum=ndaynum+1
+
+  rnum=2.*pi*ndaynum/365.
+  rylat=pi*ylat/180.
+  ttime=real(iu)+real(minute)/60.
+
+  dekl=0.396+3.631*sin(rnum)+0.038*sin(2.*rnum)+0.077*sin(3.*rnum)- &
+       22.97*cos(rnum)-0.389*cos(2.*rnum)-0.158*cos(3.*rnum)
+  rdekl=pi*dekl/180.
+
+  eq=(0.003-7.343*sin(rnum)-9.47*sin(2.*rnum)- &
+       0.329*sin(3.*rnum)-0.196*sin(4.*rnum)+ &
+       0.552*cos(rnum)-3.020*cos(2.*rnum)- &
+       0.076*cos(3.*rnum)-0.125*cos(4.*rnum))/60.
+
+  sinsol=sin(rylat)*sin(rdekl)+cos(rylat)*cos(rdekl)* &
+       cos((ttime-12.+xlon/15.+eq)*pi/12.)
+  ! Calculate the maximum solar elevation on that day
+  !sinsol=sin(rylat)*sin(rdekl)+cos(rylat)*cos(rdekl)*
+  !    &       cos((eq)*pi/12.)
+  solelev=asin(sinsol)*180./pi
+  zenithangle=90.-solelev
+
+  return
+end function zenithangle
Index: /branches/FP_AI/tests/pathnames.new
===================================================================
--- /branches/FP_AI/tests/pathnames.new	(revision 23)
+++ /branches/FP_AI/tests/pathnames.new	(revision 23)
@@ -0,0 +1,6 @@
+/flex_wrk/ast/FLEXPART_TEST/FLEXPART_CLEAN/options/
+/flex_wrk/ast/FLEXPART_TEST/FLEXPART_CLEAN/output/
+/
+/flex_wrk/WIND_FIELDS/AVAILABLE_ECMWF_OPER_fields_global
+============================================
+
Index: /branches/FP_AI/tests/pathnames.old
===================================================================
--- /branches/FP_AI/tests/pathnames.old	(revision 23)
+++ /branches/FP_AI/tests/pathnames.old	(revision 23)
@@ -0,0 +1,8 @@
+/flex_wrk/ast/FLEXPART_TEST/FLEXPART_CLEAN/options/
+/flex_wrk/ast/FLEXPART_TEST/FLEXPART_CLEAN/output/
+/nilu_wrk2/OPER_fields/all_fields_flextra/
+/nilu_wrk2/OPER_fields/all_fields_flextra/AVAILABLE_FUKU
+/flex_wrk/WIND_FIELDS/ECMWF/NEST/FUKU/
+/flex_wrk/WIND_FIELDS/ECMWF/NEST/FUKU/AVAILABLE
+============================================
+
Index: /branches/FP_AI/tests/script.sh
===================================================================
--- /branches/FP_AI/tests/script.sh	(revision 23)
+++ /branches/FP_AI/tests/script.sh	(revision 23)
@@ -0,0 +1,7 @@
+cd test_1
+ln -s ../../build/FP_ecmwf_gfortran
+
+#test 1
+
+./FP_ecmwf_gfortran 
+
Index: /branches/FP_AI/tests/test_1/FP_ecmwf_gfortran
===================================================================
--- /branches/FP_AI/tests/test_1/FP_ecmwf_gfortran	(revision 23)
+++ /branches/FP_AI/tests/test_1/FP_ecmwf_gfortran	(revision 23)
@@ -0,0 +1,1 @@
+link ../../build/FP_ecmwf_gfortran
Index: /branches/FP_AI/tests/test_1/options/AGECLASSES
===================================================================
--- /branches/FP_AI/tests/test_1/options/AGECLASSES	(revision 23)
+++ /branches/FP_AI/tests/test_1/options/AGECLASSES	(revision 23)
@@ -0,0 +1,15 @@
+************************************************
+*                                              *
+*Lagrangian particle dispersion model FLEXPART *
+*         Please select your options           *
+*                                              *
+*This file determines the ageclasses to be used*
+*                                              *
+*Ages are given in seconds. The first class    *
+*starts at age zero and goes up to the first   *
+*age specified. The last age gives the maximum *
+*time a particle is carried in the simulation. *
+*                                              *
+************************************************
+1          Integer        Number of age classes
+1728000 
Index: /branches/FP_AI/tests/test_1/options/COMMAND
===================================================================
--- /branches/FP_AI/tests/test_1/options/COMMAND	(revision 23)
+++ /branches/FP_AI/tests/test_1/options/COMMAND	(revision 23)
@@ -0,0 +1,31 @@
++++++++++++++ HEADER +++++++++++++++++
++++++++++++++ HEADER +++++++++++++++++
++++++++++++++ HEADER +++++++++++++++++
++++++++++++++ HEADER +++++++++++++++++
++++++++++++++ HEADER +++++++++++++++++
++++++++++++++ HEADER +++++++++++++++++
++++++++++++++ HEADER +++++++++++++++++
+-1
+20070105 180000
+20070107      0
+  3600
+  3600
+   900
+ 9999999
+900   SYNC
+-5.0  CTL
+4     IFINE
+5     IOUT
+1     IPOUT
+0     LSUBGRID
+0     LCONVECTION
+1     LAGESPECTRA
+0     IPIN
+1     IOFR
+0     IFLUX
+0     MDOMAINFILL
+1     IND_SOURCE
+2     IND_RECEPTOR
+0     MQUASILAG
+0     NESTED_OUTPUT
+2     LINIT_COND        INITIAL COND. FOR BW RUNS: 0=NO,1=MASS UNIT,2=MASS MIXING RATIO UNIT
Index: /branches/FP_AI/tests/test_1/options/COMMAND.alternative
===================================================================
--- /branches/FP_AI/tests/test_1/options/COMMAND.alternative	(revision 23)
+++ /branches/FP_AI/tests/test_1/options/COMMAND.alternative	(revision 23)
@@ -0,0 +1,118 @@
+********************************************************************************
+*                                                                              *
+*      Input file for the Lagrangian particle dispersion model FLEXPART        *
+*                           Please select your options                         *
+*                                                                              *
+********************************************************************************
+
+ 1              LDIRECT           1 FOR FORWARD SIMULATION, -1 FOR BACKWARD SIMULATION
+20040720 000000 YYYYMMDD HHMISS   BEGINNING DATE OF SIMULATION
+20040721 120000 YYYYMMDD HHMISS   ENDING DATE OF SIMULATION
+10800           SSSSS             OUTPUT EVERY SSSSS SECONDS
+10800           SSSSS             TIME AVERAGE OF OUTPUT (IN SSSSS SECONDS)
+900             SSSSS             SAMPLING RATE OF OUTPUT (IN SSSSS SECONDS)
+9999999         SSSSSSS           TIME CONSTANT FOR PARTICLE SPLITTING (IN SECONDS)
+900             SSSSS             SYNCHRONISATION INTERVAL OF FLEXPART (IN SECONDS)
+-5.0            CTL               FACTOR, BY WHICH TIME STEP MUST BE SMALLER THAN TL
+4               IFINE             DECREASE OF TIME STEP FOR VERTICAL MOTION BY FACTOR IFINE
+3               IOUT              1 CONC. (RESID. TIME FOR BACKWARD RUNS) OUTPUT,2 MIX. RATIO OUTPUT,3 BOTH,4 PLUME TRAJECT.,5=1+4
+0               IPOUT             PARTICLE DUMP: 0 NO, 1 EVERY OUTPUT INTERVAL, 2 ONLY AT END
+1               LSUBGRID          SUBGRID TERRAIN EFFECT PARAMETERIZATION: 1 YES, 0 NO
+1               LCONVECTION       CONVECTION: 1 YES, 0 NO
+0               LAGESPECTRA       AGE SPECTRA: 1 YES, 0 NO
+0               IPIN              CONTINUE SIMULATION WITH DUMPED PARTICLE DATA: 1 YES, 0 NO
+0               IOUTPUTFOREACHREL CREATE AN OUPUT FILE FOR EACH RELEASE LOCATION: 1 YES, 0 NO
+0               IFLUX             CALCULATE FLUXES: 1 YES, 0 NO
+0               MDOMAINFILL       DOMAIN-FILLING TRAJECTORY OPTION: 1 YES, 0 NO
+1               IND_SOURCE        1=MASS UNIT , 2=MASS MIXING RATIO UNIT
+1               IND_RECEPTOR      1=MASS UNIT , 2=MASS MIXING RATIO UNIT
+0               MQUASILAG         QUASILAGRANGIAN MODE TO TRACK INDIVIDUAL PARTICLES: 1 YES, 0 NO
+0               NESTED_OUTPUT     SHALL NESTED OUTPUT BE USED? YES, 0 NO
+2               LINIT_COND        INITIAL COND. FOR BW RUNS: 0=NO,1=MASS UNIT,2=MASS MIXING RATIO UNIT
+
+
+1. Simulation direction, 1 for forward, -1 for backward in time
+
+2. Beginning date and time of simulation. Must be given in format
+   YYYYMMDD HHMISS, where YYYY is YEAR, MM is MONTH, DD is DAY, HH is HOUR,
+   MI is MINUTE and SS is SECOND. Current version utilizes UTC.
+
+3. Ending date and time of simulation. Same format as 3.
+
+4. Average concentrations are calculated every SSSSS seconds.
+
+5. The average concentrations are time averages of SSSSS seconds
+   duration. If SSSSS is 0, instantaneous concentrations are outputted.
+
+6. The concentrations are sampled every SSSSS seconds to calculate the time
+   average concentration. This period must be shorter than the averaging time.
+
+7. Time constant for particle splitting. Particles are split into two
+   after SSSSS seconds, 2xSSSSS seconds, 4xSSSSS seconds, and so on.
+
+8. All processes are synchronized with this time interval (lsynctime).
+   Therefore, all other time constants must be multiples of this value.
+   Output interval and time average of output must be at least twice lsynctime.
+
+9. CTL must be >1 for time steps shorter than the  Lagrangian time scale
+   If CTL<0, a purely random walk simulation is done
+
+10.IFINE=Reduction factor for time step used for vertical wind
+
+11.IOUT determines how the output shall be made: concentration
+   (ng/m3, Bq/m3), mixing ratio (pptv), or both, or plume trajectory mode,
+   or concentration + plume trajectory mode.
+   In plume trajectory mode, output is in the form of average trajectories.
+
+12.IPOUT determines whether particle positions are outputted (in addition
+   to the gridded concentrations or mixing ratios) or not.
+   0=no output, 1 output every output interval, 2 only at end of the
+   simulation
+
+13.Switch on/off subgridscale terrain parameterization (increase of
+   mixing heights due to subgridscale orographic variations)
+
+14.Switch on/off the convection parameterization
+
+15.Switch on/off the calculation of age spectra: if yes, the file AGECLASSES
+   must be available
+
+16. If IPIN=1, a file "partposit_end" from a previous run must be available in
+    the output directory. Particle positions are read in and previous simulation
+    is continued. If IPIN=0, no particles from a previous run are used
+
+17. IF IOUTPUTFOREACHRELEASE is set to 1, one output field for each location
+    in the RLEASE file is created. For backward calculation this should be
+    set to 1. For forward calculation both possibilities are applicable.
+
+18. If IFLUX is set to 1, fluxes of each species through each of the output
+    boxes are calculated. Six fluxes, corresponding to northward, southward,
+    eastward, westward, upward and downward are calculated for each grid cell of
+    the output grid. The control surfaces are placed in the middle of each
+    output grid cell. If IFLUX is set to 0, no fluxes are determined.
+
+19. If MDOMAINFILL is set to 1, the first box specified in file RELEASES is used
+    as the domain where domain-filling trajectory calculations are to be done.
+    Particles are initialized uniformly distributed (according to the air mass
+    distribution) in that domain at the beginning of the simulation, and are
+    created at the boundaries throughout the simulation period.
+
+20. IND_SOURCE switches between different units for concentrations at the source
+    NOTE that in backward simulations the release of computational particles
+    takes place at the "receptor" and the sampling of particles at the "source".
+          1=mass units (for bwd-runs = concentration)
+          2=mass mixing ratio units
+21. IND_RECEPTOR switches between different units for concentrations at the receptor
+          1=mass units (concentrations)
+          2=mass mixing ratio units
+
+22. MQUASILAG indicates whether particles shall be numbered consecutively (1) or
+    with their release location number (0). The first option allows tracking of
+    individual particles using the partposit output files
+
+23. NESTED_OUTPUT decides whether model output shall be made also for a nested
+    output field (normally with higher resolution)
+
+24. LINIT_COND determines whether, for backward runs only, the sensitivity to initial
+    conditions shall be calculated and written to output files
+    0=no output, 1 or 2 determines in which units the initial conditions are provided.
Index: /branches/FP_AI/tests/test_1/options/COMMAND.reference
===================================================================
--- /branches/FP_AI/tests/test_1/options/COMMAND.reference	(revision 23)
+++ /branches/FP_AI/tests/test_1/options/COMMAND.reference	(revision 23)
@@ -0,0 +1,190 @@
+********************************************************************************
+*                                                                              *
+*      Input file for the Lagrangian particle dispersion model FLEXPART        *
+*                           Please select your options                         *
+*                                                                              *
+********************************************************************************
+
+1. __                3X, I2
+    1       
+   LDIRECT           1 FOR FORWARD SIMULATION, -1 FOR BACKWARD SIMULATION
+
+2. ________ ______   3X, I8, 1X, I6
+   20040720 000000
+   YYYYMMDD HHMISS   BEGINNING DATE OF SIMULATION
+
+3. ________ ______   3X, I8, 1X, I6
+   20040721 120000
+   YYYYMMDD HHMISS   ENDING DATE OF SIMULATION
+
+4. _____             3X, I5
+   10800 
+   SSSSS             OUTPUT EVERY SSSSS SECONDS
+
+5. _____             3X, I5
+   10800 
+   SSSSS             TIME AVERAGE OF OUTPUT (IN SSSSS SECONDS)
+
+6. _____             3X, I5
+     900 
+   SSSSS             SAMPLING RATE OF OUTPUT (IN SSSSS SECONDS)
+
+7. _________         3X, I9
+   999999999
+   SSSSSSSSS         TIME CONSTANT FOR PARTICLE SPLITTING (IN SECONDS)
+
+8. _____             3X, I5
+     900 
+   SSSSS             SYNCHRONISATION INTERVAL OF FLEXPART (IN SECONDS)
+
+9.  ---.--           4X, F6.4
+     -5.0
+    CTL              FACTOR, BY WHICH TIME STEP MUST BE SMALLER THAN TL
+
+10. ---              4X, I3
+      4
+    IFINE            DECREASE OF TIME STEP FOR VERTICAL MOTION BY FACTOR IFINE
+
+11. -                4X, I1
+    3  
+    IOUT             1 CONCENTRATION (RESIDENCE TIME FOR BACKWARD RUNS) OUTPUT, 2 MIXING RATIO OUTPUT, 3 BOTH,4 PLUME TRAJECT., 5=1+4
+
+12. -                4X, I1
+    0  
+    IPOUT            PARTICLE DUMP: 0 NO, 1 EVERY OUTPUT INTERVAL, 2 ONLY AT END
+
+13. _                4X, I1
+    1
+    LSUBGRID         SUBGRID TERRAIN EFFECT PARAMETERIZATION: 1 YES, 0 NO
+
+14. _                4X, I1
+    1
+    LCONVECTION      CONVECTION: 1 YES, 0 NO
+
+15. _                4X, I1
+    0
+    LAGESPECTRA      AGE SPECTRA: 1 YES, 0 NO
+
+16. _                4X, I1
+    0
+    IPIN             CONTINUE SIMULATION WITH DUMPED PARTICLE DATA: 1 YES, 0 NO
+
+17. _                
+    0                4X,I1 
+    IOFR             IOUTPUTFOREACHREL CREATE AN OUPUT FILE FOR EACH RELEASE LOCATION: 1 YES, 0 NO
+
+18. _                4X, I1
+    0
+    IFLUX            CALCULATE FLUXES: 1 YES, 0 NO
+
+19. _                4X, I1
+    0
+    MDOMAINFILL      DOMAIN-FILLING TRAJECTORY OPTION: 1 YES, 0 NO, 2 STRAT. O3 TRACER
+
+20. _                4X, I1
+    1
+    IND_SOURCE       1=MASS UNIT , 2=MASS MIXING RATIO UNIT 
+
+21. _                4X, I1
+    1
+    IND_RECEPTOR     1=MASS UNIT , 2=MASS MIXING RATIO UNIT 
+
+22. _                4X, I1
+    0
+    MQUASILAG        QUASILAGRANGIAN MODE TO TRACK INDIVIDUAL PARTICLES: 1 YES, 0 NO
+
+23. _                4X, I1
+    0
+    NESTED_OUTPUT    SHALL NESTED OUTPUT BE USED? 1 YES, 0 NO
+
+24. _                4X, I1
+    2
+    LINIT_COND       INITIAL COND. FOR BW RUNS: 0=NO,1=MASS UNIT,2=MASS MIXING RATIO UNIT
+
+
+1. Simulation direction, 1 for forward, -1 for backward in time 
+	(consult Seibert and Frank, 2004 for backward runs)
+
+2. Beginning date and time of simulation. Must be given in format
+   YYYYMMDD HHMISS, where YYYY is YEAR, MM is MONTH, DD is DAY, HH is HOUR,
+   MI is MINUTE and SS is SECOND. Current version utilizes UTC.
+
+3. Ending date and time of simulation. Same format as 3.
+
+4. Average concentrations are calculated every SSSSS seconds.
+
+5. The average concentrations are time averages of SSSSS seconds
+   duration. If SSSSS is 0, instantaneous concentrations are outputted.
+
+6. The concentrations are sampled every SSSSS seconds to calculate the time
+   average concentration. This period must be shorter than the averaging time.
+
+7. Time constant for particle splitting. Particles are split into two
+   after SSSSS seconds, 2xSSSSS seconds, 4xSSSSS seconds, and so on.
+
+8. All processes are synchronized with this time interval (lsynctime).
+   Therefore, all other time constants must be multiples of this value.
+   Output interval and time average of output must be at least twice lsynctime.
+
+9. CTL must be >1 for time steps shorter than the  Lagrangian time scale
+   If CTL<0, a purely random walk simulation is done
+
+10.IFINE=Reduction factor for time step used for vertical wind
+
+11.IOUT determines how the output shall be made: concentration
+   (ng/m3, Bq/m3), mixing ratio (pptv), or both, or plume trajectory mode,
+   or concentration + plume trajectory mode.
+   In plume trajectory mode, output is in the form of average trajectories.
+
+12.IPOUT determines whether particle positions are outputted (in addition
+   to the gridded concentrations or mixing ratios) or not.
+   0=no output, 1 output every output interval, 2 only at end of the
+   simulation
+
+13.Switch on/off subgridscale terrain parameterization (increase of
+   mixing heights due to subgridscale orographic variations)
+
+14.Switch on/off the convection parameterization
+
+15.Switch on/off the calculation of age spectra: if yes, the file AGECLASSES
+   must be available
+
+16. If IPIN=1, a file "partposit_end" from a previous run must be available in
+    the output directory. Particle positions are read in and previous simulation
+    is continued. If IPIN=0, no particles from a previous run are used
+
+17. IF IOUTPUTFOREACHRELEASE is set to 1, one output field for each location
+    in the RLEASE file is created. For backward calculation this should be
+    set to 1. For forward calculation both possibilities are applicable.
+
+18. If IFLUX is set to 1, fluxes of each species through each of the output
+    boxes are calculated. Six fluxes, corresponding to northward, southward,
+    eastward, westward, upward and downward are calculated for each grid cell of
+    the output grid. The control surfaces are placed in the middle of each
+    output grid cell. If IFLUX is set to 0, no fluxes are determined.
+
+19. If MDOMAINFILL is set to 1, the first box specified in file RELEASES is used
+    as the domain where domain-filling trajectory calculations are to be done.
+    Particles are initialized uniformly distributed (according to the air mass
+    distribution) in that domain at the beginning of the simulation, and are
+    created at the boundaries throughout the simulation period.
+
+20. IND_SOURCE switches between different units for concentrations at the source
+    NOTE that in backward simulations the release of computational particles 
+    takes place at the "receptor" and the sampling of particles at the "source".
+          1=mass units (for bwd-runs = concentration)
+          2=mass mixing ratio units 
+21. IND_RECEPTOR switches between different units for concentrations at the receptor
+          1=mass units (concentrations)
+          2=mass mixing ratio units 
+
+22. MQUASILAG indicates whether particles shall be numbered consecutively (1) or
+    with their release location number (0). The first option allows tracking of
+    individual particles using the partposit output files
+
+23. NESTED_OUTPUT decides whether model output shall be made also for a nested
+    output field (normally with higher resolution)
+
+24. LINIT_COND determines whether, for backward runs only, the sensitivity to initial
+    conditions shall be calculated and written to output files
+    0=no output, 1 or 2 determines in which units the initial conditions are provided.
Index: /branches/FP_AI/tests/test_1/options/OUTGRID
===================================================================
--- /branches/FP_AI/tests/test_1/options/OUTGRID	(revision 23)
+++ /branches/FP_AI/tests/test_1/options/OUTGRID	(revision 23)
@@ -0,0 +1,43 @@
+********************************************************************************
+*                                                                              *
+*      Input file for the Lagrangian particle dispersion model FLEXPART        *
+*                       Please specify your output grid                        *
+*                                                                              *
+********************************************************************************
+
+1.  ------.----       4X,F11.4
+      -179.0000       GEOGRAFICAL LONGITUDE OF LOWER LEFT CORNER OF OUTPUT GRID
+    OUTLONLEFT        (left boundary of the first grid cell - not its centre)
+
+2.  ------.----       4X,F11.4
+       -90.0000       GEOGRAFICAL LATITUDE OF LOWER LEFT CORNER OF OUTPUT GRID
+    OUTLATLOWER       (lower boundary of the first grid cell - not its centre)
+
+3.  -----             4X,I5
+      360               NUMBER OF GRID POINTS IN X DIRECTION (= No. of cells + 1)
+    NUMXGRID
+
+4.  -----             4X,I5
+      180             NUMBER OF GRID POINTS IN Y DIRECTION (= No. of cells + 1)
+    NUMYGRID
+
+5.  ------.---        4X,F10.3
+         1.000        GRID DISTANCE IN X DIRECTION
+    DXOUTLON
+
+6.  ------.---        4X,F10.3
+         1.000        GRID DISTANCE IN Y DIRECTION
+    DYOUTLAT
+
+10. -----.-           4X, F7.1
+      100.0
+    LEVEL 4           HEIGHT OF LEVEL (UPPER BOUNDARY)
+
+10. -----.-           4X, F7.1
+     3000.0
+    LEVEL 4           HEIGHT OF LEVEL (UPPER BOUNDARY)
+
+10. -----.-           4X, F7.1
+    50000.0
+    LEVEL 4           HEIGHT OF LEVEL (UPPER BOUNDARY)
+
Index: /branches/FP_AI/tests/test_1/options/OUTGRID-bk
===================================================================
--- /branches/FP_AI/tests/test_1/options/OUTGRID-bk	(revision 23)
+++ /branches/FP_AI/tests/test_1/options/OUTGRID-bk	(revision 23)
@@ -0,0 +1,43 @@
+********************************************************************************
+*                                                                              *
+*      Input file for the Lagrangian particle dispersion model FLEXPART        *
+*                       Please specify your output grid                        *
+*                                                                              *
+********************************************************************************
+
+1.  ------.----       4X,F11.4
+      -179.0000       GEOGRAFICAL LONGITUDE OF LOWER LEFT CORNER OF OUTPUT GRID
+    OUTLONLEFT        (left boundary of the first grid cell - not its centre)
+
+2.  ------.----       4X,F11.4
+       -90.0000       GEOGRAFICAL LATITUDE OF LOWER LEFT CORNER OF OUTPUT GRID
+    OUTLATLOWER       (lower boundary of the first grid cell - not its centre)
+
+3.  -----             4X,I5
+      360               NUMBER OF GRID POINTS IN X DIRECTION (= No. of cells + 1)
+    NUMXGRID
+
+4.  -----             4X,I5
+      180             NUMBER OF GRID POINTS IN Y DIRECTION (= No. of cells + 1)
+    NUMYGRID
+
+5.  ------.---        4X,F10.3
+         1.000        GRID DISTANCE IN X DIRECTION
+    DXOUTLON
+
+6.  ------.---        4X,F10.3
+         1.000        GRID DISTANCE IN Y DIRECTION
+    DYOUTLAT
+
+10. -----.-           4X, F7.1
+      100.0
+    LEVEL 4           HEIGHT OF LEVEL (UPPER BOUNDARY)
+
+10. -----.-           4X, F7.1
+     3000.0
+    LEVEL 4           HEIGHT OF LEVEL (UPPER BOUNDARY)
+
+10. -----.-           4X, F7.1
+    50000.0
+    LEVEL 4           HEIGHT OF LEVEL (UPPER BOUNDARY)
+
Index: /branches/FP_AI/tests/test_1/options/OUTGRID-bk2
===================================================================
--- /branches/FP_AI/tests/test_1/options/OUTGRID-bk2	(revision 23)
+++ /branches/FP_AI/tests/test_1/options/OUTGRID-bk2	(revision 23)
@@ -0,0 +1,43 @@
+********************************************************************************
+*                                                                              *
+*      Input file for the Lagrangian particle dispersion model FLEXPART        *
+*                       Please specify your output grid                        *
+*                                                                              *
+********************************************************************************
+
+1.  ------.----       4X,F11.4
+       492.7263       GEOGRAFICAL LONGITUDE OF LOWER LEFT CORNER OF OUTPUT GRID
+    OUTLONLEFT        (left boundary of the first grid cell - not its centre)
+
+2.  ------.----       4X,F11.4
+        31.5645       GEOGRAFICAL LATITUDE OF LOWER LEFT CORNER OF OUTPUT GRID
+    OUTLATLOWER       (lower boundary of the first grid cell - not its centre)
+
+3.  -----             4X,I5
+      123               NUMBER OF GRID POINTS IN X DIRECTION (= No. of cells + 1)
+    NUMXGRID
+
+4.  -----             4X,I5
+     111             NUMBER OF GRID POINTS IN Y DIRECTION (= No. of cells + 1)
+    NUMYGRID
+
+5.  ------.---        4X,F10.3
+         0.1076        GRID DISTANCE IN X DIRECTION
+    DXOUTLON
+
+6.  ------.---        4X,F10.3
+         0.0869        GRID DISTANCE IN Y DIRECTION
+    DYOUTLAT
+
+10. -----.-           4X, F7.1
+      100.0
+    LEVEL 4           HEIGHT OF LEVEL (UPPER BOUNDARY)
+
+10. -----.-           4X, F7.1
+      500.0
+    LEVEL 4           HEIGHT OF LEVEL (UPPER BOUNDARY)
+
+10. -----.-           4X, F7.1
+     1000.0
+    LEVEL 4           HEIGHT OF LEVEL (UPPER BOUNDARY)
+
Index: /branches/FP_AI/tests/test_1/options/OUTGRID_NEST
===================================================================
--- /branches/FP_AI/tests/test_1/options/OUTGRID_NEST	(revision 23)
+++ /branches/FP_AI/tests/test_1/options/OUTGRID_NEST	(revision 23)
@@ -0,0 +1,30 @@
+********************************************************************************
+*                                                                              *
+*      Input file for the Lagrangian particle dispersion model FLEXPART        *
+*                       Please specify your output grid                        *
+*                                                                              *
+********************************************************************************
+
+1.  ------.----       4X,F11.4
+       -15.0000       GEOGRAFICAL LONGITUDE OF LOWER LEFT CORNER OF OUTPUT GRID
+    OUTLONLEFT        (left boundary of the first grid cell - not its centre)
+
+2.  ------.----       4X,F11.4
+        35.0000       GEOGRAFICAL LATITUDE OF LOWER LEFT CORNER OF OUTPUT GRID
+    OUTLATLOWER       (lower boundary of the first grid cell - not its centre)
+
+3.  -----             4X,I5
+      220             NUMBER OF GRID POINTS IN X DIRECTION (= No. of cells + 1)
+    NUMXGRID
+
+4.  -----             4X,I5
+      120             NUMBER OF GRID POINTS IN Y DIRECTION (= No. of cells + 1)
+    NUMYGRID
+
+5.  ------.-----      4X,F12.5
+         0.25000      GRID DISTANCE IN X DIRECTION
+    DXOUTLON
+
+6.  ------.-----      4X,F12.5
+         0.25000      GRID DISTANCE IN Y DIRECTION
+    DYOUTLAT
Index: /branches/FP_AI/tests/test_1/options/RECEPTORS
===================================================================
--- /branches/FP_AI/tests/test_1/options/RECEPTORS	(revision 23)
+++ /branches/FP_AI/tests/test_1/options/RECEPTORS	(revision 23)
@@ -0,0 +1,79 @@
+********************************************************************************
+*                                                                              *
+*      Input file for the Lagrangian particle dispersion model FLEXPART        *
+*                       Please specify your receptor points                    *
+*     For the receptor points, ground level concentrations are calculated      *
+*                                                                              *
+********************************************************************************
+1.  ----------------  4X,A16
+    F15               NAME OF RECEPTOR POINT
+    RECEPTORNAME
+
+2.  ------.----       4X,F11.4
+         6.1333       GEOGRAFICAL LONGITUDE
+    XRECEPTOR 
+
+3.  ------.----       4X,F11.4
+        49.0833       GEOGRAFICAL LATITUDE
+    YRECEPTOR  
+================================================================================
+1.  ----------------  4X,A16
+    NL01              NAME OF RECEPTOR POINT
+    RECEPTORNAME
+
+2.  ------.----       4X,F11.4
+         5.7833       GEOGRAFICAL LONGITUDE
+    XRECEPTOR 
+
+3.  ------.----       4X,F11.4
+        50.9167       GEOGRAFICAL LATITUDE
+    YRECEPTOR  
+================================================================================
+1.  ----------------  4X,A16
+    B05               NAME OF RECEPTOR POINT
+    RECEPTORNAME
+
+2.  ------.----       4X,F11.4
+         4.3500       GEOGRAFICAL LONGITUDE
+    XRECEPTOR 
+
+3.  ------.----       4X,F11.4
+        50.8000       GEOGRAFICAL LATITUDE
+    YRECEPTOR  
+================================================================================
+1.  ----------------  4X,A16
+    D27               NAME OF RECEPTOR POINT
+    RECEPTORNAME
+
+2.  ------.----       4X,F11.4
+        11.1333       GEOGRAFICAL LONGITUDE
+    XRECEPTOR 
+
+3.  ------.----       4X,F11.4
+        52.9667       GEOGRAFICAL LATITUDE
+    YRECEPTOR  
+================================================================================
+1.  ----------------  4X,A16
+    D08               NAME OF RECEPTOR POINT
+    RECEPTORNAME
+
+2.  ------.----       4X,F11.4
+         8.7000       GEOGRAFICAL LONGITUDE
+    XRECEPTOR 
+
+3.  ------.----       4X,F11.4
+        53.8667       GEOGRAFICAL LATITUDE
+    YRECEPTOR  
+================================================================================
+1.  ----------------  4X,A16
+    DK05              NAME OF RECEPTOR POINT
+    RECEPTORNAME
+
+2.  ------.----       4X,F11.4
+         8.1333       GEOGRAFICAL LONGITUDE
+    XRECEPTOR 
+
+3.  ------.----       4X,F11.4
+        56.0000       GEOGRAFICAL LATITUDE
+    YRECEPTOR  
+================================================================================
Index: /branches/FP_AI/tests/test_1/options/RELEASES
===================================================================
--- /branches/FP_AI/tests/test_1/options/RELEASES	(revision 23)
+++ /branches/FP_AI/tests/test_1/options/RELEASES	(revision 23)
@@ -0,0 +1,54 @@
+*************************************************************************
+*                                                                       *
+*                                                                       *
+*                                                                       *
+*   Input file for the Lagrangian particle dispersion model FLEXPART    *
+*                        Please select your options                     *
+*                                                                       *
+*                                                                       *
+*                                                                       *
+*************************************************************************
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  1      
+___                        i3    Total number of species emitted
+
+ 24
+___                        i3    Index of species in file SPECIES
+
+=========================================================================
+20070106      0 
+________ ______            i8,1x,i6 Beginning date and time of release
+
+20070107 000000 
+________ ______            i8,1x,i6 Ending date and time of release
+
+   9.4048 
+____.____                  f9.4  Longitude [DEG] of lower left corner
+
+  48.5060
+____.____                  f9.4  Latitude [DEG] of lower left corner
+
+   9.5067
+____.____                  f9.4  Longitude [DEG] of upper right corner
+
+  48.5158
+____.____                  f9.4  Latitude [DEG] of upper right corner
+
+        2
+_________                  i9    1 for m above ground, 2 for m above sea level
+
+ 6933.60
+_____.___                  f10.3 Lower z-level (in m agl or m asl)
+ 
+ 6950.40
+_____.___                  f10.3 Upper z-level (in m agl or m asl)
+ 
+      100                
+_________                  i9    Total number of particles to be released
+
+1.0000E00
+_.____E__                  e9.4  Total mass emitted
+
+RELEASE_TEST1
+________________________________________   character*40 comment
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Index: /branches/FP_AI/tests/test_1/options/RELEASES-bk
===================================================================
--- /branches/FP_AI/tests/test_1/options/RELEASES-bk	(revision 23)
+++ /branches/FP_AI/tests/test_1/options/RELEASES-bk	(revision 23)
@@ -0,0 +1,868 @@
++++++++++++++++++ HEADER ++++++++++++++++++++
++++++++++++++++++ HEADER ++++++++++++++++++++
++++++++++++++++++ HEADER ++++++++++++++++++++
++++++++++++++++++ HEADER ++++++++++++++++++++
++++++++++++++++++ HEADER ++++++++++++++++++++
++++++++++++++++++ HEADER ++++++++++++++++++++
++++++++++++++++++ HEADER ++++++++++++++++++++
++++++++++++++++++ HEADER ++++++++++++++++++++
++++++++++++++++++ HEADER ++++++++++++++++++++
++++++++++++++++++ HEADER ++++++++++++++++++++
++++++++++++++++++ HEADER ++++++++++++++++++++
+5
+31
+31
+31
+31
+31
+
+20040101 080000
+20040102 080000
+   8.2500
+  58.3833
+   8.2500
+  58.3833
+1
+     0.000
+   100.000
+4000
+1
+1
+1
+1
+1
+rel_bj
+
+20040108 080000
+20040109 080000
+   8.2500
+  58.3833
+   8.2500
+  58.3833
+1
+     0.000
+   100.000
+4000
+1
+1
+1
+1
+1
+rel_bj
+
+20040115 080000
+20040116 080000
+   8.2500
+  58.3833
+   8.2500
+  58.3833
+1
+     0.000
+   100.000
+4000
+1
+1
+1
+1
+1
+rel_bj
+
+20040122 080000
+20040123 080000
+   8.2500
+  58.3833
+   8.2500
+  58.3833
+1
+     0.000
+   100.000
+4000
+1
+1
+1
+1
+1
+rel_bj
+
+20040129 080000
+20040130 080000
+   8.2500
+  58.3833
+   8.2500
+  58.3833
+1
+     0.000
+   100.000
+4000
+1
+1
+1
+1
+1
+rel_bj
+
+20040205 080000
+20040206 080000
+   8.2500
+  58.3833
+   8.2500
+  58.3833
+1
+     0.000
+   100.000
+4000
+1
+1
+1
+1
+1
+rel_bj
+
+20040212 080000
+20040213 080000
+   8.2500
+  58.3833
+   8.2500
+  58.3833
+1
+     0.000
+   100.000
+4000
+1
+1
+1
+1
+1
+rel_bj
+
+20040219 080000
+20040220 080000
+   8.2500
+  58.3833
+   8.2500
+  58.3833
+1
+     0.000
+   100.000
+4000
+1
+1
+1
+1
+1
+rel_bj
+
+20040226 080000
+20040227 080000
+   8.2500
+  58.3833
+   8.2500
+  58.3833
+1
+     0.000
+   100.000
+4000
+1
+1
+1
+1
+1
+rel_bj
+
+20040304 080000
+20040305 080000
+   8.2500
+  58.3833
+   8.2500
+  58.3833
+1
+     0.000
+   100.000
+4000
+1
+1
+1
+1
+1
+rel_bj
+
+20040311 080000
+20040312 080000
+   8.2500
+  58.3833
+   8.2500
+  58.3833
+1
+     0.000
+   100.000
+4000
+1
+1
+1
+1
+1
+rel_bj
+
+20040318 080000
+20040319 080000
+   8.2500
+  58.3833
+   8.2500
+  58.3833
+1
+     0.000
+   100.000
+4000
+1
+1
+1
+1
+1
+rel_bj
+
+20040325 080000
+20040326 080000
+   8.2500
+  58.3833
+   8.2500
+  58.3833
+1
+     0.000
+   100.000
+4000
+1
+1
+1
+1
+1
+rel_bj
+
+20040401 080000
+20040402 080000
+   8.2500
+  58.3833
+   8.2500
+  58.3833
+1
+     0.000
+   100.000
+4000
+1
+1
+1
+1
+1
+rel_bj
+
+20040408 080000
+20040409 080000
+   8.2500
+  58.3833
+   8.2500
+  58.3833
+1
+     0.000
+   100.000
+4000
+1
+1
+1
+1
+1
+rel_bj
+
+20040415 080000
+20040416 080000
+   8.2500
+  58.3833
+   8.2500
+  58.3833
+1
+     0.000
+   100.000
+4000
+1
+1
+1
+1
+1
+rel_bj
+
+20040422 080000
+20040423 080000
+   8.2500
+  58.3833
+   8.2500
+  58.3833
+1
+     0.000
+   100.000
+4000
+1
+1
+1
+1
+1
+rel_bj
+
+20040429 080000
+20040430 080000
+   8.2500
+  58.3833
+   8.2500
+  58.3833
+1
+     0.000
+   100.000
+4000
+1
+1
+1
+1
+1
+rel_bj
+
+20040609 080000
+20040610 080000
+   8.2500
+  58.3833
+   8.2500
+  58.3833
+1
+     0.000
+   100.000
+4000
+1
+1
+1
+1
+1
+rel_bj
+
+20040610 080000
+20040611 080000
+   8.2500
+  58.3833
+   8.2500
+  58.3833
+1
+     0.000
+   100.000
+4000
+1
+1
+1
+1
+1
+rel_bj
+
+20040617 080000
+20040618 080000
+   8.2500
+  58.3833
+   8.2500
+  58.3833
+1
+     0.000
+   100.000
+4000
+1
+1
+1
+1
+1
+rel_bj
+
+20040624 080000
+20040625 080000
+   8.2500
+  58.3833
+   8.2500
+  58.3833
+1
+     0.000
+   100.000
+4000
+1
+1
+1
+1
+1
+rel_bj
+
+20040701 080000
+20040702 080000
+   8.2500
+  58.3833
+   8.2500
+  58.3833
+1
+     0.000
+   100.000
+4000
+1
+1
+1
+1
+1
+rel_bj
+
+20040708 080000
+20040709 080000
+   8.2500
+  58.3833
+   8.2500
+  58.3833
+1
+     0.000
+   100.000
+4000
+1
+1
+1
+1
+1
+rel_bj
+
+20040715 080000
+20040716 080000
+   8.2500
+  58.3833
+   8.2500
+  58.3833
+1
+     0.000
+   100.000
+4000
+1
+1
+1
+1
+1
+rel_bj
+
+20040722 080000
+20040723 080000
+   8.2500
+  58.3833
+   8.2500
+  58.3833
+1
+     0.000
+   100.000
+4000
+1
+1
+1
+1
+1
+rel_bj
+
+20040729 080000
+20040730 080000
+   8.2500
+  58.3833
+   8.2500
+  58.3833
+1
+     0.000
+   100.000
+4000
+1
+1
+1
+1
+1
+rel_bj
+
+20040805 080000
+20040806 080000
+   8.2500
+  58.3833
+   8.2500
+  58.3833
+1
+     0.000
+   100.000
+4000
+1
+1
+1
+1
+1
+rel_bj
+
+20040812 080000
+20040813 080000
+   8.2500
+  58.3833
+   8.2500
+  58.3833
+1
+     0.000
+   100.000
+4000
+1
+1
+1
+1
+1
+rel_bj
+
+20040819 080000
+20040820 080000
+   8.2500
+  58.3833
+   8.2500
+  58.3833
+1
+     0.000
+   100.000
+4000
+1
+1
+1
+1
+1
+rel_bj
+
+20040826 080000
+20040827 080000
+   8.2500
+  58.3833
+   8.2500
+  58.3833
+1
+     0.000
+   100.000
+4000
+1
+1
+1
+1
+1
+rel_bj
+
+20040902 080000
+20040903 080000
+   8.2500
+  58.3833
+   8.2500
+  58.3833
+1
+     0.000
+   100.000
+4000
+1
+1
+1
+1
+1
+rel_bj
+
+20040909 080000
+20040910 080000
+   8.2500
+  58.3833
+   8.2500
+  58.3833
+1
+     0.000
+   100.000
+4000
+1
+1
+1
+1
+1
+rel_bj
+
+20040916 080000
+20040917 080000
+   8.2500
+  58.3833
+   8.2500
+  58.3833
+1
+     0.000
+   100.000
+4000
+1
+1
+1
+1
+1
+rel_bj
+
+20040923 080000
+20040924 080000
+   8.2500
+  58.3833
+   8.2500
+  58.3833
+1
+     0.000
+   100.000
+4000
+1
+1
+1
+1
+1
+rel_bj
+
+20040930 080000
+20041001 080000
+   8.2500
+  58.3833
+   8.2500
+  58.3833
+1
+     0.000
+   100.000
+4000
+1
+1
+1
+1
+1
+rel_bj
+
+20041007 080000
+20041008 080000
+   8.2500
+  58.3833
+   8.2500
+  58.3833
+1
+     0.000
+   100.000
+4000
+1
+1
+1
+1
+1
+rel_bj
+
+20041014 080000
+20041015 080000
+   8.2500
+  58.3833
+   8.2500
+  58.3833
+1
+     0.000
+   100.000
+4000
+1
+1
+1
+1
+1
+rel_bj
+
+20041021 080000
+20041022 080000
+   8.2500
+  58.3833
+   8.2500
+  58.3833
+1
+     0.000
+   100.000
+4000
+1
+1
+1
+1
+1
+rel_bj
+
+20041028 080000
+20041029 080000
+   8.2500
+  58.3833
+   8.2500
+  58.3833
+1
+     0.000
+   100.000
+4000
+1
+1
+1
+1
+1
+rel_bj
+
+20041104 080000
+20041105 080000
+   8.2500
+  58.3833
+   8.2500
+  58.3833
+1
+     0.000
+   100.000
+4000
+1
+1
+1
+1
+1
+rel_bj
+
+20041111 080000
+20041112 080000
+   8.2500
+  58.3833
+   8.2500
+  58.3833
+1
+     0.000
+   100.000
+4000
+1
+1
+1
+1
+1
+rel_bj
+
+20041118 080000
+20041119 080000
+   8.2500
+  58.3833
+   8.2500
+  58.3833
+1
+     0.000
+   100.000
+4000
+1
+1
+1
+1
+1
+rel_bj
+
+20041124 080000
+20041125 080000
+   8.2500
+  58.3833
+   8.2500
+  58.3833
+1
+     0.000
+   100.000
+4000
+1
+1
+1
+1
+1
+rel_bj
+
+20041125 080000
+20041126 080000
+   8.2500
+  58.3833
+   8.2500
+  58.3833
+1
+     0.000
+   100.000
+4000
+1
+1
+1
+1
+1
+rel_bj
+
+20041208 080000
+20041209 080000
+   8.2500
+  58.3833
+   8.2500
+  58.3833
+1
+     0.000
+   100.000
+4000
+1
+1
+1
+1
+1
+rel_bj
+
+20041209 080000
+20041210 080000
+   8.2500
+  58.3833
+   8.2500
+  58.3833
+1
+     0.000
+   100.000
+4000
+1
+1
+1
+1
+1
+rel_bj
+
+20041216 080000
+20041217 080000
+   8.2500
+  58.3833
+   8.2500
+  58.3833
+1
+     0.000
+   100.000
+4000
+1
+1
+1
+1
+1
+rel_bj
+
+20041223 080000
+20041224 080000
+   8.2500
+  58.3833
+   8.2500
+  58.3833
+1
+     0.000
+   100.000
+4000
+1
+1
+1
+1
+1
+rel_bj
+
+20041230 080000
+20041231 080000
+   8.2500
+  58.3833
+   8.2500
+  58.3833
+1
+     0.000
+   100.000
+4000
+1
+1
+1
+1
+1
+rel_bj
+
Index: /branches/FP_AI/tests/test_1/options/RELEASES.alternative
===================================================================
--- /branches/FP_AI/tests/test_1/options/RELEASES.alternative	(revision 23)
+++ /branches/FP_AI/tests/test_1/options/RELEASES.alternative	(revision 23)
@@ -0,0 +1,40 @@
+*************************************************************************
+*                                                                       *
+*                                                                       *
+*                                                                       *
+*   Input file for the Lagrangian particle dispersion model FLEXPART    *
+*                        Please select your options                     *
+*                                                                       *
+*                                                                       *
+*                                                                       *
+*************************************************************************
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+1                          Total number of species emitted
+24                         Index of species in file SPECIES
+=========================================================================
+   20011028  150007
+   20011028  150046
+   9.40480
+   48.5060
+   9.50670
+   48.5158
+   2
+   6933.60
+   6950.40
+   20000
+   1.00000
+FLIGHT_11242
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+   20011028  150047
+   20011028  150107
+   9.30380
+   48.5158
+   9.40480
+   48.5906
+   2
+   6833.50
+   6950.40
+   20000
+   1.00000
+FLIGHT_11185
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Index: /branches/FP_AI/tests/test_1/options/RELEASES.reference
===================================================================
--- /branches/FP_AI/tests/test_1/options/RELEASES.reference	(revision 23)
+++ /branches/FP_AI/tests/test_1/options/RELEASES.reference	(revision 23)
@@ -0,0 +1,90 @@
+*************************************************************************
+*                                                                       *
+*                                                                       *
+*                                                                       *
+*   Input file for the Lagrangian particle dispersion model FLEXPART    *
+*                        Please select your options                     *
+*                                                                       *
+*                                                                       *
+*                                                                       *
+*************************************************************************
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+  1      
+___                        i3    Total number of species emitted
+
+ 24
+___                        i3    Index of species in file SPECIES
+
+=========================================================================
+20040720      0 
+________ ______            i8,1x,i6 Beginning date and time of release
+
+20040720 120000 
+________ ______            i8,1x,i6 Ending date and time of release
+
+   9.4048 
+____.____                  f9.4  Longitude [DEG] of lower left corner
+
+  48.5060
+____.____                  f9.4  Latitude [DEG] of lower left corner
+
+   9.5067
+____.____                  f9.4  Longitude [DEG] of upper right corner
+
+  48.5158
+____.____                  f9.4  Latitude [DEG] of upper right corner
+
+        2
+_________                  i9    1 for m above ground, 2 for m above sea level
+
+ 6933.60
+_____.___                  f10.3 Lower z-level (in m agl or m asl)
+ 
+ 6950.40
+_____.___                  f10.3 Upper z-level (in m agl or m asl)
+ 
+    20000                
+_________                  i9    Total number of particles to be released
+
+1.0000E00
+_.____E__                  e9.4  Total mass emitted
+
+RELEASE_TEST1
+________________________________________   character*40 comment
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+20040720      0
+________ ______            i8,1x,i6 Beginning date and time of release
+
+20040720 120000
+________ ______            i8,1x,i6 Ending date and time of release
+
+   9.3038 
+____.____                  f9.4  Longitude [DEG] of lower left corner
+
+  48.5158
+____.____                  f9.4  Latitude [DEG] of lower left corner
+
+   9.4048
+____.____                  f9.4  Longitude [DEG] of upper right corner
+
+  48.5906
+____.____                  f9.4  Latitude [DEG] of upper right corner
+
+        2
+_________                  i9    1 for m above ground, 2 for m above sea level
+
+ 6833.50
+_____.___                  f10.3 Lower z-level (in m agl or m asl)
+ 
+ 6950.40
+_____.___                  f10.3 Upper z-level (in m agl or m asl)
+ 
+    20000                
+_________                  i9    Total number of particles to be released
+
+1.0000E00
+_.____E__                  e9.4  Total mass emitted
+
+RELEASE_TEST2
+________________________________________   character*40 comment
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Index: /branches/FP_AI/tests/test_1/options/SPECIES/SPECIES.orig
===================================================================
--- /branches/FP_AI/tests/test_1/options/SPECIES/SPECIES.orig	(revision 23)
+++ /branches/FP_AI/tests/test_1/options/SPECIES/SPECIES.orig	(revision 23)
@@ -0,0 +1,47 @@
+****************************************************************************
+*                                                                          *
+*     Input file for the Lagrangian particle dispersion model FLEXPART     *
+*               Definition file of chemical species/radionuclides          *
+*                                                                          *
+****************************************************************************
+           Radioactivity    Wet depo         Dry depo (gases)      Dry depo (particles)  Dry depo              OH React
+     SPECIES HALF LIFE [s]     A      B       D      H     f0      rho    dquer    dsig      vd   molweight   [cm^3/s] 
+ 50 TRACER1234567 1234.6   -2.4E-08  1.34   -2.4  1.3e-07  1.3   -2.4E07  1.3E-6  1.3E-6   -2.45  123.45    -2.4E-08
+  1 TRACER        -999.9   -9.9E-09         -9.9                 -9.9E09                   -9.99  350.00    -9.9E-09
+  2 O3            -999.9   -9.9E-09          1.5  1.0e-02  1.0   -9.9E09                   -9.99   48.00    -9.9E-09
+  3 NO            -999.9    8.0E-06  0.62    1.2  3.0e-03  0.0   -9.9E09                   -9.99   30.00    -9.9E-09
+  4 NO2           -999.9    1.0E-05  0.62    1.6  1.0e-02  0.1   -9.9E09                   -9.99   46.00    -9.9E-09
+  5 HNO3          -999.9    5.0E-05  0.62    1.9  1.0e+14  0.0   -9.9E09                   -9.99   63.00    -9.9E-09
+  6 HNO2          -999.9   -9.9E-09          1.6  1.0e+05  0.1   -9.9E09                   -9.99   47.00    -9.9E-09
+  7 H2O2          -999.9    1.0E-04  0.62    1.4  1.0e+05  1.0   -9.9E09                   -9.99   34.00    -9.9E-09
+  8 SO2           -999.9   -9.9E-09  0.62    2.0  1.0e+05  0.0   -9.9E09                   -9.99   64.00    -9.9E-09
+  9 HCHO          -999.9   -9.9E-09          1.3  6.0e+03  0.0   -9.9E09                   -9.99   30.00    -9.9E-09
+ 10 PAN           -999.9   -9.9E-09          2.6  3.6e+00  0.1   -9.9E09                   -9.99  121.00    -9.9E-09
+ 11 NH3           -999.9    9.9E-05  0.62    1.1  2.0e+14  0.0   -9.9E09                   -9.99   17.00    -9.9E-09
+ 12 SO4-aero      -999.9    5.0E-06  0.62   -9.9                  2.0E03  4.0E-7  3.0E-1   -9.99   -9.99    -9.9E-09
+ 13 NO3-aero      -999.9    5.0E-06  0.62   -9.9                  2.0E03  4.0E-7  3.0E-1   -9.99   -9.99    -9.9E-09
+ 14 I2-131      691200.0    8.0E-05  0.62    2.7  1.0e+05  0.1   -9.9E09                   -9.99   -9.99    -9.9E-09
+ 15 I-131       691200.0    1.0E-04  0.80   -9.9                  2.5E03  6.0E-7  3.0E-1   -9.99   -9.99    -9.9E-09
+ 16 Cs-137        -999.9    1.0E-04  0.80   -9.9                  2.5E03  6.0E-7  3.0E-1   -9.99   -9.99    -9.9E-09
+ 17 Y-91       5037120.0    1.0E-04  0.80   -9.9                  2.5E03  6.0E-7  3.0E-1   -9.99   -9.99    -9.9E-09
+ 18 Ru-106    31536000.0    1.0E-04  0.80   -9.9                  2.5E03  6.0E-7  3.0E-1   -9.99   -9.99    -9.9E-09
+ 19 Kr-85         -999.9   -9.9E-09         -9.9                 -9.9E09                   -9.99   -9.99    -9.9E-09
+ 20 Sr-90         -999.9    1.0E-04  0.80   -9.9                  2.5E03  6.0E-7  3.0E-1   -9.99   -9.99    -9.9E-09
+ 21 Xe-133      198720.0   -9.9E-09         -9.9                 -9.9E09                   -9.99   -9.99    -9.9E-09
+ 22 CO            -999.9   -9.9E-09         -9.9                 -9.9E09                   -9.99   28.00     1.5E-13
+ 23 NO2TRACER     -999.9   -9.9E-09         -9.9                 -9.9E09                   -9.99   46.00    -9.9E-09
+ 24 AIRTRACER     -999.9   -9.9E-09         -9.9                 -9.9E09                   -9.99   29.00    -9.9E-09
+ 25 NA-CO         -999.9   -9.9E-09         -9.9                 -9.9E09                   -9.99   28.00    -9.9E-09
+ 26 EU-CO         -999.9   -9.9E-09         -9.9                 -9.9E09                   -9.99   28.00    -9.9E-09
+ 27 AS-CO         -999.9   -9.9E-09         -9.9                 -9.9E09                   -9.99   28.00    -9.9E-09
+ 28 SO2TRACER     -999.9   -9.9E-09         -9.9                 -9.9E09                   -9.99   64.00    -9.9E-09
+ 29 WET_TRAC      -999.9      1E-04  0.62   -9.9                 -9.9E09                   -9.99  100.00    -9.9E-09
+ 30 DRY_TRAC      3999.9   -9.9E-09          2.0  1.0e-02  1.0   -9.9E09                   -9.99  100.00    -9.9E-09
+ 31 PCB28         -999.9      5E-06  0.62    3.8  3.1e-00  0.0   -9.9E09                   -9.99  257.54     1.1E-12
+ 32 PCB101        -999.9      5E-06  0.62    4.3  3.2e-00  0.0   -9.9E09                   -9.99  326.43     3.4E-13
+ 33 PCB180        -999.9      5E-06  0.62    4.7  1.7e+01  0.0   -9.9E09                   -9.99  395.32     1.1E-13
+ 34 G-HCH         -999.9   -9.9E-09         -9.9                 -9.9E09                   -9.99  999.99     9.9E-99
+ 35 TEST          1000.0      1E-02  0.62    2.0  1.0e-02  1.0   -9.9E09                   -9.99  100.00     1.0E+02
+ 36 PCB28-TEST    -999.9   -9.9E-09  0.62   -9.9  3.1e-00  0.0   -9.9E09                   -9.99  257.54     1.1E-12
+ 37 HNO3          -999.9   -8.0E-04  0.62   -9.9                 -9.9E09                   -9.99   63.00    -9.9E-09
+
Index: /branches/FP_AI/tests/test_1/options/SPECIES/SPECIES_001
===================================================================
--- /branches/FP_AI/tests/test_1/options/SPECIES/SPECIES_001	(revision 23)
+++ /branches/FP_AI/tests/test_1/options/SPECIES/SPECIES_001	(revision 23)
@@ -0,0 +1,21 @@
+****************************************************************************
+*                                                                          *
+*     Input file for the Lagrangian particle dispersion model FLEXPART     *
+*               Definition file of chemical species/radionuclides          *
+*                                                                          *
+****************************************************************************
+TRACER             Tracer name
+-999.9             Species half life
+-9.9E-09           Wet deposition - A
+                   Wet deposition - B
+-9.9               Dry deposition (gases) - D
+                   Dry deposition (gases) - Henrys const.
+                   Dry deposition (gases) - f0 (reactivity)
+-9.9E09            Dry deposition (particles) - rho
+                   Dry deposition (particles) - dquer
+                   Dry deposition (particles) - dsig
+-9.99              Alternative: dry deposition velocity
+350.00             molweight
+-9.9E-09           OH Reaction rate at 25 deg, [cm^3/sec]
+-9                 number of associated specias (neg. none)
+-99.99             KOA - organic matter air partitioning
Index: /branches/FP_AI/tests/test_1/options/SPECIES/SPECIES_002
===================================================================
--- /branches/FP_AI/tests/test_1/options/SPECIES/SPECIES_002	(revision 23)
+++ /branches/FP_AI/tests/test_1/options/SPECIES/SPECIES_002	(revision 23)
@@ -0,0 +1,21 @@
+****************************************************************************
+*                                                                          *
+*     Input file for the Lagrangian particle dispersion model FLEXPART     *
+*               Definition file of chemical species/radionuclides          *
+*                                                                          *
+****************************************************************************
+O3                 Tracer name
+-999.9             Species half life
+-9.9E-09           Wet deposition - A
+                   Wet deposition - B
+ 1.5               Dry deposition (gases) - D
+1.0e-02            Dry deposition (gases) - Henrys const.
+1.0                Dry deposition (gases) - f0 (reactivity)
+-9.9E09            Dry deposition (particles) - rho
+                   Dry deposition (particles) - dquer
+                   Dry deposition (particles) - dsig
+-9.99              Alternative: dry deposition velocity
+ 48.00             molweight
+-9.9E-09           OH Reaction rate at 25 deg, [cm^3/sec]
+-9                 number of associated specias (neg. none)
+-99.99             KOA - organic matter air partitioning
Index: /branches/FP_AI/tests/test_1/options/SPECIES/SPECIES_003
===================================================================
--- /branches/FP_AI/tests/test_1/options/SPECIES/SPECIES_003	(revision 23)
+++ /branches/FP_AI/tests/test_1/options/SPECIES/SPECIES_003	(revision 23)
@@ -0,0 +1,21 @@
+****************************************************************************
+*                                                                          *
+*     Input file for the Lagrangian particle dispersion model FLEXPART     *
+*               Definition file of chemical species/radionuclides          *
+*                                                                          *
+****************************************************************************
+NO                 Tracer name
+-999.9             Species half life
+ 8.0E-06           Wet deposition - A
+0.62               Wet deposition - B
+ 1.2               Dry deposition (gases) - D
+3.0e-03            Dry deposition (gases) - Henrys const.
+0.0                Dry deposition (gases) - f0 (reactivity)
+-9.9E09            Dry deposition (particles) - rho
+                   Dry deposition (particles) - dquer
+                   Dry deposition (particles) - dsig
+-9.99              Alternative: dry deposition velocity
+ 30.00             molweight
+-9.9E-09           OH Reaction rate at 25 deg, [cm^3/sec]
+-9                 number of associated specias (neg. none)
+-99.99             KOA - organic matter air partitioning
Index: /branches/FP_AI/tests/test_1/options/SPECIES/SPECIES_004
===================================================================
--- /branches/FP_AI/tests/test_1/options/SPECIES/SPECIES_004	(revision 23)
+++ /branches/FP_AI/tests/test_1/options/SPECIES/SPECIES_004	(revision 23)
@@ -0,0 +1,21 @@
+****************************************************************************
+*                                                                          *
+*     Input file for the Lagrangian particle dispersion model FLEXPART     *
+*               Definition file of chemical species/radionuclides          *
+*                                                                          *
+****************************************************************************
+NO2                Tracer name
+-999.9             Species half life
+ 1.0E-05           Wet deposition - A
+0.62               Wet deposition - B
+ 1.6               Dry deposition (gases) - D
+1.0e-02            Dry deposition (gases) - Henrys const.
+0.1                Dry deposition (gases) - f0 (reactivity)
+-9.9E09            Dry deposition (particles) - rho
+                   Dry deposition (particles) - dquer
+                   Dry deposition (particles) - dsig
+-9.99              Alternative: dry deposition velocity
+ 46.00             molweight
+-9.9E-09           OH Reaction rate at 25 deg, [cm^3/sec]
+-9                 number of associated specias (neg. none)
+-99.99             KOA - organic matter air partitioning
Index: /branches/FP_AI/tests/test_1/options/SPECIES/SPECIES_005
===================================================================
--- /branches/FP_AI/tests/test_1/options/SPECIES/SPECIES_005	(revision 23)
+++ /branches/FP_AI/tests/test_1/options/SPECIES/SPECIES_005	(revision 23)
@@ -0,0 +1,21 @@
+****************************************************************************
+*                                                                          *
+*     Input file for the Lagrangian particle dispersion model FLEXPART     *
+*               Definition file of chemical species/radionuclides          *
+*                                                                          *
+****************************************************************************
+HNO3               Tracer name
+-999.9             Species half life
+ 5.0E-05           Wet deposition - A
+0.62               Wet deposition - B
+ 1.9               Dry deposition (gases) - D
+1.0e+14            Dry deposition (gases) - Henrys const.
+0.0                Dry deposition (gases) - f0 (reactivity)
+-9.9E09            Dry deposition (particles) - rho
+                   Dry deposition (particles) - dquer
+                   Dry deposition (particles) - dsig
+-9.99              Alternative: dry deposition velocity
+ 63.00             molweight
+-9.9E-09           OH Reaction rate at 25 deg, [cm^3/sec]
+-9                 number of associated specias (neg. none)
+-99.99             KOA - organic matter air partitioning
Index: /branches/FP_AI/tests/test_1/options/SPECIES/SPECIES_006
===================================================================
--- /branches/FP_AI/tests/test_1/options/SPECIES/SPECIES_006	(revision 23)
+++ /branches/FP_AI/tests/test_1/options/SPECIES/SPECIES_006	(revision 23)
@@ -0,0 +1,21 @@
+****************************************************************************
+*                                                                          *
+*     Input file for the Lagrangian particle dispersion model FLEXPART     *
+*               Definition file of chemical species/radionuclides          *
+*                                                                          *
+****************************************************************************
+HNO2               Tracer name
+-999.9             Species half life
+-9.9E-09           Wet deposition - A
+                   Wet deposition - B
+ 1.6               Dry deposition (gases) - D
+1.0e+05            Dry deposition (gases) - Henrys const.
+0.1                Dry deposition (gases) - f0 (reactivity)
+-9.9E09            Dry deposition (particles) - rho
+                   Dry deposition (particles) - dquer
+                   Dry deposition (particles) - dsig
+-9.99              Alternative: dry deposition velocity
+ 47.00             molweight
+-9.9E-09           OH Reaction rate at 25 deg, [cm^3/sec]
+-9                 number of associated specias (neg. none)
+-99.99             KOA - organic matter air partitioning
Index: /branches/FP_AI/tests/test_1/options/SPECIES/SPECIES_007
===================================================================
--- /branches/FP_AI/tests/test_1/options/SPECIES/SPECIES_007	(revision 23)
+++ /branches/FP_AI/tests/test_1/options/SPECIES/SPECIES_007	(revision 23)
@@ -0,0 +1,21 @@
+****************************************************************************
+*                                                                          *
+*     Input file for the Lagrangian particle dispersion model FLEXPART     *
+*               Definition file of chemical species/radionuclides          *
+*                                                                          *
+****************************************************************************
+H2O2               Tracer name
+-999.9             Species half life
+ 1.0E-04           Wet deposition - A
+0.62               Wet deposition - B
+ 1.4               Dry deposition (gases) - D
+1.0e+05            Dry deposition (gases) - Henrys const.
+1.0                Dry deposition (gases) - f0 (reactivity)
+-9.9E09            Dry deposition (particles) - rho
+                   Dry deposition (particles) - dquer
+                   Dry deposition (particles) - dsig
+-9.99              Alternative: dry deposition velocity
+ 34.00             molweight
+-9.9E-09           OH Reaction rate at 25 deg, [cm^3/sec]
+-9                 number of associated specias (neg. none)
+-99.99             KOA - organic matter air partitioning
Index: /branches/FP_AI/tests/test_1/options/SPECIES/SPECIES_008
===================================================================
--- /branches/FP_AI/tests/test_1/options/SPECIES/SPECIES_008	(revision 23)
+++ /branches/FP_AI/tests/test_1/options/SPECIES/SPECIES_008	(revision 23)
@@ -0,0 +1,54 @@
+****************************************************************************
+*                                                                          *
+*     Input file for the Lagrangian particle dispersion model FLEXPART     *
+*               Definition file of chemical species/radionuclides          *
+*                                                                          *
+****************************************************************************
+SO2                Tracer name
+-999.9             Species half life
+-9.9E-09           Wet deposition - A
+0.62               Wet deposition - B
+ 2.0               Dry deposition (gases) - D
+1.0e+05            Dry deposition (gases) - Henrys const.
+0.0                Dry deposition (gases) - f0 (reactivity)
+-9.9E09            Dry deposition (particles) - rho
+                   Dry deposition (particles) - dquer
+                   Dry deposition (particles) - dsig
+-9.99              Alternative: dry deposition velocity
+ 64.00             molweight
+-9.9E-09           OH Reaction rate at 25 deg, [cm^3/sec]
+-9                 number of associated specias (neg. none)
+-99.99             KOA - organic matter air partitioning
+hr_start so2_area  so2_point
+ 0       0.636       0.814      0-1 local time
+ 1       0.571       0.767      1-2 local time
+ 2       0.523       0.743
+ 3       0.495       0.735
+ 4       0.507       0.751
+ 5       0.577       0.798
+ 6       0.732       0.873
+ 7       0.929       0.976
+ 8       1.015       1.037
+ 9       1.077       1.084
+10       1.153       1.126
+11       1.241       1.142
+12       1.315       1.157
+13       1.370       1.163
+14       1.422       1.171
+15       1.463       1.169
+16       1.463       1.162
+17       1.426       1.141
+18       1.326       1.117 
+19       1.225       1.109
+20       1.082       1.095
+21       0.928       1.044
+22       0.804       0.959
+23       0.717       0.869      23-24 local time
+week_day so2_area  so2_point
+1        1.060       1.000      Monday
+2        1.060       1.000      Tuesday
+3        1.060       1.000      Wednesday
+4        1.060       1.000      Thursday
+5        1.060       1.000      Friday
+6        0.900       1.000      Saturday
+7        0.800       1.000      Sunday
Index: /branches/FP_AI/tests/test_1/options/SPECIES/SPECIES_009
===================================================================
--- /branches/FP_AI/tests/test_1/options/SPECIES/SPECIES_009	(revision 23)
+++ /branches/FP_AI/tests/test_1/options/SPECIES/SPECIES_009	(revision 23)
@@ -0,0 +1,21 @@
+****************************************************************************
+*                                                                          *
+*     Input file for the Lagrangian particle dispersion model FLEXPART     *
+*               Definition file of chemical species/radionuclides          *
+*                                                                          *
+****************************************************************************
+HCHO               Tracer name
+-999.9             Species half life
+-9.9E-09           Wet deposition - A
+                   Wet deposition - B
+ 1.3               Dry deposition (gases) - D
+6.0e+03            Dry deposition (gases) - Henrys const.
+0.0                Dry deposition (gases) - f0 (reactivity)
+-9.9E09            Dry deposition (particles) - rho
+                   Dry deposition (particles) - dquer
+                   Dry deposition (particles) - dsig
+-9.99              Alternative: dry deposition velocity
+ 30.00             molweight
+-9.9E-09           OH Reaction rate at 25 deg, [cm^3/sec]
+-9                 number of associated specias (neg. none)
+-99.99             KOA - organic matter air partitioning
Index: /branches/FP_AI/tests/test_1/options/SPECIES/SPECIES_010
===================================================================
--- /branches/FP_AI/tests/test_1/options/SPECIES/SPECIES_010	(revision 23)
+++ /branches/FP_AI/tests/test_1/options/SPECIES/SPECIES_010	(revision 23)
@@ -0,0 +1,21 @@
+****************************************************************************
+*                                                                          *
+*     Input file for the Lagrangian particle dispersion model FLEXPART     *
+*               Definition file of chemical species/radionuclides          *
+*                                                                          *
+****************************************************************************
+PAN                Tracer name
+-999.9             Species half life
+-9.9E-09           Wet deposition - A
+                   Wet deposition - B
+ 2.6               Dry deposition (gases) - D
+3.6e+00            Dry deposition (gases) - Henrys const.
+0.1                Dry deposition (gases) - f0 (reactivity)
+-9.9E09            Dry deposition (particles) - rho
+                   Dry deposition (particles) - dquer
+                   Dry deposition (particles) - dsig
+-9.99              Alternative: dry deposition velocity
+121.00             molweight
+-9.9E-09           OH Reaction rate at 25 deg, [cm^3/sec]
+-9                 number of associated specias (neg. none)
+-99.99             KOA - organic matter air partitioning
Index: /branches/FP_AI/tests/test_1/options/SPECIES/SPECIES_011
===================================================================
--- /branches/FP_AI/tests/test_1/options/SPECIES/SPECIES_011	(revision 23)
+++ /branches/FP_AI/tests/test_1/options/SPECIES/SPECIES_011	(revision 23)
@@ -0,0 +1,21 @@
+****************************************************************************
+*                                                                          *
+*     Input file for the Lagrangian particle dispersion model FLEXPART     *
+*               Definition file of chemical species/radionuclides          *
+*                                                                          *
+****************************************************************************
+NH3                Tracer name
+-999.9             Species half life
+ 9.9E-05           Wet deposition - A
+0.62               Wet deposition - B
+ 1.1               Dry deposition (gases) - D
+2.0e+14            Dry deposition (gases) - Henrys const.
+0.0                Dry deposition (gases) - f0 (reactivity)
+-9.9E09            Dry deposition (particles) - rho
+                   Dry deposition (particles) - dquer
+                   Dry deposition (particles) - dsig
+-9.99              Alternative: dry deposition velocity
+ 17.00             molweight
+-9.9E-09           OH Reaction rate at 25 deg, [cm^3/sec]
+-9                 number of associated specias (neg. none)
+-99.99             KOA - organic matter air partitioning
Index: /branches/FP_AI/tests/test_1/options/SPECIES/SPECIES_012
===================================================================
--- /branches/FP_AI/tests/test_1/options/SPECIES/SPECIES_012	(revision 23)
+++ /branches/FP_AI/tests/test_1/options/SPECIES/SPECIES_012	(revision 23)
@@ -0,0 +1,21 @@
+****************************************************************************
+*                                                                          *
+*     Input file for the Lagrangian particle dispersion model FLEXPART     *
+*               Definition file of chemical species/radionuclides          *
+*                                                                          *
+****************************************************************************
+SO4-aero           Tracer name
+-999.9             Species half life
+ 5.0E-06           Wet deposition - A
+0.62               Wet deposition - B
+-9.9               Dry deposition (gases) - D
+ 1.0E-09           Dry deposition (gases) - Henrys const.
+                   Dry deposition (gases) - f0 (reactivity)
+ 2.0E03            Dry deposition (particles) - rho
+4.0E-7             Dry deposition (particles) - dquer
+3.0E-1             Dry deposition (particles) - dsig
+-9.99              Alternative: dry deposition velocity
+ -9.99             molweight
+-9.9E-09           OH Reaction rate at 25 deg, [cm^3/sec]
+-9                 number of associated specias (neg. none)
+-99.99             KOA - organic matter air partitioning
Index: /branches/FP_AI/tests/test_1/options/SPECIES/SPECIES_013
===================================================================
--- /branches/FP_AI/tests/test_1/options/SPECIES/SPECIES_013	(revision 23)
+++ /branches/FP_AI/tests/test_1/options/SPECIES/SPECIES_013	(revision 23)
@@ -0,0 +1,21 @@
+****************************************************************************
+*                                                                          *
+*     Input file for the Lagrangian particle dispersion model FLEXPART     *
+*               Definition file of chemical species/radionuclides          *
+*                                                                          *
+****************************************************************************
+NO3-aero           Tracer name
+-999.9             Species half life
+ 5.0E-06           Wet deposition - A
+0.62               Wet deposition - B
+-9.9               Dry deposition (gases) - D
+                   Dry deposition (gases) - Henrys const.
+                   Dry deposition (gases) - f0 (reactivity)
+ 2.0E03            Dry deposition (particles) - rho
+4.0E-7             Dry deposition (particles) - dquer
+3.0E-1             Dry deposition (particles) - dsig
+-9.99              Alternative: dry deposition velocity
+ -9.99             molweight
+-9.9E-09           OH Reaction rate at 25 deg, [cm^3/sec]
+-9                 number of associated specias (neg. none)
+-99.99             KOA - organic matter air partitioning
Index: /branches/FP_AI/tests/test_1/options/SPECIES/SPECIES_014
===================================================================
--- /branches/FP_AI/tests/test_1/options/SPECIES/SPECIES_014	(revision 23)
+++ /branches/FP_AI/tests/test_1/options/SPECIES/SPECIES_014	(revision 23)
@@ -0,0 +1,21 @@
+****************************************************************************
+*                                                                          *
+*     Input file for the Lagrangian particle dispersion model FLEXPART     *
+*               Definition file of chemical species/radionuclides          *
+*                                                                          *
+****************************************************************************
+I2-131             Tracer name
+691200.0           Species half life
+ 8.0E-05           Wet deposition - A
+0.62               Wet deposition - B
+ 2.7               Dry deposition (gases) - D
+1.0e+05            Dry deposition (gases) - Henrys const.
+0.1                Dry deposition (gases) - f0 (reactivity)
+-9.9E09            Dry deposition (particles) - rho
+                   Dry deposition (particles) - dquer
+                   Dry deposition (particles) - dsig
+-9.99              Alternative: dry deposition velocity
+ -9.99             molweight
+-9.9E-09           OH Reaction rate at 25 deg, [cm^3/sec]
+-9                 number of associated specias (neg. none)
+-99.99             KOA - organic matter air partitioning
Index: /branches/FP_AI/tests/test_1/options/SPECIES/SPECIES_015
===================================================================
--- /branches/FP_AI/tests/test_1/options/SPECIES/SPECIES_015	(revision 23)
+++ /branches/FP_AI/tests/test_1/options/SPECIES/SPECIES_015	(revision 23)
@@ -0,0 +1,21 @@
+****************************************************************************
+*                                                                          *
+*     Input file for the Lagrangian particle dispersion model FLEXPART     *
+*               Definition file of chemical species/radionuclides          *
+*                                                                          *
+****************************************************************************
+I-131              Tracer name
+691200.0           Species half life
+ 1.0E-04           Wet deposition - A
+0.80               Wet deposition - B
+-9.9               Dry deposition (gases) - D
+                   Dry deposition (gases) - Henrys const.
+                   Dry deposition (gases) - f0 (reactivity)
+ 2.5E03            Dry deposition (particles) - rho
+6.0E-7             Dry deposition (particles) - dquer
+3.0E-1             Dry deposition (particles) - dsig
+-9.99              Alternative: dry deposition velocity
+ -9.99             molweight
+-9.9E-09           OH Reaction rate at 25 deg, [cm^3/sec]
+-9                 number of associated specias (neg. none)
+-99.99             KOA - organic matter air partitioning
Index: /branches/FP_AI/tests/test_1/options/SPECIES/SPECIES_016
===================================================================
--- /branches/FP_AI/tests/test_1/options/SPECIES/SPECIES_016	(revision 23)
+++ /branches/FP_AI/tests/test_1/options/SPECIES/SPECIES_016	(revision 23)
@@ -0,0 +1,21 @@
+****************************************************************************
+*                                                                          *
+*     Input file for the Lagrangian particle dispersion model FLEXPART     *
+*               Definition file of chemical species/radionuclides          *
+*                                                                          *
+****************************************************************************
+Cs-137             Tracer name
+-999.9             Species half life
+ 1.0E-04           Wet deposition - A
+0.80               Wet deposition - B
+-9.9               Dry deposition (gases) - D
+                   Dry deposition (gases) - Henrys const.
+                   Dry deposition (gases) - f0 (reactivity)
+ 2.5E03            Dry deposition (particles) - rho
+6.0E-7             Dry deposition (particles) - dquer
+3.0E-1             Dry deposition (particles) - dsig
+-9.99              Alternative: dry deposition velocity
+ -9.99             molweight
+-9.9E-09           OH Reaction rate at 25 deg, [cm^3/sec]
+-9                 number of associated specias (neg. none)
+-99.99             KOA - organic matter air partitioning
Index: /branches/FP_AI/tests/test_1/options/SPECIES/SPECIES_017
===================================================================
--- /branches/FP_AI/tests/test_1/options/SPECIES/SPECIES_017	(revision 23)
+++ /branches/FP_AI/tests/test_1/options/SPECIES/SPECIES_017	(revision 23)
@@ -0,0 +1,21 @@
+****************************************************************************
+*                                                                          *
+*     Input file for the Lagrangian particle dispersion model FLEXPART     *
+*               Definition file of chemical species/radionuclides          *
+*                                                                          *
+****************************************************************************
+Y-91               Tracer name
+5037120.0          Species half life
+ 1.0E-04           Wet deposition - A
+0.80               Wet deposition - B
+-9.9               Dry deposition (gases) - D
+                   Dry deposition (gases) - Henrys const.
+                   Dry deposition (gases) - f0 (reactivity)
+ 2.5E03            Dry deposition (particles) - rho
+6.0E-7             Dry deposition (particles) - dquer
+3.0E-1             Dry deposition (particles) - dsig
+-9.99              Alternative: dry deposition velocity
+ -9.99             molweight
+-9.9E-09           OH Reaction rate at 25 deg, [cm^3/sec]
+-9                 number of associated specias (neg. none)
+-99.99             KOA - organic matter air partitioning
Index: /branches/FP_AI/tests/test_1/options/SPECIES/SPECIES_018
===================================================================
--- /branches/FP_AI/tests/test_1/options/SPECIES/SPECIES_018	(revision 23)
+++ /branches/FP_AI/tests/test_1/options/SPECIES/SPECIES_018	(revision 23)
@@ -0,0 +1,21 @@
+****************************************************************************
+*                                                                          *
+*     Input file for the Lagrangian particle dispersion model FLEXPART     *
+*               Definition file of chemical species/radionuclides          *
+*                                                                          *
+****************************************************************************
+Ru-106             Tracer name
+31536000.0         Species half life
+ 1.0E-04           Wet deposition - A
+0.80               Wet deposition - B
+-9.9               Dry deposition (gases) - D
+                   Dry deposition (gases) - Henrys const.
+                   Dry deposition (gases) - f0 (reactivity)
+ 2.5E03            Dry deposition (particles) - rho
+6.0E-7             Dry deposition (particles) - dquer
+3.0E-1             Dry deposition (particles) - dsig
+-9.99              Alternative: dry deposition velocity
+ -9.99             molweight
+-9.9E-09           OH Reaction rate at 25 deg, [cm^3/sec]
+-9                 number of associated specias (neg. none)
+-99.99             KOA - organic matter air partitioning
Index: /branches/FP_AI/tests/test_1/options/SPECIES/SPECIES_019
===================================================================
--- /branches/FP_AI/tests/test_1/options/SPECIES/SPECIES_019	(revision 23)
+++ /branches/FP_AI/tests/test_1/options/SPECIES/SPECIES_019	(revision 23)
@@ -0,0 +1,21 @@
+****************************************************************************
+*                                                                          *
+*     Input file for the Lagrangian particle dispersion model FLEXPART     *
+*               Definition file of chemical species/radionuclides          *
+*                                                                          *
+****************************************************************************
+Kr-85              Tracer name
+-999.9             Species half life
+-9.9E-09           Wet deposition - A
+                   Wet deposition - B
+-9.9               Dry deposition (gases) - D
+                   Dry deposition (gases) - Henrys const.
+                   Dry deposition (gases) - f0 (reactivity)
+-9.9E09            Dry deposition (particles) - rho
+                   Dry deposition (particles) - dquer
+                   Dry deposition (particles) - dsig
+-9.99              Alternative: dry deposition velocity
+ -9.99             molweight
+-9.9E-09           OH Reaction rate at 25 deg, [cm^3/sec]
+-9                 number of associated specias (neg. none)
+-99.99             KOA - organic matter air partitioning
Index: /branches/FP_AI/tests/test_1/options/SPECIES/SPECIES_020
===================================================================
--- /branches/FP_AI/tests/test_1/options/SPECIES/SPECIES_020	(revision 23)
+++ /branches/FP_AI/tests/test_1/options/SPECIES/SPECIES_020	(revision 23)
@@ -0,0 +1,21 @@
+****************************************************************************
+*                                                                          *
+*     Input file for the Lagrangian particle dispersion model FLEXPART     *
+*               Definition file of chemical species/radionuclides          *
+*                                                                          *
+****************************************************************************
+Sr-90              Tracer name
+-999.9             Species half life
+ 1.0E-04           Wet deposition - A
+0.80               Wet deposition - B
+-9.9               Dry deposition (gases) - D
+                   Dry deposition (gases) - Henrys const.
+                   Dry deposition (gases) - f0 (reactivity)
+ 2.5E03            Dry deposition (particles) - rho
+6.0E-7             Dry deposition (particles) - dquer
+3.0E-1             Dry deposition (particles) - dsig
+-9.99              Alternative: dry deposition velocity
+ -9.99             molweight
+-9.9E-09           OH Reaction rate at 25 deg, [cm^3/sec]
+-9                 number of associated specias (neg. none)
+-99.99             KOA - organic matter air partitioning
Index: /branches/FP_AI/tests/test_1/options/SPECIES/SPECIES_021
===================================================================
--- /branches/FP_AI/tests/test_1/options/SPECIES/SPECIES_021	(revision 23)
+++ /branches/FP_AI/tests/test_1/options/SPECIES/SPECIES_021	(revision 23)
@@ -0,0 +1,21 @@
+****************************************************************************
+*                                                                          *
+*     Input file for the Lagrangian particle dispersion model FLEXPART     *
+*               Definition file of chemical species/radionuclides          *
+*                                                                          *
+****************************************************************************
+Xe-133             Tracer name
+198720.0           Species half life
+-9.9E-09           Wet deposition - A
+                   Wet deposition - B
+-9.9               Dry deposition (gases) - D
+                   Dry deposition (gases) - Henrys const.
+                   Dry deposition (gases) - f0 (reactivity)
+-9.9E09            Dry deposition (particles) - rho
+                   Dry deposition (particles) - dquer
+                   Dry deposition (particles) - dsig
+-9.99              Alternative: dry deposition velocity
+ -9.99             molweight
+-9.9E-09           OH Reaction rate at 25 deg, [cm^3/sec]
+-9                 number of associated specias (neg. none)
+-99.99             KOA - organic matter air partitioning
Index: /branches/FP_AI/tests/test_1/options/SPECIES/SPECIES_022
===================================================================
--- /branches/FP_AI/tests/test_1/options/SPECIES/SPECIES_022	(revision 23)
+++ /branches/FP_AI/tests/test_1/options/SPECIES/SPECIES_022	(revision 23)
@@ -0,0 +1,21 @@
+****************************************************************************
+*                                                                          *
+*     Input file for the Lagrangian particle dispersion model FLEXPART     *
+*               Definition file of chemical species/radionuclides          *
+*                                                                          *
+****************************************************************************
+CO                 Tracer name
+-999.9             Species half life
+-9.9E-09           Wet deposition - A
+                   Wet deposition - B
+-9.9               Dry deposition (gases) - D
+                   Dry deposition (gases) - Henrys const.
+                   Dry deposition (gases) - f0 (reactivity)
+-9.9E09            Dry deposition (particles) - rho
+                   Dry deposition (particles) - dquer
+                   Dry deposition (particles) - dsig
+-9.99              Alternative: dry deposition velocity
+ 28.00             molweight
+ 1.5E-13           OH Reaction rate at 25 deg, [cm^3/sec]
+-9                 number of associated specias (neg. none)
+-99.99             KOA - organic matter air partitioning
Index: /branches/FP_AI/tests/test_1/options/SPECIES/SPECIES_024
===================================================================
--- /branches/FP_AI/tests/test_1/options/SPECIES/SPECIES_024	(revision 23)
+++ /branches/FP_AI/tests/test_1/options/SPECIES/SPECIES_024	(revision 23)
@@ -0,0 +1,21 @@
+****************************************************************************
+*                                                                          *
+*     Input file for the Lagrangian particle dispersion model FLEXPART     *
+*               Definition file of chemical species/radionuclides          *
+*                                                                          *
+****************************************************************************
+AIRTRACER             Tracer name
+-999.9             Species half life
+-9.9E-09           Wet deposition - A
+                   Wet deposition - B
+-9.9               Dry deposition (gases) - D
+                   Dry deposition (gases) - Henrys const.
+                   Dry deposition (gases) - f0 (reactivity)
+-9.9E09            Dry deposition (particles) - rho
+                   Dry deposition (particles) - dquer
+                   Dry deposition (particles) - dsig
+-9.99              Alternative: dry deposition velocity
+29.000             molweight
+-9.9E-09           OH Reaction rate at 25 deg, [cm^3/sec]
+-9                 number of associated specias (neg. none)
+-99.99             KOA - organic matter air partitioning
Index: /branches/FP_AI/tests/test_1/options/SPECIES/SPECIES_025
===================================================================
--- /branches/FP_AI/tests/test_1/options/SPECIES/SPECIES_025	(revision 23)
+++ /branches/FP_AI/tests/test_1/options/SPECIES/SPECIES_025	(revision 23)
@@ -0,0 +1,21 @@
+****************************************************************************
+*                                                                          *
+*     Input file for the Lagrangian particle dispersion model FLEXPART     *
+*               Definition file of chemical species/radionuclides          *
+*                                                                          *
+****************************************************************************
+AERO-TRACER             Tracer name
+-999.9             Species half life
+2.0E-05            Wet deposition - A
+0.8                Wet deposition - B
+-9.9               Dry deposition (gases) - D
+                   Dry deposition (gases) - Henrys const.
+                   Dry deposition (gases) - f0 (reactivity)
+1.4E+03            Dry deposition (particles) - rho
+2.5E-07            Dry deposition (particles) - dquer
+1.25               Dry deposition (particles) - dsig
+-9.99              Alternative: dry deposition velocity
+ 29.00             molweight
+-9.9E-09           OH Reaction rate at 25 deg, [cm^3/sec]
+-9                 number of associated specias (neg. none)
+-99.99             KOA - organic matter air partitioning
Index: /branches/FP_AI/tests/test_1/options/SPECIES/spec_overview
===================================================================
--- /branches/FP_AI/tests/test_1/options/SPECIES/spec_overview	(revision 23)
+++ /branches/FP_AI/tests/test_1/options/SPECIES/spec_overview	(revision 23)
@@ -0,0 +1,1 @@
+grep Tra SPEC*
Index: /branches/FP_AI/tests/test_1/options/surfdata.t
===================================================================
--- /branches/FP_AI/tests/test_1/options/surfdata.t	(revision 23)
+++ /branches/FP_AI/tests/test_1/options/surfdata.t	(revision 23)
@@ -0,0 +1,17 @@
+13 landuse categories are related roughness length
+--------------------------------------------------------
+landuse   comment                               z0
+--------------------------------------------------------
+ 1 Urban land                                   0.7
+ 2 Agricultural land                            0.1
+ 3 Range land                                   0.1
+ 4 Deciduous forest                             1.
+ 5 Coniferous forest                            1.
+ 6 Mixed forest including wetland               0.7
+ 7 water, both salt and fresh                   0.001
+ 8 barren land mostly desert                    0.01
+ 9 nonforested wetland                          0.1
+10 mixed agricultural and range land            0.1
+11 rocky open areas with low grow shrubs        0.05
+12 snow and ice                                 0.001
+13 rainforest                                   1.
Index: /branches/FP_AI/tests/test_1/options/surfdepo.t
===================================================================
--- /branches/FP_AI/tests/test_1/options/surfdepo.t	(revision 23)
+++ /branches/FP_AI/tests/test_1/options/surfdepo.t	(revision 23)
@@ -0,0 +1,57 @@
+==============================================================================
+INPUT RESISTANCES (s/m) FOR THE COMPUTATION OF SURFACE RESISTANCES TO
+DRY DEPOSITION
+==============================================================================
+AFTER WESELY, 1989
+==============================================================================
+1 to 11: Landuse types after Wesely; 12 .. snow, 13 .. rainforest
+==============================================================================
+Values are tabulated for 5 seasonal categories:
+1     Midsummer with lush vegetation
+2     Autumn with unharvested cropland
+3     Late autumn after frost, no snow
+4     Winter, snow on ground and subfreezing
+5     Transitional spring with partially green short annuals
+==============================================================================
+               1       2       3       4       5       6       7       8       9     10       11      12      13  
+________________________________________________________________________________________________________________
+ri         9999.     60.    120.     70.    130.    100.   9999.   9999.     80.    100.    150.    9999.    200.  1
+rlu        9999.   2000.   2000.   2000.   2000.   2000.   9999.   9999.   2500.   2000.   4000.    9999.   1000.
+rac         100.    200.    100.   2000.   2000.   2000.      0.      0.    300.    150.    200.       0.   2000.
+rgss        400.    150.    350.    500.    500.    100.      0.   1000.      0.    220.    400.     100.    200.
+rgso        300.    150.    200.    200.    200.    300.   2000.    400.   1000.    180.    200.   10000.    200.
+rcls       9999.   2000.   2000.   2000.   2000.   2000.   9999.   9999.   2500.   2000.   4000.    9999.   9999.
+rclo       9999.   1000.   1000.   1000.   1000.   1000.   9999.   9999.   1000.   1000.   1000.    9999.   9999.
+_________________________________________________________________________________________________________________
+ri         9999.   9999.   9999.   9999.    250.    500.   9999.   9999.   9999.   9999.   9999.    9999.    200. 2
+rlu        9999.   9000.   9000.   9000.   4000.   8000.   9999.   9999.   9000.   9000.   9000.    9999.   1000.
+rac         100.    150.    100.   1500.   2000.   1700.      0.      0.    200.    120.    140.       0.   2000.
+rgss        400.    200.    350.    500.    500.    100.      0.   1000.      0.    300.    400.     100.    200.
+rgso        300.    150.    200.    200.    200.    300.   2000.    400.    800.    180.    200.   10000.    200.
+rcls       9999.   9000.   9000.   9000.   2000.   4000.   9999.   9999.   9000.   9000.   9000.    9999.   9999.
+rclo       9999.    400.    400.    400.   1000.    600.   9999.   9999.    400.    400.    400.    9999.   9999.
+_________________________________________________________________________________________________________________
+ri         9999.   9999.   9999.   9999.    250.    500.   9999.   9999.   9999.   9999.   9999.    9999.    200. 3
+rlu        9999.   9999.   9000.   9000.   4000.   8000.   9999.   9999.   9000.   9000.   9000.    9999.   1000.
+rac         100.     10.    100.   1000.   2000.   1500.      0.      0.    100.     50.    120.       0.   2000.
+rgss        400.    150.    350.    500.    500.    200.      0.   1000.      0.    200.    400.     100.    200.
+rgso        300.    150.    200.    200.    200.    300.   2000.    400.   1000.    180.    200.   10000.    200.
+rcls       9999.   9999.   9000.   9000.   3000.   6000.   9999.   9999.   9000.   9000.   9000.    9999.   9999.
+rclo       9999.   1000.    400.    400.   1000.    600.   9999.   9999.    800.    600.    600.    9999.   9999.
+_________________________________________________________________________________________________________________
+ri         9999.   9999.   9999.   9999.    400.    800.   9999.   9999.   9999.   9999.   9999.    9999.    200. 4
+rlu        9999.   9999.   9999.   9999.   6000.   9000.   9999.   9999.   9000.   9000.   9000.    9999.   1000.
+rac         100.     10.     10.   1000.   2000.   1500.      0.      0.     50.     10.     50.       0.   2000.
+rgss        100.    100.    100.    100.    100.    100.      0.   1000.    100.    100.     50.     100.    200.
+rgso        600.   3500.   3500.   3500.   3500.   3500.   2000.    400.   3500.   3500.   3500.   10000.    200. 
+rcls       9999.   9999.   9999.   9000.    200.    400.   9999.   9999.   9000.   9999.   9000.    9999.   9999.
+rclo       9999.   1000.   1000.    400.   1500.    600.   9999.   9999.    800.   1000.    800.    9999.   9999.
+_________________________________________________________________________________________________________________
+ri         9999.    120.    240.    140.    250.    190.   9999.   9999.    160.    200.    300.    9999.    200.  5
+rlu        9999.   4000.   4000.   4000.   2000.   3000.   9999.   9999.   4000.   4000.   8000.    9999.   1000.
+rac         100.     50.     80.   1200.   2000.   1500.      0.      0.    200.     60.    120.       0.   2000.
+rgss        500.    150.    350.    500     500.    200.      0.   1000.      0.    250.    400.     100.    200.
+rgso        300.    150.    200.    200.    200.    300.   2000.    400.   1000.    180.    200.   10000.    200.
+rcls       9999.   4000.   4000.   4000.   2000.   3000.   9999.   9999.   4000.   4000.   8000.    9999.   9999.
+rclo       9999.   1000.    500.    500.   1500.    700.   9999.   9999.    600.    800.    800.    9999.   9999.
+_________________________________________________________________________________________________________________
Index: /branches/FP_AI/tests/test_1/output_reference/COMMAND.namelist
===================================================================
--- /branches/FP_AI/tests/test_1/output_reference/COMMAND.namelist	(revision 23)
+++ /branches/FP_AI/tests/test_1/output_reference/COMMAND.namelist	(revision 23)
@@ -0,0 +1,29 @@
+&COMMAND
+ LDIRECT=         -1,
+ IBDATE=   20070105,
+ IBTIME=     180000,
+ IEDATE=   20070107,
+ IETIME=          0,
+ LOUTSTEP=       3600,
+ LOUTAVER=       3600,
+ LOUTSAMPLE=        900,
+ ITSPLIT=    9999999,
+ LSYNCTIME=        900,
+ CTL= -5.0000000    ,
+ IFINE=          4,
+ IOUT=          5,
+ IPOUT=          1,
+ LSUBGRID=          0,
+ LCONVECTION=          0,
+ LAGESPECTRA=          1,
+ IPIN=          0,
+ IOUTPUTFOREACHRELEASE=          1,
+ IFLUX=          0,
+ MDOMAINFILL=          0,
+ IND_SOURCE=          1,
+ IND_RECEPTOR=          2,
+ MQUASILAG=          0,
+ NESTED_OUTPUT=          0,
+ LINIT_COND=          2,
+ SURF_ONLY=          0,
+ /
Index: /branches/FP_AI/tests/test_1/output_reference/dates
===================================================================
--- /branches/FP_AI/tests/test_1/output_reference/dates	(revision 23)
+++ /branches/FP_AI/tests/test_1/output_reference/dates	(revision 23)
@@ -0,0 +1,17 @@
+20070106230000
+20070106220000
+20070106210000
+20070106200000
+20070106190000
+20070106180000
+20070106170000
+20070106160000
+20070106150000
+20070106140000
+20070106130000
+20070106120000
+20070106110000
+20070106100000
+20070106090000
+20070106080000
+20070106070000
Index: /branches/FP_AI/tests/test_1/output_reference/header_txt
===================================================================
--- /branches/FP_AI/tests/test_1/output_reference/header_txt	(revision 23)
+++ /branches/FP_AI/tests/test_1/output_reference/header_txt	(revision 23)
@@ -0,0 +1,26 @@
+ # ibdate,ibtime, iedate, ietime, flexversion
+    20070105      180000    20070107           0 Version 9.1.9  (2014-05-21)
+ # interval, averaging time, sampling time
+       -3600       -3600        -900
+ # information on grid setup    
+ #outlon0,outlat0,numxgrid,numygrid,dxout,dyout
+  -179.00000      -90.000000             360         180   1.0000000       1.0000000    
+ # numzgrid, outheight(.) 
+           3   100.00000       3000.0000       50000.000    
+ # jjjjmmdd,ihmmss
+    20070107           0
+ # information on species
+ # 3*nspec,maxpointspec_act
+           3           1
+ # for nspec:
+ # 1, WD_ 
+ # 1, DD_ 
+ # numzgrid,species
+           1 WD_AIRTRAC
+           1 DD_AIRTRAC
+           3 AIRTRACER 
+ # information on model switches
+ # method,lsubgrid,lconvection, ind_source,ind_receptor
+           0           0           0           1           2
+ # information on age class     
+           1     1728000
Index: /branches/FP_AI/tests/test_1/pathnames
===================================================================
--- /branches/FP_AI/tests/test_1/pathnames	(revision 23)
+++ /branches/FP_AI/tests/test_1/pathnames	(revision 23)
@@ -0,0 +1,6 @@
+./options/    
+./output/          
+/
+/xnilu_wrk/flex_wrk/WIND_FIELDS/AVAILABLE_ECMWF_OPER_fields_global
+============================================
+                                            
