Index: /branches/jerome/src_flexwrf_v3.1/README.txt
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/README.txt	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/README.txt	(revision 16)
@@ -0,0 +1,123 @@
+J. Brioude, Sept 19  2013
+**************************************************************
+To compile flexwrf, choose your compiler in makefile.mom (line 23), the path to the NetCDF library and then type
+make -f makefile.mom mpi  for MPI+OPENMP hybrid run
+make -f makefile.mom omp  for OPENMP parallel run
+make -f makefile.mom serial for a serial run
+********************************************************************
+To run flexwrf, you can pass an argument to the executable that gives the name of the input file.
+for instance
+./flexwrf31_mpi /home/jbrioude/inputfile.txt
+Otherwise, the file flexwrf.input in the current directory is read by default.
+
+Examples of forward and backward runs are available in the examples directory.
+
+
+*****************************************************************
+Versions timeline
+
+version 3.1: bug fix on the sign of sshf in readwind.f90
+	     modifications of advance.f90 to limit the vertical velocity from cbl scheme
+	     bug fix in write_ncconc.f90
+	     modifications of interpol*f90 routines to avoid crashes using tke_partition_hanna.f90 and tke_partition_my.f90
+version 3.0    First public version 
+
+version 2.4.1: New modifications on the wet deposition scheme from Petra Seibert
+
+version 2.3.1: a NetCDF format output is implemented. 
+
+version 2.2.7: CBL scheme is implemented. a new random generator is implemented.
+
+version 2.0.6:
+-map factors are used in advance.f90 when converting the calculated distance
+into a WRF grid distance. 
+-fix on the divergence based vertical wind
+
+version 2.0.5:
+the time over which the kernel is not used has been reduced from 10800 seconds
+to 7200 seconds. Those numbers depend on the horizontal resolution, and a more
+flexible solution might come up in a future version
+version 2.0.4:
+- bug fix for regular output grid
+- IO problems in ASCII have been fixed
+- add the option of running flexpart with an argument that gives the name of
+  the inputfile instead of flexwrf.input
+version 2.0.3:
+- bug fix when flexpart is restarted.
+-bug fix in coordtrafo.f90
+- a new option that let the user decide if the time for the the time average
+  fields from WRF has to be corrected or not.
+
+version 2.0.2:
+- bug fix in sendint2_mpi_old.f90
+- all the *mpi*.f90 have been changed to handle more properly the memory.
+- timemanager_mpi has changed accordingly. Some bug fix too
+- bug fix in writeheader
+- parallelization of calcpar and verttransform.f90, same for the nests.
+
+version 2.0.1:
+-1 option added in flexwrf.input to define the output grid with dxout and dyout
+-fix in readinput.f90 to calculate maxpart more accurately
+
+version 2.0: first OPENMP/MPI version
+
+version 1.0: 
+This is a fortran 90 version of FLEXPART.
+Compared to PILT, the version from Jerome Fast available on the NILU flexpart website, several bugs and improvements have been made (not
+necessarily commented) in the subroutines. 
+non exhaustive list:
+1) optimization of the kein-fritch convective scheme (expensive)
+2) possibility to output the flexpart run in a regular lat/lon output grid.
+flexwrf.input has 2 options to let the model know which coordinates are used
+for the output domaine and the release boxes.
+3) Differences in earth radius between WRF and WRF-chem is handled.
+4) time averaged wind, instantaneous omega or a vertical velocity internally calculated in FLEXPART can be used now.
+5) a bug fix in pbl_profile.f due to the variable kappa.
+
+Turb option 2 and 3 from Jerome Fast's version lose mass in the model. Those
+options are not recommended.
+
+***********************************************************************
+General comments on The hybrid version of flexpart wrf:
+This version includes a parallelized hybrid version of FLEXPART that can be
+used with:
+- 1 node (1 computer) with multi threads using openmp in shared memory, 
+- or several nodes (computers) in distributed memory (using mpi) and several threads in shared memory (using openmp).
+if a mpi library is not available with your compiler, use makefile.nompi to compile flexwrf
+
+The system variable OMP_NUM_THREADS has to be set before running the model to define the number of thread used. 
+it can also be fixed in timemanager*f90. 
+If not, flexwrf20_mpi will use 1 thread.
+
+When submitting a job to several nodes, mpiexec or mpirun needs to know that 1 task has to be allocated per node to let openmp doing the work within each node in shared memory.
+See submit.sh as an example. 
+
+Compared to the single node version, this version includes modifications of:
+
+- flexwrf.f90 that is renamed into flexwrf_mpi.f90
+- timemanager.f90 that is renamed into timemanager_mpi.f90
+- the interpol*f90 and hanna* has been modified.
+- the routines *mpi*.f90 are used to send or receive data between nodes.
+
+The most important modifications are in timemanager_mpi.f90, initialize.f90 and advance.f90.
+search for JB in timemanager_mpi.f90 to have additional comments.
+in advance.f90, I modified the way the random number is picked up (line 187). I use a simple count and the id of the thread instead of the random pick up that uses ran3.
+If the series of random number is output for a give release box (uncomment lines 195 to 198), the distribution is quite good, and I don't see any bigger bias that the one in the single thread version.
+of course, the distribution is less and less random when you increase the number of nodes or threads.
+
+
+*********************************************************
+performance:
+this is the performance of the loop line 581 in timemanager_mpi.f90 that calculates the trajectories.
+I use the version v74 as the reference (single thread, fortran 77).
+There is a loss in performance between v74 and v90 because of the temporary variables th_* that has to be used as private variables in timemanager_mpi.f90
+		v74
+v90 1thread	0.96
+v90 2threads	1.86
+v90 4threads	3.57
+v90 8threads	6.22
+
+performance of the communication between nodes:
+depends on the system. The super computer that I use can transfer about 1Gb in 1 second.
+in timemanager_mpi.f90, the output lines 540 and 885 give the time needed by the system to communicate between nodes. using 100 millions particles and say 4 nodes, it takes about 1 second.
+
Index: /branches/jerome/src_flexwrf_v3.1/advance.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/advance.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/advance.f90	(revision 16)
@@ -0,0 +1,1368 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                *
+!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine,       *
+!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
+!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso,          *
+!* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann,   *
+!* This file is part of FLEXPART WRF                                   *
+!*                                                                     *
+!* 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, &
+      ngrid,depoindicator,indzindicator,cpt2,ompid,myid,n_threads,mts)  !comment by mc: ...,ompid,myid,n_threads) added  n_threads for MT parallel random number generator
+
+!                          i    i  i/oi/oi/o
+!       i/o     i/o     i/o     o  i/oi/oi/o i/o  i/o
+!*******************************************************************************
+!                                                                              *
+!  Note:  This is the FLEXPART_WRF version of subroutine gridcheck.            *
+!    The computational grid is the WRF x-y grid rather than lat-lon.           *
+!                                                                              *
+!  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 'includeinterpol'. 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                                      *
+!                                                                              *
+!  26 Oct 2005, R. Easter - changes for horizontal grid in m instead of lat,lon*
+!  10 Nov 2005, R. Easter - zero turbulent wind components is                  *
+!                           turbulence is turned off                           *
+!  Mar 2012, J. Brioude: modification to handle openmp.                        *
+!  turbulence option 3 is not going   *
+!  to work. but it shouldn't be used anyway ^M
+!  Jan 2013  M. Cassiani (look for mc or MC in the code):
+!  *^M
+!               introduction of CBL skewed turbulence model
+!               *^M
+!               & parallel random number generation
+!               *                       *
+!********************************************************************************
+!*******************************************************************************
+!                                                                              *
+! Variables:                                                                   *
+! cbt                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 mt_stream  !added by mc for random number generation^M
+!  use test_well_mod !added by mc for testting well mixed
+!  use interpol_mod
+!  use hanna_mod
+  use cmapf_mod
+!  use ieee_arithmetic
+! include 'sprng_f.h'
+!  use ran_mod
+!      include 'includepar'
+!      include 'includecom'
+!      include 'includeinterpol'
+!      include 'includehanna'
+
+  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,ii,ompid,myid,nombre
+  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,mu,mv
+  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
+  real :: ptot_lhh,Q_lhh,phi_lhh,ath,bth   !modified by mc added for CBL scheme
+  real :: old_wp_buf,del_test              !modified by mc added for CBL scheme re-initlization fo particle after NaN
+  integer(kind=2) :: icbt
+  real,parameter :: eps=nxmax/3.e5,eps2=1.e-9
+  integer :: flagrein                      !re-initialization flag for particles: modified by mc
+
+  real :: uprof(nzmax),vprof(nzmax),wprof(nzmax)
+  real :: usigprof(nzmax),vsigprof(nzmax),wsigprof(nzmax)
+  real :: rhoprof(nzmax),rhogradprof(nzmax)
+  real :: tkeprof(nzmax),pttprof(nzmax)
+  real :: u,v,w,usig,vsig,wsig,pvi
+  real(kind=dp) :: xtold
+  real :: p1,p2,p3,p4,ddx,ddy,rddx,rddy,dtt,dt1,dt2
+  integer :: ix,jy,ixp,jyp,ngrid,indz,indzp,cpt2,maxrand2
+  logical :: depoindicator(maxspec)
+  logical :: indzindicator(nzmax)
+
+  real :: ust,wst,ol,h,zeta,sigu,sigv,tlu,tlv,tlw
+  real :: sigw,dsigwdz,dsigw2dz
+
+  real :: wp2, zt2, ust2, wst2, h2, rhoa2, rhograd2, sigw2, &
+    dsigwdz2, tlw2, ptot_lhh2, Q_lhh2, phi_lhh2, ath2, bth2, ol2
+
+  logical :: isnan2
+
+!!! CHANGE: TEST OF THE WELL-MIXED CRITERION
+!        integer iclass
+!        parameter(iclass=10)
+!        double precision zacc,tacc,t(iclass),th(0:iclass),hsave
+!        logical dump
+!        save zacc,tacc,t,th,hsave,dump
+!c        itimeod=0
+!!! CHANGE
+
+  integer :: idummy = 7
+  real    :: settling = 0.
+  !added by mc for random number generation ---------------------  
+  integer ::  n_threads !added by mc for parallel random number generation
+  integer(4) :: rannum
+  real(4) :: real_rannum
+  type (mt_state) :: mts (0: MAX_STREAM)
+  integer,SAVE :: nan_count(max_STREAM)=0
+!-------------------------------------------------------
+
+
+!!! CHANGE: TEST OF THE WELL-MIXED CRITERION
+!      if (idummy.eq.-7) then
+!      open(550,file='WELLMIXEDTEST')
+!      do 17 i=0,iclass
+!17      th(i)=real(i)/real(iclass)
+!      endif
+!!! CHANGE
+
+!    if (nombre.eq.103) print*,'usig -1',usig,xts,yts,zt
+     if (xt.ne.xt .or. abs(xt).gt.1000.) print*,'problem 0', xt,yt,zt,itime,myid,ompid
+     xtold=xt
+!   print *,'aa',xt,yt,zt,u,v,w
+      nstop=0
+      do i=1,nmixz
+        indzindicator(i)=.true.
+       enddo
+
+      if (DRYDEP) then    ! reset probability for deposition
+        do  ks=1,nspec
+          depoindicator(ks)=.true.
+          prob(ks)=0.
+       enddo
+      endif
+
+      dxsave=0.           ! reset position displacements
+      dysave=0.           ! due to mean wind
+      dawsave=0.          ! and turbulent wind
+      dcwsave=0.
+      usig=0.
+      vsig=0.
+      wsig=0.
+       ust=0.
+      wst=0.
+      ol=0.
+      h=0.
+      zeta=0.
+      sigu=0.
+      sigv=0.
+      tlu=0.
+      tlv=0.
+      tlw=0.
+      sigw=0.
+      dsigwdz=0.
+      dsigw2dz=0. 
+!     wp=0.
+        itimec=itime
+      idummy=7
+       if (newrandomgen.eq.0) then
+!      cpt2=cpt2+ompid+1
+      cpt2=cpt2+1
+!     cpt2=cpt2+1000367
+      cpt2=mod(cpt2,maxrand)+1;
+
+!      nrand=int(ran3(idummy,inext,inextp,ma,iff)*real(maxrand-1))+1
+!     nrand=cpt
+      nrand=cpt2+ompid*maxrand
+!     print*,cpt2,maxrand,maxrandomp,maxomp
+!       print*, rannumb(nrand),nrelpoint
+!     print*,rannumb(nrand),myid,ompid 
+!      if (nrelpoint.ge.993 .and. nrelpoint.le.998) then
+!      write(22,*),itime,cpt2,rannumb(nrand),nrelpoint
+!!,myid,OMP_GET_THREAD_NUM()
+ !!      write(22,*),itime,cpt2,rannumb(nrand),nrelpoint
+!         endif
+
+
+!        if (nrand+2.gt.maxrand) nrand=1
+!    print*,rannumb(nrand)
+       maxrand2=maxrandomp
+
+        else
+!-------------------------------------------------------------------------------------------------
+!----- added by MC: parallel random nuymber generation using MT generator ------------------------
+       !print *,'varie3',ompid,myid,n_threads
+!      rannum=genrand_int32(mts(ompid+1+(myid*n_threads)))  !integer random number at 32 bit resolution
+       rannum=genrand_int32(mts(ompid+1))  !integer random number at 32 bit resolution
+       real_rannum = sngl(0.5_DP + 0.2328306e-9_DP * rannum) !conversion to single precision 32bit real
+       nrand=int(real_rannum*real(maxrand-1))+1
+        !print *,'varie4',rannum,real_rannum,nrand
+!--------------------------------------------------------------------------------------------------
+        maxrand2=maxrand
+
+        end if
+       
+! 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
+        write(*,*)
+        write(*,*) '*** stopping in advance ***'
+        write(*,*) '    the n-pole code section should not be active'
+        write(*,*)
+        ngrid=-1
+      else if (sglobal.and.(yt.lt.switchsouthg)) then
+        write(*,*)
+        write(*,*) '*** stopping in advance ***'
+        write(*,*) '    the s-pole code section should not be active'
+        write(*,*)
+        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
+        enddo 
+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
+
+     if (ix.lt.0) print*,'problem', xt,xtold,yt,zt,itime,myid,ompid,nrelpoint
+
+! 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
+!*************************************************************
+!      print*,'zeta',zeta,h,zt,xt
+      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
+
+
+!   print *,'xx0',OMP_GET_THREAD_NUM(),loop,xt,yt,zt,xts,yts,u,v,w
+          if (loop.eq.1) then
+!    if (nombre.eq.103) print*,'usig 0',usig,xt,yt,zt
+            if (ngrid.le.0) then
+              xts=real(xt)
+              yts=real(yt)
+!    if (nombre.eq.103) print*,'usig 0',usig,xts,yts,zt
+              call interpol_all(itime,xts,yts,zt, &
+    uprof,vprof,wprof, usigprof,vsigprof,wsigprof, &
+    rhoprof,rhogradprof, tkeprof,pttprof, &
+    u,v,w,usig,vsig,wsig,pvi, &
+    p1,p2,p3,p4,ddx,ddy,rddx,rddy,dtt,dt1,dt2, &
+    ix,jy,ixp,jyp,ngrid,indz,indzp, depoindicator, &
+    indzindicator, &
+    ust,wst,ol,h,zeta,sigu,sigv,tlu,tlv,tlw, &
+    sigw,dsigwdz,dsigw2dz,mu,mv)
+
+            else
+              call interpol_all_nests(itime,xtn,ytn,zt, &
+    uprof,vprof,wprof, usigprof,vsigprof,wsigprof, &
+    rhoprof,rhogradprof, tkeprof,pttprof, &
+    u,v,w,usig,vsig,wsig,pvi, &
+    p1,p2,p3,p4,ddx,ddy,rddx,rddy,dtt,dt1,dt2, &
+    ix,jy,ixp,jyp,ngrid,indz,indzp, depoindicator, &
+    indzindicator, &
+    ust,wst,ol,h,zeta,sigu,sigv,tlu,tlv,tlw, &
+    sigw,dsigwdz,dsigw2dz,mu,mv)
+            endif
+!    if (nombre.eq.103) print*,'usig 1',usig,xts,yts,zt
+
+          else
+
+
+!   print *,'xx',OMP_GET_THREAD_NUM(),xt,yt,zt,xts,yts,u,v,w
+! 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
+              enddo
+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
+!    if (nombre.eq.103) print*,'in usig 2',usig
+                  call interpol_misslev(i,xt,yt,zt, &
+    uprof,vprof,wprof, usigprof,vsigprof,wsigprof, &
+    rhoprof,rhogradprof, tkeprof,pttprof, &
+    u,v,w,usig,vsig,wsig,pvi, &
+    p1,p2,p3,p4,ddx,ddy,rddx,rddy,dtt,dt1,dt2, &
+    ix,jy,ixp,jyp,ngrid,indz,indzp, depoindicator, &
+    indzindicator, &
+    ust,wst,ol,h,zeta,sigu,sigv,tlu,tlv,tlw, &
+    sigw,dsigwdz,dsigw2dz)
+!JB mw not needed here
+                else
+                  call interpol_misslev_nests(i,xt,yt,zt, &
+    uprof,vprof,wprof, usigprof,vsigprof,wsigprof, &
+    rhoprof,rhogradprof, tkeprof,pttprof, &
+    u,v,w,usig,vsig,wsig,pvi, &
+    p1,p2,p3,p4,ddx,ddy,rddx,rddy,dtt,dt1,dt2, &
+    ix,jy,ixp,jyp,ngrid,indz,indzp, depoindicator, &
+    indzindicator, &
+    ust,wst,ol,h,zeta,sigu,sigv,tlu,tlv,tlw, &
+    sigw,dsigwdz,dsigw2dz)
+                endif
+              endif
+            enddo
+          endif
+
+!    if (nombre.eq.103) print*,'usig 2',usig
+
+! 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 (turb_option .eq. turb_option_mytke) then 
+! FLEXPART-WRF
+
+!               write(*,*)'itime=',itime,'xt=',xt,'yt=',yt
+              call tke_partition_my(zt, &
+   ust,wst,ol,h,zeta,sigu,sigv,tlu,tlv,tlw, &
+   sigw,dsigwdz,dsigw2dz,uprof,vprof,tkeprof,pttprof,indz,indzp)
+          else if (turb_option .eq. turb_option_tke) then
+              call tke_partition_hanna(zt, &
+   ust,wst,ol,h,zeta,sigu,sigv,tlu,tlv,tlw, &
+   sigw,dsigwdz,dsigw2dz,uprof,vprof,tkeprof,pttprof,indz,indzp)
+          else
+             if (turbswitch) then
+               call hanna(zt,  &
+    ust,wst,ol,h,zeta,sigu,sigv,tlu,tlv,tlw, &
+    sigw,dsigwdz,dsigw2dz)
+                       
+             else
+               call hanna1(zt, &
+    ust,wst,ol,h,zeta,sigu,sigv,tlu,tlv,tlw, &
+    sigw,dsigwdz,dsigw2dz)
+
+            endif
+          endif   
+!      print*,   ust,wst,ol,h,zeta,sigu,sigv,tlu,tlv,tlw, &
+!  sigw,dsigwdz,dsigw2dz,indz,indzp
+!JB
+!          if (h/abs(ol).lt.1.) then
+!c        print*,itime,'h and ol',h,ol,'neutral'
+!           reflect_switch=0
+!       else if (ol.lt.0.) then
+!c        print*,itime,'h and ol',h,ol,'unstable'
+!c          reflect_switch=1
+!           reflect_switch=0
+!        else
+!c        print*,itime,'h and ol',h,ol,'stable'
+!           reflect_switch=0
+!         endif 
+!*****************************************
+! Determine the new diffusivity velocities
+!*****************************************
+
+! Horizontal components
+!**********************
+
+!         if (nrand+1.gt.maxrandomp) nrand=1
+          if (nrand+1.gt.maxrand2) 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.maxrandomp) nrand=1
+          if (nrand+ifine.gt.maxrand2) 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
+! Determine the drift velocity and density correction velocity
+!*************************************************************
+!--------------- lines below are teh original FLEXPART  and are commented out to insert teh cbl options comment by mc
+!            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
+!************ CBL scheme integrated in FLEXPART: added by mc **********!
+         if (turbswitch) then
+          if (dtftlw.lt..5) then
+            if (cblflag.eq.1) then
+!     wp2=wp
+!     zt2=zt
+!    ust2=ust
+!    wst2=wst
+!    h2=h
+!    rhoa2=rhoa
+!    rhograd2=rhograd
+!    sigw2=sigw
+!    dsigwdz2=dsigwdz
+!    tlw2=tlw
+!    ptot_lhh2=ptot_lhh
+!    Q_lhh2=Q_lhh
+!    phi_lhh2=phi_lhh
+!    ath2=ath
+!    bth2=bth
+!    ol2=ol
+               if (-h/ol.gt.5) then  !modified by mc 
+              !if (ol.lt.0.) then   !modified by mc  
+              !if (ol.gt.0.) then   !modified by mc : for test
+                  !print  *,zt,wp,ath,bth,tlw,dtf,'prima'
+                  flagrein=0
+                  nrand=nrand+1
+                  old_wp_buf=wp
+                  del_test=(1.-old_wp_buf)/old_wp_buf
+
+                  !rhoa=1.  !for testing vertical well mixed state, by mc
+                  !rhograd=0.  !for testing vertical well mixed state, by mc
+                  call cbl(wp,zt,ust,wst,h,rhoa,rhograd,sigw,dsigwdz,tlw,ptot_lhh,Q_lhh,phi_lhh,ath,bth,ol,flagrein)
+! see inside the routine for inverse time
+                  wp=(wp+ath*dtf+bth*rannumb(nrand)*sqrt(dtf))*real(icbt)
+                  delz=wp*dtf
+!                  if ((ieee_is_nan(zt).or.ieee_is_nan(wp)).and.(flagrein.eq.0)) print*,'pb4',wp2,zt2,ust2,wst2,h2,rhoa2,rhograd2,sigw2,dsigwdz2,tlw2,ptot_lhh2,Q_lhh2,phi_lhh2,ath2,bth2,ol2,flagrein,i
+                  if (abs(wp).gt.50.) flagrein=1
+                  if (flagrein.eq.1) then  !added for re-initlization of particle vertical velcoity based on condition inside routine cbl.f90
+                      call re_initialize_particle(zt,ust,wst,h,sigw,old_wp_buf,nrand,ol)
+!                  if (ieee_is_nan(old_wp_buf)) print*,"PROBLEM WP",wp,old_wp_buf,nrand,ol,zt,ust,wst,h,sigw
+                      wp=old_wp_buf
+                      delz=wp*dtf
+                      !nan_count(myid)=nan_count(myid)+1
+                       nan_count(ompid+1)=nan_count(ompid+1)+1
+                  else       
+                  del_test=(1.-wp)/wp !catch infinity value
+!                 if (ieee_is_nan(wp) .or. ieee_is_nan(del_test)) then
+                   if (isnan2(wp).or.isnan2(del_test)) then !note that, given the test on particle velocity inside the routine cbl.f90, this condition should never be true!! 
+!                 if (isnan(wp).or.isnan(del_test)) then !note that, given the test on particle velocity inside the routine cbl.f90, this condition should never be true!! 
+                      nrand=nrand+1
+                      call re_initialize_particle(zt,ust,wst,h,sigw,old_wp_buf,nrand,ol)
+                      wp=old_wp_buf
+                      delz=wp*dtf
+                      nan_count(ompid+1)=nan_count(ompid+1)+1
+                      !nan_count(myid)=nan_count(myid)+1
+                      print *,'NaN counter equal to:',nan_count(ompid+1),'omp',ompid,'mpi',myid
+!                     ,'increase
+!                     !ifine if this number became a non-negligible fraction of
+!                     !the particle number'
+                  end if
+                  end if
+              else 
+                  !rhoa=1.  !for testing vertical well mixed state, by mc
+                  !rhograd=0. !for testing vertical well mixed state, by mc
+                  nrand=nrand+1
+                  old_wp_buf=wp                  
+                  ath=-wp/tlw+sigw*dsigwdz+wp*wp/sigw*dsigwdz+sigw*sigw/rhoa*rhograd  !1-note for inverse time should be -wp/tlw*ldirect+... calculated for wp=-wp
+                                                                                      !2-but since ldirect =-1 for inverse time and this must be calculated for (-wp) and
+                                                                                      !3-the gaussian pdf is symmetric (i.e. pdf(w)=pdf(-w) ldirect can be discarded
+                  bth=sigw*rannumb(nrand)*sqrt(2.*dtftlw)
+                  wp=(wp+ath*dtf+bth)*real(icbt)  
+                  delz=wp*dtf
+                  del_test=(1.-wp)/wp !catch infinity value
+!                    if (ieee_is_nan(wp).or.ieee_is_nan(del_test)) then 
+!                print*,'PB',wp2,zt2,ust2,wst2,h2,rhoa2,rhograd2,sigw2,dsigwdz2,tlw2,ptot_lhh2,Q_lhh2,phi_lhh2,ath2,bth2,ol2,flagrein,i
+!                print*,'PB2',ath,old_wp_buf,bth,wp,sigw
+                  if (isnan2(wp).or.isnan2(del_test).or.abs(wp).gt.50.) then 
+!                  if (wp.ne.wp .or. del_test.ne.del_test) then
+!                  if (ieee_is_nan(wp) .or. ieee_is_nan(del_test).or.abs(wp).gt.50.) then            
+                      nrand=nrand+1                      
+                      wp=sigw*rannumb(nrand)
+                      delz=wp*dtf
+                      nan_count(ompid+1)=nan_count(ompid+1)+1
+                      print *,'NaN counter equal to:',nan_count(ompid+1),'omp',ompid,'mpi',myid &
+            ,'increase ifine if this number became a non-negligible fraction of the particle number'
+                  end if  
+              end if
+            else
+                 wp=((1.-dtftlw)*wp+rannumb(nrand+i)*sqrt(2.*dtftlw) &
+                 +dtf*(dsigwdz+rhoaux*sigw))*real(icbt) 
+                 delz=wp*sigw*dtf
+            end if
+          else
+            rw=exp(-dtftlw)
+            wp=(rw*wp+rannumb(nrand+i)*sqrt(1.-rw**2) &
+                 +tlw*(1.-rw)*(dsigwdz+rhoaux*sigw))*real(icbt)
+            delz=wp*sigw*dtf
+          endif
+          
+        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
+
+!***************** end turbulent options : comemnt by mc *********************************!
+
+!        if (ieee_is_nan(wp)) then
+!         print*,"PROBLEM WP OUT",wp,old_wp_buf,nrand,ol,zt,ust,wst,h,sigw
+!        endif
+! FLEXPART_WRF - zero up,vp,wp if turbulence is turned off
+            if (turb_option .eq. turb_option_none) then
+             up=0.0
+             vp=0.0
+              wp=0.0
+              delz=0.
+            end if
+!          print*,'delz',delz,zt 
+!****************************************************
+! Compute turbulent vertical displacement of particle
+!****************************************************
+!     if (nrelpoint.eq.970) then
+!      write(15,*),rannumb(nrand),nrand,nrelpoint,OMP_GET_THREAD_NUM()
+!     endif
+
+            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 if (delz.gt.(h-zt) .and. reflect_switch==1) then ! reflection at h
+!             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
+! FLEXPART_WRF, TKE option
+              if (turb_option .gt. 1) then 
+                  do ii=2,nz
+                      if (height(ii).gt.zt) then
+                       indz=ii-1
+                       indzp=ii
+                       goto 69
+                      endif
+                   enddo
+69                 continue
+ 
+! If one of the levels necessary is not yet available,
+! calculate it
+!*****************************************************
+ 
+            do ii=indz,indzp                !i
+              if (indzindicator(ii)) then
+                if (ngrid.le.0) then
+                  call interpol_misslev(ii,xt,yt,zt, &
+    uprof,vprof,wprof, usigprof,vsigprof,wsigprof, &
+    rhoprof,rhogradprof, tkeprof,pttprof, &
+    u,v,w,usig,vsig,wsig,pvi, &
+    p1,p2,p3,p4,ddx,ddy,rddx,rddy,dtt,dt1,dt2, &
+    ix,jy,ixp,jyp,ngrid,indz,indzp, depoindicator, &
+    indzindicator, &
+    ust,wst,ol,h,zeta,sigu,sigv,tlu,tlv,tlw, &
+    sigw,dsigwdz,dsigw2dz)
+                else
+                  call interpol_misslev_nests(ii,xt,yt,zt, &
+    uprof,vprof,wprof, usigprof,vsigprof,wsigprof, &
+    rhoprof,rhogradprof, tkeprof,pttprof, &
+    u,v,w,usig,vsig,wsig,pvi, &
+    p1,p2,p3,p4,ddx,ddy,rddx,rddy,dtt,dt1,dt2, &
+    ix,jy,ixp,jyp,ngrid,indz,indzp, depoindicator, &
+    indzindicator, &
+    ust,wst,ol,h,zeta,sigu,sigv,tlu,tlv,tlw, &
+    sigw,dsigwdz,dsigw2dz)
+                endif
+              endif
+            enddo                          !i
+!              write(*,*)'after reflection'
+            if(turb_option .eq. turb_option_mytke) &
+               call tke_partition_my(zt, &
+   ust,wst,ol,h,zeta,sigu,sigv,tlu,tlv,tlw, &
+   sigw,dsigwdz,dsigw2dz,uprof,vprof,tkeprof,pttprof,indz,indzp)
+            if(turb_option .eq. turb_option_tke)   &
+               call tke_partition_hanna(zt, &
+   ust,wst,ol,h,zeta,sigu,sigv,tlu,tlv,tlw, &
+   sigw,dsigwdz,dsigw2dz,uprof,vprof,tkeprof,pttprof,indz,indzp)
+            else
+                zeta=zt/h
+                 call hanna_short(zt, &
+    ust,wst,ol,h,zeta,sigu,sigv,tlu,tlv,tlw, &
+    sigw,dsigwdz,dsigw2dz)
+
+            endif
+           endif
+
+          enddo
+          
+          if (cblflag.ne.1) nrand=nrand+i  !------>>>>>>>>>>>>>>>> modified by mc for accounting of different increment of nrand in cbl flag
+!    if (nombre.eq.103) print*,'usig 3',usig
+
+! 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
+!         print*,nrelpoint,nsp
+          if (xmass(nrelpoint,nsp).gt.eps2) goto 887
+        end do
+887     nsp=min(nsp,nspec)
+       if (density(nsp).gt.0.) then
+!        print*,'settle'
+!       print*,'settle 1'
+               call get_settling(itime,real(xt),real(yt),zt,nsp,settling)  !bugfix
+        endif
+        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
+!     if (nombre.eq.103) print*,'xt-2',dxsave,u,dt
+          dysave=dysave+v*dt
+          dawsave=dawsave+up*dt
+          dcwsave=dcwsave+vp*dt
+          zt=zt+w*dt*real(ldirect)  ! comment out and put zt=zt for testing equation based on the well_mixed conditin comemnt by mc 
+
+
+          if (zt.gt.h) then
+            if (itimec.eq.itime+lsynctime) goto 99
+            goto 700    ! complete the current interval above PBL
+          endif
+          if (zt.lt.0.) zt=-1.*zt    ! if particle below ground -> refletion
+
+
+!!!! 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
+!67        continue
+!      endif
+!c       print*,'itime',itime
+!c     if ((mod(abs(itime),3600).eq.0)) then
+!c     if ((mod(abs(itime),3600).eq.0).and.dump) then
+!      if (itime<itimeold) then
+!       print*,'dump well',itime,itimeold
+!       dump=.false.
+!        itimeold=itimeold-3600
+!       write(550,'(i8,12f10.3)') itime,hsave/tacc,zacc/tacc,
+!c      write(550,'(i8,22f10.3)') itime,hsave/tacc,zacc/tacc,
+!     + (t(i)/tacc*real(iclass),i=1,iclass)
+!        flush(550)
+!        zacc=0.
+!        tacc=0.
+!        do 68 i=1,iclass
+!68        t(i)=0.
+!        hsave=0.
+!      endif
+!      if (mod(abs(itime),3600).ne.0) dump=.true.
+!c       print*,'itime',itime,3600,mod(abs(itime),3600),dump
+!!!! CHANGE
+!!!******************  NEW test for THE WELL MIXED CRITERION by mc ***************
+!$OMP CRITICAL
+!if (zt.lt.h) then
+!          i_well=int(zt/h*num_lvl*1.)+1                                          !per fare il test qui devo considerare OMP and MPI...
+!          well_mixed_vector(i_well,ompid+1)=well_mixed_vector(i_well,ompid+1)+dt
+!          well_mixed_norm(ompid+1)=well_mixed_norm(ompid+1)+dt
+!          avg_air_dens(i_well,ompid+1)=avg_air_dens(i_well,ompid+1)+rhoa*dt
+!          
+!      end if
+!      h_well(ompid+1)=h
+!$OMP END CRITICAL    
+!!*********************************************************************************
+
+! 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),ix,jy,ixp,jyp, &
+                                      p1,p2,p3,p4,dt1,dt2,dtt,depoindicator)
+              else
+                call interpol_vdep_nests(ks,vdepo(ks),ix,jy,ixp,jyp, &
+                                      p1,p2,p3,p4,dt1,dt2,dtt,depoindicator,ngrid)
+              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
+!   if (nombre.eq.103) print*,'usig',usig,usigprof(indzp)+usigprof(indz),indz
+        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
+!*********************
+
+!JB needs to define mu and mv
+700   continue
+      if (ngrid.le.0) then
+        xts=real(xt)
+        yts=real(yt)
+        call interpol_wind(itime,xts,yts,zt, &
+    uprof,vprof,wprof, usigprof,vsigprof,wsigprof, &
+    rhoprof,rhogradprof, tkeprof,pttprof, &
+    u,v,w,usig,vsig,wsig,pvi, &
+    p1,p2,p3,p4,ddx,ddy,rddx,rddy,dtt,dt1,dt2, &
+    ix,jy,ixp,jyp,ngrid,indz,indzp, depoindicator, &
+    indzindicator,mu,mv)
+ !JB mw not needed here
+      else
+        call interpol_wind_nests(itime,xtn,ytn,zt, &
+    uprof,vprof,wprof, usigprof,vsigprof,wsigprof, &
+    rhoprof,rhogradprof, tkeprof,pttprof, &
+    u,v,w,usig,vsig,wsig,pvi, &
+    p1,p2,p3,p4,ddx,ddy,rddx,rddy,dtt,dt1,dt2, &
+    ix,jy,ixp,jyp,ngrid,indz,indzp, depoindicator, &
+    indzindicator,mu,mv)
+      endif
+
+!    if (nombre.eq.103) print*,'usig 4',usig
+! 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.maxrandomp) nrand=1
+    if (nrand+1.gt.maxrand2) 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.maxrandomp) nrand=1
+    if (nrand+2.gt.maxrand2) 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.maxrandomp) nrand=1
+    if (nrand.gt.maxrand2) nrand=1
+    ux=0.
+    vy=0.
+    wpscale=sqrt(2.*d_strat/dt)
+    wp=rannumb(nrand)*wpscale
+    nrand=nrand+1
+  endif
+
+! FLEXPART_WRF - zero ux,vy,wp if turbulence is turned off
+      if (turb_option .eq. turb_option_none) then
+        ux=0.0
+        vy=0.0
+        wp=0.0
+      end if
+
+
+! 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.) then
+!       print*,'settle 2, bef',real(xt),real(yt),zt,cpt
+           call get_settling(itime,real(xt),real(yt),zt,nsp,settling)  !bugfix
+!       print*,'settle 2, aft',real(xt),real(yt),zt,cpt,w
+!        print*,'settle'
+      endif
+      w=w+settling
+    endif
+
+! Calculate position at time step itime+lsynctime
+!************************************************
+
+!       print*,'settle 2, aft1.5',zt,settling,wp,dt
+      dxsave=dxsave+(u+ux)*dt
+!     if (nombre.eq.103) print*,'xt-1',dxsave,u,ux,dt
+      dysave=dysave+(v+vy)*dt
+      zt=zt+(w+wp)*dt*real(ldirect)
+!       print*,'settle 2, aft2',zt,cpt
+      if (zt.lt.0.) zt=min(h-eps2,-1.*zt)    ! if particle below ground -> reflection
+!       print*,'settle 2, aft3',zt,cpt
+
+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.maxrandomp) nrand=1
+      if (nrand+2.gt.maxrand2) nrand=1
+!     if (nombre.eq.103) print*,'usgig0',r,usigold,rannumb(nrand)
+      usigold=r*usigold+rs*rannumb(nrand)*usig*turbmesoscale
+!     if (nombre.eq.103) print*,'usgig1',usigold,usig,turbmesoscale
+      vsigold=r*vsigold+rs*rannumb(nrand+1)*vsig*turbmesoscale
+      wsigold=r*wsigold+rs*rannumb(nrand+2)*wsig*turbmesoscale
+
+! FLEXPART_WRF - zero u/v/wsigold if turbulence is turned off
+! Note: for mesoscale model applications this component should be ignored!
+!     if (turb_option .eq. turb_option_none) then
+!       usigold=0.0
+!       vsigold=0.0
+!       wsigold=0.0
+!     end if
+
+      dxsave=dxsave+usigold*real(lsynctime)
+      dysave=dysave+vsigold*real(lsynctime)
+
+      zt=zt+wsigold*real(lsynctime)
+!       print*,'settle 2, aft4',zt,cpt
+      if (zt.lt.0.) zt=-1.*zt    ! if particle below ground -> refletion
+!       print*,'settle 2, aft5',zt,cpt
+
+!*************************************************************
+! 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
+!     if (nombre.eq.103) print*,'xt0',dxsave,usigold,ux
+      dysave=dysave+vy
+      if (ngrid.ge.0) then
+! for FLEXPART_WRF, dx & dy are in meters,
+! dxconst=1/dx, dyconst=1/dy, and no cos(lat) is needed
+!       cosfact=dxconst/cos((yt*dy+ylat0)*pi180)
+!     if (nombre.eq.103) print*,'xt1',xt,dxsave,dxconst
+!       xt=xt+real(dxsave*dxconst*real(ldirect),kind=dp)
+!       yt=yt+real(dysave*dyconst*real(ldirect),kind=dp)
+!      xt=xt+real(dxsave/mu*dxconst*real(ldirect),kind=dp)
+!      yt=yt+real(dysave/mv*dyconst*real(ldirect),kind=dp)
+       xt=xt +real(dxsave*mu*dxconst*real(ldirect),kind=dp)  !IF COOMMENTED OUT TO is to ISOLate VERTCAL FORMULAITON FOR TEST REASON BY mc
+       yt=yt +real(dysave*mv*dyconst*real(ldirect),kind=dp)  !IF COOMMENTED OUT TO is to ISOLate VERTCAL FORMULAITON FOR TEST REASON BY mc
+! JB: needs interpolate m_w on the coordinates
+!     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
+      else
+        write(*,*) 'advance -- bad ngrid = ', ngrid
+        stop
+      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
+!       print*,'settle 2, aft6',zt,cpt
+
+
+!************************************************************************
+! 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, &
+    uprof,vprof,wprof, usigprof,vsigprof,wsigprof, &
+    rhoprof,rhogradprof, tkeprof,pttprof, &
+    u,v,w,usig,vsig,wsig,pvi, &
+    p1,p2,p3,p4,ddx,ddy,rddx,rddy,dtt,dt1,dt2, &
+    ix,jy,ixp,jyp,ngrid,indz,indzp, depoindicator, &
+    indzindicator)
+      else
+        call interpol_wind_short_nests(itime+ldt*ldirect,xtn,ytn,zt, &
+    uprof,vprof,wprof, usigprof,vsigprof,wsigprof, &
+    rhoprof,rhogradprof, tkeprof,pttprof, &
+    u,v,w,usig,vsig,wsig,pvi, &
+    p1,p2,p3,p4,ddx,ddy,rddx,rddy,dtt,dt1,dt2, &
+    ix,jy,ixp,jyp,ngrid,indz,indzp, depoindicator, &
+    indzindicator)
+
+      endif
+!       print*,'settle 2, aft7',zt,cpt
+
+  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.) then
+!       print*,'settle 3, bef',real(xt),real(yt),zt,cpt
+        call get_settling(itime+ldt,real(xt),real(yt),zt,nsp,settling)  !bugfix
+!       print*,'settle 3, aft',real(xt),real(yt),zt,cpt
+!        print*,'settle'
+      endif
+    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
+! for FLEXPART_WRF, dx & dy are in meters,
+! dxconst=1/dx, dyconst=1/dy, and no cos(lat) is needed
+!       cosfact=dxconst/cos((yt*dy+ylat0)*pi180)
+!       if (nombre.eq.103)  print*,'xt2',xt,u,dxconst,ldt
+!       xt=xt+real(u*dxconst*real(ldt*ldirect),kind=dp)
+!       yt=yt+real(v*dyconst*real(ldt*ldirect),kind=dp)
+!        print*,'mw',mu,mv
+!        xt=xt+real(u*dxconst/mu*real(ldt*ldirect),kind=dp)
+!        yt=yt+real(v*dyconst/mv*real(ldt*ldirect),kind=dp)
+         xt=xt +real(u*dxconst*mu*real(ldt*ldirect),kind=dp)  !IF COOMMENTED OUT TO is to ISOLate VERTCAL FORMULAITON FOR TEST REASON BY mc
+         yt=yt +real(v*dyconst*mv*real(ldt*ldirect),kind=dp)  !IF COOMMENTED OUT TO is to ISOLate VERTCAL FORMULAITON FOR TEST REASON BY mc
+!     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
+      else
+        write(*,*) 'advance -- bad ngrid = ', ngrid
+        stop
+      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
+
+!       if (nombre.eq.103)  print*,'end',xt,u,dxconst,ldt
+
+      end subroutine advance
+
+!       logical function isnan2(a)
+!       real :: a
+!        if ((a.ne.a)) then !.or.((a*0.).ne.0.)) then
+!       isnan2 = .true.
+!       else
+!       isnan2 = .false.
+!        end if
+!        return
+!       end 
Index: /branches/jerome/src_flexwrf_v3.1/assignland.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/assignland.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/assignland.f90	(revision 16)
@@ -0,0 +1,238 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                *
+!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine,       *
+!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
+!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso,          *
+!* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann,   *
+!*                                                                     *
+!* This file is part of FLEXPART WRF                                   *
+!*                                                                     *
+!* 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
+!*******************************************************************************
+!                                                                              *
+!     Note:  This is the FLEXPART_WRF version of subroutine assignland.        *
+!            The computational grid is the WRF x-y grid rather than lat-lon.   *
+!                                                                              *
+!     This routine assigns fractions of the 8 landuse classes to each ECMWF    *
+!     grid point.                                                              *
+!     The landuse inventory of                                                 *
+!                                                                              *
+!     van de Velde R.J., Faber W.S., van Katwijk V.F., Kuylenstierna J.C.I.,   *
+!     Scholten H.J., Thewessen T.J.M., Verspuij M., Zevenbergen M. (1994):     *
+!     The Preparation of a European Land Use Database. National Institute of   *
+!     Public Health and Environmental Protection, Report nr 712401001,         *
+!     Bilthoven, The Netherlands.                                              *
+!                                                                              *
+!     is used to create a detailed landuse inventory for Europe.               *
+!                                                                              *
+!     Outside of Europe, 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                        *
+!                                                                              *
+!    14 October  2005 R. Easter -- modified for WRF.                           *
+!                     The landuse inventory is not used at all.                *
+!                     The land/sea mask is used everywhere.                    *
+!    Feb 2012 J. Brioude: modified to fortran 90                               *
+!*******************************************************************************
+!                                                                              *
+! Variables:                                                                   *
+! xlanduse          fractions of numclass landuses for each model grid point   *
+! xlandinvent       landuse inventory (1/6 deg resolution)                     *
+!                                                                              *
+!*******************************************************************************
+
+  use par_mod
+  use com_mod
+
+  implicit none
+  integer :: ix,jy,k,l,li,nrefine,iix,jjy,n,nxn2,nyn2
+  integer,parameter :: lumaxx=1200,lumaxy=600
+  real,parameter :: xlon0lu=-180.,ylat0lu=-90.
+  real,parameter :: dxlu=0.3
+  real :: xlon,ylat,sumperc,p,xi,yj
+  real :: xlandusep(lumaxx,lumaxy,numclass)
+!  real :: xlanduse(0:nxmax-1,0:nymax-1,numclass)
+!  real :: xlandusen(0:nxmaxn-1,0:nymaxn-1,numclass,maxnests)
+
+!      include 'includepar'
+!      include 'includecom'
+!
+!      integer ix,jy,i,j,k,n,l
+!      real x,y,xlon,ylat
+
+  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
+
+  nrefine=10
+
+      do ix=0,nxmin1
+!       xlon=real(ix)*dx+xlon0         ! long.
+        do jy=0,nymin1
+!         ylat=real(jy)*dy+ylat0       ! and lat. of each gridpoint
+! FLEXPART_WRF - use this routine to get lat,lon
+          do k=1,numclass
+        sumperc=0.
+          xlanduse(ix,jy,k)=0.
+         enddo
+
+!        do iix=1, nrefine
+!          do jjy=1, nrefine
+        do iix=1, 1
+          do jjy=1, 1
+
+!          xlon=(ix+(iix-1)/real(nrefine))*dx+xlon0        ! longitude, should be between -180 and 179
+!           ylat=(jy+(jjy-1)/real(nrefine))*dy+ylat0       ! and lat. of each gridpoint
+
+          call xyindex_to_ll_wrf( 0, real(ix), real(jy), xlon, ylat )
+
+          if (xlon.ge.(xlon0lu+lumaxx*dxlu))  then
+               xlon=xlon-lumaxx*dxlu
+          endif
+           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
+
+
+!   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'
+
+
+      do l=1,numbnests
+       do jy=0,nyn(l)-1
+        do ix=0,nxn(l)-1
+
+          do k=1,numclass
+           xlandusen(ix,jy,k,l)=0.0
+          sumperc=0.
+           enddo
+
+        do iix=1, 1
+          do jjy=1, 1
+
+!          xlon=(ix+(iix-1)/real(nrefine))*dx+xlon0        ! longitude, should be between -180 and 179
+!           ylat=(jy+(jjy-1)/real(nrefine))*dy+ylat0       ! and lat. of each gridpoint
+
+          call xyindex_to_ll_wrf( l, real(ix), real(jy), xlon, ylat )
+
+             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
+
+
+      end subroutine assignland
Index: /branches/jerome/src_flexwrf_v3.1/boundcond_domainfill.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/boundcond_domainfill.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/boundcond_domainfill.f90	(revision 16)
@@ -0,0 +1,637 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                *
+!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine,       *
+!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
+!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso,          *
+!* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann,   *
+!*                                                                     *
+!* This file is part of FLEXPART WRF                                   *
+!*                                                                     *
+!* 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
+!*******************************************************************************
+!                                                                              *
+!     Note:  This is the FLEXPART_WRF version of subr. boundcond_domainfill.   *
+!            The computational grid is the WRF x-y grid rather than lat-lon.   *
+!                                                                              *
+! 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                                                          *
+!                                                                              *
+!    26 Oct 2005, R. Easter - changes to calc. of boundarea                    *
+!                             associated with WRF horizontal grid.             *
+!                             Also need to get true ylat for pv calcs.         *
+!    11 Nov 2005, R. Easter - fixed error involving xy to latlong              *
+!    2012, J. Brioude: coded in fortran 90                                     *
+!*******************************************************************************
+!                                                                              *
+! 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,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),dumx,dumy,xlon,ylat
+  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
+       enddo
+
+
+! 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
+
+! for FLEXPART_WRF, x & y coords are in meters.
+! In the "do 70" loop, ylat is only needed for for pv calcs,
+!     "if (ylat.lt.0.) pvpart=-1.*pvpart"
+! Note: in the FLEXPART_ECMWF code, ylat was not defined 
+!     in the "do 70" loop (a bug).
+          dumx=real(nx_we(k))
+          dumy=real(jy)
+! Are these dumx,dumy correct ???
+          call xyindex_to_ll_wrf( 0, dumx, dumy, xlon, ylat )
+
+! 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
+
+! for FLEXPART_ECMWF, dy is in degrees-lat, and 111198.5 converts
+!   from degrees-latitude to m 
+! for FLEXPART_WRF, dy is in meters
+!           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
+            if ((jy.eq.ny_sn(1)).or.(jy.eq.ny_sn(2))) then
+              boundarea=deltaz/2.*dy
+            else
+              boundarea=deltaz*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
+              enddo
+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)
+             enddo
+
+              windhl(m)=(dz2*windl(1)+dz1*windl(2))*dz
+              rhohl(m)=(dz2*rhol(1)+dz1*rhol(2))*dz
+             enddo
+
+            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
+                  enddo
+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) 
+                   enddo
+                  yh1(mm)=(dz2*y1(1)+dz1*y1(2))*dz
+                  enddo
+                  pvpart=(yh1(1)*dt2+yh1(2)*dt1)*dtt
+!JB
+!               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
+!                 if (((ztra1(ipart).lt.8000.)
+!    +            ).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
+!    +              xmass1(ipart,1)*60.*48./29./10.**9
+                  else
+                    goto 71
+                  endif
+
+
+! Increase numpart, if necessary
+!*******************************
+
+                  numpart=max(numpart,ipart)
+                  goto 73      ! Storage space has been found, stop searching
+                endif
+           enddo
+              if (ipart.gt.maxpart) &
+              stop 'boundcond_domainfill.f: too many particles required'
+73            minpart=ipart+1
+71        continue
+
+            enddo
+
+     enddo
+     enddo
+     enddo
+
+!*****************************************
+! 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
+
+! for FLEXPART_WRF, x & y coords are in meters.
+!         ylat=ylat0+real(ny_sn(k))*dy
+!         cosfact=cos(ylat*pi180)
+! In the "do 170" loop, ylat is only needed for for pv calcs,
+!    "if (ylat.lt.0.) pvpart=-1.*pvpart"
+          dumx=real(ix)
+          dumy=real(ny_sn(k))
+! Are these dumx,dumy correct ???
+          call xyindex_to_ll_wrf( 0, dumx, dumy, xlon, ylat )
+
+! 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
+
+! for FLEXPART_ECMWF, dx is in degrees-long, and 111198.5*cosfact converts
+!   from degrees-longitude to m 
+! for FLEXPART_WRF, dx is in meters
+!           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
+            if ((ix.eq.nx_we(1)).or.(ix.eq.nx_we(2))) then
+              boundarea=deltaz/2.*dx
+            else
+              boundarea=deltaz*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
+            enddo
+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
+                    enddo   
+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
+              enddo
+              if (ipart.gt.maxpart)  &
+              stop 'boundcond_domainfill.f: too many particles required'
+173           minpart=ipart+1
+171           continue
+          enddo
+
+      enddo
+      enddo
+      enddo
+
+  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/jerome/src_flexwrf_v3.1/calc_uvmet.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/calc_uvmet.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/calc_uvmet.f90	(revision 16)
@@ -0,0 +1,86 @@
+!! Diagnostics: U & V on earth coordinates
+! from ARWpost postprocessing routine from the WRF package.
+
+  SUBROUTINE calc_uvmet(UUU,VVV,SCRa, SCRb, i3dflag)
+
+  IMPLICIT NONE
+
+  !Arguments
+  real, allocatable, dimension(:,:,:)             :: SCRa, SCRb
+  character (len=128)                             :: cname, cdesc, cunits
+
+  !Local
+  integer                                         :: i, j, k
+  integer                                         :: i3dflag
+  real                                            :: cone
+  real, dimension(west_east_dim,south_north_dim)  :: diff, alpha
+
+  cname    = "uvmet"
+  cdesc    = "Rotated wind component"
+  cunits   = "m s-1"
+  
+   use com_mod
+
+  IF ( map_proj .ge. 3 ) THEN     ! No need to rotate
+    IF ( i3dflag == 1 ) THEN  
+      SCRa = UUU
+      SCRb = VVV
+    ENDIF
+    IF ( i3dflag == 0 ) THEN
+      SCRa(:,:,1) = U10(:,:)
+      SCRb(:,:,1) = V10(:,:)
+    END IF
+    RETURN
+  END IF
+
+
+  cone = 1.                                          !  PS
+  IF ( map_proj .eq. 1) THEN                         !  Lambert Conformal mapping
+    IF (ABS(truelat1-truelat2) .GT. 0.1) THEN
+       cone=(ALOG(COS(truelat1*RAD_PER_DEG))-            &
+             ALOG(COS(truelat2*RAD_PER_DEG))) /          &
+       (ALOG(TAN((90.-ABS(truelat1))*RAD_PER_DEG*0.5 ))- &
+        ALOG(TAN((90.-ABS(truelat2))*RAD_PER_DEG*0.5 )) )
+    ELSE
+       cone = SIN(ABS(truelat1)*RAD_PER_DEG )
+    ENDIF
+  END IF
+
+
+  diff = XLONG - stand_lon
+  DO i = 1, west_east_dim
+  DO j = 1, south_north_dim
+    IF ( diff(i,j) .gt. 180. ) THEN
+      diff(i,j) = diff(i,j) - 360.
+    END IF
+    IF ( diff(i,j) .lt. -180. ) THEN
+      diff(i,j) = diff(i,j) + 360.
+    END IF
+  END DO
+  END DO
+
+
+  DO i = 1, west_east_dim
+  DO j = 1, south_north_dim
+     IF ( XLAT(i,j) .lt. 0. ) THEN
+       alpha(i,j) = - diff(i,j) * cone * RAD_PER_DEG
+     ELSE
+       alpha(i,j) = diff(i,j) * cone * RAD_PER_DEG
+     END IF
+  END DO
+  END DO
+
+  
+
+  IF ( i3dflag == 1 ) THEN
+    DO k = 1,bottom_top_dim
+      SCRa(:,:,k) = VVV(:,:,k)*sin(alpha) + UUU(:,:,k)*cos(alpha)
+      SCRb(:,:,k) = VVV(:,:,k)*cos(alpha) - UUU(:,:,k)*sin(alpha)
+    END DO
+  ELSE
+     SCRa(:,:,1) = V10(:,:)*sin(alpha) + U10(:,:)*cos(alpha)
+     SCRb(:,:,1) = V10(:,:)*cos(alpha) - U10(:,:)*sin(alpha)
+  END IF
+
+  END SUBROUTINE calc_uvmet
+
Index: /branches/jerome/src_flexwrf_v3.1/calcfluxes.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/calcfluxes.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/calcfluxes.f90	(revision 16)
@@ -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/jerome/src_flexwrf_v3.1/calcmatrix.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/calcmatrix.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/calcmatrix.f90	(revision 16)
@@ -0,0 +1,148 @@
+!***********************************************************************
+!* 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
+!
+!     20 Oct 2005 - R. Easter - added calc of pconv_hpa(nconvlev+1)
+!     16 Nov 2005 - R. Easter - pconv,phconv are set in convmix
+!                               using pph & pphn
+!
+!******************************************************************
+
+! lconv        indicates whether there is convection in this cell, or not
+! delt         time step for convection [s]
+! cbmf         cloud base mass flux
+
+!      include 'includepar'
+!      include 'includecom'
+!      include 'includeconv'
+  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 
+! dp(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+1
+          pconv_hpa(k)=pconv(k)/100.
+        phconv_hpa(k)=phconv(k)/100.
+         enddo
+        pconv_hpa(nconvlev+1)=pconv(nconvlev+1)/100.
+        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/jerome/src_flexwrf_v3.1/calcpar.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/calcpar.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/calcpar.f90	(revision 16)
@@ -0,0 +1,323 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                *
+!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine,       *
+!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
+!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso,          *
+!* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann,   *
+!*                                                                     *
+!* This file is part of FLEXPART WRF                                   *
+!*                                                                     *
+!* 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.                      *
+!                                                                              *
+!     Note:  This is the FLEXPART_WRF version of subroutine calcpar.           *
+!                                                                              *
+!     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
+!                                                                              *
+!     17 Oct 2005 - R. Easter - added ierr in call to richardson               *
+!     18 Oct 2005 - J. Fast - limit ustar to < 5.0 m/s                         *
+!     -- Oct 2005 - R. Easter - use xy_to_ll_wrf to get latitude               *
+!             use pph for calculating zlev                                     *
+!             pass level-2 pph directly to obukhov                             *
+!     11 Nov 2005 - R. Easter - changed name of "xy to latlon" routine         *
+!     15 Nov 2005 - R. Easter - pass pplev to richardson instead of akz,bkz    *
+!    July 2012: J. Brioude: coded in fortran 90 and parallelized               *
+!*******************************************************************************
+!                                                                              *
+! 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,ierr
+  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(kind=4) :: uuh(0:nxmax-1,0:nymax-1,nuvzmax)
+   real(kind=4) :: vvh(0:nxmax-1,0:nymax-1,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
+
+  real :: xlon,dumx,dumy,dumxb,dumyb,pplev(nuvzmax),hmixdummy
+
+! Loop over entire grid
+!**********************
+!      ientry = ientry + 1
+
+!$OMP PARALLEL DEFAULT(SHARED) &
+!$OMP PRIVATE(i,ix,jy,kz,lz,kzmin,tvold,pold,zold,zlev,tv,pint, &
+!$OMP rh,ierr,subsceff,ulev,vlev,pplev,ttlev,qvlev,ol,altmin,xlon,ylat )
+!$OMP DO
+      do jy=0,nymin1
+
+        do ix=0,nxmin1
+
+! Set minimum height for tropopause
+!**********************************
+
+! FLEXPART_WRF - use this routine to get lat,lon
+!       ylat=ylat0+real(jy)*dy
+        call xyindex_to_ll_wrf( 0, real(ix), real(jy), xlon, ylat )
+
+!       if ( ((ix.eq.0) .or. (ix.eq.nxmin1) .or. 
+!    &                       (ix.eq.nxmin1/2)) .and.
+!    &       ((jy.eq.0) .or. (jy.eq.nymin1) .or. 
+!    &                       (jy.eq.nymin1/2)) ) then
+!           if (ientry .eq. 1) then
+!               write(*,'(a,2i4,2f12.5)') 
+!    &              'calcpar i,j, xlon,ylat', ix, jy, xlon, ylat
+!               write(*,'(a, 8x,2f12.5)') 
+!    &              '             dlon,dlat', 
+!    &              (xlon-xlon2d(ix,jy)), (ylat-ylat2d(ix,jy))
+!               call ll_to_xyindex_wrf(
+!    &              xlon2d(ix,jy), ylat2d(ix,jy), dumx, dumy )
+!               write(*,'(a, 8x,2f12.5)') 
+!    &              '             dxkm,dykm', 
+!    &              ((dumx-ix)*dx*1.0e-3), ((dumy-jy)*dy*1.0e-3) 
+!
+!               if ((ix .eq. 0) .and. (jy .eq. 0)) then
+!                  dumxb = 2.33
+!                  dumyb = 3.44
+!                  call xyindex_to_ll_wrf( 0, dumxb, dumyb, dumx, dumy )
+!                  call ll_to_xyindex_wrf( dumx, dumy, dumx, dumy )
+!                  write(*,'(a,2f5.2,2f12.5)') 
+!    &                'xi,yj,     dxkm,dykm', dumxb, dumyb,
+!    &                ((dumx-dumxb)*dx*1.0e-3), ((dumy-dumyb)*dy*1.0e-3)
+!                  dumxb = 4.55
+!                  dumyb = 6.77
+!                  call xyindex_to_ll_wrf( 0, dumxb, dumyb, dumx, dumy )
+!                  call ll_to_xyindex_wrf( dumx, dumy, dumx, dumy )
+!                  write(*,'(a,2f5.2,2f12.5)') 
+!    &                'xi,yj,     dxkm,dykm', dumxb, dumyb,
+!    &                ((dumx-dumxb)*dx*1.0e-3), ((dumy-dumyb)*dy*1.0e-3)
+!               end if
+!
+!           end if
+!       end if
+
+        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
+
+! 1) Calculation of friction velocity
+!************************************
+          if ( (.not.strswitch)) then
+          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))
+          endif
+          if (ustar(ix,jy,1,n).le.1.e-8) ustar(ix,jy,1,n)=1.e-8
+! FLEXPART_WRF - limit ustar
+          if (ustar(ix,jy,1,n).ge.5.0)   ustar(ix,jy,1,n)=5.0
+
+! 2) Calculation of inverse Obukhov length scale
+!***********************************************
+
+! FLEXPART_WRF - pass k=2 pressure directly
+!         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)
+          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), &
+          pph(ix,jy,2,n) )
+          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)
+            pplev(i)=pph(ix,jy,i,n)
+            ttlev(i)=tth(ix,jy,i,n)
+            qvlev(i)=qvh(ix,jy,i,n)
+            zlev(i)=0.5*(zzh(ix,jy,i+1,n)+zzh(ix,jy,i,n))-zzh(ix,jy,1,n)
+           enddo
+! FLEXPART_WRF - use  & check ierr argument
+! FLEXPART_WRF - pass pplev instead of akz,bkz
+!         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)
+          call richardson(ps(ix,jy,1,n),ustar(ix,jy,1,n),ttlev,qvlev, &
+          ulev,vlev,nuvz,  pplev,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, &
+!         td2(ix,jy,1,n),hmixdummy,wstar(ix,jy,1,n),hmixplus, &
+          ierr,sfc_option )
+!JB
+! no reflec
+!         hmix(ix,jy,1,n)=5000.
+
+          if (ierr .gt. 0) then
+              write(*,9500) 'warning', ix, jy
+          else if (ierr .lt. 0) then
+              write(*,9500) 'failure', ix, jy
+              stop
+          end if
+9500      format( 'calcpar - richardson ', a, ' - ix,jy=', 2i5 )
+
+
+          if(lsubgrid.eq.1) then
+            subsceff=min(excessoro(ix,jy),hmixplus)
+!           subsceff=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
+!         print*,'hmix',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
+            z0(4)=0.016*ustar(ix,jy,1,n)*ustar(ix,jy,1,n)/ga
+            z0(9)=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),vd)
+
+            do i=1,nspec
+              vdep(ix,jy,i,n)=vd(i)
+            enddo
+          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.
+! FLEXPART_WRF - set zlev(1)
+          zlev(1)=zold
+          do kz=2,nuvz
+! FLEXPART_WRF - use pph for pressure
+!           pint=akz(kz)+bkz(kz)*ps(ix,jy,1,n)  ! pressure on model layers
+            pint=pph(ix,jy,kz,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)
+            enddo
+
+! 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
+!$OMP END DO
+!$OMP END PARALLEL
+
+! Calculation of potential vorticity on 3-d grid, if plume trajectory mode is used
+!*********************************************************************************
+
+      if ((iout.eq.4).or.(iout.eq.5).or.(mdomainfill.eq.2)) then
+        call calcpv(n,uuh,vvh,pvh)
+      endif
+
+
+end subroutine calcpar
+
Index: /branches/jerome/src_flexwrf_v3.1/calcpar_nests.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/calcpar_nests.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/calcpar_nests.f90	(revision 16)
@@ -0,0 +1,301 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                *
+!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine,       *
+!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
+!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso,          *
+!* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann,   *
+!*                                                                     *
+!* This file is part of FLEXPART WRF                                   *
+!*                                                                     *
+!* 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.    *
+!                                                                              *
+!     Note:  This is the FLEXPART_WRF version of subroutine calcpar.           *
+!                                                                              *
+!     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            *
+!                                                                              *
+!     14 Nov 2005 - R. Easter -                                                *
+!          use xyindex_to_ll_wrf to get latitude                               *
+!          limit ustar to < 5.0 m/s                                            *
+!          added ierr in call to richardson                                    *
+!          use pph for calculating zlev                                        *
+!          pass level-2 pph directly to obukhov                                *
+!     15 Nov 2005 - R. Easter - pass pplev to richardson instead of akz,bkz    *
+!    Jul 2012: J. Brioude: coded in fortran90 and parallelized                 *
+!*******************************************************************************
+!                                                                              *
+! 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,ierr
+  real :: ttlev(nuvzmax),qvlev(nuvzmax),obukhov,scalev,ol,hmixplus
+  real :: pplev(nuvzmax),xlon
+  real :: ulev(nuvzmax),vlev(nuvzmax),ew,rh,vd(maxspec),subsceff,ylat
+  real :: altmin,tvold,pold,zold,pint,tv,zlev(nuvzmax)
+  real(kind=4) :: uuhn(0:nxmaxn-1,0:nymaxn-1,nuvzmax,maxnests)
+  real(kind=4) :: 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
+!********************
+!     ientry = ientry + 1
+
+      do l=1,numbnests
+
+! Loop over entire grid
+!**********************
+!$OMP PARALLEL DEFAULT(SHARED) &
+!$OMP PRIVATE(i,ix,jy,kz,lz,kzmin,tvold,pold,zold,zlev,tv,pint, &
+!$OMP rh,ierr,subsceff,ulev,vlev,pplev,ttlev,qvlev,ol,altmin,xlon,ylat )
+!$OMP DO
+      do jy=0,nyn(l)-1
+
+        do ix=0,nxn(l)-1
+
+! Set minimum height for tropopause
+!**********************************
+
+! FLEXPART_WRF - use this routine to get lat,lon
+!       ylat=ylat0n(l)+real(jy)*dyn(l)
+        call xyindex_to_ll_wrf( l, real(ix), real(jy), xlon, ylat )
+
+!       if ( ((ix.eq.0) .or. (ix.eq.(nxn(l)-1)) .or. 
+!    &                       (ix.eq.(nxn(l)-1)/2)) .and.
+!    &       ((jy.eq.0) .or. (jy.eq.(nyn(l)-1)) .or. 
+!    &                       (jy.eq.(nyn(l)-1)/2)) ) then
+!           if (ientry .eq. 1) then
+!               write(*,'(a,3i4,2f12.5)') 
+!    &              'calcpar_nests l,i,j, xlon,ylat', 
+!    &              l, ix, jy, xlon, ylat
+!               write(*,'(a,12x,2f12.5)') 
+!    &              '                     dlon,dlat', 
+!    &              (xlon-xlon2dn(ix,jy,l)), (ylat-ylat2dn(ix,jy,l))
+!           end if
+!       end if
+
+        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
+
+! 1) Calculation of friction velocity
+!************************************
+          if ( (.not.strswitch)) then
+
+          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))
+          endif
+! FLEXPART_WRF - limit ustar
+          if (ustarn(ix,jy,1,n,l).le.1.e-8) ustarn(ix,jy,1,n,l)=1.e-8
+          if (ustarn(ix,jy,1,n,l).ge.5.0)   ustarn(ix,jy,1,n,l)=5.0
+
+! 2) Calculation of inverse Obukhov length scale
+!***********************************************
+
+! FLEXPART_WRF - pass k=2 pressure directly
+!         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)
+          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),pphn(ix,jy,2,n,l) )
+          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)
+            pplev(i)=pphn(ix,jy,i,n,l)
+            ttlev(i)=tthn(ix,jy,i,n,l)
+            qvlev(i)=qvhn(ix,jy,i,n,l)
+      end do
+
+! FLEXPART_WRF - use  & check ierr argument
+! FLEXPART_WRF - pass pplev instead of akz,bkz
+!         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)
+          call richardson(psn(ix,jy,1,n,l),ustarn(ix,jy,1,n,l),ttlev, &
+          qvlev,ulev,vlev,nuvz,  pplev,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,ierr,sfc_option)
+
+          if (ierr .gt. 0) then
+              write(*,9500) 'warning', l, ix, jy
+          else if (ierr .lt. 0) then
+              write(*,9500) 'failure', l, ix, jy
+              stop
+          end if
+9500      format( 'calcpar_nests - richardson ', a, ' - l,ix,jy=', 3i5 )
+
+          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),vd,l)
+
+            do i=1,nspec
+              vdepn(ix,jy,i,n,l)=vd(i)
+            enddo
+          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.
+! FLEXPART_WRF - set zlev(1)
+          zlev(1)=zold
+      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
+!$OMP END DO
+!$OMP END PARALLEL
+
+! Calculation of potential vorticity on 3-d grid, if plume trajectory mode is used
+!*********************************************************************************
+
+        if ((iout.eq.4).or.(iout.eq.5)) then
+          call calcpv_nests(l,n,uuhn,vvhn,pvhn)
+        endif
+
+        enddo
+
+
+end subroutine calcpar_nests
+
Index: /branches/jerome/src_flexwrf_v3.1/calcpv.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/calcpv.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/calcpv.f90	(revision 16)
@@ -0,0 +1,400 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                *
+!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine,       *
+!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
+!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso,          *
+!* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann,   *
+!*                                                                     *
+!* This file is part of FLEXPART WRF                                   *
+!*                                                                     *
+!* 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
+!*******************************************************************************
+!                                                                              *
+!     Note:  This is the FLEXPART_WRF version of subroutine calcpv.            *
+!            The computational grid is the WRF x-y grid rather than lat-lon.   *
+!                                                                              *
+!  Calculation of potential vorticity on 3-d grid.                             *
+!                                                                              *
+!     Author: P. James                                                         *
+!     3 February 2000                                                          *
+!                                                                              *
+!     Adaptation to FLEXPART, A. Stohl, 1 May 2000                             *
+!                                                                              *
+!    26 Oct 2005, R. Easter - changes associated with WRF horizontal grid.     *
+!                             For pressure use pph instead of (akz + bkz*ps)   *
+!    *** Note -- see ??? comments below regarding the pvh calculation.         *
+!    11 Nov 2005, R. Easter - fixed error involving xy to latlon               *
+!                                                                              *
+!*******************************************************************************
+!                                                                              *
+! Variables:                                                                   *
+! n                  temporal index for meteorological fields (1 to 2)         *
+!                                                                              *
+! Constants:                                                                   *
+!                                                                              *
+!*******************************************************************************
+
+!      include 'includepar'
+!      include 'includecom'
+!
+!      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,ppmk
+!      real thup,thdn,eps,p0
+!      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)
+  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,ppmk
+  real :: pvavr,ppml(nuvzmax)
+  real :: thup,thdn
+  real,parameter :: eps=1.e-5, p0=101325
+  real(kind=4) :: uuh(0:nxmax-1,0:nymax-1,nuvzmax)
+  real(kind=4) :: vvh(0:nxmax-1,0:nymax-1,nuvzmax)
+  real :: pvh(0:nxmax-1,0:nymax-1,nuvzmax)
+
+
+
+  real :: dumlon,dumlat
+  real :: thh(0:nxmax-1,0:nymax-1,nuvzmax)
+  real :: altit(nuvzmax)
+
+! Set number of levels to check for adjacent theta
+      nlck=nuvz/3
+! FLEXPART_WRF -- altit is never used, so don't calculate it
+!      do 5 k=1,nuvz
+!        altit(k)=akz(k)/p0+bkz(k)
+!5     continue
+! *** Precalculate all theta levels for efficiency
+        do jy=0,nymin1
+        do kl=1,nuvz
+        do ix=0,nxmin1
+! FLEXPART_WRF -- use pph here
+!         ppmk=akz(kl)+bkz(kl)*ps(ix,jy,1,n)
+          ppmk=pph(ix,jy,kl,n)
+          thh(ix,jy,kl)=tth(ix,jy,kl,n)*(100000./ppmk)**kappa
+        enddo
+        enddo
+        enddo
+!
+! Loop over entire grid
+!**********************
+      do jy=0,nymin1
+        if (sglobal.and.jy.eq.0) goto 10
+        if (nglobal.and.jy.eq.nymin1) goto 10
+
+! for FLEXPART_WRF, x & y coords are in meters
+! and true latitude varies with both i and j
+!       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
+
+! for FLEXPART_WRF, x & y coords are in meters,
+! and true latitude varies with both i and j
+          call xyindex_to_ll_wrf(  &
+                0, real(ix), real(jy), dumlon, dumlat )
+          phi = dumlat * pi / 180.
+          f = 0.00014585 * sin(phi)
+          tanphi = tan(phi)
+          cosphi = cos(phi)
+
+! 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
+! Precalculate pressure values for efficiency
+          do kl=1,nuvz
+! FLEXPART_WRF -- use pph here
+!           ppml(kl)=akz(kl)+bkz(kl)*ps(ix,jy,1,n)
+            ppml(kl)=pph(ix,jy,kl,n)
+          enddo
+!
+! Loop over the vertical
+!***********************
+
+          do  kl=1,nuvz
+            theta=thh(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=thh(ix,jy,klvrp)
+            thetam=thh(ix,jy,klvrm)
+            dthetadp=(thetap-thetam)/(ppml(klvrp)-ppml(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=thh(ivr,jy,k)
+              thup=thh(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=thh(ivr,jy,k)
+              thup=thh(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
+! for FLEXPART_WRF, dx & dy are in meters.
+!           dvdx=(vx(2)-vx(1))/real(jux)/(dx*pi/180.)
+            dvdx=(vx(2)-vx(1))/real(jux)/dx
+          else
+            dvdx=vvh(ivrp,jy,kl)-vvh(ivrm,jy,kl)
+!           dvdx=dvdx/real(jumpx)/(dx*pi/180.)
+            dvdx=dvdx/real(jumpx)/dx
+! 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=thh(ix,j,k)
+              thup=thh(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=thh(ix,j,k)
+              thup=thh(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
+! for FLEXPART_WRF, dx & dy are in meters.
+!           dudy=(uy(2)-uy(1))/real(juy)/(dy*pi/180.)
+            dudy=(uy(2)-uy(1))/real(juy)/dy
+          else
+            dudy=uuh(ix,jyvp,kl)-uuh(ix,jyvm,kl)
+!           dudy=dudy/real(jumpy)/(dy*pi/180.)
+            dudy=dudy/real(jumpy)/dy
+          end if
+!
+
+! for FLEXPART_WRF, dx & dy are in meters.
+!   don't need to divide by r_earth when doing d/dy
+!   don't need to divide by r_earth*cosphi when doing d/dx
+! ??? I don't understand the uuh*tanphi term, but leave it in for now ???
+! ??? What is the "-1.e6" factor ???
+!
+!         pvh(ix,jy,kl)=dthetadp*(f+(dvdx/cosphi-dudy
+!    +    +uuh(ix,jy,kl)*tanphi)/r_earth)*(-1.e6)*9.81
+          pvh(ix,jy,kl)=dthetadp*( f + dvdx - 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/jerome/src_flexwrf_v3.1/calcpv_nests.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/calcpv_nests.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/calcpv_nests.f90	(revision 16)
@@ -0,0 +1,341 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                *
+!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine,       *
+!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
+!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso,          *
+!* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann,   *
+!*                                                                     *
+!* This file is part of FLEXPART WRF                                   *
+!*                                                                     *
+!* 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
+!*******************************************************************************
+!                                                                              *
+!     Note:  This is the FLEXPART_WRF version of subroutine calcpv_nests.      *
+!            The computational grid is the WRF x-y grid rather than lat-lon.   *
+!                                                                              *
+!  Calculation of potential vorticity on 3-d nested grid                       *
+!                                                                              *
+!     Author: P. James                                                         *
+!     22 February 2000                                                         *
+!                                                                              *
+!    11 Nov 2005, R. Easter - changes associated with WRF horizontal grid.     *
+!                             For pressure use pph instead of (akz + bkz*ps)   *
+!    *** Note -- see ??? comments below regarding the pvh calculation.         *
+!                                                                              *
+!*******************************************************************************
+!                                                                              *
+! Variables:                                                                   *
+! n                  temporal index for meteorological fields (1 to 2)         *
+! l                  index of current nest                                     *
+!                                                                              *
+! Constants:                                                                   *
+!                                                                              *
+!*******************************************************************************
+
+!     include 'includepar'
+!     include 'includecom'
+!
+!     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,ppmk
+!     real altit(nuvzmax),ppml(nuvzmax)
+!     real thup,thdn,eps,p0
+!     parameter(eps=1.e-5,p0=101325)
+!     real thhn(0:nxmaxn-1,0:nymaxn-1,nuvzmax,maxnests)
+!     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)
+
+  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,ppmk
+  real :: ppml(nuvzmax)
+  real :: thup,thdn
+  real,parameter :: eps=1.e-5,p0=101325
+  real(kind=4) :: uuhn(0:nxmaxn-1,0:nymaxn-1,nuvzmax,maxnests)
+  real(kind=4) :: vvhn(0:nxmaxn-1,0:nymaxn-1,nuvzmax,maxnests)
+  real :: pvhn(0:nxmaxn-1,0:nymaxn-1,nuvzmax,maxnests)
+
+  real :: dumlon,dumlat
+  real :: thhn(0:nxmax-1,0:nymax-1,nuvzmax,maxnests)
+  real :: altit(nuvzmax)
+
+! Set number of levels to check for adjacent theta
+      nlck=nuvz/3
+! FLEXPART_WRF -- altit is never used, so don't calculate it
+!      do 5 k=1,nuvz
+!        altit(k)=akz(k)/p0+bkz(k)
+!5     continue
+! *** Precalculate all theta levels for efficiency
+        do jy=0,nyn(l)-1
+        do kl=1,nuvz
+        do ix=0,nxn(l)-1
+! FLEXPART_WRF -- use pph here
+!         ppmk=akz(kl)+bkz(kl)*psn(ix,jy,1,n,l)
+          ppmk=pphn(ix,jy,kl,n,l)
+          thhn(ix,jy,kl,l)=tthn(ix,jy,kl,n,l)*(100000./ppmk)**kappa
+      enddo
+      enddo
+      enddo
+!
+! Loop over entire grid
+!**********************
+      do jy=0,nyn(l)-1
+! for FLEXPART_WRF, x & y coords are in meters
+! and true latitude varies with both i and j
+!       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
+
+! for FLEXPART_WRF, x & y coords are in meters
+! and true latitude varies with both i and j
+          call xyindex_to_ll_wrf(  &
+                  l, real(ix), real(jy), dumlon, dumlat )
+          phi = dumlat * pi / 180.
+          f = 0.00014585 * sin(phi)
+          tanphi = tan(phi)
+          cosphi = cos(phi)
+
+! 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
+! Precalculate pressure values for efficiency
+          do kl=1,nuvz
+! FLEXPART_WRF -- use pph here
+!           ppml(kl)=akz(kl)+bkz(kl)*psn(ix,jy,1,n,l)
+            ppml(kl)=pphn(ix,jy,kl,n,l)
+          enddo
+!
+! Loop over the vertical
+!***********************
+
+          do kl=1,nuvz
+            theta=thhn(ix,jy,kl,l)
+            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=thhn(ix,jy,klvrp,l)
+            thetam=thhn(ix,jy,klvrm,l)
+            dthetadp=(thetap-thetam)/(ppml(klvrp)-ppml(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=thhn(ivr,jy,k,l)
+              thup=thhn(ivr,jy,k+1,l)
+          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=thhn(ivr,jy,k,l)
+              thup=thhn(ivr,jy,k+1,l)
+          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
+! for FLEXPART_WRF, dx & dy are in meters.
+!         dvdx=(vx(2)-vx(1))/real(jux)/(dxn(l)*pi/180.)
+          dvdx=(vx(2)-vx(1))/real(jux)/dxn(l)
+          else
+          dvdx=vvhn(ivrp,jy,kl,l)-vvhn(ivrm,jy,kl,l)
+!         dvdx=dvdx/real(jumpx)/(dxn(l)*pi/180.)
+          dvdx=dvdx/real(jumpx)/dxn(l)
+! 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=thhn(ix,j,k,l)
+              thup=thhn(ix,j,k+1,l)
+          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=thhn(ix,j,k,l)
+              thup=thhn(ix,j,k+1,l)
+          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
+! for FLEXPART_WRF, dx & dy are in meters.
+!         dudy=(uy(2)-uy(1))/real(juy)/(dyn(l)*pi/180.)
+          dudy=(uy(2)-uy(1))/real(juy)/dyn(l)
+          else
+          dudy=uuhn(ix,jyvp,kl,l)-uuhn(ix,jyvm,kl,l)
+!         dudy=dudy/real(jumpy)/(dyn(l)*pi/180.)
+          dudy=dudy/real(jumpy)/dyn(l)
+          end if
+!
+! for FLEXPART_WRF, dx & dy are in meters.
+!   don't need to divide by r_earth when doing d/dy
+!   don't need to divide by r_earth*cosphi when doing d/dx
+! ??? I don't understand the uuhn*tanphi term, but leave it in for now ???
+! ??? What is the "-1.e6" factor ???
+!
+!         pvhn(ix,jy,kl,l)=dthetadp*(f+(dvdx/cosphi-dudy
+!    +    +uuhn(ix,jy,kl,l)*tanphi)/r_earth)*(-1.e6)*9.81
+          pvhn(ix,jy,kl,l)=dthetadp*( f + dvdx - 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/jerome/src_flexwrf_v3.1/caldate.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/caldate.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/caldate.f90	(revision 16)
@@ -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/jerome/src_flexwrf_v3.1/cbl.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/cbl.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/cbl.f90	(revision 16)
@@ -0,0 +1,314 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                *
+!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine,       *
+!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
+!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso,          *
+!* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann,   *
+!*                                                                     *
+!* 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 cbl(wp,zp,ust,wst,h,rhoa,rhograd,sigmaw,dsigmawdz,tlw,ptot,Q,phi,ath,bth,ol,flagrein)
+!                  i  i i  i   i  i    i     i       i         i   o   o   o   o  o   o   i     i/o
+!=============== well mixed formulation of CBL skewed vertical profiles following  LHH 1996 with profile of w3 from lHB 2000                    ========
+!=============== LHH formulation has been modified to account for variable density profiles and backward in time or forward in time simulations ========
+!=============== by  Massimo Cassiani ( mc ), NILU,  2012-2013, reference to Cassiani et al. 2013 (to be submitted...)                          ========
+!=======================================================================================================================================================
+!======================================================================================================
+! wp: particle velocity
+! zp: particle position
+! ust: velcotiy scale
+! wst: convective velcotiy scale
+! h: boundary layer top
+! rhoa: air density
+! rhograd: air densiy vertical gradient
+! sigmaw: turbulent flutuation of vertical velocity standard deviation
+! dsigmawdz: derivative of above
+! tlw: local lagrangina time scale
+! ptot: pdf value for the particle velocity in drift coefficient, see Cassiani et al. 2013, not used
+! Q: part of drift coefficient, not used
+! phi: part of drift coeffcient, not used
+! ath: drift coefficient, used
+! bth: diffusion coeffcient, sued
+! ol: Obukhov lenght
+! flagrein: set accordingly to conditon below if 1 then re-initialize particle velocity
+!======================================================================================================
+    use par_mod, only:pi
+    use com_mod, only:ldirect
+!   use ieee_arithmetic    
+    implicit none
+
+
+    real :: usurad2,usurad2p,C0,costluar4,eps 
+    parameter  (usurad2=0.7071067812,usurad2p=0.3989422804,C0=2,costluar4=0.66667,eps=0.000001)
+
+    integer flagrein  !re-initlization flag for the particle velocity 
+    
+    real :: wp,zp,ust,wst,h,dens,ddens,sigmaw,dsigmawdz,tlw,rhoa,rhograd
+    real ::fluarw,fluarw2
+    real ::w3,w2
+    real ::dw3,dw2
+    real ::wb,wa
+    real ::deltawa,deltawb
+    real ::wold,wold2,wold_z
+    real ::pa,pb,alfa
+    real ::Phi,Q,ptot  
+    real :: timedir
+    real ::cuberoot
+    real ::z0,ol,transition !added ol & transition with respect to cbl.f90 without transition 
+    
+
+    real :: &
+    erf, &
+    aperfa, &
+    aperfb, &
+    ath, &
+    bth
+
+    real ::  &
+    pow, &
+    z, &    
+    skew, &
+    skew2, &
+    radw2, &
+    rluarw, &
+    xluarw, &
+    aluarw, &
+    bluarw, &
+    sigmawa, &
+    sigmawb, &
+    dskew, &
+    dradw2, &
+    dfluarw, &
+    drluarw, &
+    dxluarw, &
+    daluarw, &
+    dbluarw, &
+    dsigmawa, &
+    dsigmawb, &
+    dwa, &
+    dwb, &
+    sigmawa2, &
+    sigmawb2
+    
+    
+    dens=rhoa
+    ddens=rhograd
+             
+    
+    timedir=ldirect !direction of time forward (1) or backward(-1)
+    !========================= assign z ==============================
+    z=(zp/h)
+    
+    transition=1.
+    !if (ol.lt.-50) transition=((sin(((ol+100.)/100.)*pi))-1.)/2.
+    if (-h/ol.lt.15) transition=((sin((((-h/ol)+10.)/10.)*pi)))/2.+0.5  !transition fucntion to smoohtly 
+    !========================= secondo moment of vertical velocity  =====================
+    !!!	    w2=1.4*(z**1.5*(1.-z))**(2./3.)
+    !w2=(1.7*(z*(1.-0.7*z)*(1.-z))**(2./3.))*(wst**2)
+    w2=(sigmaw*sigmaw)
+    dw2=(2.*sigmaw*dsigmawdz)
+    !dw2=(1.7*(2./3.)*(z*(1.-0.7*z)*(1.-z))**(-1./3.)* &
+    !(((1.-0.7*z)*(1.-z))+z*(-0.7)*(1.-z)+z*(1.-0.7*z)*(-1.))) *(wst**2)*1/h
+
+    !=================== dissipation fo turbulent tke  =========================
+    !alfa=0.4 !(0.75-(0.5*z*z))**(3./2.) DISSIPAZIONE ADIMENSIONALE
+    alfa=2.*w2/(C0*tlw)
+
+    !========================================================================
+    wold=timedir*wp !time direction enter here for backward calculualtions
+    !wold_z=wp
+    ! =======================================================================
+    !------------------------------ momento terzo ============================
+    !!  w3=0.8*(w2**(3./2.))
+    !!	dw3=0.8*1.5*w2**0.5*dw2
+
+    ! dw3=((1.2*z*((1.-z)**(3./2.)))+eps)*(wst**3)
+    ! dw3=(1.2*(((1.-z)**(3./2.))+z*1.5*((1.-z)**(1./2.))*(-1.)))*(wst**3)
+    ! 3=(1.2*z*((1.-z)**(3./2.)))
+    ! w3=(1.2*(((1.-z)**(3./2.))+z*1.5*((1.-z)**(1./2.))*(-1.)))
+    
+                            !w3=((1.2*z*((1.-z)**(3./2.)))*1.5+eps)*(wst**3)  !§1.5 to increase skeweness see also initalize_cbl_vel.f90 
+                            !dw3=(1.2*(((1.-z)**(3./2.))+z*1.5*((1.-z)**(1./2.))*(-1.)))*(wst**3)*(1./h)*1.5
+                            
+                            w3=((1.2*z*((1.-z)**(3./2.)))+eps)*(wst**3)*transition
+                            dw3=(1.2*(((1.-z)**(3./2.))+z*1.5*((1.-z)**(1./2.))*(-1.)))*(wst**3)*(1./h)*transition
+    !============================================================================0
+   
+    
+                            skew=w3/(w2**1.5)
+                            skew2=skew*skew
+                            dskew=(dw3*w2**(1.5)-w3*1.5*w2**0.5*dw2)/w2**3
+                            radw2=w2**0.5
+                            dradw2=0.5*w2**(-0.5)*dw2
+                            !costluar4=0.66667  ! costante da LHH
+                            fluarw=costluar4*(cuberoot(skew))	!
+                            fluarw2=fluarw*fluarw
+    
+    
+    if (skew.ne.0) then
+      
+                             dfluarw=costluar4*(1./3.)*cuberoot(skew**(-2.))*dskew
+        
+                            rluarw=(1.+fluarw2)**3.*skew2/((3.+fluarw2)**2.*fluarw2)  !-> r
+                            xluarw=(1.+fluarw2)**1.5*skew/((3.+fluarw2)*fluarw)       !
+        
+                            drluarw=( ((3.*(1.+fluarw2)**2*(2.*fluarw*dfluarw)*skew2)+ &
+                            (1.+fluarw2)**3*2.*skew*dskew) *(3.+fluarw2)**2.*fluarw2 - &
+                            (1.+fluarw2)**3*skew2* &
+                            ( (2.*(3.+fluarw2)*(2.*fluarw*dfluarw)*fluarw2) + &
+                            (3.+fluarw2)**2*2.*fluarw*dfluarw) )/ &
+                            (((3.+fluarw2)**2.*fluarw2)**2)
+                                      
+                            dxluarw=( ((1.5*(1.+fluarw2)**0.5*(2.*fluarw*dfluarw)*skew)+ &
+                            (1.+fluarw2)**1.5*dskew) *(3.+fluarw2)*fluarw - &
+                            (1.+fluarw2)**1.5*skew* &
+                            (3.*dfluarw+3*fluarw2*dfluarw) )/ &
+                            (((3.+fluarw2)*fluarw)**2)
+
+        
+    else        
+        dfluarw=0.
+        rluarw=0.
+        drluarw=0.
+        xluarw=0.
+        dxluarw=0.
+    end if
+
+
+
+                            aluarw=0.5*(1.-xluarw/(4.+rluarw)**0.5)
+                            bluarw=1.-aluarw
+
+                           daluarw=-0.5*(  (dxluarw*(4.+rluarw)**0.5) - &
+                            (0.5*xluarw*(4.+rluarw)**(-0.5)*drluarw) ) &
+                            /(4.+rluarw) 
+                            dbluarw=-daluarw
+    
+
+                            sigmawa=radw2*(bluarw/(aluarw*(1.+fluarw2)))**0.5
+                            sigmawb=radw2*(aluarw/(bluarw*(1.+fluarw2)))**0.5
+
+
+                            dsigmawa=dradw2*(bluarw/(aluarw*(1.+fluarw2)))**0.5+ &
+                            radw2*( &
+                            (0.5*(bluarw/(aluarw*(1.+fluarw2)))**(-0.5))      * &
+                            ( &
+                            (dbluarw*(aluarw*(1.+fluarw2))- &
+                            bluarw*(daluarw*(1.+fluarw2)+aluarw*2.*fluarw*dfluarw)) &
+                            /((aluarw*(1.+fluarw2))**2) &
+                            ) &
+                            )
+
+                            dsigmawb=dradw2*(aluarw/(bluarw*(1.+fluarw2)))**0.5+ &
+                            radw2*( &
+                            (0.5*(aluarw/(bluarw*(1.+fluarw2)))**(-0.5))      * &
+                            ( &
+                            (daluarw*(bluarw*(1.+fluarw2))- &
+                            aluarw*(dbluarw*(1.+fluarw2)+bluarw*2.*fluarw*dfluarw)) &
+                            /((bluarw*(1.+fluarw2))**2) &
+                            ) &
+                            )
+    
+                            wa=(fluarw*sigmawa)
+                            wb=(fluarw*sigmawb)
+                            dwa=dfluarw*sigmawa+fluarw*dsigmawa
+                            dwb=dfluarw*sigmawb+fluarw*dsigmawb
+
+                            deltawa=wold-wa
+                            deltawb=wold+wb
+                            wold2=wold*wold
+                            sigmawa2=sigmawa*sigmawa
+                            sigmawb2=sigmawb*sigmawb
+
+                            pa=(usurad2p*(1./sigmawa))*(exp(-(0.5*((deltawa/sigmawa)**2.))))
+                            pb=(usurad2p*(1./sigmawb))*(exp(-(0.5*((deltawb/sigmawb)**2.))))
+                            
+                            if (abs(deltawa).gt.10.*sigmawa.and.abs(deltawb).gt.10.*sigmawb) flagrein=1  !added control flag for re-initialization of velocity
+!                           if (abs(deltawa).gt.6.*sigmawa.and.abs(deltawb).gt.6.*sigmawb) flagrein=1  !added control flag for re-initialization of velocity
+                            	    
+                            ptot=dens*aluarw*pa+dens*bluarw*pb
+                               
+                            aperfa=deltawa*usurad2/sigmawa
+                            aperfb=deltawb*usurad2/sigmawb
+
+!       if ((ieee_is_nan(aperfa).or.ieee_is_nan(aperfb)).and.flagrein.eq.0) &
+!          print*,'PROBLEM',deltawa,deltawb,sigmawa,sigmawb,wp,zp,ust,wst,h,rhoa,rhograd,sigmaw,dsigmawdz,tlw,ptot,Q,phi,ath,bth,ol,flagrein
+                            Phi=-0.5* &
+                            (aluarw*dens*dwa+dens*wa*daluarw+aluarw*wa*ddens)*erf(aperfa) &
+                            +sigmawa*(aluarw*dens*dsigmawa*(wold2/sigmawa2+1.)+ &
+                            sigmawa*dens*daluarw+sigmawa*ddens*aluarw+ &
+                            aluarw*wold*dens/sigmawa2*(sigmawa*dwa-wa*dsigmawa))*pa &
+                            +0.5* &
+                            (bluarw*dens*dwb+wb*dens*dbluarw+wb*bluarw*ddens)*erf(aperfb) &
+                            +sigmawb*(bluarw*dens*dsigmawb*(wold2/sigmawb2+1.)+ &
+                            sigmawb*dens*dbluarw+sigmawb*ddens*bluarw+ &
+                            bluarw*wold*dens/sigmawb2*(-sigmawb*dwb+wb*dsigmawb))*pb
+
+
+                             Q=timedir*((aluarw*dens*deltawa/sigmawa2)*pa+ &
+                            (bluarw*dens*deltawb/sigmawb2)*pb)
+
+    
+
+
+                            ath=(1./ptot)*(-(C0/2.)*alfa*Q+phi)  !drift coefficient
+                            bth=sqrt(C0*alfa)                    !diffusion coefficient
+                           
+
+    
+
+    return
+
+
+    end
+                            
+
+
+
+
+    FUNCTION CUBEROOT (X) RESULT (Y)
+
+    IMPLICIT NONE
+
+    real, INTENT(IN) :: X
+    real:: Y
+
+    real, PARAMETER :: THIRD = 0.333333333
+
+
+    Y = SIGN((ABS(X))**THIRD, X)
+
+    RETURN
+
+    END FUNCTION CUBEROOT
+    
+    
+    
+
+    FUNCTION CUBEROOTD (X) RESULT (Y)
+
+    IMPLICIT NONE
+
+    DOUBLE PRECISION, INTENT(IN) :: X
+    DOUBLE PRECISION :: Y
+
+    DOUBLE PRECISION, PARAMETER :: THIRD = 0.33333333333333333333333333333333333333333333333333333333333333333333333333333333333D0
+
+
+    Y = SIGN((ABS(X))**THIRD, X)
+
+    RETURN
+
+    END FUNCTION CUBEROOTD
Index: /branches/jerome/src_flexwrf_v3.1/centerofmass.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/centerofmass.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/centerofmass.f90	(revision 16)
@@ -0,0 +1,107 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                *
+!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine,       *
+!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
+!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso,          *
+!* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann,   *
+!* This file is part of FLEXPART WRF                                   *
+!*                                                                     *
+!* 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
+!*******************************************************************************
+!                                                                              *
+!     Note:  This is the FLEXPART_WRF version of subroutine assignland.        *
+!            The computational grid is the WRF x-y grid rather than lat-lon.   *
+!                                                                              *
+!   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                                                          *
+!                                                                              *
+!    26 Oct 2005, R. Easter - changes associated with WRF horizontal grid.     *
+!                             Since x & y coords are in meters,                *
+!                             so just sum/average the xl & yl.                 *
+!                                                                              *
+!*******************************************************************************
+
+  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
+!*******************************************************
+
+! for FLEXPART_WRF, x & y coords are in meters, 
+! so just sum/average the xl & yl
+!       xll=xl(l)*pi180
+!       yll=yl(l)*pi180
+
+! Calculate 3D coordinates from longitude and latitude
+!*****************************************************
+
+! for FLEXPART_WRF, this isn't necessary
+!       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
+        xav=xav+xl(l)
+        yav=yav+yl(l)
+
+    enddo
+
+      xav=xav/real(n)
+      yav=yav/real(n)
+!     zav=zav/float(n)
+
+
+! Project the point back onto Earth's surface
+!********************************************
+
+! for FLEXPART_WRF, this isn't necessary
+!     xcenter=atan2(xav,-1.*yav)
+!     ycenter=atan2(zav,sqrt(xav*xav+yav*yav))
+
+! Convert back to degrees
+!************************
+
+! for FLEXPART_WRF, this isn't necessary
+!     xcenter=xcenter/pi180
+!     ycenter=ycenter/pi180
+      xcenter=xav
+      ycenter=yav
+
+end subroutine centerofmass
+
Index: /branches/jerome/src_flexwrf_v3.1/check_ncerror.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/check_ncerror.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/check_ncerror.f90	(revision 16)
@@ -0,0 +1,45 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                 *
+!* Adam Dingwell,                                                      *
+!*                                                                     *
+!* This file is part of FLEXPART WRF                                   *
+!                                                                      *
+! 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 check_ncerror(errcode)
+
+  !*****************************************************************************
+  !                                                                            *
+  ! This function checks the return value of any call to the netcdf interface. *
+  ! The subroutine should be called directly after any call to any nf_*        *
+  ! functions, unless some other means of erro handling has been implemented.  *
+  !                                                                            *
+  !     Author: A. Dingwell                                                    *
+  !                                                                            *
+  !     27 May 2013                                                            *
+  !                                                                            *
+  !*****************************************************************************
+
+  implicit none
+  include 'netcdf.inc'
+  integer errcode
+
+  if( errcode.ne.nf_noerr ) then
+    print*, 'Error: ', nf_strerror(errcode)
+    stop
+  endif
+  return
+end subroutine check_ncerror
+
Index: /branches/jerome/src_flexwrf_v3.1/clustering.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/clustering.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/clustering.f90	(revision 16)
@@ -0,0 +1,252 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                *
+!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine,       *
+!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
+!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso,          *
+!* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann,   *
+!*                                                                     *
+!* This file is part of FLEXPART WRF                                   *
+!*                                                                     *
+!* 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
+!*******************************************************************************
+!                                                                              *
+!     Note:  This is the FLEXPART_WRF version of subroutine clustering.        *
+!            The computational grid is the WRF x-y grid rather than lat-lon.   *
+!                                                                              *
+!   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                                                          *
+!                                                                              *
+!    26 Oct 2005, R. Easter - changes associated with WRF horizontal grid.     *
+!                 x and y coordinates are in m, so the clustering              *
+!                 calculations are simpler, with no coordinate conversions.    *
+!    10 Mar 2006, R. Easter - bug fix at (new) lines 131-2                     *
+!                 change "yclust(j)" to "yclust(nclust(i))", same for xclust   *
+!                                                                              *
+!*******************************************************************************
+!                                                                              *
+! 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,numb(ncluster),ncl,stat
+  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
+  integer,allocatable, dimension (:) :: nclust
+
+    allocate(nclust(maxpart) ,stat=stat)
+
+      if (n.lt.ncluster) return
+      rmsold=-5.
+
+! Convert longitude and latitude from degrees to radians
+!*******************************************************
+
+      do i=1,n
+        nclust(i)=i
+
+! for FLEXPART_WRF, x & y coords are in meters
+!        xl(i)=xl(i)*pi180
+!5       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
+
+! for FLEXPART_WRF, x & y coords are in meters, so calc distance directly
+!           distances=distance2(yl(i),xl(i),yclust(j),xclust(j))
+            distances=sqrt( (yl(i)-yclust(j))**2 +  &
+                            (xl(i)-xclust(j))**2 )
+
+            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
+
+! for FLEXPART_WRF, x & y coords are in meters, so calc distance directly
+!          distances=distance2(yl(i),xl(i),
+!     +    yclust(nclust(i)),xclust(nclust(i)))
+! 10-mar-2006 rce - bug fix - change "yclust(j)" to 
+!    "yclust(nclust(i))", same for xclust
+          distances=sqrt( (yl(i)-yclust(nclust(i)))**2 +  &
+                          (xl(i)-xclust(nclust(i)))**2 )
+
+! 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
+!***************************************************************
+
+! for FLEXPART_WRF, x & y coords are in meters, 
+! so no conversion is needed
+!          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
+!50        zav(nclust(i))=zav(nclust(i))+z
+          xav(nclust(i))=xav(nclust(i))+xl(i)
+          yav(nclust(i))=yav(nclust(i))+yl(i)
+          zav(nclust(i))=0.0
+    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
+!********************************************
+
+! for FLEXPART_WRF, x & y coords are in meters, 
+! so no conversion is needed
+!            xclust(j)=atan2(xav(j),-1.*yav(j))
+!            yclust(j)=atan2(zav(j),sqrt(xav(j)*xav(j)+yav(j)*yav(j)))
+            xclust(j)=xav(j)
+            yclust(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
+! for FLEXPART_WRF, x & y coords are in meters
+!        xl(i)=xl(i)/pi180
+!        yl(i)=yl(i)/pi180
+       zclust(nclust(i))=zclust(nclust(i))+zl(i)
+  end do
+
+      do j=1,ncluster
+! for FLEXPART_WRF, x & y coords are in meters
+!        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/jerome/src_flexwrf_v3.1/cmapf_mod.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/cmapf_mod.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/cmapf_mod.f90	(revision 16)
@@ -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 = real(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/jerome/src_flexwrf_v3.1/com_mod.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/com_mod.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/com_mod.f90	(revision 16)
@@ -0,0 +1,806 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                *
+!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine,       *
+!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
+!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso,          *
+!* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann,   *
+!* Adam Dingwell,                                                      *
+!*                                                                     *
+!* This file is part of FLEXPART WRF                                   *
+!*                                                                     *
+!* 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 particle diffusion model FLEXPART                    *
+!        This file contains a global common block used by FLEXPART             *
+!                                                                              *
+!        Author: A. Stohl                                                      *
+!                                                                              *
+!        June 1996                                                             *
+!                                                                              *
+!        Last update: 9 August 2000                                            *
+!                                                                              *
+!*******************************************************************************
+
+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,maxomp,maxrandomp, &
+       maxrand3,max_stream
+  implicit none
+
+  !****************************************************************
+  ! Variables defining where FLEXPART input/output files are stored
+  !****************************************************************
+
+  character :: path(numpath+2*maxnests)*120
+  integer :: length(numpath+2*maxnests)
+  character :: inputname*200
+  integer   :: len2
+  integer   :: ncout,ncoutn
+
+  ! path                    path names needed for trajectory model
+  ! length                  length of path names needed for trajectory model
+  ! ncout                   file handle of netcdf output file
+  ! ncoutn                  file handle of netcdf output nest file
+
+
+  !********************************************************
+  ! 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
+  integer :: ncirec,ncnumrec
+
+  ! 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))
+  ! ncired                  record index for netcdf files
+  ! ncnumrec                maximum record length of netcdf output files
+
+  real :: ctl,fine,dt_conv
+  integer :: ifine,iout,ipout,ipin,iflux,mdomainfill
+  integer :: mquasilag,nested_output,ind_source,ind_receptor
+  integer :: ind_rel,ind_samp,ioutputforeachrelease,linit_cond
+      integer :: turb_option, method_w_terrain_correction
+      integer :: sfc_option
+      integer :: wind_option,time_option
+      integer :: outgrid_option
+      integer :: numpoint_option,option_verbose
+      integer :: iouttype
+      integer :: cblflag ! added by mc for CBL skewed pdf calculations
+
+  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
+  ! 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(2001)*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)
+  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,link(maxspec)
+  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 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,wfdt(maxwf)
+  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)
+  integer :: add_sfc_level,itimeold
+  integer :: map_proj_id, map_proj_method
+  real :: xmet0,ymet0,coefdx
+  real :: heightmid(nzmax)
+  real :: xlon2d(0:nxmax-1,0:nymax-1),ylat2d(0:nxmax-1,0:nymax-1)
+  real :: map_stdlon, map_truelat1, map_truelat2
+  integer :: mp_physics
+
+  ! 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)
+  real :: eta_w_wrf(nzmax), eta_u_wrf(nzmax), p_top_wrf
+
+  ! 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 :: pph(0:nxmax-1,0:nymax-1,nuvzmax,2)
+  real :: zzh(0:nxmax-1,0:nymax-1,nwzmax+1,2)
+  real :: tkeh(0:nxmax-1,0:nymax-1,nuvzmax,2)
+  real :: tke(0:nxmax-1,0:nymax-1,nzmax,2)
+  real :: ptth(0:nxmax-1,0:nymax-1,nuvzmax,2)
+  real :: ptt(0:nxmax-1,0:nymax-1,nzmax,2)
+  real :: u_wrf(0:nxmax-1,0:nymax-1,nuvzmax,2)
+  real :: v_wrf(0:nxmax-1,0:nymax-1,nuvzmax,2)
+  real :: w_wrf(0:nxmax-1,0:nymax-1,nwzmax,2)
+! CDA added for new wet depo scheme
+  integer :: icloudbot(0:nxmax-1,0:nymax-1,2)
+  integer :: icloudthck(0:nxmax-1,0:nymax-1,2)
+
+
+!  real :: pplev(0:nxmax-1,0:nymax-1,nuvzmax,2)
+! CDA Commented old cloud variables
+!  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(kind=4) :: m_x(0:nxmax-1,0:nymax-1,1)
+  real(kind=4) :: m_y(0:nxmax-1,0:nymax-1,1)
+! real :: m_x(0:nxmax-1,0:nymax-1,1)
+! real :: m_y(0:nxmax-1,0:nymax-1,1)
+  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)
+  real :: xmet0n(maxnests),ymet0n(maxnests)
+      real :: xlon2dn(0:nxmaxn-1,0:nymaxn-1,maxnests)
+      real :: ylat2dn(0:nxmaxn-1,0:nymaxn-1,maxnests)
+      integer :: m_grid_id(0:maxnests), m_parent_grid_id(0:maxnests)
+      integer :: m_parent_grid_ratio(0:maxnests)
+      integer :: l_parent_nest_id(0:maxnests)
+      integer :: i_parent_start(0:maxnests), j_parent_start(0:maxnests)
+      integer :: mp_physicsn(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)
+
+! CDA added for new wet depo scheme
+  integer :: icloudbotn(0:nxmaxn-1,0:nymaxn-1,2,maxnests)
+  integer :: icloudthckn(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)
+      real :: pphn(0:nxmaxn-1,0:nymaxn-1,nuvzmax,2,maxnests)
+      real :: zzhn(0:nxmaxn-1,0:nymaxn-1,nwzmax+1,2,maxnests)
+      real :: tkehn(0:nxmaxn-1,0:nymaxn-1,nuvzmax,2,maxnests)
+      real :: tken(0:nxmaxn-1,0:nymaxn-1,nzmax,2,maxnests)
+      real :: ptthn(0:nxmaxn-1,0:nymaxn-1,nuvzmax,2,maxnests)
+      real :: pttn(0:nxmaxn-1,0:nymaxn-1,nzmax,2,maxnests)
+
+      real :: un_wrf(0:nxmaxn-1,0:nymaxn-1,nuvzmax,2,maxnests)
+      real :: vn_wrf(0:nxmaxn-1,0:nymaxn-1,nuvzmax,2,maxnests)
+      real :: wn_wrf(0:nxmaxn-1,0:nymaxn-1,nwzmax,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(kind=4) :: m_yn(0:nxmaxn-1,0:nymaxn-1,1,maxnests)
+  real(kind=4) :: m_xn(0:nxmaxn-1,0:nymaxn-1,1,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
+      real :: dyoutl, dxoutl,out_xm0,out_ym0
+  real :: dxoutln,dyoutln
+  integer :: numxgridn,numygridn
+  real :: dxoutn,dyoutn,outlon0n,outlat0n,xoutshiftn,youtshiftn
+      real :: outgrid_swlon,outgrid_swlat,outgrid_nelon,outgrid_nelat
+      real :: outgridn_swlon,outgridn_swlat,outgridn_nelon,outgridn_nelat
+  real :: out_xm0n,out_ym0n
+  !real outheight(maxzgrid),outheighthalf(maxzgrid)
+  logical :: DEP,DRYDEP,DRYDEPSPEC(maxspec),WETDEP,OHREA,ASSSPEC
+  integer nccovid,ncravid,ncwdvid,ncddvid,ncrecvid
+  !integer nccovidn,ncravidn,ncwdvidn,ncddvidn
+
+  ! 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
+  ! out_xm0,out_ym0         lower left corner of output grid in grid metres
+  ! 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
+  ! nccovid                 netcdf variable ID of concentration grid
+  ! ncravid                 netcdf variable ID of mixing ratio grid
+  ! ncddvid                 netcdf variable ID of drydep grid
+  ! ncwdvid                 netcdf variable ID of wetdep grid
+  ! nccovidn, ncravidn,     Nested output equivalents of the above variable IDs
+  ! ncddvidn, ncwdvidn
+
+
+
+  !  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 :: receptor_lon(maxreceptor),receptor_lat(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
+  integer :: numparticlecount
+!  integer :: itra1(maxpart)
+!  integer :: npoint(maxpart),nclass(maxpart)
+!  integer :: idt(maxpart),itramem(maxpart),itrasplit(maxpart)
+!  real(kind=dp) :: xtra1(maxpart),ytra1(maxpart)
+!  real :: ztra1(maxpart)
+!  real :: xmass1(maxpart,maxspec)
+
+  real,allocatable, dimension (:,:) :: xmass1
+! real,allocatable, dimension (:,:) :: drydep1
+  real,allocatable, dimension(:) :: xmasssave
+  integer,allocatable, dimension (:) :: itra1
+  integer,allocatable, dimension (:) :: npoint,nclass
+  integer,allocatable, dimension (:) :: idt,itramem,itrasplit
+  real(kind=dp),allocatable, dimension (:) :: xtra1,ytra1
+  real,allocatable, dimension (:) :: ztra1
+  real,allocatable, dimension (:) :: uap,ucp,uzp
+  real,allocatable, dimension (:) :: us,vs,ws
+  integer(kind=2),allocatable, dimension (:) :: cbt
+
+
+!  real,save :: xmasssave(maxpart)
+
+  ! 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(maxspec),wetscava(maxspec),wetscavb(maxspec)
+  real :: drydiff(maxspec),dryhenry(maxspec),dryactiv(maxspec)
+  real :: partrho(maxspec),partmean(maxspec),partsig(maxspec)
+  real :: dryvelo(maxspec),weightmol(maxspec)
+
+  ! 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(maxrandomp)
+!#if newrandomgen.EQ.1               ! added by mc: if not commented use a
+!preprocessor to select 
+   real :: rannumb(maxrand3)           !modified by mc^M
+   real :: uniform_rannumb(maxrand3)   !modified by mc^M
+
+!#else                                     ! if not commented use a preprocessor
+!    real :: rannumb(maxrandomp)           !modified by mc^M
+!   real :: uniform_rannumb(maxrandomp)   !modified by mc^M
+!  integer :: nan_count(MAX_STREAM)=0    !modified by mc
+!#endif                                  ! if not commented use a preprocessor
+
+
+
+end module com_mod
Index: /branches/jerome/src_flexwrf_v3.1/conccalc_irreg.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/conccalc_irreg.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/conccalc_irreg.f90	(revision 16)
@@ -0,0 +1,425 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                *
+!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine,       *
+!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
+!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso,          *
+!* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann,   *
+!*                                                                     *
+!* This file is part of FLEXPART WRF                                   *
+!*                                                                     *
+!* 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_irreg(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,ii,temp,incl
+  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 .or. abs(npoint(i)).gt.numpoint) 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)
+  !*****************************************************************************
+       if (xtra1(i).ne.xtra1(i))  print*,i,itra1(i),xtra1(i),ytra1(i),ix,jy
+      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.7200).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
+!        print*,'bef ks'
+!         print*,ix,jy,kz,ks,nrelpointer,nclass(i),nage
+          incl=nclass(i)
+             gridunc(ix,jy,kz,ks,nrelpointer,incl,nage)= &
+                  gridunc(ix,jy,kz,ks,nrelpointer,incl,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.7200).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_irreg
Index: /branches/jerome/src_flexwrf_v3.1/conccalc_reg.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/conccalc_reg.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/conccalc_reg.f90	(revision 16)
@@ -0,0 +1,441 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                 *
+!* Jerome Brioude, Jerome Fast, 
+!* Andreas Stohl, Petra Seibert, A. Frank, Gerhard Wotawa *
+!* Caroline Forster, Sabine Eckhardt, John Burkhart, Harald Sodemann   *
+!*                                                                     *
+!* This file is part of FLEXPART WRF                                   *
+!*                                                                     *
+!* 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_reg(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      *
+  !                                                                            *
+  !   J. Brioude, Oct 2011: changed to handle regular output                   *
+  !*****************************************************************************
+  !                                                                            *
+  ! 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,cpt3,cpt4
+  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,xlon,ylat,xl2,yl2
+  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
+  !***************************************************************************
+  cpt3=0
+  cpt4=0
+
+  do i=1,numpart
+!         cpt3=cpt3+1
+!   if (itra1(i).ne.itime .or. abs(npoint(i)).gt.numpoint) goto 20
+    if (itra1(i).ne.itime .or. abs(npoint(i)).gt.numpoint) then
+!   print*,'part in question',i,itra1(i),npoint(i),xtra1(i)
+    goto 20
+     endif 
+
+  ! 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.
+  !*****************************************************************************
+!         cpt4=cpt4+1
+
+    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
+! JB                                                          
+          xl2=xtra1(i)*dx+xmet0                               
+          yl2=ytra1(i)*dy+ymet0                               
+         call xymeter_to_ll_wrf(xl2, yl2, xlon,ylat )         
+          xl=(xlon-outlon0)/dxoutl                           
+          yl=(ylat-outlat0)/dyoutl                          
+
+      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 2 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.7200).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 
+!           print*,ix,jy,kz,ks,nrelpointer,nclass(i),nage
+            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
+  !************************************
+
+! JB 
+      if (nested_output.eq.1) then
+!        xl=(xtra1(i)*dx+xoutshiftn)/dxoutn
+!        yl=(ytra1(i)*dy+youtshiftn)/dyoutn
+
+          xl2=xtra1(i)*dx+xmet0
+          yl2=ytra1(i)*dy+ymet0
+         call xymeter_to_ll_wrf(xl2, yl2, xlon,ylat )
+          xl=(xlon-outlon0n)/dxoutln
+          yl=(ylat-outlat0n)/dyoutln
+        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.7200).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
+!     print*,'nb pt used in conccalc, try2',cpt3,cpt4,numpart
+end subroutine conccalc_reg
Index: /branches/jerome/src_flexwrf_v3.1/concoutput_irreg.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/concoutput_irreg.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/concoutput_irreg.f90	(revision 16)
@@ -0,0 +1,686 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                 *
+!* Jerome Brioude, Jerome Fast, 
+!* Andreas Stohl, Petra Seibert, A. Frank, Gerhard Wotawa *
+!* Caroline Forster, Sabine Eckhardt, John Burkhart, Harald Sodemann   *
+!*                                                                     *
+!* This file is part of FLEXPART WRF                                   *
+!*                                                                     *
+!* 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_irreg(itime,outnum,gridtotalunc,wetgridtotalunc, &
+      drygridtotalunc)
+!                             i     i          o             o
+!            o
+!*******************************************************************************
+!                                                                              *
+!     Note:  This is the FLEXPART_WRF version of subroutine concoutput         *
+!                                                                              *
+!     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 includepar                   *
+!                                                                              *
+!     Dec 2005, J. Fast - Output files can be either binary or ascii.          *
+!                         Sparse output option is turned off.                  *
+!     Dec 2005, R. Easter - changed names of "*lon0*" & "*lat0*" variables     *
+!     2012, J. Brioude- modify output format to flexpart 8*, latlon output     *
+!*******************************************************************************
+!                                                                              *
+! Variables:                                                                   *
+! outnum          number of samples                                            *
+! ncells          number of cells with non-zero concentrations                 *
+! sparse          .true. if in sparse matrix format, else .false.              *
+! nspeciesdim     either nspec (forward runs), or numpoint (backward runs)     *
+! tot_mu          1 for forward, initial mass mixing ration for backw. runs    *
+! maxpointspec    maxspec for forward runs, maxpoint for backward runs         *
+!                                                                              *
+!*******************************************************************************
+
+!      include 'includepar'
+!      include 'includecom'
+!
+!      double precision jul
+!      integer itime,i,ix,jy,kz,k,l,iix,jjy,kzz,nage,jjjjmmdd,ihmmss
+!      integer ncells(maxpointspec,maxageclass)
+!      integer ncellsd(maxpointspec,maxageclass)
+!      integer ncellsw(maxpointspec,maxageclass),nspeciesdim
+!      real outnum,weightair,densityoutrecept(maxreceptor),xl,yl
+!      real densityoutgrid(0:maxxgrid-1,0:maxygrid-1,maxzgrid),
+!     +grid(0:maxxgrid-1,0:maxygrid-1,maxzgrid,maxpointspec,maxageclass)
+!      real wetgrid(0:maxxgrid-1,0:maxygrid-1,maxpointspec,maxageclass)
+!      real drygrid(0:maxxgrid-1,0:maxygrid-1,maxpointspec,maxageclass)
+!      real gridsigma(0:maxxgrid-1,0:maxygrid-1,maxzgrid,maxpointspec,
+!     +maxageclass),
+!     +drygridsigma(0:maxxgrid-1,0:maxygrid-1,maxpointspec,maxageclass),
+!     +wetgridsigma(0:maxxgrid-1,0:maxygrid-1,maxpointspec,maxageclass)
+!      real auxgrid(nclassunc),gridtotal,gridsigmatotal,gridtotalunc
+!      real wetgridtotal,wetgridsigmatotal,wetgridtotalunc
+!      real drygridtotal,drygridsigmatotal,drygridtotalunc
+!      real factor(0:maxxgrid-1,0:maxygrid-1,maxzgrid)
+!      real halfheight,dz,dz1,dz2,tot_mu(maxpointspec)
+!      real xnelat,xnelon
+!      real xsw,xne,ysw,yne,tmpx,tmpy,tmplon,tmplat
+!      parameter(weightair=28.97)
+!      logical sparse(maxpointspec,maxageclass)
+!      logical sparsed(maxpointspec,maxageclass)
+!      logical sparsew(maxpointspec,maxageclass)
+!      character adate*8,atime*6
+  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 :: auxgrid(nclassunc),gridtotal,gridsigmatotal,gridtotalunc
+  real :: wetgridtotal,wetgridsigmatotal,wetgridtotalunc
+  real :: drygridtotal,drygridsigmatotal,drygridtotalunc
+  real :: halfheight,dz,dz1,dz2,tot_mu(maxspec,maxpointspec_act)
+  real :: xsw,xne,ysw,yne,tmpx,tmpy,tmplon,tmplat
+  real :: start, finish
+
+  real,parameter :: smallnum = tiny(0.0) ! smallest number that can be handled
+  ! real,parameter :: weightair=28.97 !AD: moved this to par_mod.f90
+  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
+      write(unitdates,'(a)') adate//atime
+
+
+! 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=out_xm0+float(ix)*dxout
+        yl=out_ym0+float(jy)*dyout
+!        xl=(xl-xlon0)/dx
+!        yl=(yl-ylat0)/dx
+        xl=(xl-xmet0)/dx
+        yl=(yl-ymet0)/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,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.
+
+!*******************************************************************
+! Generate output: may be in concentration (ng/m3) or in mixing
+! ratio (ppt) or both
+! Output either in full grid dump or sparse matrix format
+! For backward simulations, the unit is seconds, stored in grid_conc
+!*******************************************************************
+
+! Concentration output
+!*********************
+
+!      open(53,file=path(1)(1:length(1))//'latlon.txt',form='formatted')
+!          open(54,file=path(1)(1:length(1))//'latlon_corner.txt' &
+!          ,form='formatted')
+!
+!!        xnelat=outgrid_nelat
+!!        xnelon=outgrid_nelon
+!         print*,'before ll_to',outgrid_swlon,outgrid_swlat,outgrid_nelon,outgrid_nelat
+!        call ll_to_xymeter_wrf(outgrid_swlon,outgrid_swlat,xsw,ysw)
+!        call ll_to_xymeter_wrf(outgrid_nelon,outgrid_nelat,xne,yne)
+!         print*,'after ll_to'
+!        do jy=1,numygrid
+!        do ix=1,numxgrid
+!!         tmpx=out_xm0+(ix-1)*dxout
+!!         tmpy=out_ym0+(jy-1)*dyout
+!          tmpx=out_xm0+(float(ix)-0.5)*dxout
+!          tmpy=out_ym0+(float(jy)-0.5)*dyout
+!!          print*,'jb','tmpx','tmpy',dxout,dyout,ix,jy
+!          call xymeter_to_ll_wrf(tmpx,tmpy,tmplon,tmplat)
+!!jb          if(iouttype.eq.0) write(unitoutgrid) tmplon,tmplat
+!!          if(iouttype.eq.1) write(unitoutgrid,*) tmplon,tmplat
+!        write(53,*) tmplon,tmplat
+!!         tmpx=out_xm0+(ix-1-0.5)*dxout
+!!         tmpy=out_ym0+(jy-1-0.5)*dyout
+!          tmpx=out_xm0+(float(ix)-1.)*dxout
+!          tmpy=out_ym0+(float(jy)-1.)*dyout
+!!         tmpx=xsw+(xne-xsw)*float(ix-1)/float(numxgrid-1)
+!!         tmpy=ysw+(yne-ysw)*float(jy-1)/float(numygrid-1)
+!!          print*,'jb2','tmpx','tmpy',dxout,dyout,ix,jy
+!!         call xymeter_to_ll_wrf(tmpx,tmpy,tmplon,tmplat)
+!          call xymeter_to_ll_wrf_out(tmpx,tmpy,tmplon,tmplat)
+!           write(54,*) tmplon,tmplat
+!        enddo
+!        enddo
+!      close(53)
+!      close(54)
+
+!     print*,'in grid conc',nspec,iout,adate,atime
+  do ks=1,nspec
+    if (iouttype.ne.2) then ! Not netcdf output, open the standard files
+      ! AD: I don't think this is right, there is no distinction between ascii
+      ! or binary files as there is in concoutput_reg...
+      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(1)(1:length(1))//'grid_conc_'//adate// &
+               atime//'_'//anspec,form='unformatted')
+        else
+          open(unitoutgrid,file=path(1)(1:length(1))//'grid_time_'//adate// &
+               atime//'_'//anspec,form='unformatted')
+        endif
+        write(unitoutgrid) itime
+      endif
+    endif ! iouttype.ne.2
+
+    if ((iout.eq.2).or.(iout.eq.3)) then      ! mixing ratio
+      if(iouttype.ne.2) then ! Not netcdf output, open standard file
+        ! AD: still the same issue as my previous comment...
+        open(unitoutgridppt,file=path(1)(1:length(1))//'grid_pptv_'//adate// &
+              atime//'_'//anspec,form='unformatted')
+        write(unitoutgridppt) itime
+      endif
+    endif
+
+
+!     print*,'in grid conc step 2',maxpointspec_act,nageclass,numygrid,numxgrid,numzgrid
+  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
+!        if (grid(ix,jy,kz).gt.0. ) print*,grid(ix,jy,kz)
+            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 (iouttype.eq.2) then   ! netcdf output
+    if (option_verbose.ge.1) then
+      write(*,*) 'concoutput_irreg: Calling write_ncconc for main outgrid'
+    endif
+!     print*,'itime',itime
+!        call cpu_time(start)
+    call write_ncconc(itime,outnum,ks,kp,nage,tot_mu(ks,kp),0) ! 0= nest level
+!        call cpu_time(finish)
+!       print*,'write netcdf',finish-start
+
+  else  ! binary or ascii output
+
+    ! 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
+
+  endif ! iouttype.eq.2
+
+  end do
+  end do
+
+    if((iouttype.eq.0).or.(iouttype.eq.1)) then ! binary or ascii output
+      close(unitoutgridppt)
+      close(unitoutgrid)
+    endif
+
+  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
+
+  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_irreg
+
Index: /branches/jerome/src_flexwrf_v3.1/concoutput_nest_irreg.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/concoutput_nest_irreg.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/concoutput_nest_irreg.f90	(revision 16)
@@ -0,0 +1,647 @@
+!**********************************************************************
+!* Copyright 2012,2013                                                *
+!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine,       *
+!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
+!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso,          *
+!* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann,   *
+!                                                                     *
+! This file is part of FLEXPART WRF                                   *
+!                                                                     *
+! 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_irreg(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                                          *
+  !   JB: TO BE MODIFIED                                                       *
+  !*****************************************************************************
+  !                                                                            *
+  ! 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 !AD: moved this to par_mod.f90
+  logical :: sp_zer
+  character :: adate*8,atime*6
+  character(len=3) :: anspec
+
+
+!     write(*,'(//a,a//)') &
+!         '*** Stopping in concoutput_nest ***', &
+!         '    This is not implemented for FLEXPART_WRF yet'
+!     stop
+
+  ! 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=out_xm0n+float(ix)*dxoutn
+        yl=out_ym0n+float(jy)*dyoutn
+!        xl=outlon0n+real(ix)*dxoutn
+!        yl=outlat0n+real(jy)*dyoutn
+!        xl=(xl-xlon0)/dx
+!        yl=(yl-ylat0)/dy
+            xl=(xl-xmet0)/dx
+            yl=(yl-ymet0)/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
+  !*********************************************************************
+!  print*,'IN CONCOUT',nspec,iout,iouttype,ldirect
+  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
+        if (iouttype.eq.0) &
+          open(unitoutgrid,file=path(1)(1:length(1))//'grid_conc_nest_' &
+             //adate// &
+             atime//'_'//anspec,form='unformatted')
+        if (iouttype.eq.1) &
+          open(unitoutgrid,file=path(1)(1:length(1))//'grid_conc_nest_' &
+             //adate// &
+             atime//'_'//anspec,form='formatted')
+      else
+        if (iouttype.eq.0) &
+          open(unitoutgrid,file=path(1)(1:length(1))//'grid_time_nest_' &
+             //adate// &
+             atime//'_'//anspec,form='unformatted')
+        if (iouttype.eq.1) &
+          open(unitoutgrid,file=path(1)(1:length(1))//'grid_time_nest_' &
+             //adate// &
+             atime//'_'//anspec,form='formatted')
+      endif
+      if (iouttype.eq.0) write(unitoutgrid) itime
+      if (iouttype.eq.1) write(unitoutgrid,*) itime
+    endif
+
+  if ((iout.eq.2).or.(iout.eq.3)) then      ! mixing ratio
+    if (iouttype.eq.0) &
+      open(unitoutgridppt,file=path(1)(1:length(1))//'grid_pptv_nest_' &
+        //adate// &
+        atime//'_'//anspec,form='unformatted')
+    if (iouttype.eq.1) &
+      open(unitoutgridppt,file=path(1)(1:length(1))//'grid_pptv_nest_' &
+        //adate// &
+        atime//'_'//anspec,form='formatted')
+
+!   write(unitoutgridppt) itime
+    if (iouttype.eq.0) write(unitoutgridppt) itime
+    if (iouttype.eq.1) 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
+  !*******************************************************************
+
+    if (iouttype.eq.2) then   ! netcdf output
+      if (option_verbose.ge.1) then
+        write(*,*) 'concoutput_irreg: Calling write_ncconc for main outgrid'
+      endif
+      call write_ncconc(itime,outnum,ks,kp,nage,tot_mu(ks,kp),1) ! 1= nest level
+    else  ! binary or ascii output
+
+      ! 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
+        if (iouttype.eq.0) then
+          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)
+        endif
+        if (iouttype.eq.1) then
+          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)
+        endif
+  !       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
+        if (iouttype.eq.0) then
+          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)
+        endif
+        if (iouttype.eq.1) then
+          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)
+        endif
+  !       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
+        if (iouttype.eq.0) then
+          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)
+        endif
+        if (iouttype.eq.1) then
+          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)
+        endif
+  !       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
+        if (iouttype.eq.0) then
+          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)
+        endif
+        if (iouttype.eq.1) then
+          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)
+        endif
+  !       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
+        if (iouttype.eq.0) then
+          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)
+        endif
+        if (iouttype.eq.1) then
+          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)
+        endif
+!       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
+        if (iouttype.eq.0) then
+          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)
+        endif
+        if (iouttype.eq.1) then
+          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)
+        endif
+!       write(unitoutgridppt) sp_count_u
+!       write(unitoutgridppt) (sparse_dump_u(i),i=1,sp_count_r)
+
+      endif ! output for ppt
+
+    endif ! iouttype.eq.2
+
+  end do
+  end do
+
+  if ((iouttype.eq.0).or.(iouttype.eq.1)) then ! binary or ascii output
+    close(unitoutgridppt)
+    close(unitoutgrid)
+  endif
+
+  end do  ! ks=1,nspec
+
+  ! 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_irreg
+
Index: /branches/jerome/src_flexwrf_v3.1/concoutput_nest_reg.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/concoutput_nest_reg.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/concoutput_nest_reg.f90	(revision 16)
@@ -0,0 +1,645 @@
+!**********************************************************************
+!* Copyright 2012,2013                                                *
+!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine,       *
+!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
+!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso,          *
+!* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann,   *
+!                                                                     *
+! This file is part of FLEXPART WRF                                   *
+!                                                                     *
+! 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_reg(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                                          *
+  !   JB: TO BE MODIFIED                                                       *
+  !*****************************************************************************
+  !                                                                            *
+  ! 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,xl2,yl2
+
+  !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 !AD: moved this to par_mod.f90
+  logical :: sp_zer
+  character :: adate*8,atime*6
+  character(len=3) :: anspec
+
+
+!     write(*,'(//a,a//)') &
+!         '*** Stopping in concoutput_nest ***', &
+!         '    This is not implemented for FLEXPART_WRF yet'
+!     stop
+
+  ! 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
+       xl2=outlon0n+real(ix)*dxoutln
+        yl2=outlat0n+real(jy)*dyoutln
+         call ll_to_xymeter_wrf(xl2,yl2,xl,yl) !xl is coord 
+            xl=(xl-xmet0)/dx
+            yl=(yl-ymet0)/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
+     if (iouttype.eq.0) &
+      open(unitoutgrid,file=path(1)(1:length(1))//'grid_conc_nest_' &
+           //adate// &
+           atime//'_'//anspec,form='unformatted')
+     if (iouttype.eq.1) &
+      open(unitoutgrid,file=path(1)(1:length(1))//'grid_conc_nest_' &
+           //adate// &
+           atime//'_'//anspec,form='formatted')
+    else
+     if (iouttype.eq.0) &
+      open(unitoutgrid,file=path(1)(1:length(1))//'grid_time_nest_' &
+           //adate// &
+           atime//'_'//anspec,form='unformatted')
+     if (iouttype.eq.1) &
+      open(unitoutgrid,file=path(1)(1:length(1))//'grid_time_nest_' &
+           //adate// &
+           atime//'_'//anspec,form='formatted')
+    endif
+     if (iouttype.eq.0) write(unitoutgrid) itime
+     if (iouttype.eq.1) write(unitoutgrid,*) itime
+   endif
+
+  if ((iout.eq.2).or.(iout.eq.3)) then      ! mixing ratio
+     if (iouttype.eq.0) &
+   open(unitoutgridppt,file=path(1)(1:length(1))//'grid_pptv_nest_' &
+        //adate// &
+        atime//'_'//anspec,form='unformatted')
+     if (iouttype.eq.1) &
+   open(unitoutgridppt,file=path(1)(1:length(1))//'grid_pptv_nest_' &
+        //adate// &
+        atime//'_'//anspec,form='formatted')
+
+    if (iouttype.eq.0) write(unitoutgridppt) itime
+    if (iouttype.eq.1) 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
+  !*******************************************************************
+
+    if (iouttype.eq.2) then   ! netcdf output
+      if (option_verbose.ge.1) then
+        write(*,*) 'concoutput_irreg: Calling write_ncconc for main outgrid'
+      endif
+      call write_ncconc(itime,outnum,ks,kp,nage,tot_mu(ks,kp),1) ! 1= nest level
+    else  ! binary or ascii output
+
+    ! 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
+       if (iouttype.eq.0) then
+           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)
+        endif
+       if (iouttype.eq.1) then
+           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)
+        endif
+    !       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
+       if (iouttype.eq.0) then
+           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)
+       endif
+       if (iouttype.eq.1) then
+           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)
+       endif
+    !       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
+       if (iouttype.eq.0) then
+           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)
+       endif
+       if (iouttype.eq.1) then
+           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)
+       endif
+    !       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
+       if (iouttype.eq.0) then
+           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)
+        endif
+       if (iouttype.eq.1) then
+           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)
+        endif
+    !       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
+       if (iouttype.eq.0) then
+           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)
+       endif
+       if (iouttype.eq.1) then
+           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)
+       endif
+    !       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
+       if (iouttype.eq.0) then
+           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)
+       endif
+       if (iouttype.eq.1) then
+           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)
+       endif
+    !       write(unitoutgridppt) sp_count_u
+    !       write(unitoutgridppt) (sparse_dump_u(i),i=1,sp_count_r)
+
+        endif ! output for ppt
+
+    endif ! iouttype.eq.2
+
+  end do
+  end do
+
+  if (iouttype.ne.2) then ! binary (or ascii) output
+    close(unitoutgridppt)
+    close(unitoutgrid)
+  endif
+
+  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_reg
+
Index: /branches/jerome/src_flexwrf_v3.1/concoutput_reg.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/concoutput_reg.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/concoutput_reg.f90	(revision 16)
@@ -0,0 +1,741 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                *
+!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine,       *
+!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
+!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso,          *
+!* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann,   *
+!*                                                                     *
+!* This file is part of FLEXPART WRF                                   *
+!*                                                                     *
+!* 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_reg(itime,outnum,gridtotalunc,wetgridtotalunc, &
+      drygridtotalunc)
+!                             i     i          o             o
+!            o
+!*******************************************************************************
+!                                                                              *
+!     Note:  This is the FLEXPART_WRF version of subroutine concoutput         *
+!                                                                              *
+!     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 includepar                   *
+!                                                                              *
+!     Dec 2005, J. Fast - Output files can be either binary or ascii.          *
+!                         Sparse output option is turned off.                  *
+!     Dec 2005, R. Easter - changed names of "*lon0*" & "*lat0*" variables     *
+!     2012, J. Brioude- modify output format to flexpart 8*, latlon regular output *
+!                                                                              *
+!*******************************************************************************
+!                                                                              *
+! Variables:                                                                   *
+! outnum          number of samples                                            *
+! ncells          number of cells with non-zero concentrations                 *
+! sparse          .true. if in sparse matrix format, else .false.              *
+! nspeciesdim     either nspec (forward runs), or numpoint (backward runs)     *
+! tot_mu          1 for forward, initial mass mixing ration for backw. runs    *
+! maxpointspec    maxspec for forward runs, maxpoint for backward runs         *
+!                                                                              *
+!*******************************************************************************
+
+!      include 'includepar'
+!      include 'includecom'
+!
+!      double precision jul
+!      integer itime,i,ix,jy,kz,k,l,iix,jjy,kzz,nage,jjjjmmdd,ihmmss
+!      integer ncells(maxpointspec,maxageclass)
+!      integer ncellsd(maxpointspec,maxageclass)
+!      integer ncellsw(maxpointspec,maxageclass),nspeciesdim
+!      real outnum,weightair,densityoutrecept(maxreceptor),xl,yl
+!      real densityoutgrid(0:maxxgrid-1,0:maxygrid-1,maxzgrid),
+!     +grid(0:maxxgrid-1,0:maxygrid-1,maxzgrid,maxpointspec,maxageclass)
+!      real wetgrid(0:maxxgrid-1,0:maxygrid-1,maxpointspec,maxageclass)
+!      real drygrid(0:maxxgrid-1,0:maxygrid-1,maxpointspec,maxageclass)
+!      real gridsigma(0:maxxgrid-1,0:maxygrid-1,maxzgrid,maxpointspec,
+!     +maxageclass),
+!     +drygridsigma(0:maxxgrid-1,0:maxygrid-1,maxpointspec,maxageclass),
+!     +wetgridsigma(0:maxxgrid-1,0:maxygrid-1,maxpointspec,maxageclass)
+!      real auxgrid(nclassunc),gridtotal,gridsigmatotal,gridtotalunc
+!      real wetgridtotal,wetgridsigmatotal,wetgridtotalunc
+!      real drygridtotal,drygridsigmatotal,drygridtotalunc
+!      real factor(0:maxxgrid-1,0:maxygrid-1,maxzgrid)
+!      real halfheight,dz,dz1,dz2,tot_mu(maxpointspec)
+!      real xnelat,xnelon
+!      real xsw,xne,ysw,yne,tmpx,tmpy,tmplon,tmplat
+!      parameter(weightair=28.97)
+!      logical sparse(maxpointspec,maxageclass)
+!      logical sparsed(maxpointspec,maxageclass)
+!      logical sparsew(maxpointspec,maxageclass)
+!      character adate*8,atime*6
+  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,xl2,yl2
+  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 :: xsw,xne,ysw,yne,tmpx,tmpy,tmplon,tmplat
+  real,parameter :: smallnum = tiny(0.0) ! smallest number that can be handled
+  ! real,parameter :: weightair=28.97 !AD: moved this to par_mod.f90
+  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
+      write(unitdates,'(a)') adate//atime
+
+
+! 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=out_xm0+float(ix)*dxout
+!        yl=out_ym0+float(jy)*dyout
+!        xl=(xl-xmet0)/dx
+!        yl=(yl-ymet0)/dx
+            xl2=outlon0+float(ix)*dxoutl !long
+            yl2=outlat0+float(jy)*dyoutl !lat 
+         call ll_to_xymeter_wrf(xl2,yl2,xl,yl) !xl is coord 
+            xl=(xl-xmet0)/dx 
+            yl=(yl-ymet0)/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,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.
+
+!*******************************************************************
+! Generate output: may be in concentration (ng/m3) or in mixing
+! ratio (ppt) or both
+! Output either in full grid dump or sparse matrix format
+! For backward simulations, the unit is seconds, stored in grid_conc
+!*******************************************************************
+
+! Concentration output
+!*********************
+!
+!          open(23,file=path(1)(1:length(1))//'latlon.txt' &
+!          ,form='formatted')
+!          open(24,file=path(1)(1:length(1))//'latlon_corner.txt' &
+!          ,form='formatted')
+!
+!!        xnelat=outgrid_nelat
+!!        xnelon=outgrid_nelon
+!        call ll_to_xymeter_wrf(outgrid_swlon,outgrid_swlat,xsw,ysw)
+!        call ll_to_xymeter_wrf(outgrid_nelon,outgrid_nelat,xne,yne)
+!        do jy=1,numygrid
+!        do ix=1,numxgrid
+!!         tmpx=out_xm0+(ix-1)*dxout
+!!         tmpy=out_ym0+(jy-1)*dyout
+!!          tmpx=out_xm0+(float(ix)-0.5)*dxout
+!!          tmpy=out_ym0+(float(jy)-0.5)*dyout
+!          tmpx=xsw+(xne-xsw)*float(ix-1)/float(numxgrid-1) 
+!          tmpy=ysw+(yne-ysw)*float(jy-1)/float(numygrid-1)   
+!!          print*,'jb','tmpx','tmpy',dxout,dyout,ix,jy
+!          call xymeter_to_ll_wrf(tmpx,tmpy,tmplon,tmplat)
+!            xl2=outlon0+(float(ix)-0.5)*dxoutl !long  
+!            yl2=outlat0+(float(jy)-0.5)*dyoutl !lat  
+!
+!!jb          if(iouttype.eq.0) write(unitoutgrid) tmplon,tmplat
+!!          if(iouttype.eq.1) write(unitoutgrid,*) tmplon,tmplat
+!!          write(23,*) tmplon,tmplat
+!           write(23,*) xl2,yl2
+!!         tmpx=out_xm0+(ix-1-0.5)*dxout
+!!         tmpy=out_ym0+(jy-1-0.5)*dyout
+!!          tmpx=out_xm0+(float(ix)-1.)*dxout
+!!          tmpy=out_ym0+(float(jy)-1.)*dyout
+!            xl2=outlon0+float(ix-1)*dxoutl !long 
+!            yl2=outlat0+float(jy-1)*dyoutl !lat    
+!           write(24,*) xl2,yl2       
+!!         tmpx=xsw+(xne-xsw)*float(ix-1)/float(numxgrid-1)
+!!         tmpy=ysw+(yne-ysw)*float(jy-1)/float(numygrid-1)
+!!          print*,'jb2','tmpx','tmpy',dxout,dyout,ix,jy
+!!         call xymeter_to_ll_wrf(tmpx,tmpy,tmplon,tmplat)
+!!          call xymeter_to_ll_wrf_out(tmpx,tmpy,tmplon,tmplat)
+!!           write(24,*) tmplon,tmplat
+!        enddo
+!        enddo
+!           close(23)
+!           close(24)
+
+  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
+        if (iouttype.eq.0) &
+          open(unitoutgrid,file=path(1)(1:length(1))//'grid_conc_'//adate// &
+            atime//'_'//anspec,form='unformatted')
+        if (iouttype.eq.1) &
+          open(unitoutgrid,file=path(1)(1:length(1))//'grid_conc_'//adate// &
+            atime//'_'//anspec,form='formatted')
+      else
+        if (iouttype.eq.0) &
+          open(unitoutgrid,file=path(1)(1:length(1))//'grid_time_'//adate// &
+            atime//'_'//anspec,form='unformatted')
+        if (iouttype.eq.1) &
+          open(unitoutgrid,file=path(1)(1:length(1))//'grid_time_'//adate// &
+            atime//'_'//anspec,form='formatted')
+      endif
+        write(unitoutgrid) itime
+    endif
+
+    if ((iout.eq.2).or.(iout.eq.3)) then      ! mixing ratio
+      if (iouttype.eq.0) &
+        open(unitoutgridppt,file=path(1)(1:length(1))//'grid_pptv_'//adate// &
+          atime//'_'//anspec,form='unformatted')
+      if (iouttype.eq.1) &
+        open(unitoutgridppt,file=path(1)(1:length(1))//'grid_pptv_'//adate// &
+          atime//'_'//anspec,form='formatted')
+
+      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 (iouttype.eq.2) then   ! netcdf output
+    if (option_verbose.ge.1) then
+      write(*,*) 'concoutput_irreg: Calling write_ncconc for main outgrid'
+    endif
+    call write_ncconc(itime,outnum,ks,kp,nage,tot_mu(ks,kp),0) ! 0= nest level
+  else  ! binary or ascii output
+
+    ! 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
+  ! concentraion 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
+     if (iouttype.eq.0) then
+         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)
+       endif
+     if (iouttype.eq.1) then
+         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)
+       endif
+  !       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
+     if (iouttype.eq.0) then
+         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)
+      endif
+     if (iouttype.eq.1) then
+         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)
+      endif
+  !       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
+     if (iouttype.eq.0) then
+         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)
+      endif
+     if (iouttype.eq.1) then
+         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)
+      endif
+  !       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
+     if (iouttype.eq.0) then
+         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)
+       endif
+     if (iouttype.eq.1) then
+         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)
+       endif
+  !       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
+     if (iouttype.eq.0) then
+         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)
+      endif
+     if (iouttype.eq.1) then
+         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)
+      endif
+  !       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
+     if (iouttype.eq.0) then
+         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)
+       endif
+     if (iouttype.eq.1) then
+         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)
+       endif
+  !       write(unitoutgridppt) sp_count_u
+  !       write(unitoutgridppt) (sparse_dump_u(i),i=1,sp_count_r)
+
+      endif ! output for ppt
+
+  endif ! iouttype.eq.2
+
+  end do
+  end do
+
+    if((iouttype.eq.0).or.(iouttype.eq.1)) then ! binary or ascii output
+      close(unitoutgridppt)
+      close(unitoutgrid)
+    endif
+
+  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
+
+  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_reg
+
Index: /branches/jerome/src_flexwrf_v3.1/conv_mod.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/conv_mod.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/conv_mod.f90	(revision 16)
@@ -0,0 +1,71 @@
+!***********************************************************************
+!* 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 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, nuvzmax
+
+  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
+      real :: umf3(0:nxmax-1,0:nymax-1,nuvzmax)
+      real :: uer3(0:nxmax-1,0:nymax-1,nuvzmax)
+      real :: udr3(0:nxmax-1,0:nymax-1,nuvzmax)
+      real :: dmf3(0:nxmax-1,0:nymax-1,nuvzmax)
+      real :: der3(0:nxmax-1,0:nymax-1,nuvzmax)
+      real :: ddr3(0:nxmax-1,0:nymax-1,nuvzmax)
+      real :: cu_top(0:nxmax-1,0:nymax-1)
+      real :: cu_bot(0:nxmax-1,0:nymax-1)
+
+      real :: umf3n(0:nxmax-1,0:nymax-1,nuvzmax,maxnests)
+      real :: uer3n(0:nxmax-1,0:nymax-1,nuvzmax,maxnests)
+      real :: udr3n(0:nxmax-1,0:nymax-1,nuvzmax,maxnests)
+      real :: dmf3n(0:nxmax-1,0:nymax-1,nuvzmax,maxnests)
+      real :: der3n(0:nxmax-1,0:nymax-1,nuvzmax,maxnests)
+      real :: ddr3n(0:nxmax-1,0:nymax-1,nuvzmax,maxnests)
+      real :: cu_topn(0:nxmax-1,0:nymax-1,maxnests)
+      real :: cu_botn(0:nxmax-1,0:nymax-1,maxnests)
+
+  integer :: nconvlev,nconvtop
+
+end module conv_mod
Index: /branches/jerome/src_flexwrf_v3.1/convect43c.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/convect43c.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/convect43c.f90	(revision 16)
@@ -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/jerome/src_flexwrf_v3.1/convection_kfeta.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/convection_kfeta.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/convection_kfeta.f90	(revision 16)
@@ -0,0 +1,2799 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                *
+!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine,       *
+!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
+!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso,          *
+!* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann,   *
+!*                                                                     *
+!* This file is part of FLEXPART WRF                                   *
+!*                                                                     *
+!* 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/>.   *
+!***********************************************************************
+! 8/9/2007  TEST the extracted CU model offline
+! input from WRF output
+!       3_D:  U,V,W, PH(geo potential, can change to height)
+!             T,Pressure,
+!   need to change to pressure point  -- see phy_prep
+!   CUDT is read from namelist, 
+!    1-d is enough
+
+!     using a common block for KFLUTAB, will use a " include " 
+
+! This code is extracted from WRF, KFeta cumulus convection paramerization
+!     
+!   INPUT variables are all defioned in p-grid (or T-grid)
+!   
+      SUBROUTINE KF_ETA(nzmax,u1d,v1d,t1d,dz1d,qv1d,p1d,rho1d,        &   ! IN
+     &               w0avg1d,cudt,dx,dt,warm_rain,kts,kte,       &   ! IN
+     &               umf,uer,udr,dmf,der,ddr,cu_bot1,cu_top1)        ! OUT
+
+      IMPLICIT NONE
+
+      INTEGER :: ids,ide,jds,jde,kds,kde,   &
+                 ims,ime,jms,jme,kms,kme,   &
+                 its,ite,jts,jte,kts,kte,nzmax
+
+      parameter (ids=1,ide=1,jds=1,jde=1)
+      parameter (ims=1,ime=1,jms=1,jme=1)
+      parameter (its=1,ite=1,jts=1,jte=1)
+!!      parameter (kts=1,kte=10)
+
+      LOGICAL :: flag_qr, flag_qi, flag_qs,warm_rain
+      LOGICAL, DIMENSION(ims:ime,jms:jme)::     CU_ACT_FLAG
+      REAL,    DIMENSION(ims:ime,jms:jme)::     NCA,CUBOT,CUTOP
+ 
+      REAL, DIMENSION( 1:nzmax ),intent(in) ::               &
+                                                        U1D, &
+                                                        V1D, &
+                                                        T1D, &
+                                                       DZ1D, &
+                                                       QV1D, &
+                                                        P1D, &
+                                                      RHO1D, &
+                                                    W0AVG1D
+      REAL, DIMENSION(1:nzmax), INTENT(OUT) ::   umf,         &
+                                                uer,          &
+                                                udr,          &
+                                                dmf,          &
+                                                der,          &
+                                                ddr
+
+      REAL    :: TST,tv,PRS,RHOE,W0,SCR1,DXSQ,tmp,RTHCUMAX
+      REAL    :: XLV0,XLV1,XLS0,XLS1,R_d,r_v,SVP1,SVP2,SVP3,SVPT0
+      REAL    :: G, CP, EP1,EP2
+      REAL    :: CUDT, DT, DX, STEPCU
+      INTEGER :: KTAU ,kk
+      INTEGER :: i,j,k,NTST,ICLDCK
+      REAL    :: cu_top1,cu_bot1
+
+      data xlv0,xlv1,xls0,xls1/3.15E6,2370.0,2.905E6,259.532/
+      data r_d,r_v/287.04,461.6/
+      data svp1,svp2,svp3,svpt0/0.6112,17.67,29.65,273.15/
+      data g/9.81/
+
+        kds = kts
+        kde = kte
+        kms = kts
+        kme = kte
+
+       cp=7.0*r_d/2.0
+       ep1=r_v/r_d-1.0
+       ep2=r_d/r_v
+
+!       cudt=10     ! mintue
+!       dt=900.0      ! model time step (s)
+!       dx=25000.0
+!       warm_rain = .true. 
+
+!    if mp_physics = kesslerschene , warm_rain= .true.
+
+!!!!!!! 
+
+       stepcu=nint(cudt*60.0/dt)
+       stepcu=amax1(stepcu,1.0)
+
+!   initial conditions;  note that some from WRF are not needed for this dispersion applicaiton  
+!   Note the order of index in WRF (i,k,j),  we use (i,j,k)
+!   can put this in the main program somewhere.
+!   KTAU is total time/dt
+
+        call KF_LUTAB(SVP1,SVP2,SVP3,SVPT0)
+
+       write(*,*)'stepcu=',stepcu
+       KTAU=0                        
+
+      DXSQ=DX*DX
+
+!----------------------
+      NTST=STEPCU
+      TST=float(NTST*2)
+      flag_qr = .FALSE.
+      flag_qi = .FALSE.
+      flag_qs = .FALSE.
+!
+!...CHECK FOR CONVECTIVE INITIATION EVERY 5 MINUTES (OR NTST/2)...
+!
+!----------------------
+      ICLDCK=MOD(KTAU,NTST)
+      IF(ICLDCK.EQ.0 .or. KTAU .eq. 1) then
+!
+!  Let the code always check the convection by imposing NCA=-1 and CU_ACT_FLAG=.true.
+!   still keep the 2-D variable here just for modifying original code as little as possible
+
+      DO J = jts,jte
+      DO I= its,ite
+        CU_ACT_FLAG(i,j) = .true.
+        NCA(i,j) = -100
+      ENDDO
+      ENDDO
+
+      DO J = jts,jte
+       DO I=its,ite
+
+            CUTOP(I,J)=KTS
+            CUBOT(I,J)=KTE+1
+
+         IF ( NINT(NCA(I,J)) .gt. 0 ) then
+            CU_ACT_FLAG(i,j) = .false.
+         ELSE
+
+!            CUTOP(I,J)=KTS
+!            CUBOT(I,J)=KTE+1
+              DO kk=kts,kte 
+                umf(kk)=0.0
+                uer(kk)=0.0
+                udr(kk)=0.0
+                dmf(kk)=0.0
+                der(kk)=0.0
+                ddr(kk)=0.0
+              ENDDO
+
+!
+! Comment out DQDT,,,,, RAINV (not used in dispersion modeling) 
+
+            CALL KF_eta_PARA(I, J,                  &
+                 U1D,V1D,T1D,QV1D,P1D,DZ1D,         &
+                 W0AVG1D,DT,DX,DXSQ,RHO1D,          &
+                 XLV0,XLV1,XLS0,XLS1,CP,R_D,G,        &
+                 EP2,SVP1,SVP2,SVP3,SVPT0,          &
+!                 DQDT,DQIDT,DQCDT,DQRDT,DQSDT,DTDT, &
+!                 RAINCV,                            &
+                 NCA,NTST,                   &
+                 flag_QI,flag_QS,warm_rain,         &
+                 CUTOP,CUBOT,                       &
+                 ids,ide, jds,jde, kds,kde,         &
+                 ims,ime, jms,jme, kms,kme,         &
+                 its,ite, jts,jte, kts,kte,         &
+! added flux output
+                 umf,uer,udr,dmf,der,ddr)
+
+           write(*,*)'after call KF_eta_para'
+!
+         ENDIF 
+       ENDDO
+      ENDDO
+      ENDIF
+!
+         cu_top1=cutop(1,1)
+         cu_bot1=cubot(1,1)
+
+      end
+
+! ****************************************************************************
+!-----------------------------------------------------------
+       SUBROUTINE KF_eta_PARA (I, J,                           &
+                      U0,V0,T0,QV0,P0,DZQ,W0AVG1D,         &
+                      DT,DX,DXSQ,rhoe,                     &
+                      XLV0,XLV1,XLS0,XLS1,CP,R,G,          &
+                      EP2,SVP1,SVP2,SVP3,SVPT0,            &
+!                      DQDT,DQIDT,DQCDT,DQRDT,DQSDT,DTDT,   &
+!                      RAINCV,                              &
+                      NCA,NTST,                     &
+                      F_QI,F_QS,warm_rain,                 &
+                      CUTOP,CUBOT,                         &
+                      ids,ide, jds,jde, kds,kde,           &
+                      ims,ime, jms,jme, kms,kme,           &
+                      its,ite, jts,jte, kts,kte,           &
+                      umf,uer,udr,dmf,der,ddr)
+!-----------------------------------------------------------
+!***** The KF scheme that is currently used in experimental runs of EMCs 
+!***** Eta model....jsk 8/00
+!
+  use kftable_mod
+      IMPLICIT NONE
+
+!      include 'include_kftable'
+!-----------------------------------------------------------
+      INTEGER, INTENT(IN   ) :: ids,ide, jds,jde, kds,kde, &
+                                ims,ime, jms,jme, kms,kme, &
+                                its,ite, jts,jte, kts,kte, &
+                                I,J,NTST
+          ! ,P_QI,P_QS,P_FIRST_SCALAR
+
+      LOGICAL, INTENT(IN   ) :: F_QI, F_QS
+
+      LOGICAL, INTENT(IN   ) :: warm_rain
+!
+      REAL, DIMENSION( kts:kte ),                          &
+            INTENT(IN   ) ::                           U0, &
+                                                       V0, &
+                                                       T0, &
+                                                      QV0, &
+                                                       P0, &
+                                                     rhoe, &
+                                                      DZQ, &
+                                                  W0AVG1D
+!
+      REAL,  INTENT(IN   ) :: DT,DX,DXSQ
+!
+
+      REAL,  INTENT(IN   ) :: XLV0,XLV1,XLS0,XLS1,CP,R,G
+      REAL,  INTENT(IN   ) :: EP2,SVP1,SVP2,SVP3,SVPT0
+
+!
+      REAL, DIMENSION( kts:kte )::         &
+                                                     DQDT, &
+                                                    DQIDT, &
+                                                    DQCDT, &
+                                                    DQRDT, &
+                                                    DQSDT, &
+                                                     DTDT
+
+      REAL,    DIMENSION( ims:ime , jms:jme ),             &
+            INTENT(INOUT) ::                          NCA
+
+      REAL, DIMENSION( ims:ime , jms:jme ) ::       RAINCV
+
+      REAL, DIMENSION( ims:ime , jms:jme ),                &
+            INTENT(OUT) ::                          CUBOT, &
+                                                    CUTOP
+!
+!...DEFINE LOCAL VARIABLES...
+!
+      REAL, DIMENSION( kts:kte ) ::                        &
+            Q0,Z0,TV0,TU,TVU,QU,TZ,TVD,                    &
+            QD,QES,THTES,TG,TVG,QG,WU,WD,W0,EMS,EMSD,      &
+            UMF,UER,UDR,DMF,DER,DDR,UMF2,UER2,             &
+            UDR2,DMF2,DER2,DDR2,DZA,THTA0,THETEE,          &
+            THTAU,THETEU,THTAD,THETED,QLIQ,QICE,           &
+            QLQOUT,QICOUT,PPTLIQ,PPTICE,DETLQ,DETIC,       &
+            DETLQ2,DETIC2,RATIO,RATIO2
+
+
+      REAL, DIMENSION( kts:kte ) ::                        &
+            DOMGDP,EXN,TVQU,DP,RH,EQFRC,WSPD,              &
+            QDT,FXM,THTAG,THPA,THFXOUT,                    &
+            THFXIN,QPA,QFXOUT,QFXIN,QLPA,QLFXIN,           &
+            QLFXOUT,QIPA,QIFXIN,QIFXOUT,QRPA,              &
+            QRFXIN,QRFXOUT,QSPA,QSFXIN,QSFXOUT,            &
+            QL0,QLG,QI0,QIG,QR0,QRG,QS0,QSG
+
+
+      REAL, DIMENSION( kts:kte+1 ) :: OMG
+      REAL, DIMENSION( kts:kte ) :: RAINFB,SNOWFB
+      REAL, DIMENSION( kts:kte ) ::                        &
+            CLDHGT,QSD,DILFRC,DDILFRC,TKE,TGU,QGU,THTEEG
+
+! LOCAL VARS
+
+      REAL    :: P00,T00,RLF,RHIC,RHBC,PIE,         &
+                 TTFRZ,TBFRZ,C5,RATE
+      REAL    :: GDRY,ROCP,ALIQ,BLIQ,                      &
+                 CLIQ,DLIQ
+      REAL    :: FBFRC,P300,DPTHMX,THMIX,QMIX,ZMIX,PMIX,   &
+                 ROCPQ,TMIX,EMIX,TLOG,TDPT,TLCL,TVLCL,     &
+                 CPORQ,PLCL,ES,DLP,TENV,QENV,TVEN,TVBAR,   &
+                 ZLCL,WKL,WABS,TRPPT,WSIGNE,DTLCL,GDT,WLCL,&
+                 TVAVG,QESE,WTW,RHOLCL,AU0,VMFLCL,UPOLD,   &
+                 UPNEW,ABE,WKLCL,TTEMP,FRC1,   &
+                 QNEWIC,RL,R1,QNWFRZ,EFFQ,BE,BOTERM,ENTERM,&
+                 DZZ,UDLBE,REI,EE2,UD2,TTMP,F1,F2,         &
+                 THTTMP,QTMP,TMPLIQ,TMPICE,TU95,TU10,EE1,  &
+                 UD1,DPTT,QNEWLQ,DUMFDP,EE,TSAT,           &
+                 THTA,VCONV,TIMEC,SHSIGN,VWS,PEF, &
+                 CBH,RCBH,PEFCBH,PEFF,PEFF2,TDER,THTMIN,   &
+                 DTMLTD,QS,TADVEC,DPDD,FRC,DPT,RDD,A1,     &
+                 DSSDT,DTMP,T1RH,QSRH,PPTFLX,CPR,CNDTNF,   &
+                 UPDINC,AINCM2,DEVDMF,PPR,RCED,DPPTDF,     &
+                 DMFLFS,DMFLFS2,RCED2,DDINC,AINCMX,AINCM1, &
+                 AINC,TDER2,PPTFL2,FABE,STAB,DTT,DTT1,     &
+                 DTIME,TMA,TMB,TMM,BCOEFF,ACOEFF,QVDIFF,   &
+                 TOPOMG,CPM,DQ,ABEG,DABE,DFDA,FRC2,DR,     &
+                 UDFRC,TUC,QGS,RH0,RHG,QINIT,QFNL,ERR2,    &
+                 RELERR,RLC,RLS,RNC,FABEOLD,AINCOLD,UEFRC, &
+                 DDFRC,TDC,DEFRC,RHBAR,DMFFRC,DPMIN,DILBE
+   REAL    ::    ASTRT,TP,VALUE,AINTRP,TKEMAX,QFRZ,&
+                 QSS,PPTMLT,DTMELT,RHH,EVAC,BINC
+!
+      INTEGER :: INDLU,NU,NUCHM,NNN,KLFS
+   REAL    :: CHMIN,PM15,CHMAX,DTRH,RAD,DPPP
+   REAL    :: TVDIFF,DTTOT,ABSOMG,ABSOMGTC,FRDP
+
+      INTEGER :: KX,K,KL
+!
+      INTEGER :: NCHECK
+      INTEGER, DIMENSION (kts:kte) :: KCHECK
+
+      INTEGER :: ISTOP,ML,L5,KMIX,LOW,                     &
+                 LC,MXLAYR,LLFC,NLAYRS,NK,                 &
+                 KPBL,KLCL,LCL,LET,IFLAG,                  &
+                 NK1,LTOP,NJ,LTOP1,                        &
+                 LTOPM1,LVF,KSTART,KMIN,LFS,               &
+                 ND,NIC,LDB,LDT,ND1,NDK,                   &
+                 NM,LMAX,NCOUNT,NOITR,                     &
+                 NSTEP,NTC,NCHM,ISHALL,NSHALL
+      LOGICAL :: IPRNT
+      CHARACTER*1024 message
+!
+      DATA P00,T00/1.E5,273.16/
+      DATA RLF/3.339E5/
+      DATA RHIC,RHBC/1.,0.90/
+      DATA PIE,TTFRZ,TBFRZ,C5/3.141592654,268.16,248.16,1.0723E-3/
+      DATA RATE/0.03/
+!-----------------------------------------------------------
+      IPRNT=.FALSE.
+      GDRY=-G/CP
+      ROCP=R/CP
+      NSHALL = 0
+      KL=kte
+      KX=kte
+!
+!     ALIQ = 613.3
+!     BLIQ = 17.502
+!     CLIQ = 4780.8
+!     DLIQ = 32.19
+      ALIQ = SVP1*1000.
+      BLIQ = SVP2
+      CLIQ = SVP2*SVPT0
+      DLIQ = SVP3
+!
+!
+!****************************************************************************
+!                                                      ! PPT FB MODS
+!...OPTION TO FEED CONVECTIVELY GENERATED RAINWATER    ! PPT FB MODS
+!...INTO GRID-RESOLVED RAINWATER (OR SNOW/GRAUPEL)     ! PPT FB MODS
+!...FIELD.  "FBFRC" IS THE FRACTION OF AVAILABLE       ! PPT FB MODS
+!...PRECIPITATION TO BE FED BACK (0.0 - 1.0)...        ! PPT FB MODS
+      FBFRC=0.0                                        ! PPT FB MODS
+!...mods to allow shallow convection...
+      NCHM = 0
+      ISHALL = 0
+      DPMIN = 5.E3
+!...
+      P300=P0(1)-30000.
+!
+!...PRESSURE PERTURBATION TERM IS ONLY DEFINED AT MID-POINT OF
+!...VERTICAL LAYERS...SINCE TOTAL PRESSURE IS NEEDED AT THE TOP AND
+!...BOTTOM OF LAYERS BELOW, DO AN INTERPOLATION...
+!
+!...INPUT A VERTICAL SOUNDING ... NOTE THAT MODEL LAYERS ARE NUMBERED
+!...FROM BOTTOM-UP IN THE KF SCHEME...
+!
+      ML=0 
+!SUE  tmprpsb=1./PSB(I,J)
+!SUE  CELL=PTOP*tmprpsb
+!
+      DO K=1,KX
+!
+!...IF Q0 IS ABOVE SATURATION VALUE, REDUCE IT TO SATURATION LEVEL...
+!
+         ES=ALIQ*EXP((BLIQ*T0(K)-CLIQ)/(T0(K)-DLIQ))
+         QES(K)=0.622*ES/(P0(K)-ES)
+         Q0(K)=AMIN1(QES(K),QV0(K))
+         Q0(K)=AMAX1(0.000001,Q0(K))
+         QL0(K)=0.
+         QI0(K)=0.
+         QR0(K)=0.
+         QS0(K)=0.
+         RH(K) = Q0(K)/QES(K)
+         DILFRC(K) = 1.
+         TV0(K)=T0(K)*(1.+0.608*Q0(K))
+!        RHOE(K)=P0(K)/(R*TV0(K))
+!   DP IS THE PRESSURE INTERVAL BETWEEN FULL SIGMA LEVELS...
+         DP(K)=rhoe(k)*g*DZQ(k)
+! IF Turbulent Kinetic Energy (TKE) is available from turbulent mixing scheme
+! use it for shallow convection...For now, assume it is not available....
+!         TKE(K) = Q2(I,J,NK)
+         TKE(K) = 0.
+         CLDHGT(K) = 0.
+!        IF(P0(K).GE.500E2)L5=K
+         IF(P0(K).GE.0.5*P0(1))L5=K
+         IF(P0(K).GE.P300)LLFC=K
+         IF(T0(K).GT.T00)ML=K
+      ENDDO
+!
+!...DZQ IS DZ BETWEEN SIGMA SURFACES, DZA IS DZ BETWEEN MODEL HALF LEVEL
+        Z0(1)=.5*DZQ(1)
+!cdir novector
+        DO K=2,KL
+          Z0(K)=Z0(K-1)+.5*(DZQ(K)+DZQ(K-1))
+          DZA(K-1)=Z0(K)-Z0(K-1)
+        ENDDO   
+        DZA(KL)=0.
+!
+!
+!  To save time, specify a pressure interval to move up in sequential
+!  check of different ~50 mb deep groups of adjacent model layers in
+!  the process of identifying updraft source layer (USL).  Note that 
+!  this search is terminated as soon as a buoyant parcel is found and 
+!  this parcel can produce a cloud greater than specifed minimum depth
+!  (CHMIN)...For now, set interval at 15 mb...
+!
+       NCHECK = 1
+       KCHECK(NCHECK)=1
+       PM15 = P0(1)-15.E2
+       DO K=2,LLFC
+         IF(P0(K).LT.PM15)THEN
+           NCHECK = NCHECK+1
+           KCHECK(NCHECK) = K
+           PM15 = PM15-15.E2
+         ENDIF
+       ENDDO
+!
+       NU=0
+       NUCHM=0
+usl:   DO
+           NU = NU+1
+!!             write(*,*)'NU=',NU
+           IF(NU.GT.NCHECK)THEN 
+             IF(ISHALL.EQ.1)THEN
+               CHMAX = 0.
+               NCHM = 0
+               DO NK = 1,NCHECK
+                 NNN=KCHECK(NK)
+                 IF(CLDHGT(NNN).GT.CHMAX)THEN
+                   NCHM = NNN
+                   NUCHM = NK
+                   CHMAX = CLDHGT(NNN)
+                 ENDIF
+               ENDDO
+               NU = NUCHM-1
+               FBFRC=1.
+               CYCLE usl
+             ELSE
+               RETURN
+             ENDIF
+           ENDIF      
+           KMIX = KCHECK(NU)
+           LOW=KMIX
+!...
+           LC = LOW
+!
+!...ASSUME THAT IN ORDER TO SUPPORT A DEEP UPDRAFT YOU NEED A LAYER OF
+!...UNSTABLE AIR AT LEAST 50 mb DEEP...TO APPROXIMATE THIS, ISOLATE A
+!...GROUP OF ADJACENT INDIVIDUAL MODEL LAYERS, WITH THE BASE AT LEVEL
+!...LC, SUCH THAT THE COMBINED DEPTH OF THESE LAYERS IS AT LEAST 50 mb..
+!   
+           NLAYRS=0
+           DPTHMX=0.
+           NK=LC-1
+           IF ( NK+1 .LT. KTS ) THEN
+             WRITE(message,*)'WOULD GO OFF BOTTOM: KF_ETA_PARA I,J,NK',I,J,NK
+!!             CALL wrf_message (TRIM(message)) 
+           ELSE
+             DO 
+               NK=NK+1   
+               IF ( NK .GT. KTE ) THEN
+                 WRITE(message,*)'WOULD GO OFF TOP: KF_ETA_PARA I,J,DPTHMX,DPMIN',I,J,DPTHMX,DPMIN
+!!                 CALL wrf_message (TRIM(message))
+                 EXIT
+               ENDIF
+               DPTHMX=DPTHMX+DP(NK)
+               NLAYRS=NLAYRS+1
+               IF(DPTHMX.GT.DPMIN)THEN
+                 EXIT 
+               ENDIF
+             END DO    
+           ENDIF
+           IF(DPTHMX.LT.DPMIN)THEN 
+             RETURN
+           ENDIF
+           KPBL=LC+NLAYRS-1   
+!
+!...********************************************************
+!...for computational simplicity without much loss in accuracy,
+!...mix temperature instead of theta for evaluating convective
+!...initiation (triggering) potential...
+!          THMIX=0.
+           TMIX=0.
+           QMIX=0.
+           ZMIX=0.
+           PMIX=0.
+!
+!...FIND THE THERMODYNAMIC CHARACTERISTICS OF THE LAYER BY
+!...MASS-WEIGHTING THE CHARACTERISTICS OF THE INDIVIDUAL MODEL
+!...LAYERS...
+!
+!cdir novector
+           DO NK=LC,KPBL
+             TMIX=TMIX+DP(NK)*T0(NK)
+             QMIX=QMIX+DP(NK)*Q0(NK)
+             ZMIX=ZMIX+DP(NK)*Z0(NK)
+             PMIX=PMIX+DP(NK)*P0(NK)
+           ENDDO   
+!         THMIX=THMIX/DPTHMX
+          TMIX=TMIX/DPTHMX
+          QMIX=QMIX/DPTHMX
+          ZMIX=ZMIX/DPTHMX
+          PMIX=PMIX/DPTHMX
+          EMIX=QMIX*PMIX/(0.622+QMIX)
+!
+!...FIND THE TEMPERATURE OF THE MIXTURE AT ITS LCL...
+!
+!        TLOG=ALOG(EMIX/ALIQ)
+! ...calculate dewpoint using lookup table...
+!
+          astrt=1.e-3
+          ainc=0.075
+          a1=emix/aliq
+          tp=(a1-astrt)/ainc
+          indlu=int(tp)+1
+          value=(indlu-1)*ainc+astrt
+          aintrp=(a1-value)/ainc
+          tlog=aintrp*alu(indlu+1)+(1-aintrp)*alu(indlu)
+          TDPT=(CLIQ-DLIQ*TLOG)/(BLIQ-TLOG)
+          TLCL=TDPT-(.212+1.571E-3*(TDPT-T00)-4.36E-4*(TMIX-T00))*(TMIX-TDPT)
+          TLCL=AMIN1(TLCL,TMIX)
+          TVLCL=TLCL*(1.+0.608*QMIX)
+          ZLCL = ZMIX+(TLCL-TMIX)/GDRY
+          NK = LC-1
+          DO 
+            NK = NK+1
+            KLCL=NK
+            IF(ZLCL.LE.Z0(NK) .or. NK.GT.KL)THEN
+              EXIT
+            ENDIF 
+          ENDDO   
+          IF(NK.GT.KL)THEN
+            RETURN  
+          ENDIF
+          K=KLCL-1
+          DLP=(ZLCL-Z0(K))/(Z0(KLCL)-Z0(K))
+!     
+!...ESTIMATE ENVIRONMENTAL TEMPERATURE AND MIXING RATIO AT THE LCL...
+!     
+          TENV=T0(K)+(T0(KLCL)-T0(K))*DLP
+          QENV=Q0(K)+(Q0(KLCL)-Q0(K))*DLP
+          TVEN=TENV*(1.+0.608*QENV)
+!     
+!...CHECK TO SEE IF CLOUD IS BUOYANT USING FRITSCH-CHAPPELL TRIGGER
+!...FUNCTION DESCRIBED IN KAIN AND FRITSCH (1992)...W0 IS AN
+!...APROXIMATE VALUE FOR THE RUNNING-MEAN GRID-SCALE VERTICAL
+!...VELOCITY, WHICH GIVES SMOOTHER FIELDS OF CONVECTIVE INITIATION
+!...THAN THE INSTANTANEOUS VALUE...FORMULA RELATING TEMPERATURE
+!...PERTURBATION TO VERTICAL VELOCITY HAS BEEN USED WITH THE MOST
+!...SUCCESS AT GRID LENGTHS NEAR 25 km.  FOR DIFFERENT GRID-LENGTHS,
+!...ADJUST VERTICAL VELOCITY TO EQUIVALENT VALUE FOR 25 KM GRID
+!...LENGTH, ASSUMING LINEAR DEPENDENCE OF W ON GRID LENGTH...
+!     
+          IF(ZLCL.LT.2.E3)THEN
+            WKLCL=0.02*ZLCL/2.E3
+          ELSE
+            WKLCL=0.02
+          ENDIF
+          WKL=(W0AVG1D(K)+(W0AVG1D(KLCL)-W0AVG1D(K))*DLP)*DX/25.E3-WKLCL
+          IF(WKL.LT.0.0001)THEN
+            DTLCL=0.
+          ELSE 
+            DTLCL=4.64*WKL**0.33
+          ENDIF
+!
+!...for ETA model, give parcel an extra temperature perturbation based
+!...the threshold RH for condensation (U00)...
+!
+!...for now, just assume U00=0.75...
+!...!!!!!! for MM5, SET DTRH = 0. !!!!!!!!
+!         U00 = 0.75
+!         IF(U00.lt.1.)THEN
+!           QSLCL=QES(K)+(QES(KLCL)-QES(K))*DLP
+!           RHLCL = QENV/QSLCL
+!           DQSSDT = QMIX*(CLIQ-BLIQ*DLIQ)/((TLCL-DLIQ)*(TLCL-DLIQ))
+!           IF(RHLCL.ge.0.75 .and. RHLCL.le.0.95)then
+!             DTRH = 0.25*(RHLCL-0.75)*QMIX/DQSSDT
+!           ELSEIF(RHLCL.GT.0.95)THEN
+!             DTRH = (1./RHLCL-1.)*QMIX/DQSSDT
+!           ELSE
+               DTRH = 0.
+!           ENDIF
+!         ENDIF   
+!         IF(ISHALL.EQ.1)IPRNT=.TRUE.
+!         IPRNT=.TRUE.
+!         IF(TLCL+DTLCL.GT.TENV)GOTO 45
+!
+trigger:  IF(TLCL+DTLCL+DTRH.LT.TENV)THEN   
+!
+! Parcel not buoyant, CYCLE back to start of trigger and evaluate next potential USL...
+!
+            CYCLE usl
+!
+          ELSE                            ! Parcel is buoyant, determine updraft
+!     
+!...CONVECTIVE TRIGGERING CRITERIA HAS BEEN SATISFIED...COMPUTE
+!...EQUIVALENT POTENTIAL TEMPERATURE
+!...(THETEU) AND VERTICAL VELOCITY OF THE RISING PARCEL AT THE LCL...
+!     
+            CALL ENVIRTHT(PMIX,TMIX,QMIX,THETEU(K),ALIQ,BLIQ,CLIQ,DLIQ)
+!
+!...modify calculation of initial parcel vertical velocity...jsk 11/26/97
+!
+            DTTOT = DTLCL+DTRH
+            IF(DTTOT.GT.1.E-4)THEN
+              GDT=2.*G*DTTOT*500./TVEN
+              WLCL=1.+0.5*SQRT(GDT)
+              WLCL = AMIN1(WLCL,3.)
+            ELSE
+              WLCL=1.
+            ENDIF
+            PLCL=P0(K)+(P0(KLCL)-P0(K))*DLP
+            WTW=WLCL*WLCL
+!
+            TVLCL=TLCL*(1.+0.608*QMIX)
+            RHOLCL=PLCL/(R*TVLCL)
+!        
+            LCL=KLCL
+            LET=LCL
+! make RAD a function of background vertical velocity...
+            IF(WKL.LT.0.)THEN
+              RAD = 1000.
+            ELSEIF(WKL.GT.0.1)THEN
+              RAD = 2000.
+            ELSE
+              RAD = 1000.+1000*WKL/0.1
+            ENDIF
+!     
+!*******************************************************************
+!                                                                  *
+!                 COMPUTE UPDRAFT PROPERTIES                       *
+!                                                                  *
+!*******************************************************************
+!     
+!     
+!...
+!...ESTIMATE INITIAL UPDRAFT MASS FLUX (UMF(K))...
+!     
+            WU(K)=WLCL
+            AU0=0.01*DXSQ
+            UMF(K)=RHOLCL*AU0
+            VMFLCL=UMF(K)
+            UPOLD=VMFLCL
+            UPNEW=UPOLD
+!     
+!...RATIO2 IS THE DEGREE OF GLACIATION IN THE CLOUD (0 TO 1),
+!...UER IS THE ENVIR ENTRAINMENT RATE, ABE IS AVAILABLE
+!...BUOYANT ENERGY, TRPPT IS THE TOTAL RATE OF PRECIPITATION
+!...PRODUCTION...
+!     
+            RATIO2(K)=0.
+            UER(K)=0.
+            ABE=0.
+            TRPPT=0.
+            TU(K)=TLCL
+            TVU(K)=TVLCL
+            QU(K)=QMIX
+            EQFRC(K)=1.
+            QLIQ(K)=0.
+            QICE(K)=0.
+            QLQOUT(K)=0.
+            QICOUT(K)=0.
+            DETLQ(K)=0.
+            DETIC(K)=0.
+            PPTLIQ(K)=0.
+            PPTICE(K)=0.
+            IFLAG=0
+!     
+!...TTEMP IS USED DURING CALCULATION OF THE LINEAR GLACIATION
+!...PROCESS; IT IS INITIALLY SET TO THE TEMPERATURE AT WHICH
+!...FREEZING IS SPECIFIED TO BEGIN.  WITHIN THE GLACIATION
+!...INTERVAL, IT IS SET EQUAL TO THE UPDRAFT TEMP AT THE
+!...PREVIOUS MODEL LEVEL...
+!     
+            TTEMP=TTFRZ
+!     
+!...ENTER THE LOOP FOR UPDRAFT CALCULATIONS...CALCULATE UPDRAFT TEMP,
+!...MIXING RATIO, VERTICAL MASS FLUX, LATERAL DETRAINMENT OF MASS AND
+!...MOISTURE, PRECIPITATION RATES AT EACH MODEL LEVEL...
+!     
+!     
+            EE1=1.
+            UD1=0.
+            REI = 0.
+            DILBE = 0.
+updraft:    DO NK=K,KL-1
+              NK1=NK+1
+              RATIO2(NK1)=RATIO2(NK)
+              FRC1=0.
+              TU(NK1)=T0(NK1)
+              THETEU(NK1)=THETEU(NK)
+              QU(NK1)=QU(NK)
+              QLIQ(NK1)=QLIQ(NK)
+              QICE(NK1)=QICE(NK)
+              call tpmix2(p0(nk1),theteu(nk1),tu(nk1),qu(nk1),qliq(nk1),        &
+                     qice(nk1),qnewlq,qnewic,XLV1,XLV0)
+!
+!
+!...CHECK TO SEE IF UPDRAFT TEMP IS ABOVE THE TEMPERATURE AT WHICH
+!...GLACIATION IS ASSUMED TO INITIATE; IF IT IS, CALCULATE THE
+!...FRACTION OF REMAINING LIQUID WATER TO FREEZE...TTFRZ IS THE
+!...TEMP AT WHICH FREEZING BEGINS, TBFRZ THE TEMP BELOW WHICH ALL
+!...LIQUID WATER IS FROZEN AT EACH LEVEL...
+!
+              IF(TU(NK1).LE.TTFRZ)THEN
+                IF(TU(NK1).GT.TBFRZ)THEN
+                  IF(TTEMP.GT.TTFRZ)TTEMP=TTFRZ
+                  FRC1=(TTEMP-TU(NK1))/(TTEMP-TBFRZ)
+                ELSE
+                  FRC1=1.
+                  IFLAG=1
+                ENDIF
+                TTEMP=TU(NK1)
+!
+!  DETERMINE THE EFFECTS OF LIQUID WATER FREEZING WHEN TEMPERATURE
+!...IS BELOW TTFRZ...
+!
+                QFRZ = (QLIQ(NK1)+QNEWLQ)*FRC1
+                QNEWIC=QNEWIC+QNEWLQ*FRC1
+                QNEWLQ=QNEWLQ-QNEWLQ*FRC1
+                QICE(NK1) = QICE(NK1)+QLIQ(NK1)*FRC1
+                QLIQ(NK1) = QLIQ(NK1)-QLIQ(NK1)*FRC1
+                CALL DTFRZNEW(TU(NK1),P0(NK1),THETEU(NK1),QU(NK1),QFRZ,         &
+                          QICE(NK1),ALIQ,BLIQ,CLIQ,DLIQ)
+              ENDIF
+              TVU(NK1)=TU(NK1)*(1.+0.608*QU(NK1))
+!
+!  CALCULATE UPDRAFT VERTICAL VELOCITY AND PRECIPITATION FALLOUT...
+!
+              IF(NK.EQ.K)THEN
+                BE=(TVLCL+TVU(NK1))/(TVEN+TV0(NK1))-1.
+                BOTERM=2.*(Z0(NK1)-ZLCL)*G*BE/1.5
+                DZZ=Z0(NK1)-ZLCL
+              ELSE
+                BE=(TVU(NK)+TVU(NK1))/(TV0(NK)+TV0(NK1))-1.
+                BOTERM=2.*DZA(NK)*G*BE/1.5
+                DZZ=DZA(NK)
+              ENDIF
+              ENTERM=2.*REI*WTW/UPOLD
+
+              CALL CONDLOAD(QLIQ(NK1),QICE(NK1),WTW,DZZ,BOTERM,ENTERM,      &
+                        RATE,QNEWLQ,QNEWIC,QLQOUT(NK1),QICOUT(NK1),G)
+!
+!...IF VERT VELOCITY IS LESS THAN ZERO, EXIT THE UPDRAFT LOOP AND,
+!...IF CLOUD IS TALL ENOUGH, FINALIZE UPDRAFT CALCULATIONS...
+!
+              IF(WTW.LT.1.E-3)THEN
+                EXIT
+              ELSE
+                WU(NK1)=SQRT(WTW)
+              ENDIF
+!...Calculate value of THETA-E in environment to entrain into updraft...
+!
+              CALL ENVIRTHT(P0(NK1),T0(NK1),Q0(NK1),THETEE(NK1),ALIQ,BLIQ,CLIQ,DLIQ)
+!
+!...REI IS THE RATE OF ENVIRONMENTAL INFLOW...
+!
+              REI=VMFLCL*DP(NK1)*0.03/RAD
+              TVQU(NK1)=TU(NK1)*(1.+0.608*QU(NK1)-QLIQ(NK1)-QICE(NK1))
+              IF(NK.EQ.K)THEN
+                DILBE=((TVLCL+TVQU(NK1))/(TVEN+TV0(NK1))-1.)*DZZ
+              ELSE
+                DILBE=((TVQU(NK)+TVQU(NK1))/(TV0(NK)+TV0(NK1))-1.)*DZZ
+              ENDIF
+              IF(DILBE.GT.0.)ABE=ABE+DILBE*G
+!
+!...IF CLOUD PARCELS ARE VIRTUALLY COLDER THAN THE ENVIRONMENT, MINIMAL 
+!...ENTRAINMENT (0.5*REI) IS IMPOSED...
+!
+              IF(TVQU(NK1).LE.TV0(NK1))THEN    ! Entrain/Detrain IF BLOCK
+                EE2=0.5
+                UD2=1.
+                EQFRC(NK1)=0.
+              ELSE
+                LET=NK1
+                TTMP=TVQU(NK1)
+!
+!...DETERMINE THE CRITICAL MIXED FRACTION OF UPDRAFT AND ENVIRONMENTAL AIR...
+!
+                F1=0.95
+                F2=1.-F1
+                THTTMP=F1*THETEE(NK1)+F2*THETEU(NK1)
+                QTMP=F1*Q0(NK1)+F2*QU(NK1)
+                TMPLIQ=F2*QLIQ(NK1)
+                TMPICE=F2*QICE(NK1)
+                call tpmix2(p0(nk1),thttmp,ttmp,qtmp,tmpliq,tmpice,        &
+                           qnewlq,qnewic,XLV1,XLV0)
+                TU95=TTMP*(1.+0.608*QTMP-TMPLIQ-TMPICE)
+                IF(TU95.GT.TV0(NK1))THEN
+                  EE2=1.
+                  UD2=0.
+                  EQFRC(NK1)=1.0
+                ELSE
+                  F1=0.10
+                  F2=1.-F1
+                  THTTMP=F1*THETEE(NK1)+F2*THETEU(NK1)
+                  QTMP=F1*Q0(NK1)+F2*QU(NK1)
+                  TMPLIQ=F2*QLIQ(NK1)
+                  TMPICE=F2*QICE(NK1)
+                  call tpmix2(p0(nk1),thttmp,ttmp,qtmp,tmpliq,tmpice,        &
+                               qnewlq,qnewic,XLV1,XLV0)
+                  TU10=TTMP*(1.+0.608*QTMP-TMPLIQ-TMPICE)
+                  TVDIFF = ABS(TU10-TVQU(NK1))
+                  IF(TVDIFF.LT.1.e-3)THEN
+                    EE2=1.
+                    UD2=0.
+                    EQFRC(NK1)=1.0
+                  ELSE
+                    EQFRC(NK1)=(TV0(NK1)-TVQU(NK1))*F1/(TU10-TVQU(NK1))
+                    EQFRC(NK1)=AMAX1(0.0,EQFRC(NK1))
+                    EQFRC(NK1)=AMIN1(1.0,EQFRC(NK1))
+                    IF(EQFRC(NK1).EQ.1)THEN
+                      EE2=1.
+                      UD2=0.
+                    ELSEIF(EQFRC(NK1).EQ.0.)THEN
+                      EE2=0.
+                      UD2=1.
+                    ELSE
+!
+!...SUBROUTINE PROF5 INTEGRATES OVER THE GAUSSIAN DIST TO DETERMINE THE
+!   FRACTIONAL ENTRAINMENT AND DETRAINMENT RATES...
+!
+                      CALL PROF5(EQFRC(NK1),EE2,UD2)
+                    ENDIF
+                  ENDIF
+                ENDIF
+              ENDIF                            ! End of Entrain/Detrain IF BLOCK
+!
+!
+!...NET ENTRAINMENT AND DETRAINMENT RATES ARE GIVEN BY THE AVERAGE FRACTIONAL
+!   VALUES IN THE LAYER...
+!
+              EE2 = AMAX1(EE2,0.5)
+              UD2 = 1.5*UD2
+              UER(NK1)=0.5*REI*(EE1+EE2)
+              UDR(NK1)=0.5*REI*(UD1+UD2)
+!
+!...IF THE CALCULATED UPDRAFT DETRAINMENT RATE IS GREATER THAN THE TOTAL
+!   UPDRAFT MASS FLUX, ALL CLOUD MASS DETRAINS, EXIT UPDRAFT CALCULATIONS...
+!
+              IF(UMF(NK)-UDR(NK1).LT.10.)THEN
+!
+!...IF THE CALCULATED DETRAINED MASS FLUX IS GREATER THAN THE TOTAL UPD MASS
+!   FLUX, IMPOSE TOTAL DETRAINMENT OF UPDRAFT MASS AT THE PREVIOUS MODEL LVL..
+!   First, correct ABE calculation if needed...
+!
+                IF(DILBE.GT.0.)THEN
+                  ABE=ABE-DILBE*G
+                ENDIF
+                LET=NK
+!               WRITE(98,1015)P0(NK1)/100.
+                EXIT 
+              ELSE
+                EE1=EE2
+                UD1=UD2
+                UPOLD=UMF(NK)-UDR(NK1)
+                UPNEW=UPOLD+UER(NK1)
+                UMF(NK1)=UPNEW
+                DILFRC(NK1) = UPNEW/UPOLD
+!
+!...DETLQ AND DETIC ARE THE RATES OF DETRAINMENT OF LIQUID AND
+!...ICE IN THE DETRAINING UPDRAFT MASS...
+!
+                DETLQ(NK1)=QLIQ(NK1)*UDR(NK1)
+                DETIC(NK1)=QICE(NK1)*UDR(NK1)
+                QDT(NK1)=QU(NK1)
+                QU(NK1)=(UPOLD*QU(NK1)+UER(NK1)*Q0(NK1))/UPNEW
+                THETEU(NK1)=(THETEU(NK1)*UPOLD+THETEE(NK1)*UER(NK1))/UPNEW
+                QLIQ(NK1)=QLIQ(NK1)*UPOLD/UPNEW
+                QICE(NK1)=QICE(NK1)*UPOLD/UPNEW
+!
+!...PPTLIQ IS THE RATE OF GENERATION (FALLOUT) OF
+!...LIQUID PRECIP AT A GIVEN MODEL LVL, PPTICE THE SAME FOR ICE,
+!...TRPPT IS THE TOTAL RATE OF PRODUCTION OF PRECIP UP TO THE
+!...CURRENT MODEL LEVEL...
+!
+                PPTLIQ(NK1)=QLQOUT(NK1)*UMF(NK)
+                PPTICE(NK1)=QICOUT(NK1)*UMF(NK)
+!
+                TRPPT=TRPPT+PPTLIQ(NK1)+PPTICE(NK1)
+                IF(NK1.LE.KPBL)UER(NK1)=UER(NK1)+VMFLCL*DP(NK1)/DPTHMX
+              ENDIF
+!
+            END DO updraft
+!
+!...CHECK CLOUD DEPTH...IF CLOUD IS TALL ENOUGH, ESTIMATE THE EQUILIBRIU
+!   TEMPERATURE LEVEL (LET) AND ADJUST MASS FLUX PROFILE AT CLOUD TOP SO
+!   THAT MASS FLUX DECREASES TO ZERO AS A LINEAR FUNCTION OF PRESSURE BE
+!   THE LET AND CLOUD TOP...
+!     
+!...LTOP IS THE MODEL LEVEL JUST BELOW THE LEVEL AT WHICH VERTICAL VELOC
+!   FIRST BECOMES NEGATIVE...
+!     
+            LTOP=NK
+            CLDHGT(LC)=Z0(LTOP)-ZLCL 
+!
+!...Instead of using the same minimum cloud height (for deep convection)
+!...everywhere, try specifying minimum cloud depth as a function of TLCL...
+!
+!
+!
+            IF(TLCL.GT.293.)THEN
+              CHMIN = 4.E3
+            ELSEIF(TLCL.LE.293. .and. TLCL.GE.273)THEN
+              CHMIN = 2.E3 + 100.*(TLCL-273.)
+            ELSEIF(TLCL.LT.273.)THEN
+              CHMIN = 2.E3
+            ENDIF
+
+!     
+!...If cloud top height is less than the specified minimum for deep 
+!...convection, save value to consider this level as source for 
+!...shallow convection, go back up to check next level...
+!     
+!...Try specifying minimum cloud depth as a function of TLCL...
+!
+!
+!...DO NOT ALLOW ANY CLOUD FROM THIS LAYER IF:
+!
+!...            1.) if there is no CAPE, or 
+!...            2.) cloud top is at model level just above LCL, or
+!...            3.) cloud top is within updraft source layer, or
+!...            4.) cloud-top detrainment layer begins within 
+!...                updraft source layer.
+!
+            IF(LTOP.LE.KLCL .or. LTOP.LE.KPBL .or. LET+1.LE.KPBL)THEN  ! No Convection Allowed
+              CLDHGT(LC)=0.
+              DO NK=K,LTOP
+                UMF(NK)=0.
+                UDR(NK)=0.
+                UER(NK)=0.
+                DETLQ(NK)=0.
+                DETIC(NK)=0.
+                PPTLIQ(NK)=0.
+                PPTICE(NK)=0.
+              ENDDO
+!        
+            ELSEIF(CLDHGT(LC).GT.CHMIN .and. ABE.GT.1)THEN      ! Deep Convection allowed
+              ISHALL=0
+              EXIT usl
+            ELSE
+!
+!...TO DISALLOW SHALLOW CONVECTION, COMMENT OUT NEXT LINE !!!!!!!!
+              ISHALL = 1
+              IF(NU.EQ.NUCHM)THEN
+                EXIT usl               ! Shallow Convection from this layer
+              ELSE
+! Remember this layer (by virtue of non-zero CLDHGT) as potential shallow-cloud layer
+                DO NK=K,LTOP
+                  UMF(NK)=0.
+                  UDR(NK)=0.
+                  UER(NK)=0.
+                  DETLQ(NK)=0.
+                  DETIC(NK)=0.
+                  PPTLIQ(NK)=0.
+                  PPTICE(NK)=0.
+                ENDDO
+              ENDIF
+            ENDIF
+          ENDIF trigger
+        END DO usl
+    IF(ISHALL.EQ.1)THEN
+      KSTART=MAX0(KPBL,KLCL)
+      LET=KSTART
+    endif
+!     
+!...IF THE LET AND LTOP ARE THE SAME, DETRAIN ALL OF THE UPDRAFT MASS FL
+!   THIS LEVEL...
+!     
+    IF(LET.EQ.LTOP)THEN
+      UDR(LTOP)=UMF(LTOP)+UDR(LTOP)-UER(LTOP)
+      DETLQ(LTOP)=QLIQ(LTOP)*UDR(LTOP)*UPNEW/UPOLD
+      DETIC(LTOP)=QICE(LTOP)*UDR(LTOP)*UPNEW/UPOLD
+      UER(LTOP)=0.
+      UMF(LTOP)=0.
+    ELSE 
+!     
+!   BEGIN TOTAL DETRAINMENT AT THE LEVEL ABOVE THE LET...
+!     
+      DPTT=0.
+      DO NJ=LET+1,LTOP
+        DPTT=DPTT+DP(NJ)
+      ENDDO
+      DUMFDP=UMF(LET)/DPTT
+!     
+!...ADJUST MASS FLUX PROFILES, DETRAINMENT RATES, AND PRECIPITATION FALL
+!   RATES TO REFLECT THE LINEAR DECREASE IN MASS FLX BETWEEN THE LET AND
+!     
+      DO NK=LET+1,LTOP
+!
+!...entrainment is allowed at every level except for LTOP, so disallow
+!...entrainment at LTOP and adjust entrainment rates between LET and LTOP
+!...so the the dilution factor due to entyrianment is not changed but 
+!...the actual entrainment rate will change due due forced total 
+!...detrainment in this layer...
+!
+        IF(NK.EQ.LTOP)THEN
+          UDR(NK) = UMF(NK-1)
+          UER(NK) = 0.
+          DETLQ(NK) = UDR(NK)*QLIQ(NK)*DILFRC(NK)
+          DETIC(NK) = UDR(NK)*QICE(NK)*DILFRC(NK)
+        ELSE
+          UMF(NK)=UMF(NK-1)-DP(NK)*DUMFDP
+          UER(NK)=UMF(NK)*(1.-1./DILFRC(NK))
+          UDR(NK)=UMF(NK-1)-UMF(NK)+UER(NK)
+          DETLQ(NK)=UDR(NK)*QLIQ(NK)*DILFRC(NK)
+          DETIC(NK)=UDR(NK)*QICE(NK)*DILFRC(NK)
+        ENDIF
+        IF(NK.GE.LET+2)THEN
+          TRPPT=TRPPT-PPTLIQ(NK)-PPTICE(NK)
+          PPTLIQ(NK)=UMF(NK-1)*QLQOUT(NK)
+          PPTICE(NK)=UMF(NK-1)*QICOUT(NK)
+          TRPPT=TRPPT+PPTLIQ(NK)+PPTICE(NK)
+        ENDIF
+      ENDDO
+    ENDIF
+!     
+! Initialize some arrays below cloud base and above cloud top...
+!
+    DO NK=1,K
+      IF(NK.GE.LC)THEN
+        IF(NK.EQ.LC)THEN
+          UMF(NK)=VMFLCL*DP(NK)/DPTHMX
+          UER(NK)=VMFLCL*DP(NK)/DPTHMX
+        ELSEIF(NK.LE.KPBL)THEN
+          UER(NK)=VMFLCL*DP(NK)/DPTHMX
+          UMF(NK)=UMF(NK-1)+UER(NK)
+        ELSE
+          UMF(NK)=VMFLCL
+          UER(NK)=0.
+        ENDIF
+        TU(NK)=TMIX+(Z0(NK)-ZMIX)*GDRY
+        QU(NK)=QMIX
+        WU(NK)=WLCL
+      ELSE
+        TU(NK)=0.
+        QU(NK)=0.
+        UMF(NK)=0.
+        WU(NK)=0.
+        UER(NK)=0.
+      ENDIF
+      UDR(NK)=0.
+      QDT(NK)=0.
+      QLIQ(NK)=0.
+      QICE(NK)=0.
+      QLQOUT(NK)=0.
+      QICOUT(NK)=0.
+      PPTLIQ(NK)=0.
+      PPTICE(NK)=0.
+      DETLQ(NK)=0.
+      DETIC(NK)=0.
+      RATIO2(NK)=0.
+      CALL ENVIRTHT(P0(NK),T0(NK),Q0(NK),THETEE(NK),ALIQ,BLIQ,CLIQ,DLIQ)
+      EQFRC(NK)=1.0
+    ENDDO
+!     
+      LTOP1=LTOP+1
+      LTOPM1=LTOP-1
+!     
+!...DEFINE VARIABLES ABOVE CLOUD TOP...
+!     
+      DO NK=LTOP1,KX
+        UMF(NK)=0.
+        UDR(NK)=0.
+        UER(NK)=0.
+        QDT(NK)=0.
+        QLIQ(NK)=0.
+        QICE(NK)=0.
+        QLQOUT(NK)=0.
+        QICOUT(NK)=0.
+        DETLQ(NK)=0.
+        DETIC(NK)=0.
+        PPTLIQ(NK)=0.
+        PPTICE(NK)=0.
+        IF(NK.GT.LTOP1)THEN
+          TU(NK)=0.
+          QU(NK)=0.
+          WU(NK)=0.
+        ENDIF
+        THTA0(NK)=0.
+        THTAU(NK)=0.
+        EMS(NK)=0.
+        EMSD(NK)=0.
+        TG(NK)=T0(NK)
+        QG(NK)=Q0(NK)
+        QLG(NK)=0.
+        QIG(NK)=0.
+        QRG(NK)=0.
+        QSG(NK)=0.
+        OMG(NK)=0.
+      ENDDO
+        OMG(KX+1)=0.
+        DO NK=1,LTOP
+          EMS(NK)=DP(NK)*DXSQ/G
+          EMSD(NK)=1./EMS(NK)
+!     
+!...INITIALIZE SOME VARIABLES TO BE USED LATER IN THE VERT ADVECTION SCH
+!     
+          EXN(NK)=(P00/P0(NK))**(0.2854*(1.-0.28*QDT(NK)))
+          THTAU(NK)=TU(NK)*EXN(NK)
+          EXN(NK)=(P00/P0(NK))**(0.2854*(1.-0.28*Q0(NK)))
+          THTA0(NK)=T0(NK)*EXN(NK)
+          DDILFRC(NK) = 1./DILFRC(NK)
+          OMG(NK)=0.
+        ENDDO
+!     IF (XTIME.LT.10.)THEN
+!      WRITE(98,1025)KLCL,ZLCL,DTLCL,LTOP,P0(LTOP),IFLAG,
+!    * TMIX-T00,PMIX,QMIX,ABE
+!      WRITE(98,1030)P0(LET)/100.,P0(LTOP)/100.,VMFLCL,PLCL/100.,
+!    * WLCL,CLDHGT
+!     ENDIF
+!     
+!...COMPUTE CONVECTIVE TIME SCALE(TIMEC). THE MEAN WIND AT THE LCL
+!...AND MIDTROPOSPHERE IS USED.
+!     
+        WSPD(KLCL)=SQRT(U0(KLCL)*U0(KLCL)+V0(KLCL)*V0(KLCL))
+        WSPD(L5)=SQRT(U0(L5)*U0(L5)+V0(L5)*V0(L5))
+        WSPD(LTOP)=SQRT(U0(LTOP)*U0(LTOP)+V0(LTOP)*V0(LTOP))
+        VCONV=.5*(WSPD(KLCL)+WSPD(L5))
+!...for ETA model, DX is a function of location...
+!       TIMEC=DX(I,J)/VCONV
+        TIMEC=DX/VCONV
+        TADVEC=TIMEC
+        TIMEC=AMAX1(1800.,TIMEC)
+        TIMEC=AMIN1(3600.,TIMEC)
+        IF(ISHALL.EQ.1)TIMEC=2400.
+        NIC=NINT(TIMEC/DT)
+        TIMEC=FLOAT(NIC)*DT
+!     
+!...COMPUTE WIND SHEAR AND PRECIPITATION EFFICIENCY.
+!     
+        IF(WSPD(LTOP).GT.WSPD(KLCL))THEN
+          SHSIGN=1.
+        ELSE
+          SHSIGN=-1.
+        ENDIF
+        VWS=(U0(LTOP)-U0(KLCL))*(U0(LTOP)-U0(KLCL))+(V0(LTOP)-V0(KLCL))*   &
+            (V0(LTOP)-V0(KLCL))
+        VWS=1.E3*SHSIGN*SQRT(VWS)/(Z0(LTOP)-Z0(LCL))
+        PEF=1.591+VWS*(-.639+VWS*(9.53E-2-VWS*4.96E-3))
+        PEF=AMAX1(PEF,.2)
+        PEF=AMIN1(PEF,.9)
+!     
+!...PRECIPITATION EFFICIENCY IS A FUNCTION OF THE HEIGHT OF CLOUD BASE.
+!     
+        CBH=(ZLCL-Z0(1))*3.281E-3
+        IF(CBH.LT.3.)THEN
+          RCBH=.02
+        ELSE
+          RCBH=.96729352+CBH*(-.70034167+CBH*(.162179896+CBH*(-            &
+               1.2569798E-2+CBH*(4.2772E-4-CBH*5.44E-6))))
+        ENDIF
+        IF(CBH.GT.25)RCBH=2.4
+        PEFCBH=1./(1.+RCBH)
+        PEFCBH=AMIN1(PEFCBH,.9)
+!     
+!... MEAN PEF. IS USED TO COMPUTE RAINFALL.
+!     
+        PEFF=.5*(PEF+PEFCBH)
+        PEFF2 = PEFF                                ! JSK MODS
+       IF(IPRNT)THEN  
+         WRITE(98,1035)PEF,PEFCBH,LC,LET,WKL,VWS
+!       call flush(98)   
+       endif     
+!        WRITE(98,1035)PEF,PEFCBH,LC,LET,WKL,VWS
+!*****************************************************************
+!                                                                *
+!                  COMPUTE DOWNDRAFT PROPERTIES                  *
+!                                                                *
+!*****************************************************************
+!     
+!     
+       TDER=0.
+ devap:IF(ISHALL.EQ.1)THEN
+         LFS = 1
+       ELSE
+!
+!...start downdraft about 150 mb above cloud base...
+!
+!        KSTART=MAX0(KPBL,KLCL)
+!        KSTART=KPBL                                  ! Changed 7/23/99
+         KSTART=KPBL+1                                ! Changed 7/23/99
+         KLFS = LET-1
+         DO NK = KSTART+1,KL
+           DPPP = P0(KSTART)-P0(NK)
+!          IF(DPPP.GT.200.E2)THEN
+           IF(DPPP.GT.150.E2)THEN
+             KLFS = NK
+             EXIT 
+           ENDIF
+         ENDDO
+         KLFS = MIN0(KLFS,LET-1)
+         LFS = KLFS
+!
+!...if LFS is not at least 50 mb above cloud base (implying that the 
+!...level of equil temp, LET, is just above cloud base) do not allow a
+!...downdraft...
+!
+        IF((P0(KSTART)-P0(LFS)).GT.50.E2)THEN
+          THETED(LFS) = THETEE(LFS)
+          QD(LFS) = Q0(LFS)
+!
+!...call tpmix2dd to find wet-bulb temp, qv...
+!
+          call tpmix2dd(p0(lfs),theted(lfs),tz(lfs),qss,i,j)
+          THTAD(LFS)=TZ(LFS)*(P00/P0(LFS))**(0.2854*(1.-0.28*QSS))
+!     
+!...TAKE A FIRST GUESS AT THE INITIAL DOWNDRAFT MASS FLUX...
+!     
+          TVD(LFS)=TZ(LFS)*(1.+0.608*QSS)
+          RDD=P0(LFS)/(R*TVD(LFS))
+          A1=(1.-PEFF)*AU0
+          DMF(LFS)=-A1*RDD
+          DER(LFS)=DMF(LFS)
+          DDR(LFS)=0.
+          RHBAR = RH(LFS)*DP(LFS)
+          DPTT = DP(LFS)
+          DO ND = LFS-1,KSTART,-1
+            ND1 = ND+1
+            DER(ND)=DER(LFS)*EMS(ND)/EMS(LFS)
+            DDR(ND)=0.
+            DMF(ND)=DMF(ND1)+DER(ND)
+            THETED(ND)=(THETED(ND1)*DMF(ND1)+THETEE(ND)*DER(ND))/DMF(ND)
+            QD(ND)=(QD(ND1)*DMF(ND1)+Q0(ND)*DER(ND))/DMF(ND)    
+            DPTT = DPTT+DP(ND)
+            RHBAR = RHBAR+RH(ND)*DP(ND)
+          ENDDO
+          RHBAR = RHBAR/DPTT
+          DMFFRC = 2.*(1.-RHBAR)
+          DPDD = 0.
+!...Calculate melting effect
+!... first, compute total frozen precipitation generated...
+!
+          pptmlt = 0.
+          DO NK = KLCL,LTOP
+            PPTMLT = PPTMLT+PPTICE(NK)
+          ENDDO
+          if(lc.lt.ml)then
+!...For now, calculate melting effect as if DMF = -UMF at KLCL, i.e., as
+!...if DMFFRC=1.  Otherwise, for small DMFFRC, DTMELT gets too large!
+!...12/14/98 jsk...
+            DTMELT = RLF*PPTMLT/(CP*UMF(KLCL))
+          else
+            DTMELT = 0.
+          endif
+          LDT = MIN0(LFS-1,KSTART-1)
+!
+          call tpmix2dd(p0(kstart),theted(kstart),tz(kstart),qss,i,j)
+!
+          tz(kstart) = tz(kstart)-dtmelt
+          ES=ALIQ*EXP((BLIQ*TZ(KSTART)-CLIQ)/(TZ(KSTART)-DLIQ))
+          QSS=0.622*ES/(P0(KSTART)-ES)
+          THETED(KSTART)=TZ(KSTART)*(1.E5/P0(KSTART))**(0.2854*(1.-0.28*QSS))*    &
+                EXP((3374.6525/TZ(KSTART)-2.5403)*QSS*(1.+0.81*QSS))
+!....  
+          LDT = MIN0(LFS-1,KSTART-1)
+          DO ND = LDT,1,-1
+            DPDD = DPDD+DP(ND)
+            THETED(ND) = THETED(KSTART)
+            QD(ND)     = QD(KSTART)       
+!
+!...call tpmix2dd to find wet bulb temp, saturation mixing ratio...
+!
+            call tpmix2dd(p0(nd),theted(nd),tz(nd),qss,i,j)
+            qsd(nd) = qss
+!
+!...specify RH decrease of 20%/km in downdraft...
+!
+            RHH = 1.-0.2/1000.*(Z0(KSTART)-Z0(ND))
+!
+!...adjust downdraft TEMP, Q to specified RH:
+!
+            IF(RHH.LT.1.)THEN
+              DSSDT=(CLIQ-BLIQ*DLIQ)/((TZ(ND)-DLIQ)*(TZ(ND)-DLIQ))
+              RL=XLV0-XLV1*TZ(ND)
+              DTMP=RL*QSS*(1.-RHH)/(CP+RL*RHH*QSS*DSSDT)
+              T1RH=TZ(ND)+DTMP
+              ES=RHH*ALIQ*EXP((BLIQ*T1RH-CLIQ)/(T1RH-DLIQ))
+              QSRH=0.622*ES/(P0(ND)-ES)
+!
+!...CHECK TO SEE IF MIXING RATIO AT SPECIFIED RH IS LESS THAN ACTUAL
+!...MIXING RATIO...IF SO, ADJUST TO GIVE ZERO EVAPORATION...
+!
+              IF(QSRH.LT.QD(ND))THEN
+                QSRH=QD(ND)
+                T1RH=TZ(ND)+(QSS-QSRH)*RL/CP
+              ENDIF
+              TZ(ND)=T1RH
+              QSS=QSRH
+              QSD(ND) = QSS
+            ENDIF         
+            TVD(nd) = tz(nd)*(1.+0.608*qsd(nd))
+            IF(TVD(ND).GT.TV0(ND).OR.ND.EQ.1)THEN
+              LDB=ND
+              EXIT
+            ENDIF
+          ENDDO
+          IF((P0(LDB)-P0(LFS)) .gt. 50.E2)THEN   ! minimum Downdraft depth! 
+            DO ND=LDT,LDB,-1
+              ND1 = ND+1
+              DDR(ND) = -DMF(KSTART)*DP(ND)/DPDD
+              DER(ND) = 0.
+              DMF(ND) = DMF(ND1)+DDR(ND)
+              TDER=TDER+(QSD(nd)-QD(ND))*DDR(ND)
+              QD(ND)=QSD(nd)
+              THTAD(ND)=TZ(ND)*(P00/P0(ND))**(0.2854*(1.-0.28*QD(ND)))
+            ENDDO
+          ENDIF
+        ENDIF
+      ENDIF devap
+!
+!...IF DOWNDRAFT DOES NOT EVAPORATE ANY WATER FOR SPECIFIED RELATIVE
+!...HUMIDITY, NO DOWNDRAFT IS ALLOWED...
+!
+d_mf:   IF(TDER.LT.1.)THEN
+!           WRITE(98,3004)I,J 
+!3004       FORMAT(' ','No Downdraft!;  I=',I3,2X,'J=',I3,'ISHALL =',I2)
+          PPTFLX=TRPPT
+          CPR=TRPPT
+          TDER=0.
+          CNDTNF=0.
+          UPDINC=1.
+          LDB=LFS
+          DO NDK=1,LTOP
+            DMF(NDK)=0.
+            DER(NDK)=0.
+            DDR(NDK)=0.
+            THTAD(NDK)=0.
+            WD(NDK)=0.
+            TZ(NDK)=0.
+            QD(NDK)=0.
+          ENDDO
+          AINCM2=100.
+        ELSE 
+          DDINC = -DMFFRC*UMF(KLCL)/DMF(KSTART)
+          UPDINC=1.
+          IF(TDER*DDINC.GT.TRPPT)THEN
+            DDINC = TRPPT/TDER
+          ENDIF
+          TDER = TDER*DDINC
+          DO NK=LDB,LFS
+            DMF(NK)=DMF(NK)*DDINC
+            DER(NK)=DER(NK)*DDINC
+            DDR(NK)=DDR(NK)*DDINC
+          ENDDO
+         CPR=TRPPT
+         PPTFLX = TRPPT-TDER
+         PEFF=PPTFLX/TRPPT
+         IF(IPRNT)THEN
+           write(98,*)'PRECIP EFFICIENCY =',PEFF
+!          call flush(98)   
+         ENDIF
+!
+!
+!...ADJUST UPDRAFT MASS FLUX, MASS DETRAINMENT RATE, AND LIQUID WATER AN
+!   DETRAINMENT RATES TO BE CONSISTENT WITH THE TRANSFER OF THE ESTIMATE
+!   FROM THE UPDRAFT TO THE DOWNDRAFT AT THE LFS...
+!     
+!         DO NK=LC,LFS
+!           UMF(NK)=UMF(NK)*UPDINC
+!           UDR(NK)=UDR(NK)*UPDINC
+!           UER(NK)=UER(NK)*UPDINC
+!           PPTLIQ(NK)=PPTLIQ(NK)*UPDINC
+!           PPTICE(NK)=PPTICE(NK)*UPDINC
+!           DETLQ(NK)=DETLQ(NK)*UPDINC
+!           DETIC(NK)=DETIC(NK)*UPDINC
+!         ENDDO
+!     
+!...ZERO OUT THE ARRAYS FOR DOWNDRAFT DATA AT LEVELS ABOVE AND BELOW THE
+!...DOWNDRAFT...
+!     
+         IF(LDB.GT.1)THEN
+           DO NK=1,LDB-1
+             DMF(NK)=0.
+             DER(NK)=0.
+             DDR(NK)=0.
+             WD(NK)=0.
+             TZ(NK)=0.
+             QD(NK)=0.
+             THTAD(NK)=0.
+           ENDDO
+         ENDIF
+         DO NK=LFS+1,KX
+           DMF(NK)=0.
+           DER(NK)=0.
+           DDR(NK)=0.
+           WD(NK)=0.
+           TZ(NK)=0.
+           QD(NK)=0.
+           THTAD(NK)=0.
+         ENDDO
+         DO NK=LDT+1,LFS-1
+           TZ(NK)=0.
+           QD(NK)=0.
+           THTAD(NK)=0.
+         ENDDO
+       ENDIF d_mf
+!
+!...SET LIMITS ON THE UPDRAFT AND DOWNDRAFT MASS FLUXES SO THAT THE INFL
+!   INTO CONVECTIVE DRAFTS FROM A GIVEN LAYER IS NO MORE THAN IS AVAILAB
+!   IN THAT LAYER INITIALLY...
+!     
+       AINCMX=1000.
+       LMAX=MAX0(KLCL,LFS)
+       DO NK=LC,LMAX
+         IF((UER(NK)-DER(NK)).GT.1.e-3)THEN
+           AINCM1=EMS(NK)/((UER(NK)-DER(NK))*TIMEC)
+           AINCMX=AMIN1(AINCMX,AINCM1)
+         ENDIF
+       ENDDO
+       AINC=1.
+       IF(AINCMX.LT.AINC)AINC=AINCMX
+!     
+!...SAVE THE RELEVENT VARIABLES FOR A UNIT UPDRAFT AND DOWNDRAFT...THEY WILL 
+!...BE ITERATIVELY ADJUSTED BY THE FACTOR AINC TO SATISFY THE STABILIZATION
+!...CLOSURE...
+!     
+       TDER2=TDER
+       PPTFL2=PPTFLX
+       DO NK=1,LTOP
+         DETLQ2(NK)=DETLQ(NK)
+         DETIC2(NK)=DETIC(NK)
+         UDR2(NK)=UDR(NK)
+         UER2(NK)=UER(NK)
+         DDR2(NK)=DDR(NK)
+         DER2(NK)=DER(NK)
+         UMF2(NK)=UMF(NK)
+         DMF2(NK)=DMF(NK)
+       ENDDO
+       FABE=1.
+       STAB=0.95
+       NOITR=0
+       ISTOP=0
+!
+        IF(ISHALL.EQ.1)THEN                              ! First for shallow convection
+!
+! No iteration for shallow convection; if turbulent kinetic energy (TKE) is available
+! from a turbulence parameterization, scale cloud-base updraft mass flux as a function
+! of TKE, but for now, just specify shallow-cloud mass flux using TKEMAX = 5...
+!
+!...find the maximum TKE value between LC and KLCL...
+!         TKEMAX = 0.
+          TKEMAX = 5.
+!          DO 173 K = LC,KLCL
+!            NK = KX-K+1
+!            TKEMAX = AMAX1(TKEMAX,Q2(I,J,NK))
+! 173      CONTINUE
+!          TKEMAX = AMIN1(TKEMAX,10.)
+!          TKEMAX = AMAX1(TKEMAX,5.)
+!c         TKEMAX = 10.
+!c...3_24_99...DPMIN was changed for shallow convection so that it is the
+!c...          the same as for deep convection (5.E3).  Since this doubles
+!c...          (roughly) the value of DPTHMX, add a factor of 0.5 to calcu-
+!c...          lation of EVAC...
+!c         EVAC  = TKEMAX*0.1
+          EVAC  = 0.5*TKEMAX*0.1
+!         AINC = 0.1*DPTHMX*DXIJ*DXIJ/(VMFLCL*G*TIMEC)
+!          AINC = EVAC*DPTHMX*DX(I,J)*DX(I,J)/(VMFLCL*G*TIMEC)
+          AINC = EVAC*DPTHMX*DXSQ/(VMFLCL*G*TIMEC)
+          TDER=TDER2*AINC
+          PPTFLX=PPTFL2*AINC
+          DO NK=1,LTOP
+            UMF(NK)=UMF2(NK)*AINC
+            DMF(NK)=DMF2(NK)*AINC
+            DETLQ(NK)=DETLQ2(NK)*AINC
+            DETIC(NK)=DETIC2(NK)*AINC
+            UDR(NK)=UDR2(NK)*AINC
+            UER(NK)=UER2(NK)*AINC
+            DER(NK)=DER2(NK)*AINC
+            DDR(NK)=DDR2(NK)*AINC
+          ENDDO
+        ENDIF                                           ! Otherwise for deep convection
+! use iterative procedure to find mass fluxes...
+iter:     DO NCOUNT=1,10
+!     
+!*****************************************************************
+!                                                                *
+!           COMPUTE PROPERTIES FOR COMPENSATIONAL SUBSIDENCE     *
+!                                                                *
+!*****************************************************************
+!     
+!...DETERMINE OMEGA VALUE NECESSARY AT TOP AND BOTTOM OF EACH LAYER TO
+!...SATISFY MASS CONTINUITY...
+!     
+            DTT=TIMEC
+            DO NK=1,LTOP
+              DOMGDP(NK)=-(UER(NK)-DER(NK)-UDR(NK)-DDR(NK))*EMSD(NK)
+              IF(NK.GT.1)THEN
+                OMG(NK)=OMG(NK-1)-DP(NK-1)*DOMGDP(NK-1)
+                ABSOMG = ABS(OMG(NK))
+                ABSOMGTC = ABSOMG*TIMEC
+                FRDP = 0.75*DP(NK-1)
+                IF(ABSOMGTC.GT.FRDP)THEN
+                  DTT1 = FRDP/ABSOMG
+                  DTT=AMIN1(DTT,DTT1)
+                ENDIF
+              ENDIF
+            ENDDO
+            DO NK=1,LTOP
+              THPA(NK)=THTA0(NK)
+              QPA(NK)=Q0(NK)
+              NSTEP=NINT(TIMEC/DTT+1)
+              DTIME=TIMEC/FLOAT(NSTEP)
+              FXM(NK)=OMG(NK)*DXSQ/G
+            ENDDO
+!     
+!...DO AN UPSTREAM/FORWARD-IN-TIME ADVECTION OF THETA, QV...
+!     
+        DO NTC=1,NSTEP
+!     
+!...ASSIGN THETA AND Q VALUES AT THE TOP AND BOTTOM OF EACH LAYER BASED
+!...SIGN OF OMEGA...
+!     
+            DO  NK=1,LTOP
+              THFXIN(NK)=0.
+              THFXOUT(NK)=0.
+              QFXIN(NK)=0.
+              QFXOUT(NK)=0.
+            ENDDO
+            DO NK=2,LTOP
+              IF(OMG(NK).LE.0.)THEN
+                THFXIN(NK)=-FXM(NK)*THPA(NK-1)
+                QFXIN(NK)=-FXM(NK)*QPA(NK-1)
+                THFXOUT(NK-1)=THFXOUT(NK-1)+THFXIN(NK)
+                QFXOUT(NK-1)=QFXOUT(NK-1)+QFXIN(NK)
+              ELSE
+                THFXOUT(NK)=FXM(NK)*THPA(NK)
+                QFXOUT(NK)=FXM(NK)*QPA(NK)
+                THFXIN(NK-1)=THFXIN(NK-1)+THFXOUT(NK)
+                QFXIN(NK-1)=QFXIN(NK-1)+QFXOUT(NK)
+              ENDIF
+            ENDDO
+!     
+!...UPDATE THE THETA AND QV VALUES AT EACH LEVEL...
+!     
+            DO NK=1,LTOP
+              THPA(NK)=THPA(NK)+(THFXIN(NK)+UDR(NK)*THTAU(NK)+DDR(NK)*      &
+                       THTAD(NK)-THFXOUT(NK)-(UER(NK)-DER(NK))*THTA0(NK))*  &
+                       DTIME*EMSD(NK)
+              QPA(NK)=QPA(NK)+(QFXIN(NK)+UDR(NK)*QDT(NK)+DDR(NK)*QD(NK)-    &
+                      QFXOUT(NK)-(UER(NK)-DER(NK))*Q0(NK))*DTIME*EMSD(NK)
+            ENDDO   
+          ENDDO   
+          DO NK=1,LTOP
+            THTAG(NK)=THPA(NK)
+            QG(NK)=QPA(NK)
+          ENDDO
+!     
+!...CHECK TO SEE IF MIXING RATIO DIPS BELOW ZERO ANYWHERE;  IF SO, BORRO
+!...MOISTURE FROM ADJACENT LAYERS TO BRING IT BACK UP ABOVE ZERO...
+!     
+        DO NK=1,LTOP
+          IF(QG(NK).LT.0.)THEN
+            IF(NK.EQ.1)THEN                             ! JSK MODS
+!              PRINT *,' PROBLEM WITH KF SCHEME:  ' ! JSK MODS
+!              PRINT *,'QG = 0 AT THE SURFACE!!!!!!!'    ! JSK MODS
+!!              CALL wrf_error_fatal ( 'QG, QG(NK).LT.0') ! JSK MODS
+            ENDIF                                       ! JSK MODS
+            NK1=NK+1
+            IF(NK.EQ.LTOP)THEN
+              NK1=KLCL
+            ENDIF
+            TMA=QG(NK1)*EMS(NK1)
+            TMB=QG(NK-1)*EMS(NK-1)
+            TMM=(QG(NK)-1.E-9)*EMS(NK  )
+            BCOEFF=-TMM/((TMA*TMA)/TMB+TMB)
+            ACOEFF=BCOEFF*TMA/TMB
+            TMB=TMB*(1.-BCOEFF)
+            TMA=TMA*(1.-ACOEFF)
+            IF(NK.EQ.LTOP)THEN
+              QVDIFF=(QG(NK1)-TMA*EMSD(NK1))*100./QG(NK1)
+!              IF(ABS(QVDIFF).GT.1.)THEN
+!             PRINT *,'!!!WARNING!!! CLOUD BASE WATER VAPOR CHANGES BY ',     &
+!                      QVDIFF,                                                &
+!                     '% WHEN MOISTURE IS BORROWED TO PREVENT NEGATIVE ',     &
+!                     'VALUES IN KAIN-FRITSCH'
+!              ENDIF
+            ENDIF
+            QG(NK)=1.E-9
+            QG(NK1)=TMA*EMSD(NK1)
+            QG(NK-1)=TMB*EMSD(NK-1)
+          ENDIF
+        ENDDO
+        TOPOMG=(UDR(LTOP)-UER(LTOP))*DP(LTOP)*EMSD(LTOP)
+        IF(ABS(TOPOMG-OMG(LTOP)).GT.1.E-3)THEN
+!       WRITE(99,*)'ERROR:  MASS DOES NOT BALANCE IN KF SCHEME;            &
+!      TOPOMG, OMG =',TOPOMG,OMG(LTOP)
+!      TOPOMG, OMG =',TOPOMG,OMG(LTOP)
+          ISTOP=1
+          IPRNT=.TRUE.
+          EXIT iter
+        ENDIF
+!     
+!...CONVERT THETA TO T...
+!     
+        DO NK=1,LTOP
+          EXN(NK)=(P00/P0(NK))**(0.2854*(1.-0.28*QG(NK)))
+          TG(NK)=THTAG(NK)/EXN(NK)
+          TVG(NK)=TG(NK)*(1.+0.608*QG(NK))
+        ENDDO
+        IF(ISHALL.EQ.1)THEN
+          EXIT iter
+        ENDIF
+!     
+!*******************************************************************
+!                                                                  *
+!     COMPUTE NEW CLOUD AND CHANGE IN AVAILABLE BUOYANT ENERGY.    *
+!                                                                  *
+!*******************************************************************
+!     
+!...THE FOLLOWING COMPUTATIONS ARE SIMILAR TO THAT FOR UPDRAFT
+!     
+!        THMIX=0.
+          TMIX=0.
+          QMIX=0.
+!
+!...FIND THE THERMODYNAMIC CHARACTERISTICS OF THE LAYER BY
+!...MASS-WEIGHTING THE CHARACTERISTICS OF THE INDIVIDUAL MODEL
+!...LAYERS...
+!
+          DO NK=LC,KPBL
+            TMIX=TMIX+DP(NK)*TG(NK)
+            QMIX=QMIX+DP(NK)*QG(NK)  
+          ENDDO
+          TMIX=TMIX/DPTHMX
+          QMIX=QMIX/DPTHMX
+          ES=ALIQ*EXP((TMIX*BLIQ-CLIQ)/(TMIX-DLIQ))
+          QSS=0.622*ES/(PMIX-ES)
+!     
+!...REMOVE SUPERSATURATION FOR DIAGNOSTIC PURPOSES, IF NECESSARY...
+!     
+          IF(QMIX.GT.QSS)THEN
+            RL=XLV0-XLV1*TMIX
+            CPM=CP*(1.+0.887*QMIX)
+            DSSDT=QSS*(CLIQ-BLIQ*DLIQ)/((TMIX-DLIQ)*(TMIX-DLIQ))
+            DQ=(QMIX-QSS)/(1.+RL*DSSDT/CPM)
+            TMIX=TMIX+RL/CP*DQ
+            QMIX=QMIX-DQ
+            TLCL=TMIX
+          ELSE
+            QMIX=AMAX1(QMIX,0.)
+            EMIX=QMIX*PMIX/(0.622+QMIX)
+            astrt=1.e-3
+            binc=0.075
+            a1=emix/aliq
+            tp=(a1-astrt)/binc
+            indlu=int(tp)+1
+            value=(indlu-1)*binc+astrt
+            aintrp=(a1-value)/binc
+            tlog=aintrp*alu(indlu+1)+(1-aintrp)*alu(indlu)
+            TDPT=(CLIQ-DLIQ*TLOG)/(BLIQ-TLOG)
+            TLCL=TDPT-(.212+1.571E-3*(TDPT-T00)-4.36E-4*(TMIX-T00))*(TMIX-TDPT)
+            TLCL=AMIN1(TLCL,TMIX)
+          ENDIF
+          TVLCL=TLCL*(1.+0.608*QMIX)
+          ZLCL = ZMIX+(TLCL-TMIX)/GDRY
+          DO NK = LC,KL
+            KLCL=NK
+            IF(ZLCL.LE.Z0(NK))THEN
+              EXIT 
+            ENDIF
+          ENDDO
+          K=KLCL-1
+          DLP=(ZLCL-Z0(K))/(Z0(KLCL)-Z0(K))
+!     
+!...ESTIMATE ENVIRONMENTAL TEMPERATURE AND MIXING RATIO AT THE LCL...
+!     
+          TENV=TG(K)+(TG(KLCL)-TG(K))*DLP
+          QENV=QG(K)+(QG(KLCL)-QG(K))*DLP
+          TVEN=TENV*(1.+0.608*QENV)
+          PLCL=P0(K)+(P0(KLCL)-P0(K))*DLP
+          THETEU(K)=TMIX*(1.E5/PMIX)**(0.2854*(1.-0.28*QMIX))*             &
+                  EXP((3374.6525/TLCL-2.5403)*QMIX*(1.+0.81*QMIX))
+!     
+!...COMPUTE ADJUSTED ABE(ABEG).
+!     
+          ABEG=0.
+          DO NK=K,LTOPM1
+            NK1=NK+1
+            THETEU(NK1) = THETEU(NK)
+!
+            call tpmix2dd(p0(nk1),theteu(nk1),tgu(nk1),qgu(nk1),i,j)
+!
+            TVQU(NK1)=TGU(NK1)*(1.+0.608*QGU(NK1)-QLIQ(NK1)-QICE(NK1))
+            IF(NK.EQ.K)THEN
+              DZZ=Z0(KLCL)-ZLCL
+              DILBE=((TVLCL+TVQU(NK1))/(TVEN+TVG(NK1))-1.)*DZZ
+            ELSE
+              DZZ=DZA(NK)
+              DILBE=((TVQU(NK)+TVQU(NK1))/(TVG(NK)+TVG(NK1))-1.)*DZZ
+            ENDIF
+            IF(DILBE.GT.0.)ABEG=ABEG+DILBE*G
+!
+!...DILUTE BY ENTRAINMENT BY THE RATE AS ORIGINAL UPDRAFT...
+!
+            CALL ENVIRTHT(P0(NK1),TG(NK1),QG(NK1),THTEEG(NK1),ALIQ,BLIQ,CLIQ,DLIQ)
+            THETEU(NK1)=THETEU(NK1)*DDILFRC(NK1)+THTEEG(NK1)*(1.-DDILFRC(NK1))
+          ENDDO
+!     
+!...ASSUME AT LEAST 90% OF CAPE (ABE) IS REMOVED BY CONVECTION DURING
+!...THE PERIOD TIMEC...
+!     
+          IF(NOITR.EQ.1)THEN
+!         write(98,*)' '
+!         write(98,*)'TAU, I, J, =',NTSD,I,J
+!         WRITE(98,1060)FABE
+!          GOTO 265
+          EXIT iter
+          ENDIF
+          DABE=AMAX1(ABE-ABEG,0.1*ABE)
+          FABE=ABEG/ABE
+          IF(FABE.GT.1. .and. ISHALL.EQ.0)THEN
+!          WRITE(98,*)'UPDRAFT/DOWNDRAFT COUPLET INCREASES CAPE AT THIS
+!     *GRID POINT; NO CONVECTION ALLOWED!'
+            RETURN  
+          ENDIF
+          IF(NCOUNT.NE.1)THEN
+            IF(ABS(AINC-AINCOLD).LT.0.0001)THEN
+              NOITR=1
+              AINC=AINCOLD
+              CYCLE iter
+            ENDIF
+            DFDA=(FABE-FABEOLD)/(AINC-AINCOLD)
+            IF(DFDA.GT.0.)THEN
+              NOITR=1
+              AINC=AINCOLD
+              CYCLE iter
+            ENDIF
+          ENDIF
+          AINCOLD=AINC
+          FABEOLD=FABE
+          IF(AINC/AINCMX.GT.0.999.AND.FABE.GT.1.05-STAB)THEN
+!           write(98,*)' '
+!           write(98,*)'TAU, I, J, =',NTSD,I,J
+!           WRITE(98,1055)FABE
+!            GOTO 265
+            EXIT
+          ENDIF
+          IF((FABE.LE.1.05-STAB.AND.FABE.GE.0.95-STAB) .or. NCOUNT.EQ.10)THEN
+            EXIT iter
+          ELSE
+            IF(NCOUNT.GT.10)THEN
+!             write(98,*)' '
+!             write(98,*)'TAU, I, J, =',NTSD,I,J
+!             WRITE(98,1060)FABE
+!             GOTO 265
+              EXIT
+            ENDIF
+!     
+!...IF MORE THAN 10% OF THE ORIGINAL CAPE REMAINS, INCREASE THE CONVECTI
+!...MASS FLUX BY THE FACTOR AINC:
+!     
+            IF(FABE.EQ.0.)THEN
+              AINC=AINC*0.5
+            ELSE
+              IF(DABE.LT.1.e-4)THEN
+                NOITR=1
+                AINC=AINCOLD
+                CYCLE iter
+              ELSE
+                AINC=AINC*STAB*ABE/DABE
+              ENDIF
+            ENDIF
+!           AINC=AMIN1(AINCMX,AINC)
+            AINC=AMIN1(AINCMX,AINC)
+!...IF AINC BECOMES VERY SMALL, EFFECTS OF CONVECTION ! JSK MODS
+!...WILL BE MINIMAL SO JUST IGNORE IT...              ! JSK MODS
+            IF(AINC.LT.0.05)then
+              RETURN                          ! JSK MODS
+            ENDIF
+!            AINC=AMAX1(AINC,0.05)                        ! JSK MODS
+            TDER=TDER2*AINC
+            PPTFLX=PPTFL2*AINC
+!           IF (XTIME.LT.10.)THEN
+!           WRITE(98,1080)LFS,LDB,LDT,TIMEC,TADVEC,NSTEP,NCOUNT,
+!          *              FABEOLD,AINCOLD 
+!           ENDIF
+            DO NK=1,LTOP
+              UMF(NK)=UMF2(NK)*AINC
+              DMF(NK)=DMF2(NK)*AINC
+              DETLQ(NK)=DETLQ2(NK)*AINC
+              DETIC(NK)=DETIC2(NK)*AINC
+              UDR(NK)=UDR2(NK)*AINC
+              UER(NK)=UER2(NK)*AINC
+              DER(NK)=DER2(NK)*AINC
+              DDR(NK)=DDR2(NK)*AINC
+            ENDDO
+!     
+!...GO BACK UP FOR ANOTHER ITERATION...
+!     
+          ENDIF
+        ENDDO iter
+!     
+!...COMPUTE HYDROMETEOR TENDENCIES AS IS DONE FOR T, QV...
+!     
+!...FRC2 IS THE FRACTION OF TOTAL CONDENSATE      !  PPT FB MODS
+!...GENERATED THAT GOES INTO PRECIPITIATION       !  PPT FB MODS
+!
+!  Redistribute hydormeteors according to the final mass-flux values:
+!
+        IF(CPR.GT.0.)THEN 
+          FRC2=PPTFLX/(CPR*AINC)                    !  PPT FB MODS
+        ELSE
+           FRC2=0.
+        ENDIF
+        DO NK=1,LTOP
+          QLPA(NK)=QL0(NK)
+          QIPA(NK)=QI0(NK)
+          QRPA(NK)=QR0(NK)
+          QSPA(NK)=QS0(NK)
+          RAINFB(NK)=PPTLIQ(NK)*AINC*FBFRC*FRC2   !  PPT FB MODS
+          SNOWFB(NK)=PPTICE(NK)*AINC*FBFRC*FRC2   !  PPT FB MODS
+        ENDDO
+        DO NTC=1,NSTEP
+!     
+!...ASSIGN HYDROMETEORS CONCENTRATIONS AT THE TOP AND BOTTOM OF EACH LAY
+!...BASED ON THE SIGN OF OMEGA...
+!     
+          DO NK=1,LTOP
+            QLFXIN(NK)=0.
+            QLFXOUT(NK)=0.
+            QIFXIN(NK)=0.
+            QIFXOUT(NK)=0.
+            QRFXIN(NK)=0.
+            QRFXOUT(NK)=0.
+            QSFXIN(NK)=0.
+            QSFXOUT(NK)=0.
+          ENDDO   
+          DO NK=2,LTOP
+            IF(OMG(NK).LE.0.)THEN
+              QLFXIN(NK)=-FXM(NK)*QLPA(NK-1)
+              QIFXIN(NK)=-FXM(NK)*QIPA(NK-1)
+              QRFXIN(NK)=-FXM(NK)*QRPA(NK-1)
+              QSFXIN(NK)=-FXM(NK)*QSPA(NK-1)
+              QLFXOUT(NK-1)=QLFXOUT(NK-1)+QLFXIN(NK)
+              QIFXOUT(NK-1)=QIFXOUT(NK-1)+QIFXIN(NK)
+              QRFXOUT(NK-1)=QRFXOUT(NK-1)+QRFXIN(NK)
+              QSFXOUT(NK-1)=QSFXOUT(NK-1)+QSFXIN(NK)
+            ELSE
+              QLFXOUT(NK)=FXM(NK)*QLPA(NK)
+              QIFXOUT(NK)=FXM(NK)*QIPA(NK)
+              QRFXOUT(NK)=FXM(NK)*QRPA(NK)
+              QSFXOUT(NK)=FXM(NK)*QSPA(NK)
+              QLFXIN(NK-1)=QLFXIN(NK-1)+QLFXOUT(NK)
+              QIFXIN(NK-1)=QIFXIN(NK-1)+QIFXOUT(NK)
+              QRFXIN(NK-1)=QRFXIN(NK-1)+QRFXOUT(NK)
+              QSFXIN(NK-1)=QSFXIN(NK-1)+QSFXOUT(NK)
+            ENDIF
+          ENDDO   
+!     
+!...UPDATE THE HYDROMETEOR CONCENTRATION VALUES AT EACH LEVEL...
+!     
+          DO NK=1,LTOP
+            QLPA(NK)=QLPA(NK)+(QLFXIN(NK)+DETLQ(NK)-QLFXOUT(NK))*DTIME*EMSD(NK)
+            QIPA(NK)=QIPA(NK)+(QIFXIN(NK)+DETIC(NK)-QIFXOUT(NK))*DTIME*EMSD(NK)
+            QRPA(NK)=QRPA(NK)+(QRFXIN(NK)-QRFXOUT(NK)+RAINFB(NK))*DTIME*EMSD(NK)         !  PPT FB MODS
+            QSPA(NK)=QSPA(NK)+(QSFXIN(NK)-QSFXOUT(NK)+SNOWFB(NK))*DTIME*EMSD(NK)         !  PPT FB MODS
+          ENDDO     
+        ENDDO
+        DO NK=1,LTOP
+          QLG(NK)=QLPA(NK)
+          QIG(NK)=QIPA(NK)
+          QRG(NK)=QRPA(NK)
+          QSG(NK)=QSPA(NK)
+        ENDDO   
+!
+!...CLEAN THINGS UP, CALCULATE CONVECTIVE FEEDBACK TENDENCIES FOR THIS
+!...GRID POINT...
+!     
+!     IF (XTIME.LT.10.)THEN
+!     WRITE(98,1080)LFS,LDB,LDT,TIMEC,TADVEC,NSTEP,NCOUNT,FABE,AINC 
+!     ENDIF
+       IF(IPRNT)THEN  
+         WRITE(98,1080)LFS,LDB,LDT,TIMEC,TADVEC,NSTEP,NCOUNT,FABE,AINC
+!        call flush(98)   
+       endif  
+!     
+!...SEND FINAL PARAMETERIZED VALUES TO OUTPUT FILES...
+!     
+!297   IF(IPRNT)then 
+       IF(IPRNT)then 
+!    if(I.eq.16 .and. J.eq.41)then
+!      IF(ISTOP.EQ.1)THEN
+         write(98,*)
+!        write(98,*)'At t(h), I, J =',float(NTSD)*72./3600.,I,J
+         write(98,*)'P(LC), DTP, WKL, WKLCL =',p0(LC)/100.,       &
+                     TLCL+DTLCL+dtrh-TENV,WKL,WKLCL
+         write(98,*)'TLCL, DTLCL, DTRH, TENV =',TLCL,DTLCL,       &
+                      DTRH,TENV   
+         WRITE(98,1025)KLCL,ZLCL,DTLCL,LTOP,P0(LTOP),IFLAG,       &
+         TMIX-T00,PMIX,QMIX,ABE
+         WRITE(98,1030)P0(LET)/100.,P0(LTOP)/100.,VMFLCL,PLCL/100.,  &
+         WLCL,CLDHGT(LC)
+         WRITE(98,1035)PEF,PEFCBH,LC,LET,WKL,VWS 
+         write(98,*)'PRECIP EFFICIENCY =',PEFF 
+      WRITE(98,1080)LFS,LDB,LDT,TIMEC,TADVEC,NSTEP,NCOUNT,FABE,AINC
+!      ENDIF
+!!!!! HERE !!!!!!!
+           WRITE(98,1070)'  P  ','   DP ',' DT K/D ',' DR K/D ','   OMG  ',        &
+          ' DOMGDP ','   UMF  ','   UER  ','   UDR  ','   DMF  ','   DER  '        &
+          ,'   DDR  ','   EMS  ','    W0  ','  DETLQ ',' DETIC '
+           write(98,*)'just before DO 300...'
+!          call flush(98)
+           DO NK=1,LTOP
+             K=LTOP-NK+1
+             DTT=(TG(K)-T0(K))*86400./TIMEC
+             RL=XLV0-XLV1*TG(K)
+             DR=-(QG(K)-Q0(K))*RL*86400./(TIMEC*CP)
+             UDFRC=UDR(K)*TIMEC*EMSD(K)
+             UEFRC=UER(K)*TIMEC*EMSD(K)
+             DDFRC=DDR(K)*TIMEC*EMSD(K)
+             DEFRC=-DER(K)*TIMEC*EMSD(K)
+             WRITE(98,1075)P0(K)/100.,DP(K)/100.,DTT,DR,OMG(K),DOMGDP(K)*1.E4,       &
+             UMF(K)/1.E6,UEFRC,UDFRC,DMF(K)/1.E6,DEFRC,DDFRC,EMS(K)/1.E11,           &
+             W0AVG1D(K)*1.E2,DETLQ(K)*TIMEC*EMSD(K)*1.E3,DETIC(K)*                   &
+             TIMEC*EMSD(K)*1.E3
+           ENDDO
+           WRITE(98,1085)'K','P','Z','T0','TG','DT','TU','TD','Q0','QG',             &
+                  'DQ','QU','QD','QLG','QIG','QRG','QSG','RH0','RHG'
+           DO NK=1,KL
+             K=KX-NK+1
+             DTT=TG(K)-T0(K)
+             TUC=TU(K)-T00
+             IF(K.LT.LC.OR.K.GT.LTOP)TUC=0.
+             TDC=TZ(K)-T00
+             IF((K.LT.LDB.OR.K.GT.LDT).AND.K.NE.LFS)TDC=0.
+             IF(T0(K).LT.T00)THEN
+               ES=ALIQ*EXP((BLIQ*TG(K)-CLIQ)/(TG(K)-DLIQ))
+             ELSE
+               ES=ALIQ*EXP((BLIQ*TG(K)-CLIQ)/(TG(K)-DLIQ))
+             ENDIF  
+             QGS=ES*0.622/(P0(K)-ES)
+             RH0=Q0(K)/QES(K)
+             RHG=QG(K)/QGS
+             WRITE(98,1090)K,P0(K)/100.,Z0(K),T0(K)-T00,TG(K)-T00,DTT,TUC,            &
+             TDC,Q0(K)*1000.,QG(K)*1000.,(QG(K)-Q0(K))*1000.,QU(K)*                   &
+             1000.,QD(K)*1000.,QLG(K)*1000.,QIG(K)*1000.,QRG(K)*1000.,                &
+             QSG(K)*1000.,RH0,RHG
+           ENDDO
+!     
+!...IF CALCULATIONS ABOVE SHOW AN ERROR IN THE MASS BUDGET, PRINT OUT A
+!...TO BE USED LATER FOR DIAGNOSTIC PURPOSES, THEN ABORT RUN...
+!     
+!         IF(ISTOP.EQ.1 .or. ISHALL.EQ.1)THEN
+
+!         IF(ISHALL.NE.1)THEN
+!            write(98,4421)i,j,iyr,imo,idy,ihr,imn
+!           write(98)i,j,iyr,imo,idy,ihr,imn,kl
+! 4421       format(7i4)
+!            write(98,4422)kl
+! 4422       format(i6) 
+            DO 310 NK = 1,KL
+              k = kl - nk + 1
+              write(98,4455) p0(k)/100.,t0(k)-273.16,q0(k)*1000.,       &
+                       u0(k),v0(k),W0AVG1D(K),dp(k),tke(k)
+!             write(98) p0,t0,q0,u0,v0,w0,dp,tke
+!           WRITE(98,1115)Z0(K),P0(K)/100.,T0(K)-273.16,Q0(K)*1000.,
+!    *               U0(K),V0(K),DP(K)/100.,W0AVG(I,J,K)
+ 310        CONTINUE
+            IF(ISTOP.EQ.1)THEN
+!!              CALL wrf_error_fatal ( 'KAIN-FRITSCH, istop=1, diags' )
+            ENDIF
+!         ENDIF
+  4455  format(8f11.3) 
+       ENDIF
+        CNDTNF=(1.-EQFRC(LFS))*(QLIQ(LFS)+QICE(LFS))*DMF(LFS)
+        RAINCV(I,J)=DT*PPTFLX*(1.-FBFRC)/DXSQ     !  PPT FB MODS
+!        RAINCV(I,J)=.1*.5*DT*PPTFLX/DXSQ               !  PPT FB MODS
+!         RNC=0.1*TIMEC*PPTFLX/DXSQ
+        RNC=RAINCV(I,J)*NIC
+       IF(ISHALL.EQ.0.AND.IPRNT)write (98,909)I,J,RNC
+
+!     WRITE(98,1095)CPR*AINC,TDER+PPTFLX+CNDTNF
+!     
+!  EVALUATE MOISTURE BUDGET...
+!     
+
+        QINIT=0.
+        QFNL=0.
+        DPT=0.
+        DO 315 NK=1,LTOP
+          DPT=DPT+DP(NK)
+          QINIT=QINIT+Q0(NK)*EMS(NK)
+          QFNL=QFNL+QG(NK)*EMS(NK)
+          QFNL=QFNL+(QLG(NK)+QIG(NK)+QRG(NK)+QSG(NK))*EMS(NK)
+  315   CONTINUE
+        QFNL=QFNL+PPTFLX*TIMEC*(1.-FBFRC)       !  PPT FB MODS
+!        QFNL=QFNL+PPTFLX*TIMEC                 !  PPT FB MODS
+        ERR2=(QFNL-QINIT)*100./QINIT
+       IF(IPRNT)WRITE(98,1110)QINIT,QFNL,ERR2
+      IF(ABS(ERR2).GT.0.05 .AND. ISTOP.EQ.0)THEN 
+!       write(99,*)'!!!!!!!! MOISTURE BUDGET ERROR IN KFPARA !!!'
+!       WRITE(99,1110)QINIT,QFNL,ERR2
+        IPRNT=.TRUE.
+        ISTOP=1
+            write(98,4422)kl
+ 4422       format(i6)
+            DO 311 NK = 1,KL
+              k = kl - nk + 1
+!             write(99,4455) p0(k)/100.,t0(k)-273.16,q0(k)*1000.,       &
+!                      u0(k),v0(k),W0AVG1D(K),dp(k)
+!             write(98) p0,t0,q0,u0,v0,w0,dp,tke
+!           WRITE(98,1115)P0(K)/100.,T0(K)-273.16,Q0(K)*1000.,          &
+!                    U0(K),V0(K),W0AVG1D(K),dp(k)/100.,tke(k)
+            WRITE(98,4456)P0(K)/100.,T0(K)-273.16,Q0(K)*1000.,          &
+                     U0(K),V0(K),W0AVG1D(K),dp(k)/100.,tke(k)
+ 311        CONTINUE
+!           call flush(98)
+
+!        GOTO 297
+!         STOP 'QVERR'
+      ENDIF
+ 1115 FORMAT (2X,F7.2,2X,F5.1,2X,F6.3,2(2X,F5.1),2X,F7.2,2X,F7.4)
+ 4456  format(8f12.3)
+        IF(PPTFLX.GT.0.)THEN
+          RELERR=ERR2*QINIT/(PPTFLX*TIMEC)
+        ELSE
+          RELERR=0.
+        ENDIF
+     IF(IPRNT)THEN
+        WRITE(98,1120)RELERR
+        WRITE(98,*)'TDER, CPR, TRPPT =',              &
+          TDER,CPR*AINC,TRPPT*AINC
+     ENDIF
+!     
+!...FEEDBACK TO RESOLVABLE SCALE TENDENCIES.
+!     
+!...IF THE ADVECTIVE TIME PERIOD (TADVEC) IS LESS THAN SPECIFIED MINIMUM
+!...TIMEC, ALLOW FEEDBACK TO OCCUR ONLY DURING TADVEC...
+!     
+        IF(TADVEC.LT.TIMEC)NIC=NINT(TADVEC/DT)
+        NCA(I,J)=FLOAT(NIC)
+        IF(ISHALL.EQ.1)THEN
+          TIMEC = 2400.
+          NCA(I,J) = FLOAT(NTST)
+          NSHALL = NSHALL+1
+        ENDIF 
+        DO K=1,KX
+!         IF(IMOIST(INEST).NE.2)THEN
+!
+!...IF HYDROMETEORS ARE NOT ALLOWED, THEY MUST BE EVAPORATED OR SUBLIMAT
+!...AND FED BACK AS VAPOR, ALONG WITH ASSOCIATED CHANGES IN TEMPERATURE.
+!...NOTE:  THIS WILL INTRODUCE CHANGES IN THE CONVECTIVE TEMPERATURE AND
+!...WATER VAPOR FEEDBACK TENDENCIES AND MAY LEAD TO SUPERSATURATED VALUE
+!...OF QG...
+!
+!           RLC=XLV0-XLV1*TG(K)
+!           RLS=XLS0-XLS1*TG(K)
+!           CPM=CP*(1.+0.887*QG(K))
+!           TG(K)=TG(K)-(RLC*(QLG(K)+QRG(K))+RLS*(QIG(K)+QSG(K)))/CPM
+!           QG(K)=QG(K)+(QLG(K)+QRG(K)+QIG(K)+QSG(K))
+!           DQLDT(I,J,NK)=0.
+!           DQIDT(I,J,NK)=0.
+!           DQRDT(I,J,NK)=0.
+!           DQSDT(I,J,NK)=0.
+!         ELSE
+!
+!...IF ICE PHASE IS NOT ALLOWED, MELT ALL FROZEN HYDROMETEORS...
+!
+          IF(.NOT. F_QI .and. warm_rain )THEN
+
+            CPM=CP*(1.+0.887*QG(K))
+            TG(K)=TG(K)-(QIG(K)+QSG(K))*RLF/CPM
+            DQCDT(K)=(QLG(K)+QIG(K)-QL0(K)-QI0(K))/TIMEC
+            DQIDT(K)=0.
+            DQRDT(K)=(QRG(K)+QSG(K)-QR0(K)-QS0(K))/TIMEC
+            DQSDT(K)=0.
+          ELSEIF(.NOT. F_QI .and. .not. warm_rain)THEN
+!
+!...IF ICE PHASE IS ALLOWED, BUT MIXED PHASE IS NOT, MELT FROZEN HYDROME
+!...BELOW THE MELTING LEVEL, FREEZE LIQUID WATER ABOVE THE MELTING LEVEL
+!
+            CPM=CP*(1.+0.887*QG(K))
+            IF(K.LE.ML)THEN
+              TG(K)=TG(K)-(QIG(K)+QSG(K))*RLF/CPM
+            ELSEIF(K.GT.ML)THEN
+              TG(K)=TG(K)+(QLG(K)+QRG(K))*RLF/CPM
+            ENDIF
+            DQCDT(K)=(QLG(K)+QIG(K)-QL0(K)-QI0(K))/TIMEC
+            DQIDT(K)=0.
+            DQRDT(K)=(QRG(K)+QSG(K)-QR0(K)-QS0(K))/TIMEC
+            DQSDT(K)=0.
+          ELSEIF(F_QI) THEN
+!
+!...IF MIXED PHASE HYDROMETEORS ARE ALLOWED, FEED BACK CONVECTIVE TENDEN
+!...OF HYDROMETEORS DIRECTLY...
+!
+            DQCDT(K)=(QLG(K)-QL0(K))/TIMEC
+            DQIDT(K)=(QIG(K)-QI0(K))/TIMEC
+            DQRDT(K)=(QRG(K)-QR0(K))/TIMEC
+            IF (F_QS) THEN
+               DQSDT(K)=(QSG(K)-QS0(K))/TIMEC
+            ELSE
+               DQIDT(K)=DQIDT(K)+(QSG(K)-QS0(K))/TIMEC
+            ENDIF
+          ELSE
+              PRINT *,'THIS COMBINATION OF IMOIST, IEXICE, IICE NOT ALLOWED!'
+!!              CALL wrf_error_fatal ( 'KAIN-FRITSCH, THIS COMBINATION OF IMOIST, IEXICE, IICE NOT ALLOWED' )
+          ENDIF
+          DTDT(K)=(TG(K)-T0(K))/TIMEC
+          DQDT(K)=(QG(K)-Q0(K))/TIMEC
+        ENDDO
+        RAINCV(I,J)=DT*PPTFLX*(1.-FBFRC)/DXSQ     !  PPT FB MODS
+!        RAINCV(I,J)=.1*.5*DT*PPTFLX/DXSQ               !  PPT FB MODS
+!         RNC=0.1*TIMEC*PPTFLX/DXSQ
+        RNC=RAINCV(I,J)*NIC
+ 909     FORMAT('AT I, J =',i3,1x,i3,' CONVECTIVE RAINFALL =',F8.4,' mm')
+!      write (98,909)I,J,RNC
+!      write (6,909)I,J,RNC
+!      WRITE(98,*)'at NTSD =',NTSD,',No. of KF points activated =',
+!     *            NCCNT
+!      call flush(98)
+1000  FORMAT(' ',10A8)
+1005  FORMAT(' ',F6.0,2X,F6.4,2X,F7.3,1X,F6.4,2X,4(F6.3,2X),2(F7.3,1X))
+1010  FORMAT(' ',' VERTICAL VELOCITY IS NEGATIVE AT ',F4.0,' MB')
+1015   FORMAT(' ','ALL REMAINING MASS DETRAINS BELOW ',F4.0,' MB')
+1025   FORMAT(5X,' KLCL=',I2,' ZLCL=',F7.1,'M',                         &
+        ' DTLCL=',F5.2,' LTOP=',I2,' P0(LTOP)=',-2PF5.1,'MB FRZ LV=',   &
+        I2,' TMIX=',0PF4.1,1X,'PMIX=',-2PF6.1,' QMIX=',3PF5.1,          &
+        ' CAPE=',0PF7.1)
+1030   FORMAT(' ',' P0(LET) = ',F6.1,' P0(LTOP) = ',F6.1,' VMFLCL =',   &
+      E12.3,' PLCL =',F6.1,' WLCL =',F6.3,' CLDHGT =',                  &
+      F8.1)
+1035  FORMAT(1X,'PEF(WS)=',F4.2,'(CB)=',F4.2,'LC,LET=',2I3,'WKL='       &
+      ,F6.3,'VWS=',F5.2)
+!1055  FORMAT('*** DEGREE OF STABILIZATION =',F5.3,                  &
+!      ', NO MORE MASS FLUX IS ALLOWED!')
+!1060     FORMAT(' ITERATION DOES NOT CONVERGE TO GIVE THE SPECIFIED    &
+!      &DEGREE OF STABILIZATION!  FABE= ',F6.4) 
+ 1070 FORMAT (16A8) 
+ 1075 FORMAT (F8.2,3(F8.2),2(F8.3),F8.2,2F8.3,F8.2,6F8.3) 
+ 1080 FORMAT(2X,'LFS,LDB,LDT =',3I3,' TIMEC, TADVEC, NSTEP=',           &
+              2(1X,F5.0),I3,'NCOUNT, FABE, AINC=',I2,1X,F5.3,F6.2) 
+ 1085 FORMAT (A3,16A7,2A8) 
+ 1090 FORMAT (I3,F7.2,F7.0,10F7.2,4F7.3,2F8.3) 
+ 1095 FORMAT(' ','  PPT PRODUCTION RATE= ',F10.0,' TOTAL EVAP+PPT= ',F10.0)
+1105   FORMAT(' ','NET LATENT HEAT RELEASE =',E12.5,' ACTUAL HEATING =',&
+       E12.5,' J/KG-S, DIFFERENCE = ',F9.3,'%')
+1110   FORMAT(' ','INITIAL WATER =',E12.5,' FINAL WATER =',E12.5,       &
+       ' TOTAL WATER CHANGE =',F8.2,'%')
+! 1115 FORMAT (2X,F6.0,2X,F7.2,2X,F5.1,2X,F6.3,2(2X,F5.1),2X,F7.2,2X,F7.4)
+1120   FORMAT(' ','MOISTURE ERROR AS FUNCTION OF TOTAL PPT =',F9.3,'%')
+!
+!-----------------------------------------------------------------------
+!--------------SAVE CLOUD TOP AND BOTTOM FOR RADIATION------------------
+!-----------------------------------------------------------------------
+!
+      CUTOP(I,J)=REAL(LTOP)
+      CUBOT(I,J)=REAL(LCL)
+       UMF(LTOP)=0.0
+!
+!-----------------------------------------------------------------------
+       END SUBROUTINE  KF_eta_PARA
+!********************************************************************
+! ***********************************************************************
+      SUBROUTINE TPMIX2(p,thes,tu,qu,qliq,qice,qnewlq,qnewic,XLV1,XLV0)
+!
+! Lookup table variables:
+!     INTEGER, PARAMETER :: (KFNT=250,KFNP=220)
+!     REAL, SAVE, DIMENSION(1:KFNT,1:KFNP) :: TTAB,QSTAB
+!     REAL, SAVE, DIMENSION(1:KFNP) :: THE0K
+!     REAL, SAVE, DIMENSION(1:200) :: ALU
+!     REAL, SAVE :: RDPR,RDTHK,PLUTOP
+! End of Lookup table variables:
+
+  
+!-----------------------------------------------------------------------
+  use kftable_mod
+
+       IMPLICIT NONE
+  
+!       include 'include_kftable'
+!-----------------------------------------------------------------------
+       REAL,         INTENT(IN   )   :: P,THES,XLV1,XLV0
+       REAL,         INTENT(OUT  )   :: QNEWLQ,QNEWIC
+       REAL,         INTENT(INOUT)   :: TU,QU,QLIQ,QICE
+       REAL    ::    TP,QQ,BTH,TTH,PP,T00,T10,T01,T11,Q00,Q10,Q01,Q11,          &
+                 TEMP,QS,QNEW,DQ,QTOT,RLL,CPP
+       INTEGER ::    IPTB,ITHTB
+!-----------------------------------------------------------------------
+
+!c******** LOOKUP TABLE VARIABLES... ****************************
+!      parameter(kfnt=250,kfnp=220)
+!c
+!      COMMON/KFLUT/ ttab(kfnt,kfnp),qstab(kfnt,kfnp),the0k(kfnp),
+!     *              alu(200),rdpr,rdthk,plutop 
+!C*************************************************************** 
+!c
+!c***********************************************************************
+!c     scaling pressure and tt table index                         
+!c***********************************************************************
+!c
+      tp=(p-plutop)*rdpr
+      qq=tp-aint(tp)
+      iptb=int(tp)+1
+
+!
+!***********************************************************************
+!              base and scaling factor for the                           
+!***********************************************************************
+!
+!  scaling the and tt table index                                        
+      bth=(the0k(iptb+1)-the0k(iptb))*qq+the0k(iptb)
+      tth=(thes-bth)*rdthk
+      pp   =tth-aint(tth)
+      ithtb=int(tth)+1
+       IF(IPTB.GE.220 .OR. IPTB.LE.1 .OR. ITHTB.GE.250 .OR. ITHTB.LE.1)THEN
+         write(98,*)'**** OUT OF BOUNDS *********'
+!        call flush(98)
+       ENDIF
+!
+      t00=ttab(ithtb  ,iptb  )
+      t10=ttab(ithtb+1,iptb  )
+      t01=ttab(ithtb  ,iptb+1)
+      t11=ttab(ithtb+1,iptb+1)
+!
+      q00=qstab(ithtb  ,iptb  )
+      q10=qstab(ithtb+1,iptb  )
+      q01=qstab(ithtb  ,iptb+1)
+      q11=qstab(ithtb+1,iptb+1)
+!
+!***********************************************************************
+!              parcel temperature                                        
+!***********************************************************************
+!
+      temp=(t00+(t10-t00)*pp+(t01-t00)*qq+(t00-t10-t01+t11)*pp*qq)
+!
+      qs=(q00+(q10-q00)*pp+(q01-q00)*qq+(q00-q10-q01+q11)*pp*qq)
+!
+      DQ=QS-QU
+      IF(DQ.LE.0.)THEN
+        QNEW=QU-QS
+        QU=QS
+      ELSE 
+!
+!   IF THE PARCEL IS SUBSATURATED, TEMPERATURE AND MIXING RATIO MUST BE
+!   ADJUSTED...IF LIQUID WATER IS PRESENT, IT IS ALLOWED TO EVAPORATE
+! 
+        QNEW=0.
+        QTOT=QLIQ+QICE
+!
+!   IF THERE IS ENOUGH LIQUID OR ICE TO SATURATE THE PARCEL, TEMP STAYS AT ITS
+!   WET BULB VALUE, VAPOR MIXING RATIO IS AT SATURATED LEVEL, AND THE MIXING
+!   RATIOS OF LIQUID AND ICE ARE ADJUSTED TO MAKE UP THE ORIGINAL SATURATION
+!   DEFICIT... OTHERWISE, ANY AVAILABLE LIQ OR ICE VAPORIZES AND APPROPRIATE
+!   ADJUSTMENTS TO PARCEL TEMP; VAPOR, LIQUID, AND ICE MIXING RATIOS ARE MADE.
+!
+!...subsaturated values only occur in calculations involving various mixtures of
+!...updraft and environmental air for estimation of entrainment and detrainment.
+!...For these purposes, assume that reasonable estimates can be given using 
+!...liquid water saturation calculations only - i.e., ignore the effect of the
+!...ice phase in this process only...will not affect conservative properties...
+!
+        IF(QTOT.GE.DQ)THEN
+          qliq=qliq-dq*qliq/(qtot+1.e-10)
+          qice=qice-dq*qice/(qtot+1.e-10)
+          QU=QS
+        ELSE
+          RLL=XLV0-XLV1*TEMP
+          CPP=1004.5*(1.+0.89*QU)
+          IF(QTOT.LT.1.E-10)THEN
+!
+!...IF NO LIQUID WATER OR ICE IS AVAILABLE, TEMPERATURE IS GIVEN BY:
+            TEMP=TEMP+RLL*(DQ/(1.+DQ))/CPP
+          ELSE
+!
+!...IF SOME LIQ WATER/ICE IS AVAILABLE, BUT NOT ENOUGH TO ACHIEVE SATURATION,
+!   THE TEMPERATURE IS GIVEN BY:
+!
+            TEMP=TEMP+RLL*((DQ-QTOT)/(1+DQ-QTOT))/CPP
+            QU=QU+QTOT
+            QTOT=0.
+            QLIQ=0.
+            QICE=0.
+          ENDIF
+        ENDIF
+      ENDIF
+      TU=TEMP
+      qnewlq=qnew
+      qnewic=0.
+!
+      END SUBROUTINE TPMIX2
+!******************************************************************************
+      SUBROUTINE DTFRZNEW(TU,P,THTEU,QU,QFRZ,QICE,ALIQ,BLIQ,CLIQ,DLIQ)
+!-----------------------------------------------------------------------
+       IMPLICIT NONE
+!-----------------------------------------------------------------------
+   REAL,         INTENT(IN   )   :: P,QFRZ,ALIQ,BLIQ,CLIQ,DLIQ
+   REAL,         INTENT(INOUT)   :: TU,THTEU,QU,QICE
+   REAL    ::    RLC,RLS,RLF,CPP,A,DTFRZ,ES,QS,DQEVAP,PII
+!-----------------------------------------------------------------------
+!
+!...ALLOW THE FREEZING OF LIQUID WATER IN THE UPDRAFT TO PROCEED AS AN 
+!...APPROXIMATELY LINEAR FUNCTION OF TEMPERATURE IN THE TEMPERATURE RANGE 
+!...TTFRZ TO TBFRZ...
+!...FOR COLDER TERMPERATURES, FREEZE ALL LIQUID WATER...
+!...THERMODYNAMIC PROPERTIES ARE STILL CALCULATED WITH RESPECT TO LIQUID WATER
+!...TO ALLOW THE USE OF LOOKUP TABLE TO EXTRACT TMP FROM THETAE...
+!
+      RLC=2.5E6-2369.276*(TU-273.16)
+      RLS=2833922.-259.532*(TU-273.16)
+      RLF=RLS-RLC
+      CPP=1004.5*(1.+0.89*QU)
+!
+!  A = D(es)/DT IS THAT CALCULATED FROM BUCK (1981) EMPERICAL FORMULAS
+!  FOR SATURATION VAPOR PRESSURE...
+!
+      A=(CLIQ-BLIQ*DLIQ)/((TU-DLIQ)*(TU-DLIQ))
+      DTFRZ = RLF*QFRZ/(CPP+RLS*QU*A)
+      TU = TU+DTFRZ
+      
+      ES = ALIQ*EXP((BLIQ*TU-CLIQ)/(TU-DLIQ))
+      QS = ES*0.622/(P-ES)
+!
+!...FREEZING WARMS THE AIR AND IT BECOMES UNSATURATED...ASSUME THAT SOME OF THE 
+!...LIQUID WATER THAT IS AVAILABLE FOR FREEZING EVAPORATES TO MAINTAIN SATURA-
+!...TION...SINCE THIS WATER HAS ALREADY BEEN TRANSFERRED TO THE ICE CATEGORY,
+!...SUBTRACT IT FROM ICE CONCENTRATION, THEN SET UPDRAFT MIXING RATIO AT THE NEW
+!...TEMPERATURE TO THE SATURATION VALUE...
+!
+      DQEVAP = QS-QU
+      QICE = QICE-DQEVAP
+      QU = QU+DQEVAP
+      PII=(1.E5/P)**(0.2854*(1.-0.28*QU))
+      THTEU=TU*PII*EXP((3374.6525/TU-2.5403)*QU*(1.+0.81*QU))
+!
+      END SUBROUTINE DTFRZNEW
+! --------------------------------------------------------------------------------
+
+      SUBROUTINE CONDLOAD(QLIQ,QICE,WTW,DZ,BOTERM,ENTERM,RATE,QNEWLQ,           &
+                          QNEWIC,QLQOUT,QICOUT,G)
+
+!-----------------------------------------------------------------------
+   IMPLICIT NONE
+!-----------------------------------------------------------------------
+!  9/18/88...THIS PRECIPITATION FALLOUT SCHEME IS BASED ON THE SCHEME US
+!  BY OGURA AND CHO (1973).  LIQUID WATER FALLOUT FROM A PARCEL IS CAL-
+!  CULATED USING THE EQUATION DQ=-RATE*Q*DT, BUT TO SIMULATE A QUASI-
+!  CONTINUOUS PROCESS, AND TO ELIMINATE A DEPENDENCY ON VERTICAL
+!  RESOLUTION THIS IS EXPRESSED AS Q=Q*EXP(-RATE*DZ).
+
+      REAL, INTENT(IN   )   :: G
+      REAL, INTENT(IN   )   :: DZ,BOTERM,ENTERM,RATE
+      REAL, INTENT(INOUT)   :: QLQOUT,QICOUT,WTW,QLIQ,QICE,QNEWLQ,QNEWIC
+      REAL :: QTOT,QNEW,QEST,G1,WAVG,CONV,RATIO3,OLDQ,RATIO4,DQ,PPTDRG
+
+!
+!  9/18/88...THIS PRECIPITATION FALLOUT SCHEME IS BASED ON THE SCHEME US
+!  BY OGURA AND CHO (1973).  LIQUID WATER FALLOUT FROM A PARCEL IS CAL- 
+!  CULATED USING THE EQUATION DQ=-RATE*Q*DT, BUT TO SIMULATE A QUASI-   
+!  CONTINUOUS PROCESS, AND TO ELIMINATE A DEPENDENCY ON VERTICAL        
+!  RESOLUTION THIS IS EXPRESSED AS Q=Q*EXP(-RATE*DZ).                   
+      QTOT=QLIQ+QICE                                                    
+      QNEW=QNEWLQ+QNEWIC                                                
+!                                                                       
+!  ESTIMATE THE VERTICAL VELOCITY SO THAT AN AVERAGE VERTICAL VELOCITY 
+!  BE CALCULATED TO ESTIMATE THE TIME REQUIRED FOR ASCENT BETWEEN MODEL 
+!  LEVELS...                                                            
+!                                                                       
+      QEST=0.5*(QTOT+QNEW)                                              
+      G1=WTW+BOTERM-ENTERM-2.*G*DZ*QEST/1.5                             
+      IF(G1.LT.0.0)G1=0.                                                
+      WAVG=0.5*(SQRT(WTW)+SQRT(G1))                                      
+      CONV=RATE*DZ/WAVG                                                 
+!                                                                       
+!  RATIO3 IS THE FRACTION OF LIQUID WATER IN FRESH CONDENSATE, RATIO4 IS
+!  THE FRACTION OF LIQUID WATER IN THE TOTAL AMOUNT OF CONDENSATE INVOLV
+!  IN THE PRECIPITATION PROCESS - NOTE THAT ONLY 60% OF THE FRESH CONDEN
+!  SATE IS IS ALLOWED TO PARTICIPATE IN THE CONVERSION PROCESS...       
+!                                                                       
+      RATIO3=QNEWLQ/(QNEW+1.E-8)                                       
+!     OLDQ=QTOT                                                         
+      QTOT=QTOT+0.6*QNEW                                                
+      OLDQ=QTOT                                                         
+      RATIO4=(0.6*QNEWLQ+QLIQ)/(QTOT+1.E-8)                            
+      QTOT=QTOT*EXP(-CONV)                                              
+!                                                                       
+!  DETERMINE THE AMOUNT OF PRECIPITATION THAT FALLS OUT OF THE UPDRAFT  
+!  PARCEL AT THIS LEVEL...                                              
+!                                                                       
+      DQ=OLDQ-QTOT                                                      
+      QLQOUT=RATIO4*DQ                                                  
+      QICOUT=(1.-RATIO4)*DQ                                             
+!                                                                       
+!  ESTIMATE THE MEAN LOAD OF CONDENSATE ON THE UPDRAFT IN THE LAYER, CAL
+!  LATE VERTICAL VELOCITY                                               
+!                                                                       
+      PPTDRG=0.5*(OLDQ+QTOT-0.2*QNEW)                                   
+      WTW=WTW+BOTERM-ENTERM-2.*G*DZ*PPTDRG/1.5                          
+      IF(ABS(WTW).LT.1.E-4)WTW=1.E-4
+!                                                                       
+!  DETERMINE THE NEW LIQUID WATER AND ICE CONCENTRATIONS INCLUDING LOSSE
+!  DUE TO PRECIPITATION AND GAINS FROM CONDENSATION...                  
+!                                                                       
+      QLIQ=RATIO4*QTOT+RATIO3*0.4*QNEW                                  
+      QICE=(1.-RATIO4)*QTOT+(1.-RATIO3)*0.4*QNEW                        
+      QNEWLQ=0.                                                         
+      QNEWIC=0.                                                         
+
+      END SUBROUTINE CONDLOAD
+
+! ----------------------------------------------------------------------
+      SUBROUTINE PROF5(EQ,EE,UD)                                        
+!
+!***********************************************************************
+!*****    GAUSSIAN TYPE MIXING PROFILE....******************************
+!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+!  THIS SUBROUTINE INTEGRATES THE AREA UNDER THE CURVE IN THE GAUSSIAN  
+!  DISTRIBUTION...THE NUMERICAL APPROXIMATION TO THE INTEGRAL IS TAKEN FROM
+!  "HANDBOOK OF MATHEMATICAL FUNCTIONS WITH FORMULAS, GRAPHS AND MATHEMATICS TABLES"
+!  ED. BY ABRAMOWITZ AND STEGUN, NATL BUREAU OF STANDARDS APPLIED
+!  MATHEMATICS SERIES.  JUNE, 1964., MAY, 1968.                         
+!                                     JACK KAIN                         
+!                                     7/6/89                            
+!CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
+!-----------------------------------------------------------------------
+      IMPLICIT NONE
+!-----------------------------------------------------------------------
+      REAL,         INTENT(IN   )   :: EQ
+      REAL,         INTENT(INOUT)   :: EE,UD
+      REAL ::       SQRT2P,A1,A2,A3,P,SIGMA,FE,X,Y,EY,E45,T1,T2,C1,C2
+
+      DATA SQRT2P,A1,A2,A3,P,SIGMA,FE/2.506628,0.4361836,-0.1201676,       &
+           0.9372980,0.33267,0.166666667,0.202765151/                        
+      X=(EQ-0.5)/SIGMA                                                  
+      Y=6.*EQ-3.                                                        
+      EY=EXP(Y*Y/(-2))                                                  
+      E45=EXP(-4.5)                                                     
+      T2=1./(1.+P*ABS(Y))                                               
+      T1=0.500498                                                       
+      C1=A1*T1+A2*T1*T1+A3*T1*T1*T1                                     
+      C2=A1*T2+A2*T2*T2+A3*T2*T2*T2                                     
+      IF(Y.GE.0.)THEN                                                   
+        EE=SIGMA*(0.5*(SQRT2P-E45*C1-EY*C2)+SIGMA*(E45-EY))-E45*EQ*EQ/2.
+        UD=SIGMA*(0.5*(EY*C2-E45*C1)+SIGMA*(E45-EY))-E45*(0.5+EQ*EQ/2.-    &
+           EQ)                                                          
+      ELSE                                                              
+        EE=SIGMA*(0.5*(EY*C2-E45*C1)+SIGMA*(E45-EY))-E45*EQ*EQ/2.       
+        UD=SIGMA*(0.5*(SQRT2P-E45*C1-EY*C2)+SIGMA*(E45-EY))-E45*(0.5+EQ*   &
+           EQ/2.-EQ)                                                    
+      ENDIF                                                             
+      EE=EE/FE                                                          
+      UD=UD/FE                                                          
+
+      END SUBROUTINE PROF5
+
+! ------------------------------------------------------------------------
+      SUBROUTINE TPMIX2DD(p,thes,ts,qs,i,j)
+!
+! Lookup table variables:
+!     INTEGER, PARAMETER :: (KFNT=250,KFNP=220)
+!     REAL, SAVE, DIMENSION(1:KFNT,1:KFNP) :: TTAB,QSTAB
+!     REAL, SAVE, DIMENSION(1:KFNP) :: THE0K
+!     REAL, SAVE, DIMENSION(1:200) :: ALU
+!     REAL, SAVE :: RDPR,RDTHK,PLUTOP
+! End of Lookup table variables:
+!-----------------------------------------------------------------------
+  use kftable_mod
+
+      IMPLICIT NONE
+!      include 'include_kftable'
+
+!-----------------------------------------------------------------------
+      REAL,         INTENT(IN   )   :: P,THES
+      REAL,         INTENT(INOUT)   :: TS,QS
+      INTEGER,      INTENT(IN   )   :: i,j     ! avail for debugging
+      REAL    ::    TP,QQ,BTH,TTH,PP,T00,T10,T01,T11,Q00,Q10,Q01,Q11
+      INTEGER ::    IPTB,ITHTB
+      CHARACTER*256 :: MESS
+!-----------------------------------------------------------------------
+
+!
+!******** LOOKUP TABLE VARIABLES (F77 format)... ****************************
+!     parameter(kfnt=250,kfnp=220)
+!
+!     COMMON/KFLUT/ ttab(kfnt,kfnp),qstab(kfnt,kfnp),the0k(kfnp),        &
+!                   alu(200),rdpr,rdthk,plutop 
+!*************************************************************** 
+!
+!***********************************************************************
+!     scaling pressure and tt table index                         
+!***********************************************************************
+!
+      tp=(p-plutop)*rdpr
+      qq=tp-aint(tp)
+      iptb=int(tp)+1
+!
+!***********************************************************************
+!              base and scaling factor for the                           
+!***********************************************************************
+!
+!  scaling the and tt table index                                        
+      bth=(the0k(iptb+1)-the0k(iptb))*qq+the0k(iptb)
+      tth=(thes-bth)*rdthk
+      pp   =tth-aint(tth)
+      ithtb=int(tth)+1
+!
+      t00=ttab(ithtb  ,iptb  )
+      t10=ttab(ithtb+1,iptb  )
+      t01=ttab(ithtb  ,iptb+1)
+      t11=ttab(ithtb+1,iptb+1)
+!
+      q00=qstab(ithtb  ,iptb  )
+      q10=qstab(ithtb+1,iptb  )
+      q01=qstab(ithtb  ,iptb+1)
+      q11=qstab(ithtb+1,iptb+1)
+!
+!***********************************************************************
+!              parcel temperature and saturation mixing ratio                                        
+!***********************************************************************
+!
+      ts=(t00+(t10-t00)*pp+(t01-t00)*qq+(t00-t10-t01+t11)*pp*qq)
+!
+      qs=(q00+(q10-q00)*pp+(q01-q00)*qq+(q00-q10-q01+q11)*pp*qq)
+!
+      END SUBROUTINE TPMIX2DD
+
+! -----------------------------------------------------------------------
+      SUBROUTINE ENVIRTHT(P1,T1,Q1,THT1,ALIQ,BLIQ,CLIQ,DLIQ)                       
+!
+!-----------------------------------------------------------------------
+  use kftable_mod
+      IMPLICIT NONE
+!      include 'include_kftable'
+
+!-----------------------------------------------------------------------
+   REAL,         INTENT(IN   )   :: P1,T1,Q1,ALIQ,BLIQ,CLIQ,DLIQ
+   REAL,         INTENT(INOUT)   :: THT1
+   REAL    ::    EE,TLOG,ASTRT,AINC,A1,TP,VALUE,AINTRP,TDPT,TSAT,THT,      &
+                 T00,P00,C1,C2,C3,C4,C5
+   INTEGER ::    INDLU
+!-----------------------------------------------------------------------
+      DATA T00,P00,C1,C2,C3,C4,C5/273.16,1.E5,3374.6525,2.5403,3114.834,   &
+           0.278296,1.0723E-3/                                          
+!                                                                       
+!  CALCULATE ENVIRONMENTAL EQUIVALENT POTENTIAL TEMPERATURE...          
+!                                                                       
+! NOTE: Calculations for mixed/ice phase no longer used...jsk 8/00
+!
+      EE=Q1*P1/(0.622+Q1)                                             
+!     TLOG=ALOG(EE/ALIQ)                                              
+! ...calculate LOG term using lookup table...
+!
+      astrt=1.e-3
+      ainc=0.075
+      a1=ee/aliq
+      tp=(a1-astrt)/ainc
+      indlu=int(tp)+1
+      value=(indlu-1)*ainc+astrt
+      aintrp=(a1-value)/ainc
+      tlog=aintrp*alu(indlu+1)+(1-aintrp)*alu(indlu)
+!
+      TDPT=(CLIQ-DLIQ*TLOG)/(BLIQ-TLOG)                               
+      TSAT=TDPT-(.212+1.571E-3*(TDPT-T00)-4.36E-4*(T1-T00))*(T1-TDPT) 
+      THT=T1*(P00/P1)**(0.2854*(1.-0.28*Q1))                          
+      THT1=THT*EXP((C1/TSAT-C2)*Q1*(1.+0.81*Q1))                      
+!
+      END SUBROUTINE ENVIRTHT                                                              
+! ***********************************************************************
+!====================================================================
+      SUBROUTINE kf_eta_init(RTHCUTEN,RQVCUTEN,RQCCUTEN,RQRCUTEN,      &
+                     RQICUTEN,RQSCUTEN,NCA,W0AVG,P_QI,P_QS,         &
+                     SVP1,SVP2,SVP3,SVPT0,                          &
+                     P_FIRST_SCALAR,restart,allowed_to_read,        &
+                     ids, ide, jds, jde, kds, kde,                  &
+                     ims, ime, jms, jme, kms, kme,                  &
+                     its, ite, jts, jte, kts, kte                   )
+!--------------------------------------------------------------------
+   IMPLICIT NONE
+!--------------------------------------------------------------------
+   LOGICAL , INTENT(IN)           ::  restart,allowed_to_read
+   INTEGER , INTENT(IN)           ::  ids, ide, jds, jde, kds, kde, &
+                                      ims, ime, jms, jme, kms, kme, &
+                                      its, ite, jts, jte, kts, kte
+   INTEGER , INTENT(IN)           ::  P_QI,P_QS,P_FIRST_SCALAR
+
+   REAL,     DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT) ::       &
+                                                          RTHCUTEN, &
+                                                          RQVCUTEN, &
+                                                          RQCCUTEN, &
+                                                          RQRCUTEN, &
+                                                          RQICUTEN, &
+                                                          RQSCUTEN
+
+   REAL ,   DIMENSION( ims:ime , kms:kme , jms:jme ) , INTENT(OUT) :: W0AVG
+
+   REAL, DIMENSION( ims:ime , jms:jme ), INTENT(INOUT):: NCA
+
+   INTEGER :: i, j, k, itf, jtf, ktf
+   REAL, INTENT(IN)    :: SVP1,SVP2,SVP3,SVPT0
+
+   jtf=min0(jte,jde-1)
+   ktf=min0(kte,kde-1)
+   itf=min0(ite,ide-1)
+
+   IF(.not.restart)THEN
+
+      DO j=jts,jtf
+      DO k=kts,ktf
+      DO i=its,itf
+         RTHCUTEN(i,k,j)=0.
+         RQVCUTEN(i,k,j)=0.
+         RQCCUTEN(i,k,j)=0.
+         RQRCUTEN(i,k,j)=0.
+      ENDDO
+      ENDDO
+      ENDDO
+
+      IF (P_QI .ge. P_FIRST_SCALAR) THEN
+         DO j=jts,jtf
+         DO k=kts,ktf
+         DO i=its,itf
+            RQICUTEN(i,k,j)=0.
+         ENDDO
+         ENDDO
+         ENDDO
+      ENDIF
+
+      IF (P_QS .ge. P_FIRST_SCALAR) THEN
+         DO j=jts,jtf
+         DO k=kts,ktf
+         DO i=its,itf
+            RQSCUTEN(i,k,j)=0.
+         ENDDO
+         ENDDO
+         ENDDO
+      ENDIF
+
+      DO j=jts,jtf
+      DO i=its,itf
+         NCA(i,j)=-100.
+      ENDDO
+      ENDDO
+
+      DO j=jts,jtf
+      DO k=kts,ktf
+      DO i=its,itf
+         W0AVG(i,k,j)=0.
+      ENDDO
+      ENDDO
+      ENDDO
+
+   endif
+ 
+   CALL KF_LUTAB(SVP1,SVP2,SVP3,SVPT0)
+
+   END SUBROUTINE kf_eta_init
+
+!-------------------------------------------------------
+
+      subroutine kf_lutab(SVP1,SVP2,SVP3,SVPT0)
+!
+!  This subroutine is a lookup table.
+!  Given a series of series of saturation equivalent potential 
+!  temperatures, the temperature is calculated.
+!
+!--------------------------------------------------------------------
+  use kftable_mod
+      IMPLICIT NONE
+!    include 'include_kftable'
+
+      INTEGER :: KP,IT,ITCNT,I
+      REAL :: DTH,TMIN,TOLER,PBOT,DPR,                               &
+             TEMP,P,ES,QS,PI,THES,TGUES,THGUES,F0,T1,T0,THGS,F1,DT, &
+             ASTRT,AINC,A1,THTGS
+!    REAL    :: ALIQ,BLIQ,CLIQ,DLIQ,SVP1,SVP2,SVP3,SVPT0
+      REAL    :: ALIQ,BLIQ,CLIQ,DLIQ
+      REAL, INTENT(IN)    :: SVP1,SVP2,SVP3,SVPT0
+!
+! equivalent potential temperature increment
+      data dth/1./
+! minimum starting temp 
+      data tmin/150./
+! tolerance for accuracy of temperature 
+      data toler/0.001/
+! top pressure (pascals)
+      plutop=5000.0
+! bottom pressure (pascals)
+      pbot=110000.0
+
+      ALIQ = SVP1*1000.
+      BLIQ = SVP2
+      CLIQ = SVP2*SVPT0
+      DLIQ = SVP3
+
+!
+! compute parameters
+!
+! 1._over_(sat. equiv. theta increment)
+      rdthk=1./dth
+! pressure increment
+!
+      DPR=(PBOT-PLUTOP)/REAL(KFNP-1)
+!      dpr=(pbot-plutop)/REAL(kfnp-1)
+! 1._over_(pressure increment)
+      rdpr=1./dpr
+! compute the spread of thes
+!     thespd=dth*(kfnt-1)
+!
+! calculate the starting sat. equiv. theta
+!
+      temp=tmin 
+      p=plutop-dpr
+      do kp=1,kfnp
+        p=p+dpr
+        es=aliq*exp((bliq*temp-cliq)/(temp-dliq))
+        qs=0.622*es/(p-es)
+        pi=(1.e5/p)**(0.2854*(1.-0.28*qs))
+        the0k(kp)=temp*pi*exp((3374.6525/temp-2.5403)*qs*        &
+               (1.+0.81*qs))
+      enddo   
+!
+! compute temperatures for each sat. equiv. potential temp.
+!
+      p=plutop-dpr
+      do kp=1,kfnp
+        thes=the0k(kp)-dth
+        p=p+dpr
+        do it=1,kfnt
+! define sat. equiv. pot. temp.
+          thes=thes+dth
+! iterate to find temperature
+! find initial guess
+          if(it.eq.1) then
+            tgues=tmin
+          else
+            tgues=ttab(it-1,kp)
+          endif
+          es=aliq*exp((bliq*tgues-cliq)/(tgues-dliq))
+          qs=0.622*es/(p-es)
+          pi=(1.e5/p)**(0.2854*(1.-0.28*qs))
+          thgues=tgues*pi*exp((3374.6525/tgues-2.5403)*qs*      &
+               (1.+0.81*qs))
+          f0=thgues-thes
+          t1=tgues-0.5*f0
+          t0=tgues
+          itcnt=0
+! iteration loop
+          do itcnt=1,11
+            es=aliq*exp((bliq*t1-cliq)/(t1-dliq))
+            qs=0.622*es/(p-es)
+            pi=(1.e5/p)**(0.2854*(1.-0.28*qs))
+            thtgs=t1*pi*exp((3374.6525/t1-2.5403)*qs*(1.+0.81*qs))
+            f1=thtgs-thes
+            if(abs(f1).lt.toler)then
+              exit
+            endif
+!           itcnt=itcnt+1
+            dt=f1*(t1-t0)/(f1-f0)
+            t0=t1
+            f0=f1
+            t1=t1-dt
+          enddo 
+          ttab(it,kp)=t1 
+          qstab(it,kp)=qs
+        enddo
+      enddo   
+!
+! lookup table for tlog(emix/aliq)
+!
+! set up intial values for lookup tables
+!
+       astrt=1.e-3
+       ainc=0.075
+!
+       a1=astrt-ainc
+       do i=1,200
+         a1=a1+ainc
+         alu(i)=alog(a1)
+       enddo   
+!
+      END SUBROUTINE KF_LUTAB
+
Index: /branches/jerome/src_flexwrf_v3.1/convmix.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/convmix.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/convmix.f90	(revision 16)
@@ -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 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,stat
+  integer :: jy, kpart, ktop, ngrid,kz
+!  integer :: igrid(maxpart), ipoint(maxpart), igridn(maxpart,maxnests)
+  integer,allocatable, dimension (:) :: igrid,ipoint
+  integer,allocatable, dimension (:,:) :: igridn
+
+  ! 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
+
+  real :: duma, dumz(nuvzmax+1)
+
+      write(*,'(//a,a//)') &
+          '*** Stopping in subr. convmix ***', &
+          '    This is not implemented for FLEXPART_WRF'
+      stop
+
+    allocate(igrid(maxpart) ,stat=stat)
+    allocate(ipoint(maxpart) ,stat=stat)
+    allocate(igridn(maxpart,maxnests) ,stat=stat)
+
+
+      return
+      end subroutine convmix
Index: /branches/jerome/src_flexwrf_v3.1/convmix_kfeta.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/convmix_kfeta.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/convmix_kfeta.f90	(revision 16)
@@ -0,0 +1,627 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                *
+!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine,       *
+!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
+!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso,          *
+!* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann,   *
+!*                                                                     *
+!* This file is part of FLEXPART WRF                                   *
+!*                                                                     *
+!* 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_kfeta(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
+
+!     CHANGED on 10.10.2007  save convective mass fluxes, update them every dt_conv
+
+!     CHANGED by Weiguo WANG 13 Aug, 2007, use KFeta CU convection scheme
+!
+!     Changes by J. Brioude: particles sorting  is much more efficient.
+!
+!       input for kftea cumulus scheme
+!         u1d - 1-d u wind velocity profile
+!         v1d - 1-d v wind velocity profile
+!         t1d - 1-D temperture (K)
+!         qv1d- 1-D water vapor mixin gratio (kg/kg) 
+!         p1d - 1-D pressure profile (pa) 
+!         rho1d-1-D density profile (kg/m3)
+!         w0avg1d - 1-D vertical velocity (m/s)
+!                  all above are defined at T-point or P-poit
+!         dz1d  - dz between full levels 
+!         delx    - grid size of column (m)
+!         dt    - integraiton time step (s)
+!         cudt  - cumulus activation time interval (min)
+!         kts   - starting point in z for convection calculation
+!         kte   - ending point 
+
+!     output 
+!         umf - updraft mass flux
+!         uer - updraft entrainment flux
+!         udr - updraft detrainment flux
+!         dmf - downdraft mass flux 
+!         der - downdraft entrainemnt flux
+!         ddr - downdraft detrainment flux
+!         cu_top1 -- top of cumulus cloud  (index? for height)
+!         cu_bot1 -- bottom of cumulus cloud (index)
+
+!**************************************************************
+
+  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,kzp,a
+  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,warm_rain
+  real :: x, y, xtn,ytn, ztold, delt
+  real :: dt1,dt2,dtt,dummy
+  real :: duma, dumz(nuvzmax+1)
+  integer :: mind1,mind2
+  ! dt1,dt2,dtt,mind1,mind2       variables used for time interpolation
+  integer :: itage,nage,duminc
+  real,parameter :: eps=nxmax/3.e5
+
+      integer :: i,k,numberp(maxpart)
+!-- for KFeta
+      real, dimension(nuvzmax):: u1d,v1d,t1d,dz1d,qv1d,p1d, &
+                                    rho1d,w0avg1d,umf,uer,udr, &
+                                    dmf,der,ddr,zh
+      real :: cudt,delx,dt,cu_bot1,cu_top1,zp,fmix        
+      real, dimension(nuvzmax+1):: umfzf,dmfzf,zf 
+      integer :: kts,kte,if_update
+!
+
+!     monitoring variables
+       real :: sumconv,sumall,sumpart
+       integer :: sumpartgrid(1000000)
+
+!      print *, "IN convmix_kfeta"
+!      write(*,'(//a,a//)')
+!     &    '*** Stopping in subr. convmix ***',
+!     &    '    This is not implemented for FLEXPART_WRF'
+!      stop
+
+
+! Calculate auxiliary variables for time interpolation
+!*****************************************************
+
+      delt=real(abs(lsynctime))
+    
+!     dt_conv is given from input namelist 
+!       dt_conv=3600.0
+      if_update=0
+      if ( mod(real(itime),dt_conv) .eq. 0 ) if_update=1
+!      print*,'conv itime',itime,dt_conv,if_update
+
+!      delt=dt_conv
+
+
+      dt1=real(itime-memtime(1))
+      dt2=real(memtime(2)-itime)
+      dtt=1./(dt1+dt2)
+      mind1=memind(1)
+      mind2=memind(2)
+
+      lconv = .false. 
+
+! for KFeta
+!      warm_rain=.true.    ! depends on mp_physics in WRF, may add an option in the future
+      cudt = 10.0        ! cumulus para is called every 10 min in a time step, if dt < cudt, call once
+                            
+      kts=1
+      kte=nuvz-1
+
+! 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
+!************************************************************************
+!       print*,'step1'
+      do ipart=1,numpart
+        igrid(ipart)=-1
+        do j=numbnests,1,-1
+        igridn(ipart,j)=-1 
+     enddo
+        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
+
+       sumpart = 0. 
+       sumconv = 0.
+        
+!       print*,'step2'
+
+!**************************************************************************************
+! 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.
+!**************************************************************************************
+       delx = dx
+
+! sort particles according to horizontal position and calculate index vector IPOINT
+
+      call sort2(numpart,igrid,ipoint)
+!       print*,'step2 after sort',minval(igrid),maxval(igrid),numpart
+
+! count particle # in each column
+!       do 40 i=abs(minval(igrid)),maxval(igrid)
+!           sumpart=0.      
+!        do 41 k=1,numpart
+!          if(igrid(k) .eq. i) then
+!           sumpart=sumpart+1
+!          endif
+!41      continue
+!        do 42 k=1,numparc     Changes by J. Brioude: the sort of particles is much more efficient.t
+!42        if(igrid(k) .eq. i) numberp(k)=int(sumpart)  
+!40     continue
+! JB
+         if (maxval(igrid).gt.1000000) then
+         print*,'too much x and y grid. modify convmix_kfeta.f'
+         stop
+         endif
+        do k=1,1000000
+        sumpartgrid(k)=0
+        enddo
+        do k=1,numpart
+        if (igrid(k).gt.0) sumpartgrid(igrid(k))=sumpartgrid(igrid(k))+1
+        enddo
+        do k=1,numpart
+        if (igrid(k).gt.0) then 
+        numberp(k)=sumpartgrid(igrid(k))
+        else
+        numberp(k)=0
+        endif 
+        enddo 
+         
+!       print*,'step3',numpart
+
+! Now visit all grid columns where particles are present
+! by going through the sorted particles
+
+      igrold = -1
+      a=0
+      do kpart=1,numpart
+        igr = igrid(kpart)
+        if (igr .eq. -1 .or. numberp(kpart).le.20 &
+!       if (igr .eq. -1 
+      ) goto 50
+        ipart = ipoint(kpart)
+
+!       sumall = sumall + 1
+!c  For one column, we only need to compute 1D met once
+
+        if (igr .ne. igrold) then
+            sumconv=sumconv+1
+! we are in a new grid column
+          jy = (igr-1)/nx
+          ix = igr - jy*nx - 1
+         a=a+1
+!         print*,'a',a
+! Interpolate all meteorological data needed for the convection scheme
+
+          do kz=1,nuvz-1         ! nconvlev+1
+! FLEXPART_WRF - used add_sfc_level for the shifting
+! for W, it is not shifted, make sure w is 'true' vertical velocity!
+
+            kzp = kz + add_sfc_level
+           u1d(kz)=(u_wrf(ix,jy,kzp,mind1)*dt2+ &
+                    u_wrf(ix,jy,kzp,mind2)*dt1)*dtt          
+           v1d(kz)=(v_wrf(ix,jy,kzp,mind1)*dt2+ &
+                    v_wrf(ix,jy,kzp,mind2)*dt1)*dtt
+           t1d(kz)=(tth(ix,jy,kzp,mind1)*dt2+ &
+                    tth(ix,jy,kzp,mind2)*dt1)*dtt
+           qv1d(kz)=(qvh(ix,jy,kzp,mind1)*dt2+ &
+                     qvh(ix,jy,kzp,mind2)*dt1)*dtt
+           p1d(kz)=(pph(ix,jy,kzp,mind1)*dt2+ &
+                    pph(ix,jy,kzp,mind2)*dt1)*dtt
+           dz1d(kz)=(zzh(ix,jy,kzp+1,mind1)*dt2+ &
+                     zzh(ix,jy,kzp+1,mind2)*dt1)*dtt- &
+                    (zzh(ix,jy,kzp,mind1)*dt2+ &
+                     zzh(ix,jy,kzp,mind2)*dt1)*dtt
+           w0avg1d(kz)=(w_wrf(ix,jy,kz,mind1)*dt2+ &
+                        w_wrf(ix,jy,kz,mind2)*dt1)*dtt+ &
+                       (w_wrf(ix,jy,kz+1,mind1)*dt2+ &
+                        w_wrf(ix,jy,kz+1,mind2)*dt1)*dtt
+           w0avg1d(kz)=0.5*w0avg1d(kz)
+           rho1d(kz)=p1d(kz)/ &
+                    (t1d(kz)*(1.0+0.608*qv1d(kz))) &
+                     /287.0
+
+!         write(*,'(1x,I10,10F10.2)')kz,u1d(kz),v1d(kz),w0avg1d(kz), 
+!     &          t1d(kz),qv1d(kz),p1d(kz)/100,dz1d(kz)
+
+
+       enddo
+
+! -- old convective mass fluxes
+          do k=kts,kte
+           umf(k)=umf3(ix,jy,k)
+           uer(k)=uer3(ix,jy,k)
+           udr(k)=udr3(ix,jy,k)
+           dmf(k)=dmf3(ix,jy,k)
+           der(k)=der3(ix,jy,k)
+           ddr(k)=ddr3(ix,jy,k)
+          enddo
+           cu_top1=cu_top(ix,jy)
+           cu_bot1=cu_bot(ix,jy)
+
+
+!        write(*,*)'1-D wind'
+
+! Calculate convection flux, updrought flux, entrainment, detrainment flux
+!                            downdraft flux, entrainment ,detrainment flux
+           warm_rain=.false.
+          if (mp_physics .eq. 1) warm_rain = .true.
+! -- Update fluxes          
+          if (if_update .eq. 1 ) then          !! if_update
+!          write(*,*)'update convective fluxes, itime=',itime/3600.
+!            print*,u1d(4:8),v1d(4:8),t1d(4:8),dz1d(4:8),qv1d(4:8)
+!            print*,p1d(4:8),rho1d(4:8),w0avg1d(4:8)
+!            print*,cudt,delx,dt_conv,warm_rain
+!            print*,'attend'
+!            pause
+          CALL KF_ETA(nuvzmax,u1d,v1d,t1d,dz1d,qv1d,p1d,    &       ! IN
+                rho1d,w0avg1d,cudt,delx,dt_conv,warm_rain,kts,kte,   &     ! IN
+                  umf,uer,udr,dmf,der,ddr,cu_bot1,cu_top1)      ! OUT
+          dummy=0.
+          do k=kts,kte
+           umf3(ix,jy,k)=umf(k)
+           uer3(ix,jy,k)=uer(k)
+           udr3(ix,jy,k)=udr(k)
+           dmf3(ix,jy,k)=dmf(k)
+           der3(ix,jy,k)=der(k)
+           ddr3(ix,jy,k)=ddr(k)
+          dummy=dummy+umf(k)+uer(k)+udr(k)
+          enddo
+          if (dummy.gt.0.) then
+!         print*,'dummy',dummy
+          duminc=1
+          else
+          duminc=0
+           endif
+           cu_top(ix,jy)=cu_top1
+           cu_bot(ix,jy)=cu_bot1
+!         if (cu_top1.gt.1.) print*,'cu h',cu_bot1,cu_top1
+          endif                                !! if_update
+!         if (a.gt.2000) then
+!           print*,'after kf_eta',a
+!          a=0
+!         endif
+
+!         write(*,*)'ix,jy=',ix,jy,itime
+!         write(*,*)'previous column part#=',sumpart          
+!          write(*,*)'FLUX,k,umf,uer,udr,dmf,der,ddr'
+!         write(*,*)'cu_bot1,cu_top1=',cu_bot1,cu_top1
+!         if (cu_top1 .lt. cu_bot1) write(*,*)'umf=', umf(1),umf(10)
+
+!          do kz=kts,kte
+!          write(*,'(1x,I10,10E10.2)')kz,umf(kz),uer(kz),udr(kz),dmf(kz)
+!     & ,der(kz),ddr(kz),p1d(kz)/100
+ 
+!          enddo
+
+            sumpart=0
+           IF (cu_top1 .gt. cu_bot1+1 ) then     ! lconv 
+!           write(250+lconvection,*)'-1',itime,ix,jy
+            lconv = .true.
+
+! Prepare data for redistributing particle
+
+       CALL pre_redist_kf(nuvzmax,nuvz,umf,dmf,dz1d,p1d,delx,delt, & !  IN
+            cu_bot1,cu_top1,   &                     ! IN
+            zf,zh,  &  ! OUT
+            umfzf,dmfzf,fmix)                             ! OUT
+   
+           else
+           lconv= .false.
+
+           ENDIF                              ! lconv
+
+          
+          igrold = igr
+          ktop = 0
+        endif
+        
+           sumpart=sumpart+1                
+! treat particle only if column has convection
+        if (lconv .eqv. .true.) then
+! assign new vertical position to particle
+!          ztold=ztra1(ipart)
+          zp=ztra1(ipart)
+!C          write(*,*)'befrore convection zp= ',zp
+
+!            write(*,*)'part No =',sumpart
+       CALL redist_kf(lconvection,ldirect,delt,delx, &          ! IN
+                          dz1d,nzmax, nz,umf,uer,udr,dmf, &  ! IN
+                            der,ddr,rho1d,              &    ! IN
+                            zf,zh,                     &     ! IN
+                            umfzf,dmfzf,fmix,         &      ! IN
+                            zp)                              ! IN/OUT
+
+          if (zp .lt. 0.0) zp=-1.0*zp
+          if (zp .gt. height(nz)-0.5) &
+              zp = height(nz)-0.5
+!          if (abs(zp-ztra1(ipart)) .ge. 1e-5) 
+!    &write(250+lconvection,*)ztra1(ipart),zp,zp-ztra1(ipart)
+!       if (duminc.eq.1)
+!    +  print*,'true conv',dummy,zp-ztra1(ipart),cu_top1-cu_bot1
+
+          ztra1(ipart) = zp
+!C            write(*,*)'after convection, zp=',zp
+
+!C OLD      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
+            enddo
+ 37         continue
+!        print*,'step 4'
+
+            if (nage.le.nageclass) &
+            call calcfluxes(nage,ipart,real(xtra1(ipart)), &
+            real(ytra1(ipart)),ztold)
+          endif
+
+        endif   !(lconv .eqv. .true)
+       enddo
+ 50     continue
+
+!        write(*,*)'total convective columns=',sumconv,
+!    &             'time=', 1.0*itime/3600 
+
+!***********************************************************************************
+! 2. Nested domains
+!***********************************************************************************
+
+! sort particles according to horizontal position and calculate index vector IPOINT
+
+      do inest=1,numbnests
+        delx = dxn(inest)
+        if (delx .le. 10000.0) goto 70        ! for small grid size, no need to do convection 
+        do ipart=1,numpart
+          ipoint(ipart)=ipart
+          igrid(ipart) = igridn(ipart,inest)
+        enddo
+        call sort2(numpart,igrid,ipoint)
+
+!        print*,'step in nest'
+! 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
+
+! Interpolate all meteorological data needed for the convection scheme
+ 
+          do kz=1,nuvz         ! nconvlev+1
+! FLEXPART_WRF - used add_sfc_level for the shifting
+! for W, it is not shifted, make sure w is 'true' vertical velocity!
+ 
+            kzp = kz + add_sfc_level
+           u1d(kz)=(un_wrf(ix,jy,kzp,mind1,inest)*dt2+ &
+                    un_wrf(ix,jy,kzp,mind2,inest)*dt1)*dtt
+           v1d(kz)=(vn_wrf(ix,jy,kzp,mind1,inest)*dt2+ &
+                    vn_wrf(ix,jy,kzp,mind2,inest)*dt1)*dtt
+           t1d(kz)=(tthn(ix,jy,kzp,mind1,inest)*dt2+ &
+                    tthn(ix,jy,kzp,mind2,inest)*dt1)*dtt
+           qv1d(kz)=(qvhn(ix,jy,kzp,mind1,inest)*dt2+ &
+                     qvhn(ix,jy,kzp,mind2,inest)*dt1)*dtt
+           p1d(kz)=(pphn(ix,jy,kzp,mind1,inest)*dt2+ &
+                    pphn(ix,jy,kzp,mind2,inest)*dt1)*dtt
+           dz1d(kz)=(zzhn(ix,jy,kzp+1,mind1,inest)*dt2+ &
+                     zzhn(ix,jy,kzp+1,mind2,inest)*dt1)*dtt- &
+                    (zzhn(ix,jy,kzp,mind1,inest)*dt2+ &
+                     zzhn(ix,jy,kzp,mind2,inest)*dt1)*dtt
+           w0avg1d(kz)=(wn_wrf(ix,jy,kz,mind1,inest)*dt2+ &
+                        wn_wrf(ix,jy,kz,mind2,inest)*dt1)*dtt+ &
+                       (wn_wrf(ix,jy,kz+1,mind1,inest)*dt2+ &
+                        wn_wrf(ix,jy,kz+1,mind2,inest)*dt1)*dtt
+           w0avg1d(kz)=0.5*w0avg1d(kz)
+           rho1d(kz)=p1d(kz)/ &
+                    (t1d(kz)*(1.0+0.608*qv1d(kz))) &
+                     /287.0
+ 
+          enddo 
+
+!C Old convective mass fluxes
+          do k=kts,kte
+           umf(k)=umf3n(ix,jy,k,inest)
+           uer(k)=uer3n(ix,jy,k,inest)
+           udr(k)=udr3n(ix,jy,k,inest)
+           dmf(k)=dmf3n(ix,jy,k,inest)
+           der(k)=der3n(ix,jy,k,inest)
+           ddr(k)=ddr3n(ix,jy,k,inest)
+          enddo
+           cu_top1=cu_topn(ix,jy,inest)
+           cu_bot1=cu_botn(ix,jy,inest)
+
+
+
+!alculate convection flux, updrought flux, entrainment, detrainment flux
+!                            downdraft flux, entrainment ,detrainment flux
+        warm_rain = .false.
+        if (mp_physicsn(inest) .eq. 1 ) warm_rain = .true.
+
+          if (if_update .eq. 1 ) then   !!! update
+          CALL KF_ETA(nuvzmax,u1d,v1d,t1d,dz1d,qv1d,p1d,    &       ! IN
+                rho1d,w0avg1d,cudt,delx,dt_conv,warm_rain,kts,kte,  &      ! IN
+                  umf,uer,udr,dmf,der,ddr,cu_bot1,cu_top1)      ! OUT
+          do k=kts,kte
+           umf3n(ix,jy,k,inest)=umf(k)
+           uer3n(ix,jy,k,inest)=uer(k)
+           udr3n(ix,jy,k,inest)=udr(k)
+           dmf3n(ix,jy,k,inest)=dmf(k)
+           der3n(ix,jy,k,inest)=der(k)
+           ddr3n(ix,jy,k,inest)=ddr(k)
+          enddo
+           cu_topn(ix,jy,inest)=cu_top1
+           cu_botn(ix,jy,inest)=cu_bot1
+          endif                       !!! update
+
+ 
+           
+           IF (cu_top1 .gt. cu_bot1) then     ! lconv
+             
+            lconv = .true. 
+  
+! Prepare data for redistributing particle
+
+       CALL pre_redist_kf(nuvzmax,nuvz,umf,dmf,dz1d,p1d,delx,delt, & !  IN
+            cu_bot1,cu_top1,      &                  ! IN
+            zf,zh, &   ! OUT
+            umfzf,dmfzf,fmix)                             ! OUT
+
+           else
+            lconv = .false.           
+           ENDIF                              ! lconv
+
+
+            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)
+          zp=ztra1(ipart)
+ 
+       CALL redist_kf(lconvection,ldirect,delt,delx,  &         ! IN
+                          dz1d,nzmax, nz,umf,uer,udr,dmf, &  ! IN
+                            der,ddr,rho1d,          &        ! IN
+                            zf,zh,                  &        ! IN
+                            umfzf,dmfzf,            &        ! IN
+                            zp)                              ! IN/OUT
+         
+          if (zp .lt. 0.0) zp=-1.0*zp
+          if (zp .gt. height(nz)-0.5)  &
+              zp = height(nz)-0.5 
+          ztra1(ipart) = zp
+
+! 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
+           enddo
+ 47           continue
+
+              if (nage.le.nageclass) &
+             call calcfluxes(nage,ipart,real(xtra1(ipart)), &
+             real(ytra1(ipart)),ztold)
+            endif
+
+          endif !(lconv .eqv. .true.)
+
+       enddo
+ 60       continue
+        enddo
+ 70     continue    !inest - loop
+!       print*,'end of convmix'
+!--------------------------------------------------------------------------
+!     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_kfeta
Index: /branches/jerome/src_flexwrf_v3.1/coordtrafo.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/coordtrafo.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/coordtrafo.f90	(revision 16)
@@ -0,0 +1,122 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                *
+!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine,       *
+!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
+!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso,          *
+!* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann,   *
+!*                                                                     *
+!* This file is part of FLEXPART WRF                                   *
+!*                                                                     *
+!* 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
+!**********************************************************************
+!                                                                     * 
+! Note:  This is the FLEXPART_WRF version of subroutine coordtrafo.   *
+!                                                                     * 
+!             FLEXPART MODEL SUBROUTINE COORDTRAFO                    *
+!                                                                     *
+!**********************************************************************
+!                                                                     * 
+! AUTHOR:      G. WOTAWA                                              *
+! DATE:        1994-02-07                                             *
+! LAST UPDATE: 1996-05-18   A. STOHL                                  *
+!                                                                     * 
+! Dec 2005, R. Easter - changed names of "*lon0*" & "*lat0*" variables*
+! July 2012, J Brioude: modification following flexpart 9             * 
+!**********************************************************************
+!                                                                     *
+! 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)-xmet0)/dx
+        xpoint2(i)=(xpoint2(i)-xmet0)/dx
+        ypoint1(i)=(ypoint1(i)-ymet0)/dy
+      ypoint2(i)=(ypoint2(i)-ymet0)/dy
+   end do
+
+15    continue
+
+
+! CHECK IF RELEASE POINTS ARE WITHIN DOMAIN
+!******************************************
+
+      do i=1,numpoint
+
+      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.(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
+
+!      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 ... '
+!         write(*,*) ' COMMENT: ',compoint(i)
+
+          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.2000) compoint(j-1)=compoint(j)
+           do k=1,nspec
+             xmass(j-1,k)=xmass(j,k)
+          end do
+
+         enddo
+          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/jerome/src_flexwrf_v3.1/copyright.txt
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/copyright.txt	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/copyright.txt	(revision 16)
@@ -0,0 +1,18 @@
+!* Copyright 2012,2013                                                *
+!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine,       *
+!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
+!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso,          *
+!* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann,   *
+
+This file is part of FLEXPART-WRF
+FLEXPART-WRF 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. 
+
+The GNU General Public License is available at http://www.gnu.org/licenses 
Index: /branches/jerome/src_flexwrf_v3.1/data/surfdata.t
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/data/surfdata.t	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/data/surfdata.t	(revision 16)
@@ -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/jerome/src_flexwrf_v3.1/data/surfdepo.t
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/data/surfdepo.t	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/data/surfdepo.t	(revision 16)
@@ -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/jerome/src_flexwrf_v3.1/drydepokernel.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/drydepokernel.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/drydepokernel.f90	(revision 16)
@@ -0,0 +1,160 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                *
+!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine,       *
+!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
+!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso,          *
+!* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann,   *
+!*                                                                     *
+!* This file is part of FLEXPART WRF                                   *
+!*                                                                     *
+!* 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,itage,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                                                       *
+  !
+  !     D. Arnold: modification to skip the kernel the first 3 hours.
+  !     then, modification to a regular lat-lon.
+  !
+  !                                                                            *
+  !*****************************************************************************
+  !                                                                            *
+  ! 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
+! CDA new declarations
+   real :: rhoprof(2),rhoi,xlon,ylat,xl2,yl2
+   integer :: itage
+! CDA
+
+!JB
+  if (outgrid_option.eq.0) then
+! CDA
+  xl=(x*dx+xoutshift)/dxout
+  yl=(y*dy+youtshift)/dyout
+  elseif (outgrid_option.eq.1) then
+! CDA new code:
+  xl2=x*dx+xmet0
+  yl2=y*dy+ymet0
+  call xymeter_to_ll_wrf(xl2,yl2,xlon,ylat)
+  xl=(xlon-outlon0)/dxoutl
+  yl=(ylat-outlat0)/dyoutl
+  endif
+
+
+  ix=int(xl)
+  jy=int(yl)
+
+! CDA skip kernel
+      if (itage.lt.7200) then ! no kernel, direct attribution to grid cell
+        do ks=1,nspec
+          if ((abs(deposit(ks)).gt.0).and.DRYDEPSPEC(ks)) then
+!$OMP CRITICAL 
+            if ((ix.ge.0).and.(jy.ge.0).and.(ix.le.numxgrid-1).and. &
+                                      (jy.le.numygrid-1)) &
+        drygridunc2(ix,jy,ks,kp,nunc,nage)= &
+          drygridunc2(ix,jy,ks,kp,nunc,nage)+deposit(ks)
+!$OMP END CRITICAL
+          endif
+        enddo       
+ 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
+  !**********************************************
+    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
+!$OMP CRITICAL 
+       drygridunc2(ix,jy,ks,kp,nunc,nage)= &
+            drygridunc2(ix,jy,ks,kp,nunc,nage)+deposit(ks)*w
+!$OMP END CRITICAL
+      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)
+!$OMP CRITICAL 
+      drygridunc2(ixp,jyp,ks,kp,nunc,nage)= &
+           drygridunc2(ixp,jyp,ks,kp,nunc,nage)+deposit(ks)*w
+!$OMP END CRITICAL
+  endif
+
+  if ((ixp.ge.0).and.(jy.ge.0).and.(ixp.le.numxgrid-1).and. &
+       (jy.le.numygrid-1)) then
+   w=(1.-wx)*wy
+!$OMP CRITICAL 
+      drygridunc2(ixp,jy,ks,kp,nunc,nage)= &
+           drygridunc2(ixp,jy,ks,kp,nunc,nage)+deposit(ks)*w
+!$OMP END CRITICAL
+  endif
+
+  if ((ix.ge.0).and.(jyp.ge.0).and.(ix.le.numxgrid-1).and. &
+       (jyp.le.numygrid-1)) then
+     w=wx*(1.-wy)
+!$OMP CRITICAL 
+      drygridunc2(ix,jyp,ks,kp,nunc,nage)= &
+            drygridunc2(ix,jyp,ks,kp,nunc,nage)+deposit(ks)*w
+!$OMP END CRITICAL
+  endif
+
+  endif
+
+    end do
+
+  endif !kernel
+end subroutine drydepokernel
Index: /branches/jerome/src_flexwrf_v3.1/drydepokernel_nest.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/drydepokernel_nest.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/drydepokernel_nest.f90	(revision 16)
@@ -0,0 +1,159 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                *
+!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine,       *
+!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
+!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso,          *
+!* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann,   *
+!*                                                                     *
+!* This file is part of FLEXPART WRF                                   *
+!*                                                                     *
+!* 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,itage,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
+! CDA new declarations
+   real :: rhoprof(2),rhoi,xlon,ylat,xl2,yl2
+   integer :: itage
+! CDA
+
+
+!JB
+  if (outgrid_option.eq.0) then
+! CDA
+  xl=(x*dx+xoutshiftn)/dxoutn
+  yl=(y*dy+youtshiftn)/dyoutn
+  elseif (outgrid_option.eq.1) then
+! CDA new code:
+  xl2=x*dx+xmet0
+  yl2=y*dy+ymet0
+  call xymeter_to_ll_wrf(xl2,yl2,xlon,ylat)
+  xl=(xlon-outlon0n)/dxoutln
+  yl=(ylat-outlat0n)/dyoutln
+  endif
+
+  ix=int(xl)
+  jy=int(yl)
+
+! CDA skip kernel
+      if (itage.lt.7200) then ! no kernel, direct attribution to grid cell
+        do ks=1,nspec
+          if ((abs(deposit(ks)).gt.0).and.DRYDEPSPEC(ks)) then
+!$OMP CRITICAL 
+            if ((ix.ge.0).and.(jy.ge.0).and.(ix.le.numxgridn-1).and. &
+                                      (jy.le.numygridn-1)) &
+        drygriduncn2(ix,jy,ks,kp,nunc,nage)= &
+          drygriduncn2(ix,jy,ks,kp,nunc,nage)+deposit(ks)
+!$OMP END CRITICAL
+          endif
+        enddo
+ 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
+  !**********************************************
+    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
+!$OMP CRITICAL 
+      drygriduncn2(ix,jy,ks,kp,nunc,nage)= &
+           drygriduncn2(ix,jy,ks,kp,nunc,nage)+deposit(ks)*w
+!$OMP END CRITICAL
+  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)
+!$OMP CRITICAL 
+      drygriduncn2(ixp,jyp,ks,kp,nunc,nage)= &
+           drygriduncn2(ixp,jyp,ks,kp,nunc,nage)+deposit(ks)*w
+!$OMP END CRITICAL
+  endif
+
+  if ((ixp.ge.0).and.(jy.ge.0).and.(ixp.le.numxgridn-1).and. &
+       (jy.le.numygridn-1)) then
+    w=(1.-wx)*wy
+!$OMP CRITICAL 
+      drygriduncn2(ixp,jy,ks,kp,nunc,nage)= &
+           drygriduncn2(ixp,jy,ks,kp,nunc,nage)+deposit(ks)*w
+!$OMP END CRITICAL
+  endif
+
+  if ((ix.ge.0).and.(jyp.ge.0).and.(ix.le.numxgridn-1).and. &
+       (jyp.le.numygridn-1)) then
+    w=wx*(1.-wy)
+!$OMP CRITICAL 
+      drygriduncn2(ix,jyp,ks,kp,nunc,nage)= &
+           drygriduncn2(ix,jyp,ks,kp,nunc,nage)+deposit(ks)*w
+!$OMP END CRITICAL
+  endif
+
+  endif
+
+    end do
+  endif !kernel
+
+end subroutine drydepokernel_nest
Index: /branches/jerome/src_flexwrf_v3.1/dynamic_viscosity.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/dynamic_viscosity.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/dynamic_viscosity.f90	(revision 16)
@@ -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/jerome/src_flexwrf_v3.1/erf.f
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/erf.f	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/erf.f	(revision 16)
@@ -0,0 +1,159 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                 *
+!* Jerome Brioude, Delia Arnold, Jerome Fast, 
+!* Andreas Stohl, Petra Seibert, A. Frank, Gerhard Wotawa *
+!* Caroline Forster, Sabine Eckhardt, John Burkhart, Harald Sodemann   *
+!*                                                                     *
+!* This file is part of FLEXPART WRF                                   *
+!*                                                                     *
+!* 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/>.   *
+!***********************************************************************
+!
+! J. Brioude: the version in fortran 9 gives some error. better use f77
+!
+c To be used, if the non-standard Fortran function erf does not exist on
+c your machine
+C
+C     aus:  Numerical Recipes (FORTRAN) / Chapter 6.                       
+C                                                                   
+C     6.1  FUNCTION GAMMLN                                         
+C     6.2  FUNCTION GAMMP   <6.2:GSER/6.2:GCF/6.1:GAMMLN>         
+C     6.2  FUNCTION GAMMQ   <6.2:GSER/6.2:GCF/6.1:GAMMLN>        
+C     6.2  SUBROUTINE GSER    <6.1:GAMMLN>                      
+C     6.2  SUBROUTINE GCF     <6.1:GAMMLN>                     
+C     6.2  FUNCTION ERF     <6.2:GAMMP/6.2:GSER/6.2:GCF/6.1:GAMMLN> 
+C     6.2  FUNCTION ERFC    <6.2.:GAMMP/6.2:GAMMQ/6.2:GSER/        
+C                            6.2:GCF/6.1:GAMMLN>                  
+C     6.2  FUNCTION ERFCC                                             
+C
+      FUNCTION GAMMLN(XX)
+      REAL*8 COF(6),STP,HALF,ONE,FPF,X,TMP,SER
+      DATA COF,STP/76.18009173D0,-86.50532033D0,24.01409822D0,
+     *    -1.231739516D0,.120858003D-2,-.536382D-5,2.50662827465D0/
+      DATA HALF,ONE,FPF/0.5D0,1.0D0,5.5D0/
+      X=XX-ONE
+      TMP=X+FPF
+      TMP=(X+HALF)*LOG(TMP)-TMP
+      SER=ONE
+      DO 11 J=1,6
+        X=X+ONE
+        SER=SER+COF(J)/X
+11    CONTINUE
+      GAMMLN=TMP+LOG(STP*SER)
+      RETURN
+      END
+C
+      FUNCTION GAMMP(A,X)
+      IF(X.LT.0..OR.A.LE.0.) STOP 'GAMMP'
+      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
+      RETURN
+      END
+C
+      FUNCTION GAMMQ(A,X)
+      IF(X.LT.0..OR.A.LE.0.) STOP 'GAMMQ'
+      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
+      RETURN
+      END
+C
+      SUBROUTINE GSER(GAMSER,A,X,GLN)
+      PARAMETER (ITMAX=100,EPS=3.E-7)
+      GLN=GAMMLN(A)
+      IF(X.LE.0.)THEN
+!       IF(X.LT.0.) PAUSE 'GSER'
+        GAMSER=0.
+        RETURN
+      ENDIF
+      AP=A
+      SUM=1./A
+      DEL=SUM
+      DO 11 N=1,ITMAX
+        AP=AP+1.
+        DEL=DEL*X/AP
+        SUM=SUM+DEL
+        IF(ABS(DEL).LT.ABS(SUM)*EPS)GO TO 1
+11    CONTINUE
+      STOP 'GSER: A too large, ITMAX too small'
+1     GAMSER=SUM*EXP(-X+A*LOG(X)-GLN)
+      RETURN
+      END
+C
+      SUBROUTINE GCF(GAMMCF,A,X,GLN)
+      PARAMETER (ITMAX=100,EPS=3.E-7)
+      GLN=GAMMLN(A)
+      GOLD=0.
+      A0=1.
+      A1=X
+      B0=0.
+      B1=1.
+      FAC=1.
+      DO 11 N=1,ITMAX
+        AN=FLOAT(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
+11    CONTINUE
+      STOP 'GCF: A too large, ITMAX too small'
+1     GAMMCF=EXP(-X+A*ALOG(X)-GLN)*G
+      RETURN
+      END
+C
+      FUNCTION erf(X)
+      IF(X.LT.0.)THEN
+        erf=-GAMMP(.5,X**2)
+      ELSE
+        erf=GAMMP(.5,X**2)
+      ENDIF
+      RETURN
+      END
+C
+      FUNCTION ERFC(X)
+      IF(X.LT.0.)THEN
+        ERFC=1.+GAMMP(.5,X**2)
+      ELSE
+        ERFC=GAMMQ(.5,X**2)
+      ENDIF
+      RETURN
+      END
+C
+      FUNCTION ERFCC(X)
+      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
+      RETURN
+      END
+C
Index: /branches/jerome/src_flexwrf_v3.1/ew.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/ew.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/ew.f90	(revision 16)
@@ -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/jerome/src_flexwrf_v3.1/examples/AVAILABLE2
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/examples/AVAILABLE2	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/examples/AVAILABLE2	(revision 16)
@@ -0,0 +1,27 @@
+XXXXXX EMPTY LINES XXXXXXXXX
+XXXXXX EMPTY LINES XXXXXXXX
+YYYYMMDD HHMMSS   name of the file(up to 80 characters)
+20100518 000000      'wrfout_d02_2010-05-18_00.nc'      ' '
+20100518 003000      'wrfout_d02_2010-05-18_00.nc'      ' '
+20100518 010000      'wrfout_d02_2010-05-18_00.nc'      ' '
+20100518 013000      'wrfout_d02_2010-05-18_00.nc'      ' '
+20100518 020000      'wrfout_d02_2010-05-18_00.nc'      ' '
+20100518 023000      'wrfout_d02_2010-05-18_00.nc'      ' '
+20100518 030000      'wrfout_d02_2010-05-18_03.nc'      ' '
+20100518 033000      'wrfout_d02_2010-05-18_03.nc'      ' '
+20100518 040000      'wrfout_d02_2010-05-18_03.nc'      ' '
+20100518 043000      'wrfout_d02_2010-05-18_03.nc'      ' '
+20100518 050000      'wrfout_d02_2010-05-18_03.nc'      ' '
+20100518 053000      'wrfout_d02_2010-05-18_03.nc'      ' '
+20100518 060000      'wrfout_d02_2010-05-18_06.nc'      ' '
+20100518 063000      'wrfout_d02_2010-05-18_06.nc'      ' '
+20100518 070000      'wrfout_d02_2010-05-18_06.nc'      ' '
+20100518 073000      'wrfout_d02_2010-05-18_06.nc'      ' '
+20100518 080000      'wrfout_d02_2010-05-18_06.nc'      ' '
+20100518 083000      'wrfout_d02_2010-05-18_06.nc'      ' '
+20100518 090000      'wrfout_d02_2010-05-18_09.nc'      ' '
+20100518 093000      'wrfout_d02_2010-05-18_09.nc'      ' '
+20100518 100000      'wrfout_d02_2010-05-18_09.nc'      ' '
+20100518 103000      'wrfout_d02_2010-05-18_09.nc'      ' '
+20100518 110000      'wrfout_d02_2010-05-18_09.nc'      ' '
+20100518 113000      'wrfout_d02_2010-05-18_09.nc'      ' '
Index: /branches/jerome/src_flexwrf_v3.1/examples/AVAILABLE3
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/examples/AVAILABLE3	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/examples/AVAILABLE3	(revision 16)
@@ -0,0 +1,27 @@
+XXXXXX EMPTY LINES XXXXXXXXX
+XXXXXX EMPTY LINES XXXXXXXX
+YYYYMMDD HHMMSS   name of the file(up to 80 characters)
+20100518 000000      'wrfout_d03_2010-05-18_00.nc'      ' '
+20100518 003000      'wrfout_d03_2010-05-18_00.nc'      ' '
+20100518 010000      'wrfout_d03_2010-05-18_00.nc'      ' '
+20100518 013000      'wrfout_d03_2010-05-18_00.nc'      ' '
+20100518 020000      'wrfout_d03_2010-05-18_00.nc'      ' '
+20100518 023000      'wrfout_d03_2010-05-18_00.nc'      ' '
+20100518 030000      'wrfout_d03_2010-05-18_03.nc'      ' '
+20100518 033000      'wrfout_d03_2010-05-18_03.nc'      ' '
+20100518 040000      'wrfout_d03_2010-05-18_03.nc'      ' '
+20100518 043000      'wrfout_d03_2010-05-18_03.nc'      ' '
+20100518 050000      'wrfout_d03_2010-05-18_03.nc'      ' '
+20100518 053000      'wrfout_d03_2010-05-18_03.nc'      ' '
+20100518 060000      'wrfout_d03_2010-05-18_06.nc'      ' '
+20100518 063000      'wrfout_d03_2010-05-18_06.nc'      ' '
+20100518 070000      'wrfout_d03_2010-05-18_06.nc'      ' '
+20100518 073000      'wrfout_d03_2010-05-18_06.nc'      ' '
+20100518 080000      'wrfout_d03_2010-05-18_06.nc'      ' '
+20100518 083000      'wrfout_d03_2010-05-18_06.nc'      ' '
+20100518 090000      'wrfout_d03_2010-05-18_09.nc'      ' '
+20100518 093000      'wrfout_d03_2010-05-18_09.nc'      ' '
+20100518 100000      'wrfout_d03_2010-05-18_09.nc'      ' '
+20100518 103000      'wrfout_d03_2010-05-18_09.nc'      ' '
+20100518 110000      'wrfout_d03_2010-05-18_09.nc'      ' '
+20100518 113000      'wrfout_d03_2010-05-18_09.nc'      ' '
Index: /branches/jerome/src_flexwrf_v3.1/examples/README_FIRST.txt
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/examples/README_FIRST.txt	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/examples/README_FIRST.txt	(revision 16)
@@ -0,0 +1,49 @@
+Those test cases can be run by copying a compiled binary and the flexwrf.input file of a test case in a directory. In addition, data from the directory src_flexwrf_v3.0/data are required for calculating dry deposition for the Cesium species.
+The three test cases cover most of the format the input file should have if 2 output grid nests, ageclasses, several species with hourly emission variations are used.
+
+an example of AVAILABLE file with the proper format is given for 2 different domains, assuming that each WRF output has 6 time frames with a time interval output of 30 minutes.
+#################################
+file flexwrf.input.forward1: 
+- This case is a forward run (using LDIRECT=1) 
+- The output gives the concentration and deposition from the total release of the 2 release location by using IOUTPUTFOREACHREL=0
+- a passive airtracer and Cesium particles are released (NSPEC=2), without any hourly emission variation (EMITVAR=0)
+- 2 output grid are defined. They are defined using latitude/longitude coordinates, the number of grid cells  and the grid spacing
+- 2 ageclasses are asked by using LAGESPECTRA=1
+- The NetCDF output format is selected, with 3 time frames per file.
+
+Because the species #1 is a passive tracer, the dry and wet deposition fields
+are empty. The wet and dry deposition fields exist for species #2
+
+This test case can be run by typing
+./flexwrf30_pgi_omp flexwrf.input.forward1
+if, for instance, an OpenMP is compiled.
+#################################
+file flexwrf.input.forward2: 
+- This case is a forward run (using LDIRECT=1)
+- The output gives the concentration and deposition from each release location by using IOUTPUTFOREACHREL=1
+- a passive airtracer and Cesium particles are released (NSPEC=2), with hourly and daily emission variation (EMITVAR=1)
+- 1 output grid is defined. It is defined base on metric coordinates of the WRF output
+- No ageclass is used because  LAGESPECTRA=0
+- The NetCDF output format is selected, with 1 time frame per file. because IOUTPUTFOREACHREL=1, an additional dimension is used in the netcdf file compared to the case flexwrf.input.forward1
+
+This test case can be run by typing
+./flexwrf30_pgi_omp flexwrf.input.forward2
+if, for instance, an OpenMP is compiled.
+#################################
+file flexwrf.input.backward1:
+- This case is a backward run (using LDIRECT=-1)
+- Only one species is emitted, the passive airtracer.
+- The output gives the source-receptor relationship of the 3 release locations over Los Angeles Basin. Their vertical location is defined based on pressure
+- 1 output grid is defined. 
+- No ageclass is used because LAGESPECTRA=0
+- The binary format is selected. The header file (binary format), latlon*.txt files (ascii format) and grid_time* (binary format) files are generated.
+
+This test case can be run by typing
+./flexwrf30_pgi_omp flexwrf.input.backward1
+if, for instance, an OpenMP is compiled.
+
+#################################
+file flexwrf.input.backward2:
+Identical to flexwrf.input.backward1 except that 2 WRF nested output are read. (The nested WRF output files is not available on http://www.flexpart.eu)
+In such case, the OUTPUT grid can be defined in WRF coordinates but relative to the outer WRF domain.
+
Index: /branches/jerome/src_flexwrf_v3.1/examples/flexwrf.input.backward1
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/examples/flexwrf.input.backward1	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/examples/flexwrf.input.backward1	(revision 16)
@@ -0,0 +1,103 @@
+=====================FORMER PATHNAMES FILE===================
+/scratch2/portfolios/BMC/stela/jbrioude/flexwrf_backward1/
+/scratch2/portfolios/BMC/stela/jbrioude/wrfnomodif2/
+/scratch2/portfolios/BMC/stela/jbrioude/wrfnomodif2/AVAILABLE2
+=============================================================
+=====================FORMER COMMAND FILE=====================
+    -1               LDIRECT:          1 for forward simulation, -1 for backward simulation
+    20100518 000000  YYYYMMDD HHMISS   beginning date of simulation
+    20100518 110000  YYYYMMDD HHMISS   ending date of simulation
+    3600             SSSSS  (int)      output every SSSSS seconds
+    3600             SSSSS  (int)      time average of output (in SSSSS seconds)
+    180              SSSSS  (int)      sampling rate of output (in SSSSS seconds)
+    999999999        SSSSS  (int)      time constant for particle splitting (in seconds)
+    180              SSSSS  (int)      synchronisation interval of flexpart (in seconds)
+    10.              CTL    (real)     factor by which time step must be smaller than tl
+    10               IFINE  (int)      decrease of time step for vertical motion by factor ifine
+    1                IOUT              1 concentration, 2 mixing ratio, 3 both, 4 plume traject, 5=1+4
+    0                IPOUT             particle dump: 0 no, 1 every output interval, 2 only at end
+    0                LSUBGRID          subgrid terrain effect parameterization: 1 yes, 0 no
+    0                LCONVECTION       convection: 3 yes, 0 no
+    3600.            DT_CONV  (real)   time interval to call convection, seconds
+    0                LAGESPECTRA       age spectra: 1 yes, 0 no
+    0                IPIN              continue simulation with dumped particle data: 1 yes, 0 no
+    0                IFLUX             calculate fluxes: 1 yes, 0 no
+    1                IOUTPUTFOREACHREL CREATE AN OUPUT FILE FOR EACH RELEASE LOCATION: 1 YES, 0 NO
+    0                MDOMAINFILL       domain-filling trajectory option: 1 yes, 0 no, 2 strat. o3 tracer
+    1                IND_SOURCE        1=mass unit , 2=mass mixing ratio unit
+    2                IND_RECEPTOR      1=mass unit , 2=mass mixing ratio unit
+    0                NESTED_OUTPUT     shall nested output be used? 1 yes, 0 no
+    0                LINIT_COND   INITIAL COND. FOR BW RUNS: 0=NO,1=MASS UNIT,2=MASS MIXING RATIO UNIT
+    1                TURB_OPTION       0=no turbulence; 1=diagnosed as in flexpart_ecmwf; 2 and 3=from tke.
+    1                CBL SCHEME        0=no, 1=yes. works if TURB_OPTION=1
+    1                SFC_OPTION        0=default computation of u*, hflux, pblh, 1=from wrf
+   -1                WIND_OPTION       0=snapshot winds, 1=mean winds,2=snapshot eta-dot,-1=w based on divergence
+    0                TIME_OPTION       1=correction of time validity for time-average wind,  0=no need
+    0                OUTGRID_COORD     0=wrf grid(meters), 1=regular lat/lon grid
+    1                RELEASE_COORD     0=wrf grid(meters), 1=regular lat/lon grid
+    0                IOUTTYPE          0=default binary, 1=ascii (for particle dump only),2=netcdf
+    3                NCTIMEREC (int)   Time frames per output file, only used for netcdf
+    0                VERBOSE           VERBOSE MODE,0=minimum, 100=maximum
+=====================FORMER AGECLASESS FILE==================
+    2                NAGECLASS        number of age classes
+    7200             SSSSSS  (int)    age class in SSSSS seconds
+    999999           SSSSSS  (int)    age class in SSSSS seconds
+=====================FORMER OUTGRID FILE=====================
+ 0.                  OUTLONLEFT      geograhical longitude of lower left corner of output grid
+ 0.                  OUTLATLOWER     geographical latitude of lower left corner of output grid
+   100               NUMXGRID        number of grid points in x direction (= # of cells )
+   120               NUMYGRID        number of grid points in y direction (= # of cells )
+    1                OUTGRIDDEF      outgrid defined 0=using grid distance, 1=upperright corner coordinate
+ 1200000.            DXOUTLON        grid distance in x direction or upper right corner of output grid
+ 1440000.            DYOUTLON        grid distance in y direction or upper right corner of output grid
+    2                NUMZGRID        number of vertical levels
+    100.0            LEVEL           height of level (upper boundary)
+  20000.0            LEVEL           height of level (upper boundary)
+=====================FORMER RECEPTOR FILE====================
+    0                NUMRECEPTOR     number of receptors
+=====================FORMER SPECIES FILE=====================
+     2               NUMTABLE        number of variable properties. The following lines are fixed format
+XXXX|NAME    |decaytime |wetscava  |wetsb|drydif|dryhenry|drya|partrho  |parmean|partsig|dryvelo|weight |
+    AIRTRACER     -999.9   -9.9E-09         -9.9                 -9.9E09                   -9.99   29.00
+    Cs-137        -999.9    1.0E-04  0.80   -9.9                  2.5E03  6.0E-7  3.0E-1   -9.99   -9.99
+=====================FORMER RELEEASES FILE===================
+   1                NSPEC           total number of species emitted
+   0                EMITVAR         1 for emission variation 
+   1                LINK            index of species in file SPECIES
+3                  NUMPOINT        number of releases
+20100518 110000   ID1, IT1        beginning date and time of release
+20100518 110000   ID2, IT2        ending date and time of release
+-117.6152         XPOINT1 (real)  longitude [deg] of lower left corner
+  34.0450         YPOINT1 (real)  latitude [deg] of lower left corner
+-117.5952         XPOINT2 (real)  longitude [deg] of upper right corner
+  34.0650         YPOINT2 (real)  latitude [DEG] of upper right corner
+        3         KINDZ  (int)  1 for m above ground, 2 for m above sea level, 3 pressure
+  984.3800        ZPOINT1 (real)  lower z-level
+  972.5500        ZPOINT2 (real)  upper z-level
+   10000          NPART (int)     total number of particles to be released
+.1000E+01         XMASS (real)    total mass emitted
+release1            NAME OF RELEASE LOCATION
+20100518 110000
+20100518 110000
+-118.0229
+  34.1349
+-117.9913
+  34.1356
+        3
+   932.270
+   922.270
+   10000
+.1000E+01
+release2
+20100518 110000
+20100518 110000
+-116.9502
+  33.7114
+-116.9183
+  33.7341
+        3
+   687.110
+   677.110
+   10000
+.1000E+01
+release3
Index: /branches/jerome/src_flexwrf_v3.1/examples/flexwrf.input.backward2
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/examples/flexwrf.input.backward2	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/examples/flexwrf.input.backward2	(revision 16)
@@ -0,0 +1,105 @@
+=====================FORMER PATHNAMES FILE===================
+/scratch2/portfolios/BMC/stela/jbrioude/flexwrf_backward2/
+/scratch2/portfolios/BMC/stela/jbrioude/wrfnomodif2/
+/scratch2/portfolios/BMC/stela/jbrioude/wrfnomodif2/AVAILABLE2
+/scratch2/portfolios/BMC/stela/jbrioude/wrfnomodif2/
+/scratch2/portfolios/BMC/stela/jbrioude/wrfnomodif2/AVAILABLE3
+=============================================================
+=====================FORMER COMMAND FILE=====================
+    -1               LDIRECT:          1 for forward simulation, -1 for backward simulation
+    20100518 000000  YYYYMMDD HHMISS   beginning date of simulation
+    20100518 110000  YYYYMMDD HHMISS   ending date of simulation
+    3600             SSSSS  (int)      output every SSSSS seconds
+    3600             SSSSS  (int)      time average of output (in SSSSS seconds)
+    180              SSSSS  (int)      sampling rate of output (in SSSSS seconds)
+    999999999        SSSSS  (int)      time constant for particle splitting (in seconds)
+    180              SSSSS  (int)      synchronisation interval of flexpart (in seconds)
+    10.              CTL    (real)     factor by which time step must be smaller than tl
+    10               IFINE  (int)      decrease of time step for vertical motion by factor ifine
+    1                IOUT              1 concentration, 2 mixing ratio, 3 both, 4 plume traject, 5=1+4
+    0                IPOUT             particle dump: 0 no, 1 every output interval, 2 only at end
+    0                LSUBGRID          subgrid terrain effect parameterization: 1 yes, 0 no
+    0                LCONVECTION       convection: 3 yes, 0 no
+    3600.            DT_CONV  (real)   time interval to call convection, seconds
+    0                LAGESPECTRA       age spectra: 1 yes, 0 no
+    0                IPIN              continue simulation with dumped particle data: 1 yes, 0 no
+    0                IFLUX             calculate fluxes: 1 yes, 0 no
+    1                IOUTPUTFOREACHREL CREATE AN OUPUT FILE FOR EACH RELEASE LOCATION: 1 YES, 0 NO
+    0                MDOMAINFILL       domain-filling trajectory option: 1 yes, 0 no, 2 strat. o3 tracer
+    1                IND_SOURCE        1=mass unit , 2=mass mixing ratio unit
+    2                IND_RECEPTOR      1=mass unit , 2=mass mixing ratio unit
+    0                NESTED_OUTPUT     shall nested output be used? 1 yes, 0 no
+    0                LINIT_COND   INITIAL COND. FOR BW RUNS: 0=NO,1=MASS UNIT,2=MASS MIXING RATIO UNIT
+    1                TURB_OPTION       0=no turbulence; 1=diagnosed as in flexpart_ecmwf; 2 and 3=from tke.
+    1                CBL SCHEME        0=no, 1=yes. works if TURB_OPTION=1
+    1                SFC_OPTION        0=default computation of u*, hflux, pblh, 1=from wrf
+   -1                WIND_OPTION       0=snapshot winds, 1=mean winds,2=snapshot eta-dot,-1=w based on divergence
+    0                TIME_OPTION       1=correction of time validity for time-average wind,  0=no need
+    0                OUTGRID_COORD     0=wrf grid(meters), 1=regular lat/lon grid
+    1                RELEASE_COORD     0=wrf grid(meters), 1=regular lat/lon grid
+    0                IOUTTYPE          0=default binary, 1=ascii (for particle dump only),2=netcdf
+    3                NCTIMEREC (int)   Time frames per output file, only used for netcdf
+    0                VERBOSE           VERBOSE MODE,0=minimum, 100=maximum
+=====================FORMER AGECLASESS FILE==================
+    2                NAGECLASS        number of age classes
+    7200             SSSSSS  (int)    age class in SSSSS seconds
+    999999           SSSSSS  (int)    age class in SSSSS seconds
+=====================FORMER OUTGRID FILE=====================
+ 0.                  OUTLONLEFT      geograhical longitude of lower left corner of output grid
+ 0.                  OUTLATLOWER     geographical latitude of lower left corner of output grid
+   100               NUMXGRID        number of grid points in x direction (= # of cells )
+   120               NUMYGRID        number of grid points in y direction (= # of cells )
+    1                OUTGRIDDEF      outgrid defined 0=using grid distance, 1=upperright corner coordinate
+ 1200000.            DXOUTLON        grid distance in x direction or upper right corner of output grid
+ 1440000.            DYOUTLON        grid distance in y direction or upper right corner of output grid
+    2                NUMZGRID        number of vertical levels
+    100.0            LEVEL           height of level (upper boundary)
+  20000.0            LEVEL           height of level (upper boundary)
+=====================FORMER RECEPTOR FILE====================
+    0                NUMRECEPTOR     number of receptors
+=====================FORMER SPECIES FILE=====================
+     2               NUMTABLE        number of variable properties. The following lines are fixed format
+XXXX|NAME    |decaytime |wetscava  |wetsb|drydif|dryhenry|drya|partrho  |parmean|partsig|dryvelo|weight |
+    AIRTRACER     -999.9   -9.9E-09         -9.9                 -9.9E09                   -9.99   29.00
+    Cs-137        -999.9    1.0E-04  0.80   -9.9                  2.5E03  6.0E-7  3.0E-1   -9.99   -9.99
+=====================FORMER RELEEASES FILE===================
+   1                NSPEC           total number of species emitted
+   0                EMITVAR         1 for emission variation 
+   1                LINK            index of species in file SPECIES
+3                  NUMPOINT        number of releases
+20100518 110000   ID1, IT1        beginning date and time of release
+20100518 110000   ID2, IT2        ending date and time of release
+-117.6152         XPOINT1 (real)  longitude [deg] of lower left corner
+  34.0450         YPOINT1 (real)  latitude [deg] of lower left corner
+-117.5952         XPOINT2 (real)  longitude [deg] of upper right corner
+  34.0650         YPOINT2 (real)  latitude [DEG] of upper right corner
+        3         KINDZ  (int)  1 for m above ground, 2 for m above sea level, 3 pressure
+  984.3800        ZPOINT1 (real)  lower z-level
+  972.5500        ZPOINT2 (real)  upper z-level
+   10000          NPART (int)     total number of particles to be released
+.1000E+01         XMASS (real)    total mass emitted
+release1            NAME OF RELEASE LOCATION
+20100518 110000
+20100518 110000
+-118.0229
+  34.1349
+-117.9913
+  34.1356
+        3
+   932.270
+   922.270
+   10000
+.1000E+01
+release2
+20100518 110000
+20100518 110000
+-116.9502
+  33.7114
+-116.9183
+  33.7341
+        3
+   687.110
+   677.110
+   10000
+.1000E+01
+release3
Index: /branches/jerome/src_flexwrf_v3.1/examples/flexwrf.input.forward1
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/examples/flexwrf.input.forward1	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/examples/flexwrf.input.forward1	(revision 16)
@@ -0,0 +1,103 @@
+=====================FORMER PATHNAMES FILE===================
+/scratch2/portfolios/BMC/stela/jbrioude/test_depo1/
+/scratch2/portfolios/BMC/stela/jbrioude/wrfnomodif2/
+/scratch2/portfolios/BMC/stela/jbrioude/wrfnomodif2/AVAILABLE2
+=============================================================
+=====================FORMER COMMAND FILE=====================
+    1                LDIRECT:          1 for forward simulation, -1 for backward simulation
+    20100518 000000  YYYYMMDD HHMISS   beginning date of simulation
+    20100518 110000  YYYYMMDD HHMISS   ending date of simulation
+    3600             SSSSS  (int)      output every SSSSS seconds
+    3600             SSSSS  (int)      time average of output (in SSSSS seconds)
+    180              SSSSS  (int)      sampling rate of output (in SSSSS seconds)
+    999999999        SSSSS  (int)      time constant for particle splitting (in seconds)
+    180              SSSSS  (int)      synchronisation interval of flexpart (in seconds)
+    10.              CTL    (real)     factor by which time step must be smaller than tl
+    10               IFINE  (int)      decrease of time step for vertical motion by factor ifine
+    1                IOUT              1 concentration, 2 mixing ratio, 3 both, 4 plume traject, 5=1+4
+    0                IPOUT             particle dump: 0 no, 1 every output interval, 2 only at end
+    0                LSUBGRID          subgrid terrain effect parameterization: 1 yes, 0 no
+    0                LCONVECTION       convection: 3 yes, 0 no
+    3600.            DT_CONV  (real)   time interval to call convection, seconds
+    1                LAGESPECTRA       age spectra: 1 yes, 0 no
+    0                IPIN              continue simulation with dumped particle data: 1 yes, 0 no
+    0                IFLUX             calculate fluxes: 1 yes, 0 no
+    0                IOUTPUTFOREACHREL CREATE AN OUPUT FILE FOR EACH RELEASE LOCATION: 1 YES, 0 NO
+    0                MDOMAINFILL       domain-filling trajectory option: 1 yes, 0 no, 2 strat. o3 tracer
+    1                IND_SOURCE        1=mass unit , 2=mass mixing ratio unit
+    2                IND_RECEPTOR      1=mass unit , 2=mass mixing ratio unit
+    1                NESTED_OUTPUT     shall nested output be used? 1 yes, 0 no
+    0                LINIT_COND   INITIAL COND. FOR BW RUNS: 0=NO,1=MASS UNIT,2=MASS MIXING RATIO UNIT
+    1                TURB_OPTION       0=no turbulence; 1=diagnosed as in flexpart_ecmwf; 2 and 3=from tke.
+    0                CBL SCHEME        0=no, 1=yes. works if TURB_OPTION=1
+    1                SFC_OPTION        0=default computation of u*, hflux, pblh, 1=from wrf
+    1                WIND_OPTION       0=snapshot winds, 1=mean winds,2=snapshot eta-dot,-1=w based on divergence
+    1                TIME_OPTION       1=correction of time validity for time-average wind,  0=no need
+    1                OUTGRID_COORD     0=wrf grid(meters), 1=regular lat/lon grid
+    1                RELEASE_COORD     0=wrf grid(meters), 1=regular lat/lon grid
+    2                IOUTTYPE          0=default binary, 1=ascii (for particle dump only),2=netcdf
+    3                NCTIMEREC (int)   Time frames per output file, only used for netcdf
+    0                VERBOSE           VERBOSE MODE,0=minimum, 100=maximum
+=====================FORMER AGECLASESS FILE==================
+    2                NAGECLASS        number of age classes
+    7200             SSSSSS  (int)    age class in SSSSS seconds
+    999999           SSSSSS  (int)    age class in SSSSS seconds
+=====================FORMER OUTGRID FILE=====================
+   -123.00            OUTLONLEFT      geograhical longitude of lower left corner of output grid
+    38.0              OUTLATLOWER     geographical latitude of lower left corner of output grid
+    24               NUMXGRID        number of grid points in x direction (= # of cells )
+    28               NUMYGRID        number of grid points in y direction (= # of cells )
+    0                OUTGRIDDEF      outgrid defined 0=using grid distance, 1=upperright corner coordinate
+    0.1250           DXOUTLON        grid distance in x direction or upper right corner of output grid
+    0.1250           DYOUTLON        grid distance in y direction or upper right corner of output grid
+    3                NUMZGRID        number of vertical levels
+    100.0            LEVEL           height of level (upper boundary)
+   1000.0            LEVEL           height of level (upper boundary)
+  20000.0            LEVEL           height of level (upper boundary)
+================OUTGRID_NEST==========================
+   -123.             OUTLONLEFT      geograhical longitude of lower left corner of output grid
+    38.00             OUTLATLOWER     geographical latitude of lower left corner of output grid
+    24               NUMXGRID        number of grid points in x direction (= # of cells )
+    28               NUMYGRID        number of grid points in y direction (= # of cells )
+    0                OUTGRIDDEF      outgrid defined 0=using grid distance, 1=upperright corner coordinate
+    0.125            DXOUTLON        grid distance in x direction or upper right corner of output grid
+    0.125            DYOUTLON        grid distance in y direction or upper right corner of output grid
+=====================FORMER RECEPTOR FILE====================
+    0                NUMRECEPTOR     number of receptors
+=====================FORMER SPECIES FILE=====================
+     2               NUMTABLE        number of variable properties. The following lines are fixed format
+XXXX|NAME    |decaytime |wetscava  |wetsb|drydif|dryhenry|drya|partrho  |parmean|partsig|dryvelo|weight |
+    AIRTRACER     -999.9   -9.9E-09         -9.9                 -9.9E09                   -9.99   29.00
+    Cs-137        -999.9    1.0E-04  0.80   -9.9                  2.5E03  6.0E-7  3.0E-1   -9.99   -9.99
+=====================FORMER RELEEASES FILE===================
+   2                NSPEC           total number of species emitted
+   0                EMITVAR         1 for emission variation 
+   1                LINK            index of species in file SPECIES
+   2                LINK            index of species in file SPECIES
+2                 NUMPOINT        number of releases
+20100518 000000   ID1, IT1        beginning date and time of release
+20100518 110000   ID2, IT2        ending date and time of release
+-123.0000         XPOINT1 (real)  longitude [deg] of lower left corner
+  40.3000         YPOINT1 (real)  latitude [deg] of lower left corner
+-122.6000         XPOINT2 (real)  longitude [deg] of upper right corner
+  40.6000         YPOINT2 (real)  latitude [DEG] of upper right corner
+        1         KINDZ  (int)  1 for m above ground, 2 for m above sea level, 3 pressure
+   100.000        ZPOINT1 (real)  lower z-level
+  1000.000        ZPOINT2 (real)  upper z-level
+   50000          NPART (int)     total number of particles to be released
+.1000E+04         XMASS (real)    total mass emitted
+.1000E+04         XMASS (real)    total mass emitted
+box1              NAME OF RELEASE LOCATION
+20100518 000000
+20100518 110000
+-122.0000
+  38.3000
+-121.6000
+  38.6000
+        1
+   100.000
+  1000.000
+   50000
+.5000E+04
+.1000E+04
+box2
Index: /branches/jerome/src_flexwrf_v3.1/examples/flexwrf.input.forward2
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/examples/flexwrf.input.forward2	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/examples/flexwrf.input.forward2	(revision 16)
@@ -0,0 +1,157 @@
+=====================FORMER PATHNAMES FILE===================
+/scratch2/portfolios/BMC/stela/jbrioude/flexwrf_forward2/
+/scratch2/portfolios/BMC/stela/jbrioude/wrfnomodif2/
+/scratch2/portfolios/BMC/stela/jbrioude/wrfnomodif2/AVAILABLE2
+=============================================================
+=====================FORMER COMMAND FILE=====================
+    1                LDIRECT:          1 for forward simulation, -1 for backward simulation
+    20100518 000000  YYYYMMDD HHMISS   beginning date of simulation
+    20100518 110000  YYYYMMDD HHMISS   ending date of simulation
+    3600             SSSSS  (int)      output every SSSSS seconds
+    3600             SSSSS  (int)      time average of output (in SSSSS seconds)
+    180              SSSSS  (int)      sampling rate of output (in SSSSS seconds)
+    999999999        SSSSS  (int)      time constant for particle splitting (in seconds)
+    180              SSSSS  (int)      synchronisation interval of flexpart (in seconds)
+    10.              CTL    (real)     factor by which time step must be smaller than tl
+    10               IFINE  (int)      decrease of time step for vertical motion by factor ifine
+    1                IOUT              1 concentration, 2 mixing ratio, 3 both, 4 plume traject, 5=1+4
+    0                IPOUT             particle dump: 0 no, 1 every output interval, 2 only at end
+    0                LSUBGRID          subgrid terrain effect parameterization: 1 yes, 0 no
+    0                LCONVECTION       convection: 3 yes, 0 no
+    3600.            DT_CONV  (real)   time interval to call convection, seconds
+    0                LAGESPECTRA       age spectra: 1 yes, 0 no
+    0                IPIN              continue simulation with dumped particle data: 1 yes, 0 no
+    0                IFLUX             calculate fluxes: 1 yes, 0 no
+    1                IOUTPUTFOREACHREL CREATE AN OUPUT FILE FOR EACH RELEASE LOCATION: 1 YES, 0 NO
+    0                MDOMAINFILL       domain-filling trajectory option: 1 yes, 0 no, 2 strat. o3 tracer
+    1                IND_SOURCE        1=mass unit , 2=mass mixing ratio unit
+    1                IND_RECEPTOR      1=mass unit , 2=mass mixing ratio unit
+    0                NESTED_OUTPUT     shall nested output be used? 1 yes, 0 no
+    0                LINIT_COND   INITIAL COND. FOR BW RUNS: 0=NO,1=MASS UNIT,2=MASS MIXING RATIO UNIT
+    1                TURB_OPTION       0=no turbulence; 1=diagnosed as in flexpart_ecmwf; 2 and 3=from tke.
+    1                CBL SCHEME        0=no, 1=yes. works if TURB_OPTION=1
+    1                SFC_OPTION        0=default computation of u*, hflux, pblh, 1=from wrf
+    0                WIND_OPTION       0=snapshot winds, 1=mean winds,2=snapshot eta-dot,-1=w based on divergence
+    0                TIME_OPTION       1=correction of time validity for time-average wind,  0=no need
+    0                OUTGRID_COORD     0=wrf grid(meters), 1=regular lat/lon grid
+    1                RELEASE_COORD     0=wrf grid(meters), 1=regular lat/lon grid
+    2                IOUTTYPE          0=default binary, 1=ascii (for particle dump only),2=netcdf
+    1                NCTIMEREC (int)   Time frames per output file, only used for netcdf
+    0                VERBOSE           VERBOSE MODE,0=minimum, 100=maximum
+=====================FORMER AGECLASESS FILE==================
+    2                NAGECLASS        number of age classes
+    7200             SSSSSS  (int)    age class in SSSSS seconds
+    999999           SSSSSS  (int)    age class in SSSSS seconds
+=====================FORMER OUTGRID FILE=====================
+ 0.                  OUTLONLEFT      geograhical longitude of lower left corner of output grid
+ 0.                  OUTLATLOWER     geographical latitude of lower left corner of output grid
+   100               NUMXGRID        number of grid points in x direction (= # of cells )
+   120               NUMYGRID        number of grid points in y direction (= # of cells )
+    1                OUTGRIDDEF      outgrid defined 0=using grid distance, 1=upperright corner coordinate
+ 1200000.            DXOUTLON        grid distance in x direction or upper right corner of output grid
+ 1440000.            DYOUTLON        grid distance in y direction or upper right corner of output grid
+    3                NUMZGRID        number of vertical levels
+    100.0            LEVEL           height of level (upper boundary)
+   1000.0            LEVEL           height of level (upper boundary)
+  20000.0            LEVEL           height of level (upper boundary)
+=====================FORMER RECEPTOR FILE====================
+    0                NUMRECEPTOR     number of receptors
+=====================FORMER SPECIES FILE=====================
+     2               NUMTABLE        number of variable properties. The following lines are fixed format
+XXXX|NAME    |decaytime |wetscava  |wetsb|drydif|dryhenry|drya|partrho  |parmean|partsig|dryvelo|weight |
+    AIRTRACER     -999.9   -9.9E-09         -9.9                 -9.9E09                   -9.99   29.00
+    Cs-137        -999.9    1.0E-04  0.80   -9.9                  2.5E03  6.0E-7  3.0E-1   -9.99   -9.99
+=====================FORMER RELEEASES FILE===================
+   2                NSPEC           total number of species emitted
+   1                EMITVAR         1 for emission variation 
+   1                LINK            index of species in file SPECIES
+    0  0.487  0.932      0-1 local time
+    1  0.273  0.931      1-2 local time
+    2  0.169  0.927
+    3  0.138  0.926
+    4  0.212  0.928
+    5  0.492  0.936
+    6  0.993  0.952
+    7  1.386  0.975
+    8  1.493  1.046
+    9  1.299  1.055
+   10  1.218  1.061
+   11  1.204  1.064
+   12  1.228  1.067
+   13  1.273  1.068
+   14  1.334  1.069
+   15  1.475  1.068
+   16  1.570  1.024
+   17  1.645  1.017
+   18  1.590  1.008
+   19  1.312  1.007
+   20  1.021  1.004
+   21  0.854  0.996
+   22  0.753  0.981
+   23  0.580  0.958      23-24 local time
+   1        1.000       1.000      Monday
+   2        1.000       1.000      Tuesday
+   3        1.000       1.000      Wednesday
+   4        1.000       1.000      Thursday
+   5        1.000       1.000      Friday
+   6        1.000       1.000      Saturday
+   7        1.000       1.000      Sunday
+    2                LINK            index of species in file SPECIES
+    0  0.487  0.932      0-1 local time
+    1  0.273  0.931      1-2 local time
+    2  0.169  0.927
+    3  0.138  0.926
+    4  0.212  0.928
+    5  0.492  0.936
+    6  0.993  0.952
+    7  1.386  0.975
+    8  1.493  1.046
+    9  1.299  1.055
+   10  1.218  1.061
+   11  1.204  1.064
+   12  1.228  1.067
+   13  1.273  1.068
+   14  1.334  1.069
+   15  1.475  1.068
+   16  1.570  1.024
+   17  1.645  1.017
+   18  1.590  1.008
+   19  1.312  1.007
+   20  1.021  1.004
+   21  0.854  0.996
+   22  0.753  0.981
+   23  0.580  0.958      23-24 local time
+   1        1.000       1.000      Monday
+   2        1.000       1.000      Tuesday
+   3        1.000       1.000      Wednesday
+   4        1.000       1.000      Thursday
+   5        1.000       1.000      Friday
+   6        1.000       1.000      Saturday
+   7        1.000       1.000      Sunday
+2                 NUMPOINT        number of releases
+20100518 000000   ID1, IT1        beginning date and time of release
+20100518 110000   ID2, IT2        ending date and time of release
+-123.0000         XPOINT1 (real)  longitude [deg] of lower left corner
+  40.3000         YPOINT1 (real)  latitude [deg] of lower left corner
+-122.6000         XPOINT2 (real)  longitude [deg] of upper right corner
+  40.6000         YPOINT2 (real)  latitude [DEG] of upper right corner
+        1         KINDZ  (int)  1 for m above ground, 2 for m above sea level, 3 pressure
+   100.000        ZPOINT1 (real)  lower z-level
+  1000.000        ZPOINT2 (real)  upper z-level 
+   50000          NPART (int)     total number of particles to be released
+.1000E+04         XMASS (real)    total mass emitted
+.1000E+04         XMASS (real)    total mass emitted
+release_1         NAME OF RELEASE LOCATION
+20100518 000000
+20100518 110000
+-122.0000
+  38.3000
+-121.6000
+  38.6000
+        1
+   100.000
+  1000.000
+   50000
+.5000E+04
+.1000E+04
+release_2
Index: /branches/jerome/src_flexwrf_v3.1/f_get_coeff.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/f_get_coeff.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/f_get_coeff.f90	(revision 16)
@@ -0,0 +1,93 @@
+subroutine f_get_coeff(nn,mm,rr,ww,avec,nj,id,pp,np)
+!===============================================================================
+! Compute MT jump ahead polynomial coefficients
+! uses GF(2)[x] computation
+!===============================================================================
+  use mt_kind_defs
+  use gf2xe
+  implicit none
+  integer(INT32), intent(in) :: nn,mm,rr,ww,avec,nj,id
+  integer(INT32), intent(inout) :: pp(0:nn-1),np
+  type(gf2x_obj) :: af,bf,ff,f1,f2
+  type(gf2x_prime_obj) :: fp
+  integer(INT32) :: i,ib,nws
+
+!==============================
+! MT characteristic polynomial
+!  ff : MT char poly.
+!==============================
+  call set_coef(af,nn)
+  call set_coef(af,mm)   ! af = x^nn + x^mm
+  call set_coef(bf,nn-1)
+  call set_coef(bf,mm-1) ! bf = x^(nn-1) + x^(mm-1)
+
+  call pow(f1,af,ww-rr)  ! f1 = af^(ww-rr)
+  call pow(f2,bf,rr)     ! f2 = bf^(rr)
+  call mult(ff,f1,f2)    ! ff = f1*f2
+  do i=0,rr-1
+    ib = mod(i,ww)
+    if (BTEST(avec,ib)) then
+      call pow(f2,bf,rr-1-i)
+      call mult_assign(f2,f1)
+      call add_assign(ff,f2)
+    endif
+  enddo
+  do i=rr,ww-1
+    ib = mod(i,ww)
+    if (BTEST(avec,ib)) then
+      call pow(f1,af,ww-1-i)
+      call add_assign(ff,f1)
+    endif
+  enddo
+
+!#ifdef _DEBUG_
+!  write(*,'("@",$)')
+!  call print_hex(ff)
+!#endif
+
+  call delete(af)
+  call delete(bf)
+  call delete(f1)
+  call delete(f2)
+
+!==============================
+! set ff for Barrett reduction
+!==============================
+  call set_prime(fp,ff)  ! fp = ff
+  call delete(ff)
+  call delete(f1)
+  call delete(f2)
+
+!===============
+! jump ahead
+!  long jump
+!===============
+  call gf2x_pow_pow_2(f1,nj,fp)   ! f1 = x**(2**nj) mod fp
+
+!#ifdef _DEBUG_
+!  write(*,'("@",$)')
+!  call print_hex(f1)
+!#endif
+
+!===============
+! short jump
+!===============
+  call pow(ff,f1,id,fp) ! ff = f1**id mod fp
+
+!#ifdef _DEBUG_
+!  write(*,'("@",$)')
+!  call print_hex(ff)
+!#endif
+
+  pp(:) = 0
+  np = get_deg(ff)+1
+  nws = CEILING(real(np,kind=KIND(1.0d0))/32)
+  pp(0:nws-1) = ff%c(0:nws-1)
+
+  call delete(f1)
+  call delete(f2)
+  call delete(ff)
+  call delete(fp)
+
+  return
+end subroutine
Index: /branches/jerome/src_flexwrf_v3.1/flexwrf.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/flexwrf.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/flexwrf.f90	(revision 16)
@@ -0,0 +1,287 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                *
+!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine,       *
+!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
+!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso,          *
+!* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann,   *
+!*                                                                     *
+!* This file is part of FLEXPART WRF                                   *
+!*                                                                     *
+!* 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 flexwrf
+!*******************************************************************************
+!                                                                              *
+!     This is the Lagrangian Particle Dispersion Model FLEXPART_WRF.           *
+!                                                                              *
+!         FLEXPART uses met. files from the ECMWF model (in grib format),      *
+!             and its internal computational grid is latitude-longitude.       *
+!                                                                              *
+!         FLEXPART_WRF uses met. files from the WRF model (in NetCDF format),  *
+!             and its internal computational grid is the WRF x-y grid.         *
+!                                                                              *
+!     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                                                              *
+!                                                                              *
+!     Nov 2005, R. Easter - Added the above comments and changed               *
+!                           the program name to "flexpart_wrf"                 *
+!                                                                              *
+!     Feb 2012, J Brioude- modify the name of the pilt_wrf model from PNLL     *
+!                          to flexwrf.
+!                          start doing versions                                *
+!                input information should be put in flexwr.input               *
+!     Mar 2012, J Brioude: Hybrid parallelization of v74. everything converted *
+!                   in fortran 90, based on version 90.1 of the main stream    *
+!                   version of FLEXPART.                                       *
+!     Jun 2012, J Brioude: Add tests on arguments to the flexwrf input file. *
+!*******************************************************************************
+!                                                                              *
+! Variables:                                                                   *
+!                                                                              *
+! Constants:                                                                   *
+!                                                                              *
+!*******************************************************************************
+
+
+  use point_mod
+  use par_mod
+  use com_mod
+  use conv_mod
+
+  use luxury
+  use mt_stream
+
+  implicit none
+
+! include 'mpif.h'
+
+  integer :: i,j,ix,jy,inest,ii
+! ,MPI_COMM_WORLD
+  integer :: idummy = -320
+  integer :: inext,inextp,ma(55),iff
+! integer, dimension(MPI_STATUS_SIZE) :: status
+  integer :: myid,ntasks,islave
+!  integer, parameter :: master=0, mstgtag1=11, msgtag2=12
+   integer :: ierr
+
+  real, external :: ran3  ! added by mc to use RAN3 using the original JB random number system 
+  integer, allocatable :: seed(:) ! here and below further variable used by the MT generator 
+  integer(4) :: iseed = 73519232
+  integer :: id
+  type (mt_state) :: mts (0: MAX_STREAM)
+  character :: nummpi_id*2  !for test on pc
+
+!      if (myid.eq.0) then
+!let's comment the line above to let each node reading and making the same
+!thing.
+
+!  save inext,inextp,ma,iff
+  iff=0
+!  call MPI_INIT( ierr )
+!  call MPI_COMM_RANK ( MPI_COMM_WORLD, myid, ierr )
+!  call MPI_COMM_SIZE ( MPI_COMM_WORLD, ntasks, ierr )
+
+     if (command_argument_count().eq.0) then
+     print*,'the input file used is flexwrf.input in the ' // &
+      'local folder of the executable'
+     inputname='flexwrf.input'
+     endif
+     if (command_argument_count().gt.0) then
+         call get_command_argument(1,inputname,len2,ierr)
+     print*,'the input file used is ' // inputname
+     endif
+
+
+! Generate a large number of random numbers
+!******************************************
+      if (newrandomgen.eq.0) then
+!      idummy = -320-(myid*4049)
+       idummy = -320
+      do j=1,maxomp
+      do i=1,maxrand-1,2
+      ii=i+(j-1)*maxrand
+        call gasdev1(idummy,rannumb(ii),rannumb(ii+1),inext,inextp,ma,iff)
+      enddo
+      enddo
+      ii=maxrand*maxomp
+      call gasdev1(idummy,rannumb(ii),rannumb(ii-1),inext,inextp,ma,iff)
+!     print*,'rand',myid
+!     print*,rannumb(1:5)
+!     call ranlux(uniform_rannumb,maxrandomp)  ! this generate a uniform
+!     distribution
+      else
+      idummy=254 !+myid*443   !different seed for different mpi processes are produced so indepedent stream for any mpi process suing RANLUX are certain
+      call RLUXGO(3,idummy,0,0)  ! this set the luxury level to 3 and initalize the generator for any myid 
+      do i=1,maxrand-1,2
+      call gasdevlux2R(rannumb(i),rannumb(i+1)) !this will generate a guassian distribution 
+      end do
+      call gasdevlux2R(rannumb(maxrand),rannumb(maxrand-1))
+      ! Generate a stream of uniform deviate random numbers to be used for CBL
+      call ranlux(uniform_rannumb,maxrand)  ! this generate a uniform distribution
+
+!----- comment by MC: now initialize the mersenne twister generator for a number
+!max_stream of possible streams 
+!----- to be called subsequently by any openmp process activated. note RANLUX
+!above is suppose to be the best generator
+!----- but it is slower than mersenne twister and moreover it would require some
+!adaptation for workiong with openmp processes
+      !do this on any mpi_process taht will have  a copy of all the MT generator
+      !initialization
+      ! set parameters
+
+      call set_mt19937
+
+      !  initialize MT state type
+      call new (mts(0))
+
+      call init (mts(0),iseed)   !iseed unique and defined above. note that the lenght of the period of the master stream is about 2^19000
+
+      !  initialize additional streams from the master. this is done jumping
+      !  between different points in the stream any child stream has period
+      !  2^256
+      do id=1, MAX_STREAM
+      call create_stream (mts(0),mts(id),id)
+      end do
+      end if
+
+
+! Read the unified input file - jdf
+!***************************
+
+      call readinput
+
+   if ( DRYDEP ) then
+! Read the landuse inventory
+!***************************
+
+      call readlanduse
+
+! Assign fractional cover of landuse classes to each ECMWF grid point
+!********************************************************************
+
+      call assignland
+
+! Read and compute surface resistances to dry deposition of gases
+!****************************************************************
+
+      call readdepo
+   endif
+
+! Convert the release point coordinates from geografical to grid coordinates
+!***************************************************************************
+
+      call coordtrafo
+
+! Initialize all particles to non-existent
+!*****************************************
+
+!      do j=1,maxpart
+!        itra1(j)=-999999999
+!      enddo
+
+! For continuation of previous run, read in particle positions
+!*************************************************************
+
+      if (ipin.eq.1) then
+        call readpartpositions
+      else
+        numpart=0
+    numparticlecount=0
+
+      endif
+
+
+! Calculate volume, surface area, etc., of all output grid cells
+!***************************************************************
+!      if (myid.eq.0) then
+      if (outgrid_option.eq.0) then 
+      call outgrid_init_irreg
+      if (nested_output.eq.1) call outgrid_init_nest_irreg !need to be fixed
+      elseif (outgrid_option.eq.1) then
+      call outgrid_init_reg
+      if (nested_output.eq.1) call outgrid_init_nest_reg !need to be fixed
+      endif 
+!      endif
+
+
+  ! Read the OH field
+  !******************
+
+  if (OHREA.eqv..TRUE.) &
+       call readohfield
+
+! Write basic information on the simulation to a file "header"
+! and open files that are to be kept open throughout the simulation
+!******************************************************************
+
+!      if (myid.eq.0) then
+      if (iouttype.eq.0 .or. iouttype.eq.1) then ! binary or ascii output
+        call writeheader
+        if (nested_output.eq.1) call writeheader_nest() !need to be fixed
+      else  ! netcdf output
+        call write_ncheader(0,0)
+        if (nested_output.eq.1)  call write_ncheader(0,1)
+      endif !iouttype
+!  open(unitdates,file=path(2)(1:length(2))//'dates')
+      open(unitdates,file=path(1)(1:length(1))//'dates')
+      call openreceptors
+      if ((iout.eq.4).or.(iout.eq.5)) call openouttraj
+
+!      endif
+! Releases can only start and end at discrete times (multiples of lsynctime)
+!***************************************************************************
+      
+      do i=1,numpoint
+        ireleasestart(i)=nint(real(ireleasestart(i))/ &
+        real(lsynctime))*lsynctime
+        ireleaseend(i)=nint(real(ireleaseend(i))/ &
+        real(lsynctime))*lsynctime
+        enddo
+
+! Initialize cloud-base mass fluxes for the convection scheme
+!************************************************************
+
+      do jy=0,nymin1
+        do ix=0,nxmin1
+        cbaseflux(ix,jy)=0.
+    end do
+  end do
+
+      do  inest=1,numbnests
+        do  jy=0,nyn(inest)-1
+          do  ix=0,nxn(inest)-1
+          cbasefluxn(ix,jy,inest)=0.
+    end do
+  end do
+  end do
+
+
+! Calculate particle trajectories
+!********************************
+!     endif !if condition on myid
+!    call MPI_BARRIER(MPI_COMM_WORLD,ierr)
+
+      call timemanager(mts)
+
+
+      write(*,'(/a/)') 'CONGRATULATIONS: YOU HAVE SUCCESSFULLY ' //  &
+        'COMPLETED A FLEXPART_WRF MODEL RUN!'
+
+!   call MPI_FINALIZE ( ierr )
+
+end program flexwrf
+
Index: /branches/jerome/src_flexwrf_v3.1/flexwrf.input.reference
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/flexwrf.input.reference	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/flexwrf.input.reference	(revision 16)
@@ -0,0 +1,92 @@
+=====================FORMER PATHNAMES FILE===================
+/scratch2/portfolios/BMC/stela/jbrioude/flexwrf_forward1/
+/scratch2/portfolios/BMC/stela/jbrioude/wrfnomodif2/
+/scratch2/portfolios/BMC/stela/jbrioude/wrfnomodif2/AVAILABLE2
+=============================================================
+=====================FORMER COMMAND FILE=====================
+    1                LDIRECT:          1 for forward simulation, -1 for backward simulation
+    20100518 000000  YYYYMMDD HHMISS   beginning date of simulation
+    20100518 110000  YYYYMMDD HHMISS   ending date of simulation
+    3600             SSSSS  (int)      output every SSSSS seconds
+    3600             SSSSS  (int)      time average of output (in SSSSS seconds)
+    180              SSSSS  (int)      sampling rate of output (in SSSSS seconds)
+    999999999        SSSSS  (int)      time constant for particle splitting (in seconds)
+    180              SSSSS  (int)      synchronisation interval of flexpart (in seconds)
+    10.              CTL    (real)     factor by which time step must be smaller than tl
+    10               IFINE  (int)      decrease of time step for vertical motion by factor ifine
+    1                IOUT              1 concentration, 2 mixing ratio, 3 both, 4 plume traject, 5=1+4
+    0                IPOUT             particle dump: 0 no, 1 every output interval, 2 only at end
+    0                LSUBGRID          subgrid terrain effect parameterization: 1 yes, 0 no
+    0                LCONVECTION       convection: 3 yes, 0 no
+    3600.            DT_CONV  (real)   time interval to call convection, seconds
+    1                LAGESPECTRA       age spectra: 1 yes, 0 no
+    0                IPIN              continue simulation with dumped particle data: 1 yes, 0 no
+    0                IFLUX             calculate fluxes: 1 yes, 0 no
+    0                IOUTPUTFOREACHREL CREATE AN OUPUT FILE FOR EACH RELEASE LOCATION: 1 YES, 0 NO
+    0                MDOMAINFILL       domain-filling trajectory option: 1 yes, 0 no, 2 strat. o3 tracer
+    1                IND_SOURCE        1=mass unit , 2=mass mixing ratio unit
+    2                IND_RECEPTOR      1=mass unit , 2=mass mixing ratio unit
+    0                NESTED_OUTPUT     shall nested output be used? 1 yes, 0 no
+    0                LINIT_COND   INITIAL COND. FOR BW RUNS: 0=NO,1=MASS UNIT,2=MASS MIXING RATIO UNIT
+    1                TURB_OPTION       0=no turbulence; 1=diagnosed as in flexpart_ecmwf; 2 and 3=from tke.
+    0                CBL SCHEME        0=no, 1=yes. works if TURB_OPTION=1
+    1                SFC_OPTION        0=default computation of u*, hflux, pblh, 1=from wrf
+    1                WIND_OPTION       0=snapshot winds, 1=mean winds,2=snapshot eta-dot,-1=w based on divergence
+    1                TIME_OPTION       1=correction of time validity for time-average wind,  0=no need
+    1                OUTGRID_COORD     0=wrf grid(meters), 1=regular lat/lon grid
+    1                RELEASE_COORD     0=wrf grid(meters), 1=regular lat/lon grid
+    2                IOUTTYPE          0=default binary, 1=ascii (for particle dump only),2=netcdf
+    3                NCTIMEREC (int)   Time frames per output file, only used for netcdf
+    0                VERBOSE           VERBOSE MODE,0=minimum, 100=maximum
+=====================FORMER AGECLASESS FILE==================
+    2                NAGECLASS        number of age classes
+    7200             SSSSSS  (int)    age class in SSSSS seconds
+    999999           SSSSSS  (int)    age class in SSSSS seconds
+=====================FORMER OUTGRID FILE=====================
+   -123.00            OUTLONLEFT      geograhical longitude of lower left corner of output grid
+    38.0              OUTLATLOWER     geographical latitude of lower left corner of output grid
+    24               NUMXGRID        number of grid points in x direction (= # of cells )
+    28               NUMYGRID        number of grid points in y direction (= # of cells )
+    0                OUTGRIDDEF      outgrid defined 0=using grid distance, 1=upperright corner coordinate
+    0.1250           DXOUTLON        grid distance in x direction or upper right corner of output grid
+    0.1250           DYOUTLON        grid distance in y direction or upper right corner of output grid
+    3                NUMZGRID        number of vertical levels
+    100.0            LEVEL           height of level (upper boundary)
+   1000.0            LEVEL           height of level (upper boundary)
+  20000.0            LEVEL           height of level (upper boundary)
+=====================FORMER RECEPTOR FILE====================
+    0                NUMRECEPTOR     number of receptors
+=====================FORMER SPECIES FILE=====================
+     2               NUMTABLE        number of variable properties. The following lines are fixed format
+XXXX|NAME    |decaytime |wetscava  |wetsb|drydif|dryhenry|drya|partrho  |parmean|partsig|dryvelo|weight |
+    AIRTRACER     -999.9   -9.9E-09         -9.9                 -9.9E09                   -9.99   29.00
+    Cs-137        -999.9    1.0E-04  0.80   -9.9                  2.5E03  6.0E-7  3.0E-1   -9.99   -9.99
+=====================FORMER RELEEASES FILE===================
+   1                NSPEC           total number of species emitted
+   0                EMITVAR         1 for emission variation 
+   1                LINK            index of species in file SPECIES
+2                 NUMPOINT        number of releases
+20100518 120000   ID1, IT1        beginning date and time of release
+20100518 220000   ID2, IT2        ending date and time of release
+-123.0000         XPOINT1 (real)  longitude [deg] of lower left corner
+  40.3000         YPOINT1 (real)  latitude [deg] of lower left corner
+-122.6000         XPOINT2 (real)  longitude [deg] of upper right corner
+  40.6000         YPOINT2 (real)  latitude [DEG] of upper right corner
+        1         KINDZ  (int)  1 for m above ground, 2 for m above sea level, 3 pressure
+   100.000        ZPOINT1 (real)  lower z-level
+  1000.000        ZPOINT2 (real)  upper z-level
+   50000          NPART (int)     total number of particles to be released
+.1000E+04         XMASS (real)    total mass emitted, species 1
+box1              NAME OF RELEASE LOCATION
+20100518 120000
+20100518 130000
+-122.0000
+  38.3000
+-121.6000
+  38.6000
+        1
+   100.000
+  1000.000
+   50000
+.5000E+04
+box2
Index: /branches/jerome/src_flexwrf_v3.1/flexwrf_mpi.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/flexwrf_mpi.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/flexwrf_mpi.f90	(revision 16)
@@ -0,0 +1,309 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                *
+!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine,       *
+!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
+!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso,          *
+!* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann,   *
+!*                                                                     *
+!* This file is part of FLEXPART WRF                                   *
+!*                                                                     *
+!* 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 flexwrf_mpi
+!
+!*******************************************************************************
+!                                                                              *
+!     This is the Lagrangian Particle Dispersion Model FLEXPART_WRF.           *
+!                                                                              *
+!         FLEXPART uses met. files from the ECMWF model (in grib format),      *
+!             and its internal computational grid is latitude-longitude.       *
+!                                                                              *
+!         FLEXPART_WRF uses met. files from the WRF model (in NetCDF format),  *
+!             and its internal computational grid is the WRF x-y grid.         *
+!                                                                              *
+!     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                                                              *
+!                                                                              *
+!     Nov 2005, R. Easter - Added the above comments and changed               *
+!                           the program name to "flexpart_wrf"                 *
+!                                                                              *
+!     Feb 2012, J Brioude- modify the name of the pilt_wrf model from PNLL     *
+!                          to flexwrf.
+!                          start doing versions                                *
+!                input information should be put in flexwr.input               *
+!     Mar 2012, J Brioude: Hybrid parallelization of v74. everything converted *
+!                   in fortran 90, based on version 90.1 of the main stream    *
+!                   version of FLEXPART.                                       *
+!     Jun 2012, J Brioude: Add tests on arguments to the flexwrf input file. *
+!*******************************************************************************
+!                                                                              *
+! Variables:                                                                   *
+!                                                                              *
+! Constants:                                                                   *
+!                                                                              *
+!*******************************************************************************
+
+
+  use point_mod
+  use par_mod
+  use com_mod
+  use conv_mod
+
+  !-- modules below added by mc for parallel random generaiton using teh RANLUX
+  !and Mersenne-Twister generator
+  use luxury
+  use mt_stream
+  implicit none
+
+  include 'mpif.h'
+
+  integer :: i,j,ix,jy,inest,ii
+!  integer :: MPI_COMM_WORLD
+  integer :: idummy 
+  integer :: inext,inextp,ma(55),iff
+  integer, dimension(MPI_STATUS_SIZE) :: status
+  integer :: myid,ntasks,ierr,islave
+! ,len2
+! character(len=200) :: inputname
+  real, external :: ran3  ! added by mc to use RAN3 using the original JB random number system 
+  integer, allocatable :: seed(:) ! here and below further variable used by the MT generator 
+  integer(4) :: iseed = 73519232
+  integer :: id
+  type (mt_state) :: mts (0: MAX_STREAM)
+  character :: nummpi_id*2  !for test on pc
+
+!  integer, parameter :: master=0, mstgtag1=11, msgtag2=12
+
+
+!      if (myid.eq.0) then
+!let's comment the line above to let each node reading and making the same
+!thing.
+
+!  save inext,inextp,ma,iff
+  iff=0
+!    print*,'before 1'
+  call MPI_INIT( ierr )
+  call MPI_COMM_RANK ( MPI_COMM_WORLD, myid, ierr )
+  call MPI_COMM_SIZE ( MPI_COMM_WORLD, ntasks, ierr )
+
+!    print*,'after 1'
+
+  print*,'MPI id',myid
+! Generate a large number of random numbers
+!         write(*,9100) 'degrees longitude,latitude', 
+!     +                 'degrees longitude,latitude'
+!      else
+!         write(*,9100) 'grid-meters', 'grid-meters'
+!      endif
+!9100  format( '    x,y coordinates in input  files must be in ', a /
+!     +        '    x,y coordinates in output files will be in ', a / )
+
+
+     if (command_argument_count().eq.0) then 
+     print*,'the input file used is flexwrf.input in the ' // &
+      'local folder of the executable'
+     inputname='flexwrf.input' 
+     endif
+     if (command_argument_count().gt.0) then  
+         call get_command_argument(1,inputname,len2,ierr)
+     print*,'the input file used is ' // inputname
+     endif
+! Generate a large number of random numbers
+!******************************************
+      if (newrandomgen.eq.0) then
+       idummy = -320-(myid*4049)
+!      idummy = -320
+      do j=1,maxomp
+      do i=1,maxrand-1,2
+      ii=i+(j-1)*maxrand        
+        call gasdev1(idummy,rannumb(ii),rannumb(ii+1),inext,inextp,ma,iff)
+      enddo
+      enddo
+      ii=maxrand*maxomp
+      call gasdev1(idummy,rannumb(ii),rannumb(ii-1),inext,inextp,ma,iff)
+!     print*,'rand',myid
+!     print*,rannumb(1:5)
+!     call ranlux(uniform_rannumb,maxrandomp)  ! this generate a uniform distribution
+      else
+      idummy=254+myid*443   !different seed for different mpi processes are produced so indepedent stream for any mpi process suing RANLUX are certain
+      call RLUXGO(3,idummy,0,0)  ! this set the luxury level to 3 and initalize the generator for any myid 
+      do i=1,maxrand-1,2
+      call gasdevlux2R(rannumb(i),rannumb(i+1)) !this will generate a guassian distribution 
+      end do
+      call gasdevlux2R(rannumb(maxrand),rannumb(maxrand-1))
+      ! Generate a stream of uniform deviate random numbers to be used for CBL
+      call ranlux(uniform_rannumb,maxrand)  ! this generate a uniform distribution
+
+!----- comment by MC: now initialize the mersenne twister generator for a number
+!max_stream of possible streams 
+!----- to be called subsequently by any openmp process activated. note RANLUX
+!above is suppose to be the best generator
+!----- but it is slower than mersenne twister and moreover it would require some
+!adaptation for workiong with openmp processes
+      !do this on any mpi_process taht will have  a copy of all the MT generator
+      !initialization
+      ! set parameters
+
+      call set_mt19937
+
+      !  initialize MT state type
+      call new (mts(0))
+
+      call init (mts(0),iseed)   !iseed unique and defined above. note that the lenght of the period of the master stream is about 2^19000
+
+      !  initialize additional streams from the master. this is done jumping
+      !  between different points in the stream any child stream has period
+      !  2^256
+      do id=1, MAX_STREAM
+      call create_stream (mts(0),mts(id),id)
+      end do
+      end if
+
+! Read the unified input file - jdf
+!***************************
+
+      call readinput
+
+   if ( DRYDEP ) then
+
+! Read the landuse inventory
+!***************************
+
+      call readlanduse
+
+! Assign fractional cover of landuse classes to each ECMWF grid point
+!********************************************************************
+
+      call assignland
+
+
+! Read and compute surface resistances to dry deposition of gases
+!****************************************************************
+
+      call readdepo
+   endif
+! Convert the release point coordinates from geografical to grid coordinates
+!***************************************************************************
+
+      call coordtrafo
+
+! Initialize all particles to non-existent
+!*****************************************
+
+!      do j=1,maxpart
+!        itra1(j)=-999999999
+!      enddo
+
+! For continuation of previous run, read in particle positions
+!*************************************************************
+
+      if (ipin.eq.1) then
+        call readpartpositions
+      else
+        numpart=0
+    numparticlecount=0
+
+      endif
+
+
+! Calculate volume, surface area, etc., of all output grid cells
+!***************************************************************
+!     if (myid.eq.0) then
+      if (outgrid_option.eq.0) then 
+      call outgrid_init_irreg
+      if (nested_output.eq.1) call outgrid_init_nest_irreg() !need to be fixed
+      elseif (outgrid_option.eq.1) then
+      call outgrid_init_reg
+      if (nested_output.eq.1) call outgrid_init_nest_reg() !need to be fixed
+      endif
+!     endif
+!     if (nested_output.eq.1) call outgrid_init_nest() !need to be fixed
+
+
+  ! Read the OH field
+  !******************
+
+  if (OHREA.eqv..TRUE.) &
+       call readohfield
+
+! Write basic information on the simulation to a file "header"
+! and open files that are to be kept open throughout the simulation
+!******************************************************************
+
+      if (myid.eq.0) then
+      if (iouttype.eq.0 .or. iouttype.eq.1) then ! binary or ascii output
+        call writeheader
+        if (nested_output.eq.1) call writeheader_nest() !need to be fixed
+      else  ! netcdf output
+        call write_ncheader(0,0)
+        if (nested_output.eq.1)  call write_ncheader(0,1)
+!       if (nested_output.eq.1) then
+!          write(*,*) 'netcdf nested output not finished yet! aborting'
+!          stop
+!       endif
+      endif !iouttype
+!  open(unitdates,file=path(2)(1:length(2))//'dates')
+      open(unitdates,file=path(1)(1:length(1))//'dates')
+      call openreceptors
+      if ((iout.eq.4).or.(iout.eq.5)) call openouttraj
+
+      endif
+! Releases can only start and end at discrete times (multiples of lsynctime)
+!***************************************************************************
+      
+      do i=1,numpoint
+        ireleasestart(i)=nint(real(ireleasestart(i))/ &
+        real(lsynctime))*lsynctime
+        ireleaseend(i)=nint(real(ireleaseend(i))/ &
+        real(lsynctime))*lsynctime
+        enddo
+
+! Initialize cloud-base mass fluxes for the convection scheme
+!************************************************************
+
+      do jy=0,nymin1
+        do ix=0,nxmin1
+        cbaseflux(ix,jy)=0.
+    end do
+  end do
+
+      do  inest=1,numbnests
+        do  jy=0,nyn(inest)-1
+          do  ix=0,nxn(inest)-1
+          cbasefluxn(ix,jy,inest)=0.
+    end do
+  end do
+  end do
+
+
+! Calculate particle trajectories
+!********************************
+!     endif !if condition on myid
+    call MPI_BARRIER(MPI_COMM_WORLD,ierr)
+
+
+!     print*,'entering timemanager'
+      call timemanager_mpi(mts)
+
+
+      write(*,'(/a/)') 'CONGRATULATIONS: YOU HAVE SUCCESSFULLY ' //  &
+        'COMPLETED A FLEXPART_WRF MODEL RUN!'
+
+   call MPI_FINALIZE ( ierr )
+
+end program flexwrf_mpi 
+
Index: /branches/jerome/src_flexwrf_v3.1/flux_mod.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/flux_mod.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/flux_mod.f90	(revision 16)
@@ -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/jerome/src_flexwrf_v3.1/fluxoutput.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/fluxoutput.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/fluxoutput.f90	(revision 16)
@@ -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(1)(1:length(1))//'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/jerome/src_flexwrf_v3.1/gasdevlux.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/gasdevlux.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/gasdevlux.f90	(revision 16)
@@ -0,0 +1,73 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                *
+!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine,       *
+!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
+!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso,          *
+!* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann,   *
+!* This file is part of FLEXPART WRF                                   *
+!*                                                                     *
+!* 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/>.   *
+!***********************************************************************
+    !C--- adapted from press et al. 1992 numerial recipes in Fortran by Massimo Cassiani to jse RANLUX as uniform random number generator
+      FUNCTION gasdevlux()
+      USE luxury
+      INTEGER idum
+      REAL gasdevlux     
+      INTEGER iset
+      REAL fac,gset,rsq,v1,v2,RTEST(2)
+      SAVE iset,gset
+      DATA iset/0/
+      if (iset.eq.0) then
+1      call RANLUX(RTEST,2)
+
+        v1=2.*RTEST(1)-1.
+        v2=2.*RTEST(2)-1.
+        rsq=v1**2+v2**2
+        if(rsq.ge.1..or.rsq.eq.0.)goto 1
+        fac=sqrt(-2.*log(rsq)/rsq)
+        gset=v1*fac
+        gasdevlux=v2*fac
+        iset=1
+      else
+        gasdevlux=gset
+        iset=0
+      endif
+      return
+      END
+      
+      subroutine gasdevlux2R(random1,random2)
+      USE luxury
+      INTEGER idum
+      REAL random1,random2      
+      INTEGER iset
+      REAL fac,gset,rsq,v1,v2,RTEST(2)
+      
+1      call RANLUX(RTEST,2)
+
+        v1=2.*RTEST(1)-1.
+        v2=2.*RTEST(2)-1.
+        rsq=v1**2+v2**2
+        if(rsq.ge.1..or.rsq.eq.0.)goto 1
+        fac=sqrt(-2.*log(rsq)/rsq)
+        random1=v1*fac
+        random2=v2*fac
+  ! Limit the random numbers to lie within the interval -4 and +4
+  !**************************************************************
+       if (random1.lt.-4.) random1=-4.
+       if (random2.lt.-4.) random2=-4.
+       if (random1.gt.4.) random1=4.
+       if (random2.gt.4.) random2=4.
+      return
+      END
+    
Index: /branches/jerome/src_flexwrf_v3.1/get_settling.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/get_settling.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/get_settling.f90	(revision 16)
@@ -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
+  !****************************************************************
+!  print*,'indice',indz,xt,yt,zt
+  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))
+!   print*,'cun',dquer(nsp),density(nsp),cunningham(nsp)
+    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/jerome/src_flexwrf_v3.1/getfields.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/getfields.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/getfields.f90	(revision 16)
@@ -0,0 +1,228 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                *
+!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine,       *
+!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
+!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso,          *
+!* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann,   *
+!*                                                                     *
+!* This file is part of FLEXPART WRF                                   *
+!*                                                                     *
+!* 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.                                           *
+!                                                                              *
+!  Dec 2005, R. Easter -                                                       *
+!          When "memtime(2) = itime = wftime(numbwf)", do not read a new file. *
+!          This allows the ending date/time of the flexpart run to match       *
+!          the date/time of the last met. file.                                *
+!                                                                              *
+!*******************************************************************************
+!                                                                              *
+! 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 calculation *
+! 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(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)
+   real(kind=4) :: divh(0:nxmax-1,0:nymax-1,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 :: wwh(0:nxmax-1,0:nymax-1,nwzmax)
+  real(kind=4) :: uuhn(0:nxmaxn-1,0:nymaxn-1,nuvzmax,maxnests)
+  real(kind=4) :: vvhn(0:nxmaxn-1,0:nymaxn-1,nuvzmax,maxnests)
+  real :: pvhn(0:nxmaxn-1,0:nymaxn-1,nuvzmax,maxnests)
+  real(kind=4) :: wwhn(0:nxmaxn-1,0:nymaxn-1,nwzmax,maxnests)
+  real :: start, finish
+
+  integer :: indmin = 1
+
+
+   real(kind=4) :: divhn(0:nxmaxn-1,0:nymaxn-1,nuvzmax,maxnests)
+   character(len=28) :: name2
+   character(len=8)  :: chartime
+    integer :: ix,jy,kz
+
+
+ 
+! 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
+
+! FLEXPART_WRF - following change allows the ending date/time 
+! of the flexpart run to match that of the last met. file
+      else if ( (ldirect*memtime(1).lt.ldirect*itime).and. &
+     (memtime(2).eq.itime) .and. (wftime(numbwf).eq.itime) ) then
+
+        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 cpu_time(start)
+           if ((time_option.eq.1).and.(wind_option.eq.1)) &
+              call readwind_timeav(indj+1,memind(2),uuh,vvh,wwh)
+            call readwind(indj+1,memind(2),uuh,vvh,wwh,divh)
+           if ((time_option.eq.1).and.(wind_option.eq.1)) &
+              call readwind_nests_timeav(indj+1,memind(2),uuhn,vvhn,wwhn)
+            call readwind_nests(indj+1,memind(2),uuhn,vvhn,wwhn,divhn)
+              if (option_verbose.gt.1) then
+            call cpu_time(finish)
+           print*,'readwind',finish-start
+            call cpu_time(start)
+             endif
+              call calcpar(memind(2),uuh,vvh,pvh)
+              call calcpar_nests(memind(2),uuhn,vvhn,pvhn)
+             if (option_verbose.gt.1) then
+            call cpu_time(finish)
+           print*,'calcpar',finish-start
+            call cpu_time(start)
+             endif
+              call verttransform(memind(2),uuh,vvh,wwh,pvh,divh)
+              call verttransform_nests(memind(2),uuhn,vvhn,wwhn,pvhn,divhn)
+             if (option_verbose.gt.1) then
+            call cpu_time(finish)
+           print*,'verttran',finish-start
+             endif
+              memtime(2)=wftime(indj+1)
+              nstop = 1
+              goto 40
+           endif
+       enddo
+ 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
+         if ((time_option.eq.1).and.(wind_option.eq.1)) &
+           call readwind_timeav(indj,memind(1),uuh,vvh,wwh)
+         call readwind(indj,memind(1),uuh,vvh,wwh,divh)
+         if ((time_option.eq.1).and.(wind_option.eq.1)) &
+           call readwind_nests_timeav(indj,memind(1),uuhn,vvhn,wwhn)
+         call readwind_nests(indj,memind(1),uuhn,vvhn,wwhn,divhn)
+         call calcpar(memind(1),uuh,vvh,pvh)
+         call calcpar_nests(memind(1),uuhn,vvhn,pvhn)
+         call verttransform(memind(1),uuh,vvh,wwh,pvh,divh)
+         call verttransform_nests(memind(1),uuhn,vvhn,wwhn,pvhn,divhn)
+         memtime(1)=wftime(indj)
+         memind(2)=2
+        if ((time_option.eq.1).and.(wind_option.eq.1)) &
+           call readwind_timeav(indj+1,memind(2),uuh,vvh,wwh)
+        call readwind(indj+1,memind(2),uuh,vvh,wwh,divh)
+        if ((time_option.eq.1).and.(wind_option.eq.1)) &
+           call readwind_nests_timeav(indj+1,memind(2),uuhn,vvhn,wwhn)
+        call readwind_nests(indj+1,memind(2),uuhn,vvhn,wwhn,divhn)
+        call calcpar(memind(2),uuh,vvh,pvh)
+        call calcpar_nests(memind(2),uuhn,vvhn,pvhn)
+        call verttransform(memind(2),uuh,vvh,wwh,pvh,divh)
+        call verttransform_nests(memind(2),uuhn,vvhn,wwhn,pvhn,divhn)
+        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/jerome/src_flexwrf_v3.1/getrb.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/getrb.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/getrb.f90	(revision 16)
@@ -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/jerome/src_flexwrf_v3.1/getrc.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/getrc.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/getrc.f90	(revision 16)
@@ -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/jerome/src_flexwrf_v3.1/getvdep.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/getvdep.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/getvdep.f90	(revision 16)
@@ -0,0 +1,205 @@
+!**********************************************************************
+! 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,vdepo)
+  !                   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
+
+!JB: assume no snow input from WRF 
+  snow=0.
+  ! 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/jerome/src_flexwrf_v3.1/getvdep_nests.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/getvdep_nests.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/getvdep_nests.f90	(revision 16)
@@ -0,0 +1,205 @@
+!**********************************************************************
+! 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,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
+
+  snow=0.
+  ! 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/jerome/src_flexwrf_v3.1/gf2xe.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/gf2xe.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/gf2xe.f90	(revision 16)
@@ -0,0 +1,1146 @@
+module gf2xe
+!===============================================================================
+! Fortran 90/95 Module for GF(2)[x] computation
+!===============================================================================
+  use mt_kind_defs
+  implicit none
+  private
+  public :: gf2x_obj
+  public :: gf2x_prime_obj
+  public :: new,delete
+  public :: print_bit,print_hex
+  public :: get_deg
+  public :: set_coef, set_prime
+  public :: assign
+  public ::  add,  add_assign
+  public :: mult, mult_assign
+  public ::  pow, square
+  public :: div, rem, divrem
+  public :: mult_by_x, div_by_x, mod_by_x
+  public :: shift
+  public :: deg_i32, mult_i32, square_i32, shift_i32
+  public :: mult_i32_old
+  public :: gf2x_pow_pow_2
+
+  integer(INT32), parameter :: MAX_KARA  = 64
+
+  type gf2x_obj
+    integer(INT32), pointer :: c(:) => NULL()
+    integer(INT32) :: deg  = -1
+    integer(INT32) :: size = -1
+  end type
+
+  type gf2x_prime_obj
+    type(gf2x_obj) :: prime_poly
+    type(gf2x_obj) :: barrett_poly
+    integer(INT32) :: deg
+  end type
+
+  interface new
+    module procedure gf2x_new
+    module procedure gf2x_delete_prime
+  end interface
+
+  interface delete
+    module procedure gf2x_delete
+    module procedure gf2x_delete_prime
+  end interface
+
+  interface print_bit
+    module procedure gf2x_print_bit
+  end interface
+
+  interface print_hex
+    module procedure gf2x_print_hex
+  end interface
+
+  interface set_coef
+    module procedure gf2x_set_coef
+  end interface
+
+  interface set_prime
+    module procedure gf2x_set_prime
+  end interface
+
+  interface assign
+    module procedure gf2x_assign
+  end interface
+
+  interface add
+    module procedure gf2x_add
+  end interface
+
+  interface add_assign
+    module procedure gf2x_add_assign
+  end interface
+
+  interface mult
+    module procedure gf2x_mult_kara
+  end interface
+
+  interface mult_assign
+    module procedure gf2x_mult_assign_kara
+  end interface
+
+  interface pow
+    module procedure gf2x_pow
+    module procedure gf2x_pow_mod
+  end interface
+
+  interface square
+    module procedure gf2x_square
+  end interface
+
+  interface mult_by_x
+    module procedure gf2x_mult_by_x
+  end interface
+
+  interface mod_by_x
+    module procedure gf2x_mod_by_x
+  end interface
+
+  interface div_by_x
+    module procedure gf2x_div_by_x
+  end interface
+
+  interface div
+    module procedure gf2x_div
+  end interface
+
+  interface rem
+    module procedure gf2x_rem
+    module procedure gf2x_rem_barrett
+  end interface
+
+  interface divrem
+    module procedure gf2x_divrem
+  end interface
+
+  interface shift
+    module procedure gf2x_shift
+  end interface
+
+contains
+
+!!DEC$ ATTRIBUTES FORCEINLINE :: get_size
+function get_size(deg) result(size)
+  integer(INT32) :: deg,size
+  size = CEILING(real(deg+1,kind=REAL64)/32.0_REAL64)
+  return
+end function
+
+subroutine gf2x_new(this,deg)
+  type(gf2x_obj), intent(inout) :: this
+  integer(INT32), intent(in) :: deg
+  integer(INT32) :: isize
+  intrinsic :: SIZE
+  if (deg < 0) then
+    this%deg  = -1
+    this%size = -1
+    return
+  endif
+  isize = get_size(deg)
+  this%size = isize
+  this%deg  = deg
+  if (.not.associated(this%c)) then
+    allocate(this%c(0:isize-1))
+  else
+    if (SIZE(this%c) < this%size) then
+      deallocate(this%c)
+      NULLIFY(this%c)
+      allocate(this%c(0:isize-1))
+    endif
+  endif
+  this%c(:) = 0
+  return
+end subroutine
+
+subroutine gf2x_delete(this)
+  type(gf2x_obj), intent(inout) :: this
+  integer(INT32) :: ierr
+  if (associated(this%c)) then
+    deallocate(this%c,STAT=ierr)
+  endif
+  NULLIFY(this%c)
+  this%deg  = -1
+  this%size = -1
+  return
+end subroutine
+
+subroutine gf2x_print_bit(this)
+  type(gf2x_obj), intent(in) :: this
+  integer(INT32) :: i,ib,iw,deg
+  deg = get_deg(this)
+  if (deg < 0) then
+    write(*,'("0")')
+    return
+  endif
+  do i=deg,0,-1
+    ib = mod(i,32)
+    iw = i/32
+    if (BTEST(this%c(iw),ib)) then
+      write(*,'("1",$)')
+    else
+      write(*,'("0",$)')
+    endif
+  enddo
+  write(*,'("")')
+  return
+end subroutine
+
+subroutine gf2x_print_hex(this)
+  type(gf2x_obj), intent(in) :: this
+  integer(INT32) :: i,ib,iw,isize
+  character(9) :: str
+  if (is_zero(this)) then
+    write(*,'("0")')
+    return
+  endif
+  isize = get_size(this%deg)
+  i = isize-1
+  write(str,'(Z8)')this%c(i)
+  write(*,'(A,$)')TRIM(ADJUSTL(str))
+  do i=isize-2,0,-1
+    write(*,'(Z8.8,$)')this%c(i)
+  enddo
+  write(*,'("")')
+  return
+end subroutine
+
+subroutine gf2x_assign(c,a)
+  type(gf2x_obj), intent(inout) :: c  ! c := a
+  type(gf2x_obj), intent(in)    :: a
+  integer(INT32) :: ia,isa,i
+
+  call delete(c)
+  if (is_zero(a)) then
+    return
+  endif
+
+  ia = get_deg(a)
+  isa = get_size(ia)
+  call new(c,ia)
+  do i=0,isa-1
+    c%c(i) = a%c(i)
+  enddo
+  
+  return
+end subroutine
+
+function is_zero(a) result(is)
+  type(gf2x_obj), intent(in) :: a
+  logical :: is
+  integer(INT32) :: deg
+  deg = get_deg(a) 
+  if (deg==-1) then
+    is = .true.
+  else
+    is = .false.
+  endif
+  return
+end function
+
+!!DEC$ ATTRIBUTES FORCEINLINE :: get_deg
+function get_deg(a) result(deg)
+  type(gf2x_obj), intent(in) :: a
+  integer(INT32) :: deg
+  integer(INT32) :: isize,i,top_deg
+  intrinsic :: SIZE
+  deg=-1
+  if (.not.associated(a%c)) return
+  isize = SIZE(a%c)
+  do i=isize-1,0,-1
+    if (a%c(i) /= 0) then
+      top_deg = deg_i32(a%c(i))
+      deg = 32*i + top_deg
+      return
+    endif
+  enddo
+  return
+end function
+
+subroutine gf2x_set_coef(a,i)
+  type(gf2x_obj), intent(inout) :: a
+  integer(INT32), intent(in) :: i
+  type(gf2x_obj), pointer :: w
+  integer(INT32) :: ib,iw
+  NULLIFY(w)
+  if (is_zero(a)) then
+    call new(a,i)
+  endif
+  allocate(w)
+  call new(w,i)
+  iw =     i/32
+  ib = mod(i,32)
+  w%c(iw) = ibset(w%c(iw),ib)
+  call add_assign(w,a)  ! w := w + a
+  call assign(a,w)      ! a := w
+  call delete(w)
+  deallocate(w)
+  NULLIFY(w)
+  a%deg = get_deg(a)
+  return
+end subroutine
+
+subroutine gf2x_add_assign(c,a)
+  type(gf2x_obj), intent(inout) :: c  ! c := c + a
+  type(gf2x_obj), intent(in)    :: a
+  type(gf2x_obj), pointer :: w
+  integer(INT32) :: ia,ic
+  integer(INT32) :: isa,isc,i
+  if (is_zero(a)) then
+    return
+  endif
+  if (is_zero(c)) then
+    call assign(c,a)
+    return
+  endif
+  ia = a%deg
+  ic = c%deg
+  isa = a%size
+  isc = c%size
+  if (isc < isa) then
+    NULLIFY(w)
+    allocate(w)
+    call new(w,MAX(ia,ic))
+    do i=0,isc-1
+      w%c(i) = IEOR(c%c(i),a%c(i))
+    enddo
+    do i=isc,isa-1
+      w%c(i) = a%c(i)
+    enddo
+    call assign(c,w)
+    call delete(w)
+    deallocate(w)
+    NULLIFY(w)
+  else
+    do i=0,isa-1
+      c%c(i) = IEOR(c%c(i),a%c(i))
+    enddo
+    c%deg = get_deg(c)
+    c%size = get_size(c%deg)
+  endif
+  return
+end subroutine
+
+subroutine gf2x_add(c,a,b)
+  type(gf2x_obj), intent(inout) :: c   ! c := a + b
+  type(gf2x_obj), intent(in)    :: a,b
+  integer(INT32) :: ia,ib,ic
+  integer(INT32) :: isa,isb,isc,i
+  if (is_zero(a) .and. is_zero(b)) then
+    return
+  endif
+  if (is_zero(a)) then
+    call assign(c,b)
+    return
+  endif
+  if (is_zero(b)) then
+    call assign(c,a)
+    return
+  endif
+  ia = get_deg(a)
+  ib = get_deg(b)
+  isa = get_size(ia)
+  isb = get_size(ib)
+  if (c%deg < MAX(ia,ib)) call new(c,MAX(ia,ib))
+  if (isa < isb) then
+    do i=0,isa-1
+      c%c(i) = IEOR(a%c(i),b%c(i))
+    enddo
+    do i=isa,isb-1
+      c%c(i) = b%c(i)
+    enddo
+  else
+    do i=0,isb-1
+      c%c(i) = IEOR(a%c(i),b%c(i))
+    enddo
+    do i=isb,isa-1
+      c%c(i) = a%c(i)
+    enddo
+  endif
+  c%deg  = get_deg(c)
+  c%size = get_size(c%deg)
+  return
+end subroutine
+
+subroutine gf2x_pow(c,a,e)
+  type(gf2x_obj), intent(inout) :: c ! c = a**e
+  type(gf2x_obj), intent(in)    :: a
+  integer(INT32), intent(in) :: e
+  type(gf2x_obj), pointer :: w
+  integer(INT32) :: ch,cl
+  integer(INT32) :: i,deg
+  NULLIFY(w)
+  call delete(c)
+  if (e==1) then
+    call assign(c,a)
+    return
+  endif
+  if (e==0) then
+    call set_coef(c,0)
+    return
+  endif
+  if (e<0) then
+    write(*,*)"pow: c = a^e : exponent should be e>=0."
+    stop
+  endif
+  if (is_zero(a)) return
+
+  deg = deg_i32(e)
+
+  allocate(w)
+  call set_coef(c,0)
+  do i=deg,0,-1
+    call square(w,c)        ! w := c**2
+    if (BTEST(e,i)) then
+      call mult(c,w,a)      ! c := w * a
+    else
+      call assign(c,w)      ! c := w
+    endif
+  enddo
+  call delete(w)
+  deallocate(w)
+  NULLIFY(w)
+
+  return
+end subroutine
+
+subroutine gf2x_square(c,a)
+  type(gf2x_obj), intent(inout) :: c ! c := a**2
+  type(gf2x_obj), intent(in)    :: a
+  integer(INT32) :: ch,cl
+  integer(INT32) :: i,deg
+  call delete(c)
+  if (is_zero(a)) return
+  deg = a%deg*2
+  call new(c,deg)
+  do i=0,a%size-1
+    if (a%c(i) == 0) cycle
+    call square_i32(a%c(i),ch,cl)
+    if (cl /= 0) c%c(2*i)   = IEOR(c%c(2*i),  cl)
+    if (ch /= 0) c%c(2*i+1) = IEOR(c%c(2*i+1),ch)
+  enddo
+  c%deg = get_deg(c)
+  c%size = get_size(c%deg)
+  return
+end subroutine
+
+recursive subroutine gf2x_mult_kara(c,a,b)
+!
+! multiply 2 polyomials using Karatsuba algorithm
+!
+  type(gf2x_obj), intent(inout) :: c    ! c := a * b
+  type(gf2x_obj), intent(in)    :: a,b
+  type(gf2x_obj), pointer :: ah,al,bh,bl,ahbh,albl,ahl,bhl,ahlbhl
+  integer(INT32) :: isa,isb,isc
+  integer(INT32) :: i,j,deg
+
+  NULLIFY(ah,al,bh,bl,ahbh,albl,ahl,bhl,ahlbhl)
+  call delete(c)
+  if (is_zero(a)) return
+  if (is_zero(b)) return
+
+  isa = a%size
+  isb = b%size
+  isc = MAX(isa,isb)
+  if (isc < MAX_KARA) then
+    call gf2x_mult_normal(c,a,b)
+    return
+  endif
+
+  if (mod(isc,2)/=0) then
+    isc = isc + 1
+  endif
+
+  allocate(ah,al,bh,bl,ahbh,albl,ahl,bhl,ahlbhl)
+  deg = 32*(isc/2)-1
+  call new(al,deg)
+  call new(bl,deg)
+  call new(ah,deg)
+  call new(bh,deg)
+
+  do i=0,MIN(isc/2-1,isa-1)
+    al%c(i) = a%c(i)
+  enddo
+  do i=0,MIN(isc/2-1,isb-1)
+    bl%c(i) = b%c(i)
+  enddo
+  do i=isc/2,isa-1
+    ah%c(i-isc/2) = a%c(i)
+  enddo
+  do i=isc/2,isb-1
+    bh%c(i-isc/2) = b%c(i)
+  enddo
+  ah%deg = get_deg(ah)
+  al%deg = get_deg(al)
+  bh%deg = get_deg(bh)
+  bl%deg = get_deg(bl)
+  ah%size = get_size(ah%deg)
+  al%size = get_size(al%deg)
+  bh%size = get_size(bh%deg)
+  bl%size = get_size(bl%deg)
+
+!===================================
+
+  call add(ahl,ah,al)
+  call add(bhl,bh,bl)
+  call gf2x_mult_kara(ahlbhl,ahl,bhl)
+  call delete(ahl)
+  call delete(bhl)
+  deallocate(ahl,bhl)
+
+!===================================
+
+  call gf2x_mult_kara(ahbh,ah,bh)
+  call delete(ah)
+  call delete(bh)
+  deallocate(ah,bh)
+
+  call add_assign(ahlbhl,ahbh)
+
+!===================================
+
+  call gf2x_mult_kara(albl,al,bl)
+  call delete(al)
+  call delete(bl)
+  deallocate(al,bl)
+
+  call add_assign(ahlbhl,albl)
+
+!===================================
+  deg = a%deg + b%deg
+  call new(c,deg)
+
+  do i=0,MIN(c%size,albl%size)-1
+    c%c(i) = albl%c(i)
+  enddo
+  call delete(albl)
+
+  if (.not. is_zero(ahlbhl)) then
+    do i=isc/2,MIN(c%size,isc/2+ahlbhl%size)-1
+      c%c(i) = IEOR(c%c(i),ahlbhl%c(i-isc/2))
+    enddo
+  endif
+  call delete(ahlbhl)
+
+  if (.not. is_zero(ahbh)) then
+    do i=isc,MIN(c%size,isc+ahbh%size)-1
+      c%c(i) = IEOR(c%c(i),ahbh%c(i-isc))
+    enddo
+  endif
+  call delete(ahbh)
+  deallocate(ahbh,albl,ahlbhl)
+  NULLIFY(ah,al,bh,bl,ahbh,albl,ahl,bhl,ahlbhl)
+  c%deg  = get_deg(c)
+  c%size = get_size(c%deg)
+  return
+end subroutine
+
+subroutine gf2x_mult_assign_kara(a,b)
+  type(gf2x_obj), intent(inout) :: a  ! a := a * b
+  type(gf2x_obj), intent(in)    :: b
+  type(gf2x_obj), pointer :: w
+  NULLIFY(w)
+  if (is_zero(a)) then
+    call delete(a)
+    return
+  endif
+  if (is_zero(b)) then
+    call delete(a)
+    return
+  endif
+  allocate(w)
+  call gf2x_mult_kara(w,a,b)
+  call assign(a,w)
+  call delete(w)
+  deallocate(w)
+  NULLIFY(w)
+  return
+end subroutine
+
+subroutine gf2x_mult_assign_normal(a,b)
+  type(gf2x_obj), intent(inout) :: a  ! a := a * b
+  type(gf2x_obj), intent(in)    :: b
+  type(gf2x_obj), pointer :: w
+  integer(INT32) :: ch,cl
+  integer(INT32) :: i,j,deg
+  NULLIFY(w)
+  allocate(w)
+  deg = a%deg + b%deg
+  call new(w,deg)
+  call gf2x_mult_normal(w,a,b)
+  call assign(a,w)  ! a := w
+  call delete(w)
+  deallocate(w)
+  NULLIFY(w)
+  return
+end subroutine
+
+subroutine gf2x_mult_normal(c,a,b)
+  type(gf2x_obj), intent(inout) :: c    ! c := a * b
+  type(gf2x_obj), intent(in)    :: a,b
+  integer(INT32) :: ch,cl
+  integer(INT32) :: i,j,ij,deg,kk,mm
+  integer(INT32), allocatable :: hi(:,:),lo(:,:)
+
+  call delete(c)
+  if (is_zero(a) .or. is_zero(b) ) then
+    return
+  endif
+
+  deg = a%deg + b%deg
+  call new(c,deg)
+
+!#define _NEW_
+!#undef _NEW_
+!#ifdef _NEW_
+!  do j=0,c%size-2
+!    kk = MIN(j,  a%size-1)
+!    mm = MAX(0,j-b%size+1)
+!    do i=mm,kk
+!      call mult_i32(a%c(i),b%c(j-i),ch,cl)
+!      c%c(j)   = IEOR(c%c(j),  cl)
+!      c%c(j+1) = IEOR(c%c(j+1),ch)
+!    enddo
+!  enddo
+!  j=c%size-1
+!  kk = a%size-1
+!  mm = c%size-b%size
+!  do i=mm,kk
+!    call mult_i32(a%c(i),b%c(j-i),ch,cl)
+!    c%c(j)   = IEOR(c%c(j),  cl)
+!  enddo
+!
+!#else
+  do j=0,b%size-1
+  if (b%c(j) == 0) cycle
+  do i=0,a%size-1
+  if (a%c(i) == 0) cycle
+
+    ij = i + j
+    call mult_i32(a%c(i),b%c(j),ch,cl)
+                     c%c(ij)   = IEOR(c%c(ij),  cl)
+    if (ij+1<c%size) c%c(ij+1) = IEOR(c%c(ij+1),ch)
+
+  enddo
+  enddo
+!#endif
+
+  c%deg = get_deg(c)
+  c%size = get_size(c%deg)
+
+  return
+end subroutine
+
+subroutine gf2x_shift(c,a,i)
+  type(gf2x_obj), intent(inout) :: c  ! c := shift(a,i)
+  type(gf2x_obj), intent(in)    :: a
+  integer(INT32), intent(in) :: i
+  integer(INT32) :: j,isn,iw,ib,ida,isa,ch,cm,cl
+  if (i==0) then
+    call assign(c,a)
+    return
+  endif
+  ida = get_deg(a)
+  isa = get_size(ida)
+  if (ida + i < 0) then
+    call delete(c)
+    return
+  endif
+  iw = abs(i)/32
+  ib = mod(abs(i),32)
+  call delete(c)
+  call new(c,ida+i)
+  if (i > 0) then
+    do j=0,isa-1
+      call shift_i32(a%c(j),+ib,ch,cm,cl)
+      if (ch /= 0) c%c(j+iw+1) = IEOR(c%c(j+iw+1),ch)
+      if (cm /= 0) c%c(j+iw)   = IEOR(c%c(j+iw)  ,cm)
+    enddo
+  else 
+    call shift_i32(a%c(iw),-ib,ch,cm,cl)
+    if (cm /= 0) c%c(0)   = IEOR(c%c(0),cm)
+    do j=iw+1,isa-1
+      call shift_i32(a%c(j),-ib,ch,cm,cl)
+      if (cm /= 0) c%c(j-iw)   = IEOR(c%c(j-iw)  ,cm)
+      if (cl /= 0) c%c(j-iw-1) = IEOR(c%c(j-iw-1),cl)
+    enddo
+  endif
+  c%deg = get_deg(c)
+  c%size = get_size(c%deg)
+  return
+end subroutine
+
+subroutine gf2x_divrem(q,r,a,b)
+ ! a =: q * b + r
+  type(gf2x_obj), intent(inout) :: q  ! q := a div b
+  type(gf2x_obj), intent(inout) :: r  ! r := a mod b
+  type(gf2x_obj), intent(in)    :: a,b
+  type(gf2x_obj), pointer :: w,t,s
+  integer(INT32) :: ida,idb,idw
+  call delete(q)
+  call delete(r)
+  ida = a%deg
+  idb = b%deg
+  if (ida < idb) then
+    call assign(r,a)
+    return
+  endif
+  NULLIFY(w,t,s)
+  allocate(w,t,s)
+  call assign(w,a)
+  idw = w%deg
+  do
+    call mult_by_x(t,b,idw-idb)  ! t := b * x^(deg(w)-deg(b))
+    call set_coef(s,idw-idb)     ! s := s + x^(deg(w)-deg(b))
+    call add_assign(w,t)         ! w := w + t
+    call delete(t)
+    idw = w%deg
+    if (idw < idb) exit
+  enddo
+  call assign(r,w)
+  call delete(w)
+  call assign(q,s)
+  call delete(s)
+  deallocate(w,t,s)
+  NULLIFY(w,t,s)
+  return
+end subroutine
+
+subroutine gf2x_div(q,a,b)
+ ! a =: q * b + r
+  type(gf2x_obj), intent(inout) :: q  ! q := a div b
+  type(gf2x_obj), intent(in)    :: a,b
+  type(gf2x_obj), pointer :: w,t,s
+  integer(INT32) :: ida,idb,idw
+  call delete(q)
+  ida = a%deg
+  idb = b%deg
+  if (ida < idb) then
+    return
+  endif
+  NULLIFY(w,t,s)
+  allocate(w,t,s)
+  call assign(w,a)
+  idw = w%deg
+  do
+    call mult_by_x(t,b,idw-idb)  ! t := b * x^(deg(w)-deg(b))
+    call set_coef(s,idw-idb)     ! s := s + x^(deg(w)-deg(b))
+    call add_assign(w,t)         ! w := w + t
+    call delete(t)
+    idw = w%deg
+    if (idw < idb) exit
+  enddo
+  call delete(w)
+  call assign(q,s)
+  call delete(s)
+  deallocate(w,t,s)
+  NULLIFY(w,t,s)
+  return
+end subroutine
+
+subroutine gf2x_rem(r,a,b)
+  type(gf2x_obj), intent(inout) :: r   ! r := a mod b
+  type(gf2x_obj), intent(in)    :: a,b
+  type(gf2x_obj), pointer :: w,t
+  integer(INT32) :: ida,idb,idw
+  call delete(r)
+  ida = a%deg
+  idb = b%deg
+  if (ida < idb) then
+    call assign(r,a)
+    return
+  endif
+  NULLIFY(w,t)
+  allocate(w,t)
+  call assign(w,a)
+  idw = w%deg
+  do
+    call mult_by_x(t,b,idw-idb)  ! t := b * x^(deg(w)-deg(b))
+    call add_assign(w,t)         ! w := w + t
+    call delete(t)
+    idw = w%deg
+    if (idw < idb) exit
+  enddo
+  call assign(r,w)
+  call delete(w)
+  deallocate(w,t)
+  NULLIFY(w,t)
+  return
+end subroutine
+
+subroutine gf2x_set_prime(mp,m)
+!
+! Set a primitive polynomial to the cotainer.
+! the container contains the prime poly and precomputed polynomial for Barrett reduciont.
+! This routine does not check the primitivity.
+!  mp : container
+!   m : primitive polynomial
+!
+  type(gf2x_prime_obj), intent(inout) :: mp
+  type(gf2x_obj),       intent(in)    :: m
+  type(gf2x_obj), pointer :: xx
+  integer(INT32) :: deg
+  call delete(mp)
+  call assign(mp%prime_poly,m)
+  deg = get_deg(m)
+  mp%deg = deg
+  NULLIFY(xx)
+  allocate(xx)
+  call set_coef(xx,2*deg)
+  call div(mp%barrett_poly,xx,m)
+  call delete(xx)
+  deallocate(xx)
+  NULLIFY(xx)
+  return
+end subroutine
+
+subroutine gf2x_delete_prime(mp)
+  type(gf2x_prime_obj), intent(inout) :: mp
+  call delete(mp%prime_poly)
+  call delete(mp%barrett_poly)
+  return
+end subroutine
+
+subroutine gf2x_rem_barrett(r,a,m)
+!
+! compute  r := a mod m using Barrett algorithm
+!
+  type(gf2x_obj), intent(inout) :: r     ! r := a mod m
+  type(gf2x_obj), intent(in)    :: a
+  type(gf2x_prime_obj), intent(in) :: m  ! precomputed polynomial for Barrett algorithm
+  type(gf2x_obj), pointer :: q,p
+  integer(INT32) :: deg
+
+  call delete(r)
+  deg = m%deg
+  if (a%deg < deg) then
+    call assign(r,a)
+    return
+  endif
+
+  NULLIFY(q,p)
+  allocate(q,p)
+
+  call div_by_x(q,a,deg)              ! q = a  /  x**deg
+  call mod_by_x(r,a,deg)              ! r = a mod x**deg
+
+  call mult_assign(q,m%barrett_poly)  ! q = q  *  mu
+  call div_by_x(p,q,deg)              ! p = q  /  x**deg
+
+  call mult_assign(p,m%prime_poly)    ! p = p  *  m
+  call mod_by_x(q,p,deg)              ! q = p mod x**deg
+
+  call add_assign(r,q)                ! r = r + q
+
+  call delete(p)
+  call delete(q)
+
+  deallocate(p,q)
+  NULLIFY(p,q)
+
+  return
+end subroutine
+
+subroutine gf2x_mod_by_x(c,a,i)
+  type(gf2x_obj), intent(inout) :: c  ! c := a mod x^i
+  type(gf2x_obj), intent(in)    :: a
+  integer(INT32), intent(in) :: i
+  type(gf2x_obj), pointer :: w
+  integer(INT32) :: iw,ib,j
+  call delete(c)
+  if (a%deg < i) then
+    call assign(c,a)
+    return
+  endif
+  if (i == 0) then
+    call delete(c)
+    return
+  endif
+  if (i < 0) then
+    write(*,'("mod_by_x: error, negative i:",I10)')i
+    stop
+  endif
+  iw = i/32
+  ib = mod(i,32)
+  NULLIFY(w)
+  allocate(w)
+  call new(w,i)
+  do j=0,w%size-1
+    w%c(j) = a%c(j)
+  enddo
+  w%c(w%size-1) = IAND(w%c(w%size-1),2**ib-1)
+  call assign(c,w)
+  call delete(w)
+  deallocate(w)
+  NULLIFY(w)
+  return
+end subroutine
+
+subroutine gf2x_mult_by_x(c,a,i)
+  type(gf2x_obj), intent(inout) :: c  ! c := a * x^i
+  type(gf2x_obj), intent(in)    :: a
+  integer(INT32), intent(in) :: i
+  if (i < 0) then
+    write(*,'("mult_by_x: error, negative i:",I10)')i
+    stop
+  endif
+  if (i == 0) then
+    call assign(c,a)
+    return
+  endif
+  call shift(c,a,i)
+  return
+end subroutine
+
+subroutine gf2x_div_by_x(c,a,i)
+  type(gf2x_obj), intent(inout) :: c  ! c := a div x^i
+  type(gf2x_obj), intent(in)    :: a
+  integer(INT32), intent(in) :: i
+  if (i < 0) then
+    write(*,'("div_by_x: error, negative i:",I10)')i
+    stop
+  endif
+  if (i == 0) then
+    call assign(c,a)
+    return
+  endif
+  call shift(c,a,-i)
+  return
+end subroutine
+
+
+subroutine gf2x_pow_pow_2(c,e,m)
+  type(gf2x_obj), intent(inout) :: c  ! c := x**(2**e) mod m
+  integer(INT32), intent(in)           :: e
+  type(gf2x_prime_obj), intent(in) :: m  ! precomputed polynomial for Barrett algorithm
+  integer(INT32) :: i,ee
+  type(gf2x_obj), pointer :: w,s
+
+  ee = CEILING(log(REAL(m%deg))/log(2.0))
+  call delete(c)
+  if (ee > e) then
+    call set_coef(c,2**e)
+    return
+  endif
+
+  NULLIFY(w,s)
+  allocate(w,s)
+  call set_coef(w,2**ee)
+  call rem(s,w,m)      ! s = w mod m
+  do i=ee+1,e
+    call square(w,s)   ! w = s**2
+    call rem(s,w,m)    ! s = w mod m
+  enddo
+  call assign(c,s)
+  call delete(w)
+  call delete(s)
+  deallocate(w,s)
+  NULLIFY(w,s)
+  return
+end subroutine
+
+subroutine gf2x_pow_mod(c,a,e,m)
+  type(gf2x_obj), intent(inout) :: c  ! c := a**e mod m
+  type(gf2x_obj), intent(in)    :: a
+  integer(INT32), intent(in)           :: e
+  type(gf2x_prime_obj), intent(in) :: m  ! precomputed polynomial for Barrett algorithm
+  type(gf2x_obj), pointer :: w
+  integer(INT32) :: i,deg
+  NULLIFY(w)
+  call delete(c)
+  if (e==1) then
+    if (a%deg >= m%deg) then
+       call rem(c,a,m)
+       return
+    else
+      call assign(c,a)
+      return
+    endif
+  endif
+  if (e==0) then
+    call set_coef(c,0)
+    return
+  endif
+  if (e<0) then
+    write(*,*)"pow: c = a^e mod m : exponent should be e>=0."
+    stop
+  endif
+  if (is_zero(a)) return
+
+  deg = deg_i32(e)
+
+  allocate(w)
+  call set_coef(c,0)
+  do i=deg,0,-1
+    call square(w,c)        ! c := c**2 mod m
+    call rem(c,w,m)
+    if (BTEST(e,i)) then
+      call mult(w,c,a)      ! c := c * a mod m
+      call rem(c,w,m)
+    endif
+  enddo
+  call delete(w)
+  deallocate(w)
+  NULLIFY(w)
+  return
+end subroutine
+
+!========================================================================
+function deg_i32(a) result(d)
+  integer(INT32) :: a,d,i
+  d=-1
+  do i=31,0,-1
+    if (BTEST(a,i)) then
+      d=i
+      exit
+    endif
+  enddo
+  return
+end function
+
+function deg_i64(a) result(d)
+  integer(INT64) :: a
+  integer(INT32) :: d,i
+  do i=63,0,-1
+    if (BTEST(a,i)) then
+      d=i
+      exit
+    endif
+  enddo
+  return
+end function
+
+subroutine square_i32(a,ch,cl)
+  integer(INT32), intent(in) :: a
+  integer(INT32), intent(out) :: ch,cl   ! (ch,cl) = a**2
+  integer(INT32) :: ia,i
+  integer(INT64) :: da,dc
+  da = a
+  if (da < 0) da = da + 2_8**32 ! convert to unsigned
+  dc = Z'0'
+  ia = deg_i32(a)
+  do i = 0,ia
+    if (BTEST(a,i)) then
+      dc = ibset(dc,i*2)
+    endif
+  enddo
+  ch = ISHFT(dc,-32)
+  cl = dc
+  return
+end subroutine
+
+!DEC$ ATTRIBUTES FORCEINLINE :: mult_i32
+subroutine mult_i32(a,b,ch,cl)
+  integer(INT32), intent(in) :: a,b
+  integer(INT32), intent(out) :: ch,cl  ! (ch,cl) = a*b
+  integer(INT32) :: tmp,u(0:3)
+  integer(INT32), parameter :: ZE = Z'eeeeeeee'
+  integer(INT32), parameter :: ZC = Z'cccccccc'
+  integer(INT32), parameter :: Z8 = Z'88888888'
+
+  if (a==0 .or. b ==0) then
+    ch = 0
+    cl = 0
+    return
+  endif
+
+  u(0) = 0
+  u(1) = a
+  u(2) = ISHFT(u(1),+1)
+  u(3) =  IEOR(u(2),a)
+
+  cl =                  IEOR(ISHFT(u(     ISHFT(b,-30)   ),2),u(IAND(ISHFT(b,-28),3)))
+  ch =                  ISHFT(cl,-28)
+  cl = IEOR(ISHFT(cl,4),IEOR(ISHFT(u(IAND(ISHFT(b,-26),3)),2),u(IAND(ISHFT(b,-24),3))))
+  ch =  IOR(ISHFT(ch,4),ISHFT(cl,-28))
+  cl = IEOR(ISHFT(cl,4),IEOR(ISHFT(u(IAND(ISHFT(b,-22),3)),2),u(IAND(ISHFT(b,-20),3))))
+  ch =  IOR(ISHFT(ch,4),ISHFT(cl,-28))
+  cl = IEOR(ISHFT(cl,4),IEOR(ISHFT(u(IAND(ISHFT(b,-18),3)),2),u(IAND(ISHFT(b,-16),3))))
+  ch =  IOR(ISHFT(ch,4),ISHFT(cl,-28))
+  cl = IEOR(ISHFT(cl,4),IEOR(ISHFT(u(IAND(ISHFT(b,-14),3)),2),u(IAND(ISHFT(b,-12),3))))
+  ch =  IOR(ISHFT(ch,4),ISHFT(cl,-28))
+  cl = IEOR(ISHFT(cl,4),IEOR(ISHFT(u(IAND(ISHFT(b,-10),3)),2),u(IAND(ISHFT(b, -8),3))))
+  ch =  IOR(ISHFT(ch,4),ISHFT(cl,-28))
+  cl = IEOR(ISHFT(cl,4),IEOR(ISHFT(u(IAND(ISHFT(b, -6),3)),2),u(IAND(ISHFT(b, -4),3))))
+  ch =  IOR(ISHFT(ch,4),ISHFT(cl,-28))
+  cl = IEOR(ISHFT(cl,4),IEOR(ISHFT(u(IAND(ISHFT(b, -2),3)),2),u(IAND(      b     ,3))))
+
+  tmp = -IAND(ISHFT(a,-31),1)
+  tmp =  IAND(tmp,ISHFT(IAND(b,ZE),-1))
+  ch  =  IEOR(ch,tmp)
+
+  tmp = -IAND(ISHFT(a,-30),1)
+  tmp =  IAND(tmp,ISHFT(IAND(b,ZC),-2))
+  ch  =  IEOR(ch,tmp)
+
+  tmp = -IAND(ISHFT(a,-29),1)
+  tmp =  IAND(tmp,ISHFT(IAND(b,Z8),-3))
+  ch  =  IEOR(ch,tmp)
+
+  return
+end subroutine
+
+
+subroutine mult_i32_old(a,b,ch,cl)
+  integer(INT32), intent(in) :: a,b
+  integer(INT32), intent(out) :: ch,cl  ! (ch,cl) = a*b
+  integer(INT32) :: ia,ib,i
+  integer(INT64) :: da,db,dc
+  da = a
+  db = b
+  if (da < 0) da = da + 2_8**32 ! convert to unsigned
+  if (db < 0) db = db + 2_8**32 ! convert to unsigned
+  ia = deg_i32(a)
+  ib = deg_i32(b)
+  dc = Z'0'
+  do i = 0,ia
+    if (BTEST(a,i)) then
+      dc = IEOR(dc,db)
+    endif
+    dc = ISHFTC(dc,-1)
+  enddo
+  dc = ISHFTC(dc,ia+1)
+  ch = ISHFT(dc,-32)
+  cl = dc
+!  write(*,'(B64.64)')dc
+!  write(*,'(B32.32)')ch
+!  write(*,'(B64.64)')cl
+  return
+end subroutine
+
+subroutine shift_i32(a,i,ch,cm,cl)
+  integer(INT32), intent(in) :: a
+  integer(INT32), intent(in) :: i
+  integer(INT32), intent(out) :: ch,cm,cl  ! (ch,cm,cl) = shift(a,i)
+  integer(INT64) :: dc
+  if (abs(i) >= 32) then
+    write(*,*)"shift_int32: error i=",i
+    stop
+  endif
+  select case (i)
+  case (0)
+    ch = 0; cm = a; cl = 0
+    return
+  case (1:31)
+    dc = a
+    if (dc < 0) dc = dc + 2_8**32 ! convert to unsigned
+    dc = ISHFT(dc,i)
+    ch = ISHFT(dc,-32)
+    cm = dc
+    cl = 0
+    return
+  case (-31:-1)
+    dc = a
+    if (dc < 0) dc = dc + 2_8**32 ! convert to unsigned
+    dc = ISHFT(dc,i+32)
+    ch = 0
+    cm = ISHFT(dc,-32)
+    cl = dc
+    return
+  end select
+  return
+end subroutine
+
+end module
Index: /branches/jerome/src_flexwrf_v3.1/gridcheck.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/gridcheck.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/gridcheck.f90	(revision 16)
@@ -0,0 +1,677 @@
+      subroutine gridcheck
+!**********************************************************************
+!                                                                     * 
+!             TRAJECTORY MODEL SUBROUTINE GRIDCHECK                   *
+!             FLEXPART VERSION -> DO NOT USE IN FLEXTRA, PRAEPRO      *
+!                                                                     *
+!**********************************************************************
+!                                                                     * 
+! AUTHOR:      R. Easter & J. Fast, PNNL                              *
+! DATE:        2005-autumn-??                                         *
+!                                                                     * 
+! Dec 2005, R. Easter - changed names of "*lon0*" & "*lat0*" variables*
+!                                                                     * 
+!**********************************************************************
+!                                                                     *
+! DESCRIPTION:                                                        *
+!                                                                     *
+! Note:  This is the FLEXPART_WRF version of subroutine gridcheck.    *
+!    The computational grid is the WRF x-y grid rather than lat-lon.  *
+!    There are many differences from the FLEXPART version.            *
+!                                                                     *
+! This subroutine determines the grid specifications                  *
+! of the WRF model run from the first met. input file.                *
+!     (longitudes & latitudes, number of grid points, grid distance,  *
+!     vertical discretization)                                        *
+! The consistancy of met. input files is checked in the routine       *
+! "readwind" each call.  (Grid info must not change.)                 *
+!                                                                     *
+!                                                                     *
+! XMET0,YMET0 -- x,y coordinates (in m) of the lower left             *
+!                "T-grid" point                                       *
+!           NOTE: These replace XLON0,YLAT0 of FLEXPART (ECMWF),      *
+!           which uses longitude,longitude (degrees) as coordinates.  *
+!                                                                     *
+! NX        number of grid points x-direction                         *
+! NY        number of grid points y-direction                         *
+! DX        grid distance x-direction (in m)                          *
+! DY        grid distance y-direction (in m)                          *
+! NUVZ      number of grid points for horizontal wind                 *
+!           components in z direction                                 *
+! NWZ       number of grid points for vertical wind                   *
+!           component in z direction                                  *
+!                                                                     *
+! For WRF, the "W" grid has NWZ == "bottom_top_stag" levels           *
+! For WRF, the "U", "V", and "T" grids have                           *
+!     NWZ-1 == "bottom_top"  levels.                                  *
+! In the ecmwf FLEXPART, the "U", "V", and "T" grids are              *
+!     "augmented" with an additional "surface" layer,                 *
+!     and thus have NUVZ==NWZ levels                                  *
+! Because of the high vertical resolution often used in WRF,          *
+!     it may be desirable to eliminate this "surface layer".          *
+!                                                                     *
+!                                                                     *
+! UVHEIGHT(1)-         heights of gridpoints where u and v are        *
+! UVHEIGHT(NUVZ)       given                                          *
+! WHEIGHT(1)-          heights of gridpoints where w is given         *
+! WHEIGHT(NWZ)                                                        *
+!                                                                     *
+!**********************************************************************
+!
+!      include 'includepar'
+!      include 'includecom'
+!      include 'includeconv'
+!  use grib_api
+  use par_mod
+  use com_mod
+  use conv_mod
+  use cmapf_mod, only: stlmbr,stcm2p
+
+      integer,parameter :: ndims_max=4
+      integer :: i, idiagaa, ierr, ifn, itime, ix
+      integer :: jy
+      integer :: kz
+      integer :: lendim(ndims_max), lendim_exp(ndims_max), &
+          lendim_max(ndims_max)
+      integer :: ndims, ndims_exp, &
+              ext_scalar,pbl_physics,mp_physics_dum
+      integer :: n_west_east, n_south_north, n_bottom_top
+
+      real :: dx_met, dy_met
+      real :: duma, dumb, dumc
+      real :: dump1, dump2, dumdz
+      real :: pint,m
+
+      character(len=160) :: fnamenc, varname,fnamenc2
+
+      real(kind=4) :: m_u(0:nxmax-1,0:nymax-1,1)
+      real(kind=4) :: m_v(0:nxmax-1,0:nymax-1,1)
+
+
+
+!
+!   get grid info from the wrf netcdf file
+!
+!     write(*,'(//a)') 'gridcheck output'
+
+      if(ideltas.gt.0) then
+        ifn=1
+      else
+        ifn=numbwf
+      endif
+      fnamenc = path(2)(1:length(2))//wfname(ifn)
+      idiagaa = 0
+
+      call read_ncwrfout_gridinfo( ierr, idiagaa, fnamenc, &
+        n_west_east, n_south_north, n_bottom_top,  &
+        dx_met, dy_met, &
+        m_grid_id(0), m_parent_grid_id(0), m_parent_grid_ratio(0), &
+        i_parent_start(0), j_parent_start(0), &
+        map_proj_id, map_stdlon, map_truelat1, map_truelat2, &
+        ext_scalar,pbl_physics,mp_physics_dum )
+
+       mp_physics=mp_physics_dum   
+
+      if (ierr.ne.0) goto 999
+
+!
+! set grid dimension and size variables
+!
+      nx = n_west_east
+      nxfield = nx
+      ny = n_south_north
+
+      nxmin1=nx-1
+      nymin1=ny-1
+!    print*,'nxo',nxmin1,nymin1
+      nuvz = n_bottom_top
+      nwz = n_bottom_top + 1
+      nlev_ec = n_bottom_top
+
+! for FLEXPART_WRF, x & y coords are in meters, and
+! we define lower-left corner of outermost (mother) grid == (0.0,0.0)
+      xmet0 = 0.0
+      ymet0 = 0.0
+
+      dx = dx_met
+      dy = dy_met
+
+      dxconst = 1.0/dx
+      dyconst = 1.0/dy
+
+      l_parent_nest_id(0) = -1
+
+      xglobal=.false.
+      if (nxshift.ne.0) stop  &
+        'nxshift (par_mod) must be zero for non-global domain'
+
+      sglobal=.false.
+      switchsouthg=999999.
+
+      nglobal=.false.
+      switchnorthg=999999.
+
+      if (nxshift.lt.0) stop 'nxshift (par_mod) must not be negative'
+      if (nxshift.ge.nxfield) stop 'nxshift (par_mod) too large'
+     
+!
+! check that grid dimensions are not too big
+!
+! FLEXPART_WRF 07-nov-2005 - require (nx+1 .le. nxmax) and (ny+1 .le. nymax)
+! because u,v in met. files are on staggered grid
+!     if (nx.gt.nxmax) then                         
+      if (nx+1 .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+1, nxmax =', nx,nxmax
+        stop
+      endif
+
+!     if (ny.gt.nymax) then                         
+      if (ny+1 .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+1, nymax =', 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
+
+!
+!   read latitude and longitude
+!   read oro, lsm, and excessoro
+
+      varname = 'MAPFAC_MX'
+      lendim_exp(1) = nx
+      lendim_max(1) = nxmax
+      lendim_exp(2) = ny
+      lendim_max(2) = nymax
+      ndims_exp = 3
+      itime=1
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+          varname, m_x(0,0,1), &
+          itime, &
+          ndims, ndims_exp, ndims_max, &
+          lendim, lendim_exp, lendim_max )
+      if (ierr .ne. 0) then
+      varname = 'MAPFAC_M'
+      lendim_exp(1) = nx
+      lendim_max(1) = nxmax
+      lendim_exp(2) = ny
+      lendim_max(2) = nymax
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+          varname, m_x(0,0,1), &
+          itime, &
+          ndims, ndims_exp, ndims_max, &
+          lendim, lendim_exp, lendim_max )
+      endif  
+      if (ierr .ne. 0) then
+          print*,'error doing MAP X'
+      varname = 'MAPFAC_UX'
+      lendim_exp(1) = nx+1
+      lendim_max(1) = nxmax
+      lendim_exp(2) = ny
+      lendim_max(2) = nymax
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+          varname, m_u(0,0,1), &
+          itime, &
+          ndims, ndims_exp, ndims_max, &
+          lendim, lendim_exp, lendim_max )
+      do j = 0, nymin1
+      do i = 0, nxmin1
+      m_x(i,j,1)=(m_u(i,j,1)+m_u(i+1,j,1))*0.5
+      enddo
+      enddo
+      if (ierr .ne. 0) then
+          print*,'error doing MAP U'
+          print*,'NO MAP FACTOR IS GOING TO BE USED.'
+          print*,'LARGE UNCERTAINTIES TO BE EXPECTED'
+      do j = 0, nymin1
+      do i = 0, nxmin1
+      m_x(i,j,1)=1.
+      enddo
+      enddo
+      end if
+      end if
+!     do j = 0, nymin1
+!     do i = 0, nxmin1
+!     m_x(i,j,1)=1.
+!     enddo
+!     enddo
+
+      varname = 'MAPFAC_MY'
+      lendim_exp(1) = nx
+      lendim_max(1) = nxmax
+      lendim_exp(2) = ny
+      lendim_max(2) = nymax
+
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+          varname, m_y(0,0,1), &
+          itime, &
+          ndims, ndims_exp, ndims_max, &
+          lendim, lendim_exp, lendim_max )
+      if (ierr .ne. 0) then
+      varname = 'MAPFAC_M'
+      lendim_exp(1) = nx
+      lendim_max(1) = nxmax
+      lendim_exp(2) = ny
+      lendim_max(2) = nymax
+
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+          varname, m_y(0,0,1), &
+          itime, &
+          ndims, ndims_exp, ndims_max, &
+          lendim, lendim_exp, lendim_max )
+      endif
+      if (ierr .ne. 0) then
+          print*,'error doing MAP Y'
+      varname = 'MAPFAC_VY'
+      lendim_exp(1) = nx
+      lendim_max(1) = nxmax
+      lendim_exp(2) = ny+1
+      lendim_max(2) = nymax
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+          varname, m_v(0,0,1), &
+          itime, &
+          ndims, ndims_exp, ndims_max, &
+          lendim, lendim_exp, lendim_max )
+      do j = 0, nymin1
+      do i = 0, nxmin1
+      m_y(i,j,1)=(m_v(i,j,1)+m_v(i,j+1,1))*0.5
+      enddo
+      enddo
+      if (ierr .ne. 0) then
+          print*,'ERROR doing MAP V'
+          print*,'NO MAP FACTOR IS GOING TO BE USED.'
+          print*,'LARGE UNCERTAINTIES TO BE EXPECTED'
+      do j = 0, nymin1
+      do i = 0, nxmin1
+      m_y(i,j,1)=1.
+      enddo
+      enddo
+      end if
+      end if
+      lendim_exp(1) = nx
+      lendim_max(1) = nxmax
+      lendim_exp(2) = ny
+      lendim_max(2) = nymax
+!     do j = 0, nymin1
+!     do i = 0, nxmin1
+!     m_y(i,j,1)=1.
+!     enddo
+!     enddo
+
+!
+      idiagaa = 0
+
+      varname = 'XLAT'
+      do i = 1, ndims_max
+          lendim_exp(i) = 0
+          lendim_max(i) = 1
+      end do
+      itime = 1
+      lendim_exp(1) = nx
+      lendim_max(1) = nxmax
+      lendim_exp(2) = ny
+      lendim_max(2) = nymax
+      ndims_exp = 3
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+      	  varname, ylat2d, &
+      	  itime, &
+      	  ndims, ndims_exp, ndims_max, &
+      	  lendim, lendim_exp, lendim_max )
+      if (ierr .ne. 0) then
+          write(*,*)
+          write(*,*) '*** checkgrid -- error doing ncread of XLAT'
+          stop
+      end if
+!       print*,'values',ylat2d(309,101),ylat2d(300,101),ylat2d(250,101)
+!       print*,'values',ylat2d(309,101),ylat2d(300,101),ylat2d(250,101)
+      varname = 'XLONG'
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, & 
+      	  varname, xlon2d, &
+      	  itime, &
+      	  ndims, ndims_exp, ndims_max, &
+      	  lendim, lendim_exp, lendim_max )
+      if (ierr .ne. 0) then
+          write(*,*)
+          write(*,*) '*** checkgrid -- error doing ncread of XLONG'
+          stop
+      end if
+
+      varname = 'HGT'
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+      	  varname, oro, &
+      	  itime, &
+      	  ndims, ndims_exp, ndims_max, &
+      	  lendim, lendim_exp, lendim_max )
+      if (ierr .ne. 0) then
+          write(*,*)
+          write(*,*) '*** checkgrid -- error doing ncread of HGT'
+          stop
+      end if
+
+! lsm = landsea mask == land fraction (or non-ocean fraction)
+! for now, set lsm=1.0 which means land
+      do jy=0,ny-1
+      do ix=0,nxfield-1
+!         lsm(ix,jy)=zsec4(nxfield*(ny-jy-1)+ix+1)
+          lsm(ix,jy)=1.0
+      end do
+      end do
+
+! for now, set excessoro=0.0
+      do jy=0,ny-1
+      do ix=0,nxfield-1
+          excessoro(ix,jy)=0.0
+      end do
+      end do
+      do jy=1,ny-2
+      do ix=1,nxfield-2
+      m=4.*oro(ix,jy)+oro(ix-1,jy)+oro(ix+1,jy)+oro(ix,jy-1)+oro(ix,jy+1)
+      m=m/8.
+      excessoro(ix,jy)=4.*(oro(ix,jy)-m)**2.+(oro(ix-1,jy)-m)**2. &
+      +(oro(ix+1,jy)-m)**2.+(oro(ix,jy-1)-m)**2.+(oro(ix,jy+1)-m)**2.
+      excessoro(ix,jy)=(excessoro(ix,jy)/8.)**0.5
+      end do
+      end do
+
+
+! check that the map projection routines are working
+      call test_xyindex_to_ll_wrf( 0 )
+
+
+! 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
+
+
+! CALCULATE VERTICAL DISCRETIZATION OF WRF MODEL
+! PARAMETER akm,bkm DESCRIBE THE HYBRID "ETA" COORDINATE SYSTEM
+
+! read eta_w_wrf, eta_u_wrf, and p_top_wrf from the netcdf wrfout file
+      itime = 1
+
+      varname = 'ZNW'
+      do i = 1, ndims_max
+          lendim_exp(i) = 0
+          lendim_max(i) = 1
+      end do
+      lendim_exp(1) = nwz
+      lendim_max(1) = nwzmax
+      ndims_exp = 2
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+      	  varname, eta_w_wrf, &
+      	  itime, &
+      	  ndims, ndims_exp, ndims_max, &
+      	  lendim, lendim_exp, lendim_max )
+      if (ierr .ne. 0) then
+        fnamenc2='wrfout_d03_zn.nc'
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc2, & 
+      	  varname, eta_w_wrf, &
+      	  itime, &
+      	  ndims, ndims_exp, ndims_max, &
+      	  lendim, lendim_exp, lendim_max )
+      if (ierr .ne. 0) then
+
+          write(*,*)
+          write(*,*) '*** checkgrid -- error doing ncread of ZNW'
+!         stop
+      end if
+      end if
+
+      varname = 'ZNU'
+      do i = 1, ndims_max
+          lendim_exp(i) = 0
+          lendim_max(i) = 1
+      end do
+      lendim_exp(1) = nwz-1
+      lendim_max(1) = nwzmax
+      ndims_exp = 2
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+      	  varname, eta_u_wrf, &
+      	  itime, &
+      	  ndims, ndims_exp, ndims_max, &
+      	  lendim, lendim_exp, lendim_max )
+      if (ierr .ne. 0) then
+        fnamenc2='wrfout_d03_zn.nc'
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc2, &
+      	  varname, eta_u_wrf, &
+      	  itime, &
+      	  ndims, ndims_exp, ndims_max, &
+      	  lendim, lendim_exp, lendim_max )
+        
+      if (ierr .ne. 0) then
+          write(*,*)
+          write(*,*) '*** checkgrid -- error doing ncread of ZNU'
+          stop
+      end if
+      end if
+
+      varname = 'P_TOP'
+      do i = 1, ndims_max
+          lendim_exp(i) = 0
+          lendim_max(i) = 1
+      end do
+      lendim_exp(1) = 1
+      lendim_max(1) = 6
+      ndims_exp = 2
+      if (ext_scalar .lt. 0) ndims_exp = 1
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+      	  varname, p_top_wrf, &
+      	  itime, &
+      	  ndims, ndims_exp, ndims_max, &
+      	  lendim, lendim_exp, lendim_max ) 
+      if (ierr .ne. 0) then
+          write(*,*)
+          write(*,*) '*** checkgrid -- error doing ncread of P_TOP'
+          stop
+      end if
+
+! diagnostics for testing
+      if (idiagaa .gt. 0) then
+          write(*,*)
+          write(*,*) 'k, eta_w_wrf, eta_u_wrf ='
+          write(*,'(i3,2f11.6)')  &
+              (kz, eta_w_wrf(kz), eta_u_wrf(kz), kz=1,nwz-1)
+          kz = nwz
+          write(*,'(i3,2f11.6)') kz, eta_w_wrf(kz)
+          write(*,*)
+          write(*,*) 'p_top_wrf =', p_top_wrf
+          write(*,*)
+
+          duma = 0.0
+          dumb = 1.0e30
+          dumc = -1.0e30
+          do jy = 0, ny-1
+          do ix = 0, nx-1
+              duma = duma + oro(ix,jy)
+              dumb = min( dumb, oro(ix,jy) )
+              dumc = max( dumc, oro(ix,jy) )
+          end do
+          end do
+          duma = duma/(nx*ny)
+          write(*,*) 'oro avg, min, max =', duma, dumb, dumc
+          write(*,*)
+      end if
+
+
+!
+! the wrf eta vertical grid at layer boundaries (w grid) and 
+! layer centers (u grid) is defined by
+!	eta_w_wrf(kz) = (pdh_w(kz) - p_top_wrf)/(pdh_surface - p_top_wrf)
+!	eta_u_wrf(kz) = (pdh_u(kz) - p_top_wrf)/(pdh_surface - p_top_wrf)
+! where "pdh_" refers to the dry hydrostatic component of the pressure
+!
+! so
+!	pdh_w(kz) = ((1.0 - eta_w_wrf(kz))*p_top_wrf) + eta_w_wrf(kz)*pdh_surface
+!	pdh_u(kz) = ((1.0 - eta_u_wrf(kz))*p_top_wrf) + eta_u_wrf(kz)*pdh_surface
+!
+! the ecmwf eta vertical grid is defined by
+!	p_w(kz) = akm(kz) + bkm(kz)*p_surface
+!	p_u(kz) = akz(kz) + bkz(kz)*p_surface
+!
+! the following definitions of akm, bkm, akz, bkz for wrf would be roughly 
+! consistent those for ecmwf EXCEPT that for wrf, they involve the 
+! dry hydrostatic component of the pressure
+!     do kz = 1, nwz
+!         akm(kz) = (1.0 - eta_w_wrf(kz))*p_top_wrf
+!         bkm(kz) = eta_w_wrf(kz)
+!     end do
+!     do kz = 1, nuvz
+!         akz(kz) = (1.0 - eta_u_wrf(kz))*p_top_wrf
+!         bkz(kz) = eta_u_wrf(kz)
+!     end do
+!
+! *** in FLEXPART_WRF we decided to used pressure from the met. files
+!     and drop the akz/bkz/akm/bkm entirely ***
+!
+
+
+! in FLEXPART_ECMWF, the U, V, & T-grid levels are always shifted up by 1, 
+!    and an extra near-surface level is defined at kz=1 
+!    which is loaded with the 10 m winds and 2 m temperature & humidity
+! for FLEXPART_WRF, this is optional, and is done when add_sfc_level=1
+! (Note -- it will take a lot of effort to get rid of this augmented
+!    level because many of the surface & boundary layer routines
+!    are expecting it.  so for now, always augment.)
+
+      dump1 = (101325.0-p_top_wrf)*eta_w_wrf(1) + p_top_wrf
+      dump2 = (101325.0-p_top_wrf)*eta_w_wrf(2) + p_top_wrf
+      dumdz = log(dump1/dump2)*8.4e3
+      write(*,*)
+!     write(*,*) 'add_sfc_level =', add_sfc_level
+!     write(*,*) 'WRF layer 1 approx. thickness =', dumdz
+
+      if (add_sfc_level .eq. 1) then
+          nuvz = nuvz + 1
+      else
+          write(*,'(/a/a/)') '*** gridcheck fatal error ***', &
+              '    add_sfc_level=0 is not yet implemented'
+!         stop
+      end if
+
+
+!*******************************************************************************
+! following comments are from FLEXPART_ECMWF.  This options for doubled vertical
+! resolution has not been tried in FLEXPART_WRF, but it probably could be done
+! with little effort.
+! ------------------------------------------------------------------------------
+! 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 100 i=1,nuvz
+!       aknew(i)=akz(i)
+!100    bknew(i)=bkz(i)
+
+! 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)
+!
+! FLEXPART_WRF - use approx. pressures to set nconvlev, and limit it to nuvz-2
+!*******************************************************************************
+
+      do i=1,nuvz-2
+!     do i=1,nuvz-1
+!       pint=akz(i)+bkz(i)*101325.
+        pint = (101325.0-p_top_wrf)*eta_u_wrf(i) + p_top_wrf
+        if (pint.lt.5000.0) goto 96
+      enddo
+96    nconvlev=i
+      nconvlev = min( nconvlev, nuvz-2 )
+      if (nconvlev.gt.nconvlevmax-1) then
+        nconvlev=nconvlevmax-1
+        pint = (101325.0-p_top_wrf)*eta_u_wrf(nconvlev) + p_top_wrf
+        write(*,*) 'Attention, convection only calculated up to ', & 
+            pint*0.01, ' hPa'
+      endif
+
+
+! Output of grid info
+!********************
+
+      write(*,*)
+      write(*,*)
+      write(*,'(a/a,2i7/a,2i7//a,3i7/a,2i7/a,4i7)')  &
+        '# of vertical levels in WRF data',  &
+        '    n_bottom_top & "true" nuvz:', n_bottom_top,  &
+                                           (nuvz-add_sfc_level), &
+        '    nwz &     "augmented" nuvz:', nwz, nuvz, &
+        '    nwzmax, nuvzmax, nzmax    :', nwzmax, nuvzmax, nzmax, &
+        '    nconvlevmax, nconvlev     :', nconvlevmax, nconvlev, &
+        '    nx, ny, nxmax, nymax      :', nx, ny, nxmax, nymax  
+      write(*,*)
+      write(*,'(a)') 'Mother domain:'
+      write(*,'(a,f10.1,a1,f10.1,a,f10.1)') '  east-west   range: ', &
+        xmet0,' to ',xmet0+(nx-1)*dx,'   Grid distance: ',dx
+      write(*,'(a,f10.1,a1,f10.1,a,f10.1)') '  south-north range: ', &
+        ymet0,' to ',ymet0+(ny-1)*dy,'   Grid distance: ',dy
+      write(*,*)
+
+
+!
+! all done
+!
+      return
+
+
+! file open error
+999   write(*,*)  
+      write(*,*) ' ###########################################'// &
+                 '###### '
+      write(*,*) '       TRAJECTORY MODEL SUBROUTINE GRIDCHECK:'
+      write(*,*) ' CAN NOT OPEN INPUT DATA FILE = '
+      write(*,*) wfname(ifn)
+      write(*,*) ' ###########################################'// & 
+                 '###### '
+      write(*,*)
+      stop
+
+end subroutine gridcheck
+
+
+
Index: /branches/jerome/src_flexwrf_v3.1/gridcheck_nests.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/gridcheck_nests.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/gridcheck_nests.f90	(revision 16)
@@ -0,0 +1,636 @@
+      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.   *
+!                                                                              *
+!     Note:  This is the FLEXPART_WRF version of subroutine gridcheck.         *
+!            The computational grid is the WRF x-y grid rather than lat-lon.   *
+!            There are many differences from the FLEXPART version.             *
+!                                                                              *
+!     Authors: A. Stohl, G. Wotawa                                             *
+!     8 February 1999                                                          *
+!                                                                              *
+!     Nov 2005 - R. Easter - MAJOR revisions for FLEXPART_WRF                  *
+!     Dec 2005, R. Easter - changed names of "*lon0*" & "*lat0*" variables     *
+!                                                                              *
+!*******************************************************************************
+
+!  use grib_api
+  use par_mod
+  use com_mod
+
+
+      integer,parameter :: ndims_max=4
+      integer :: i, ierr, ifn, itime, ix
+      integer :: idiagaa, idiagaa_1, idiagaa_2, idiagbb
+      integer :: iduma, idumb
+      integer :: jy
+      integer :: k
+      integer :: l, lp
+      integer :: lendim(ndims_max), lendim_exp(ndims_max), & 
+          lendim_max(ndims_max)
+      integer :: m
+      integer :: map_proj_id_dum
+      integer :: ndims, ndims_exp, &
+              ext_scalar,pbl_physics,mp_physics_dum
+      integer :: n_west_east, n_south_north, n_bottom_top
+      integer :: nuvzn, nwzn
+
+      real :: dx_met, dy_met
+      real :: duma, dumb, dumc, dumx, dumy
+      real :: dump1, dump2, dumdz
+      real :: eta_w_wrf_nest(nwzmax), eta_u_wrf_nest(nwzmax) 
+      real :: map_stdlon_dum, map_truelat1_dum, map_truelat2_dum
+      real :: pint, p_top_wrf_nest
+      real :: xaux1, xaux2, yaux1, yaux2
+
+      character(len=160) :: fnamenc, varname
+
+      real(kind=4) :: m_un(0:nxmaxn-1,0:nymaxn-1,1,maxnests)
+      real(kind=4) :: m_vn(0:nxmaxn-1,0:nymaxn-1,1,maxnests)
+
+! Loop about all nesting levels
+!******************************
+!     idiagaa_1 = 1
+      idiagaa_1 = 0
+      idiagaa_2 = 0
+!     idiagbb = 10
+      idiagbb = 0
+
+      do l=1,numbnests
+
+      write(*,'(//a,i3)') 'gridcheck_nests output for grid #', l
+
+!
+!   get grid info from the wrf netcdf file
+!
+      if(ideltas.gt.0) then
+        ifn=1
+      else
+        ifn=numbwf
+      endif
+      m = numpath+2*(l-1)+1
+      fnamenc = path(m)(1:length(m)) // wfnamen(l,ifn)
+
+      idiagaa = idiagaa_1
+
+      call read_ncwrfout_gridinfo( ierr, idiagaa, fnamenc, &
+        n_west_east, n_south_north, n_bottom_top,  &
+        dx_met, dy_met,  &
+        m_grid_id(l), m_parent_grid_id(l), m_parent_grid_ratio(l),  &
+        i_parent_start(l), j_parent_start(l), &
+        map_proj_id_dum, map_stdlon_dum,  &
+        map_truelat1_dum, map_truelat2_dum, &
+        ext_scalar,pbl_physics,mp_physics_dum )
+      if (ierr .ne. 0) goto 999
+
+
+      mp_physicsn(l)=mp_physics_dum
+
+! subtract 1 because i & j indexing in flexpart always starts at 0
+      i_parent_start(l) = i_parent_start(l)-1
+      j_parent_start(l) = j_parent_start(l)-1
+
+!
+! set grid dimension and size variables
+!
+      nxn(l) = n_west_east
+      nyn(l) = n_south_north
+
+      nuvzn = n_bottom_top
+      nwzn = n_bottom_top + 1
+
+! for FLEXPART_WRF, x & y coords are in meters
+      dxn(l) = dx_met
+      dyn(l) = dy_met
+
+
+!
+! check that grid dimensions are not too big
+!
+! flexpart_wrf 07-nov-2005 - require (nxn+1 .le. nxmaxn) and (nyn+1 .le. nymaxn)
+! because u,v in met. files are on staggered grid
+      if (nxn(l)+1 .gt. nxmaxn) then                         
+        write(*,*) 'FLEXPART gridcheck_nests error: ' // &
+                   'Too many grid points in x direction.'
+        write(*,*) 'Change parameter settings in file par_mod.'
+        write(*,*) 'l, nxn(l)+1, nxmaxn =', l, nxn(l), nxmaxn
+        stop
+      endif
+
+      if (nyn(l)+1 .gt. nymaxn) then                         
+        write(*,*) 'FLEXPART gridcheck_nests error: ' // &
+                   'Too many grid points in y direction.'
+        write(*,*) 'Change parameter settings in file par_mod.'
+        write(*,*) 'l, nyn(l)+1, nymaxn =', l, nyn(l), nymaxn
+        stop
+      endif
+
+      nuvzn = nuvzn+add_sfc_level
+      if (nuvzn .ne. nuvz) then                         
+        write(*,*) 'FLEXPART gridcheck_nests error: ' // &
+                   'nuvzn and nuvz differ'
+        write(*,*) 'l, nuvzn, nuvz =', l, nuvzn, nuvz
+        stop
+      endif
+
+      if (nwzn .ne. nwz) then                         
+        write(*,*) 'FLEXPART gridcheck_nests error: ' // &
+                   'nwzn and nwz differ'
+        write(*,*) 'l, nwzn, nwz =', l, nwzn, nwz
+        stop
+      endif
+
+! check that map projection info matches parent
+      duma = 3.0e-7*max( abs(map_stdlon),   1.0e-30 )
+      dumb = 3.0e-7*max( abs(map_truelat1), 1.0e-30 )
+      dumc = 3.0e-7*max( abs(map_truelat2), 1.0e-30 )
+      iduma = 0
+      if (map_proj_id .ne. map_proj_id_dum)             iduma = 1
+      if (abs(map_stdlon-map_stdlon_dum)     .gt. duma) iduma = 2
+      if (abs(map_truelat1-map_truelat1_dum) .gt. dumb) iduma = 3
+      if (abs(map_truelat2-map_truelat2_dum) .gt. dumc) iduma = 4
+      if (iduma .ne. 0) then
+        write(*,*) 'FLEXPART gridcheck_nests error: ' // &
+                   'map projection parameters differ'
+        write(*,*) 'l, map param #=', l, iduma
+        stop
+      end if
+
+      varname = 'MAPFAC_MX'
+      lendim_exp(1) = nxn(l)
+      lendim_max(1) = nxmaxn
+      lendim_exp(2) = nyn(l)
+      lendim_max(2) = nymaxn
+      ndims_exp = 3
+      itime=1
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+          varname, m_xn(0,0,1,l), &
+          itime, &
+          ndims, ndims_exp, ndims_max, &
+          lendim, lendim_exp, lendim_max )
+      if (ierr .ne. 0) then
+      varname = 'MAPFAC_M'
+      lendim_exp(1) = nxn(l)
+      lendim_max(1) = nxmaxn
+      lendim_exp(2) = nyn(l)
+      lendim_max(2) = nymaxn
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+          varname, m_xn(0,0,1,l), &
+          itime, &
+          ndims, ndims_exp, ndims_max, &
+          lendim, lendim_exp, lendim_max )
+      endif
+      if (ierr .ne. 0) then
+          print*,'error doing MAP X'
+      varname = 'MAPFAC_UX'
+      lendim_exp(1) = nxn(l)+1
+      lendim_max(1) = nxmaxn
+      lendim_exp(2) = nyn(l)
+      lendim_max(2) = nymaxn
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+          varname, m_un(0,0,1,l), &
+          itime, &
+          ndims, ndims_exp, ndims_max, &
+          lendim, lendim_exp, lendim_max )
+      do j = 0, nyn(l)-1
+      do i = 0, nxn(l)-1
+      m_xn(i,j,1,l)=(m_un(i,j,1,l)+m_un(i+1,j,1,l))*0.5
+      enddo
+      enddo
+      if (ierr .ne. 0) then
+          print*,'error doing MAP U'
+          print*,'NO MAP FACTOR IS GOING TO BE USED.'
+          print*,'LARGE UNCERTAINTIES TO BE EXPECTED'
+      do j = 0, nyn(l)-1
+      do i = 0, nxn(l)-1
+      m_xn(i,j,1,l)=1.
+      enddo
+      enddo
+      end if
+      end if
+
+      varname = 'MAPFAC_MY'
+      lendim_exp(1) = nxn(l)
+      lendim_max(1) = nxmaxn
+      lendim_exp(2) = nyn(l)
+      lendim_max(2) = nymaxn
+
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+          varname, m_yn(0,0,1,l), &
+          itime, &
+          ndims, ndims_exp, ndims_max, &
+          lendim, lendim_exp, lendim_max )
+      if (ierr .ne. 0) then
+      varname = 'MAPFAC_M'
+      lendim_exp(1) = nxn(l)
+      lendim_max(1) = nxmaxn
+      lendim_exp(2) = nyn(l)
+      lendim_max(2) = nymaxn
+     call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+          varname, m_yn(0,0,1,l), &
+          itime, &
+          ndims, ndims_exp, ndims_max, &
+          lendim, lendim_exp, lendim_max )
+      endif
+      if (ierr .ne. 0) then
+          print*,'error doing MAP Y'
+      varname = 'MAPFAC_VY'
+      lendim_exp(1) = nxn(l)
+      lendim_max(1) = nxmaxn
+      lendim_exp(2) = nyn(l)+1
+      lendim_max(2) = nymaxn
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+          varname, m_vn(0,0,1,l), &
+          itime, &
+          ndims, ndims_exp, ndims_max, &
+          lendim, lendim_exp, lendim_max )
+      do j = 0, nyn(l)-1
+      do i = 0, nxn(l)-1
+      m_yn(i,j,1,l)=(m_vn(i,j,1,l)+m_vn(i,j+1,1,l))*0.5
+      enddo
+      enddo
+      if (ierr .ne. 0) then
+          print*,'ERROR doing MAP V'
+          print*,'NO MAP FACTOR IS GOING TO BE USED.'
+          print*,'LARGE UNCERTAINTIES TO BE EXPECTED'
+      do j = 0, nyn(l)-1
+      do i = 0, nxn(l)-1
+      m_yn(i,j,1,l)=1.
+      enddo
+      enddo
+      end if
+      end if
+      lendim_exp(1) = nxn(l)
+      lendim_max(1) = nxmaxn
+      lendim_exp(2) = nyn(l)
+      lendim_max(2) = nymaxn
+
+!
+!   read latitude and longitude
+!   read oro, lsm, and excessoro
+!
+
+      idiagaa = idiagaa_2
+
+      varname = 'XLAT'
+      do i = 1, ndims_max
+          lendim_exp(i) = 0
+          lendim_max(i) = 1
+      end do
+      itime = 1
+      lendim_exp(1) = nxn(l)
+      lendim_max(1) = nxmaxn
+      lendim_exp(2) = nyn(l)
+      lendim_max(2) = nymaxn
+      ndims_exp = 3
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+      	  varname, ylat2dn(0,0,l), &
+      	  itime, &
+      	  ndims, ndims_exp, ndims_max, &
+      	  lendim, lendim_exp, lendim_max ) 
+      if (ierr .ne. 0) then
+          write(*,*)
+          write(*,*) '*** checkgrid -- error doing ncread of XLAT'
+          stop
+      end if
+
+      varname = 'XLONG'
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+      	  varname, xlon2dn(0,0,l), &
+      	  itime, &
+      	  ndims, ndims_exp, ndims_max, &
+      	  lendim, lendim_exp, lendim_max )
+      if (ierr .ne. 0) then
+          write(*,*)
+          write(*,*) '*** checkgrid -- error doing ncread of XLONG'
+          stop
+      end if
+
+      varname = 'HGT'
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+      	  varname, oron(0,0,l), &
+      	  itime, &
+      	  ndims, ndims_exp, ndims_max, &
+      	  lendim, lendim_exp, lendim_max )
+      if (ierr .ne. 0) then
+          write(*,*)
+          write(*,*) '*** checkgrid -- error doing ncread of HGT'
+          stop
+      end if
+
+! lsm = landsea mask == land fraction (or non-ocean fraction)
+! for now, set lsm=1.0 which means land
+      do jy=0,nyn(l)-1
+      do ix=0,nxn(l)-1
+          lsmn(ix,jy,l)=1.0
+      end do
+      end do
+
+! for now, set excessoro=0.0
+      do jy=0,nyn(l)-1
+      do ix=0,nxn(l)-1
+          excessoron(ix,jy,l)=0.0
+      end do
+      end do
+      do jy=1,nyn(l)-2
+      do ix=1,nxn(l)-2
+      m=oron(ix,jy,l)+oron(ix-1,jy,l)+oron(ix+1,jy,l)+ &
+        oron(ix,jy-1,l)+oron(ix,jy+1,l)
+      m=m/5.
+      excessoron(ix,jy,l)=(oron(ix,jy,l)-m)**2.+(oron(ix-1,jy,l)-m)**2. &
+      +(oron(ix+1,jy,l)-m)**2.+(oron(ix,jy-1,l)-m)**2.+(oron(ix,jy+1,l)-m)**2.
+      excessoron(ix,jy,l)=(excessoron(ix,jy,l)/5.)**0.5
+      end do
+      end do
+
+
+!
+! identify the parent grid (which is probably "l-1", so this code 
+!    may be more complicated that necessary)
+! set xmet0n, ymet0n, which  are the x,y coords of lower-left corner 
+!   of a nested grid (in meters on the mother grid)
+!
+! note on dumc:
+!   the lower-left corner of the nested cell (0,0) coincides with the 
+!       lower-left corner of the parent cell (i_parent_start,j_parent_start)
+!   this being the case, the center of nested cell (0,0) is shifted
+!       by (-dumc*parent_gridsize) relative to the center of the parent cell
+!   (for m_parent_grid_ratio = 2, 3, 4, 5; dumc = 1/4, 1/3, 3/8, 2/5)
+!
+      l_parent_nest_id(l) = -1
+      if (m_parent_grid_id(l) .gt. 0) then
+      do lp = 0, l-1
+         if ( (l_parent_nest_id(l) .eq. -1) .and. &
+              (m_parent_grid_id(l) .eq. m_grid_id(lp)) ) then
+
+            l_parent_nest_id(l) = lp
+            m = m_parent_grid_ratio(l)
+            dumc = real(m-1)/real(m*2)
+            if (lp .eq. 0) then
+               xmet0n(l) = xmet0 + dx*(i_parent_start(l)-dumc)
+               ymet0n(l) = ymet0 + dy*(j_parent_start(l)-dumc)
+            else
+               xmet0n(l) = xmet0n(lp) + dxn(lp)*(i_parent_start(l)-dumc)
+               ymet0n(l) = ymet0n(lp) + dyn(lp)*(j_parent_start(l)-dumc)
+            end if
+         end if
+      end do
+      end if
+      if (idiagbb .gt. 0) write(*,'(/a,3i8)')  &
+            'l, m_grid_id(l), m_parent_grid_id(l)', &
+             l, m_grid_id(l), m_parent_grid_id(l)
+
+      if (l_parent_nest_id(l) .eq. -1) then
+         write(*,'(/a,i3/)')  &
+            'gridcheck_nests fatal error -- ' // &
+            'parent grid not found for l =', l
+         stop
+      end if
+
+!
+! diagnostics for testing the nesting calculations
+! (set idiagbb=0 to turn it off)
+!
+      lp = l_parent_nest_id(l)
+      if (idiagbb .gt. 0) then
+         write(*,'(a,2i8)') 'l_parent, m_grid_id(l_parent)       ', &
+                             lp,       m_grid_id(lp)
+         write(*,'(a,2i8)') 'm_parent_grid_ratio(l)              ', &
+                             m_parent_grid_ratio(l)
+         write(*,'(a,i8,f11.2)') &
+                            'i_parent_start(l), xi_...           ', &
+                             i_parent_start(l), i_parent_start(l)-dumc
+         write(*,'(a,i8,f11.2)') &
+                            'j_parent_start(l), yj_...           ', &
+                             j_parent_start(l), j_parent_start(l)-dumc
+      end if
+!23456789012345678901234567890123456789012345678901234567890123456789012
+
+      if (idiagbb .gt. 0) then
+         write(*,*)
+         do jy = j_parent_start(l)-1, j_parent_start(l)
+         do ix = i_parent_start(l)-1, i_parent_start(l)
+            if (lp .eq. 0) then
+               write(*,'(a,2i7,2f11.4)') 'parent i,j,lon,lat', &
+                  ix, jy, xlon2d(ix,jy), ylat2d(ix,jy)
+            else
+               write(*,'(a,2i7,2f11.4)') 'parent i,j,lon,lat', &
+                  ix, jy, xlon2dn(ix,jy,lp), ylat2dn(ix,jy,lp) 
+            end if
+         end do
+         end do
+
+         dumc = real( (m_parent_grid_ratio(l)-1) )/ &
+                real( (m_parent_grid_ratio(l)*2) )
+         dumx = i_parent_start(l) - dumc
+         dumy = j_parent_start(l) - dumc
+         call xyindex_to_ll_wrf( lp, dumx, dumy, xaux1, yaux1 )
+         write(*,'(a,2f7.2,2f11.4)') 'par. xi,yj,lon,lat', &
+            dumx, dumy, xaux1, yaux1
+
+         write(*,*)
+         write(*,'(a,2i7,2f11.4)') 'nest   i,j,lon,lat', &
+            0, 0, xlon2dn(0,0,l), ylat2dn(0,0,l)
+         write(*,*)
+
+         dumx = (xmet0n(l) - xmet0)/dx
+         dumy = (ymet0n(l) - ymet0)/dy
+         call xyindex_to_ll_wrf( 0, dumx, dumy, xaux1, yaux1 )
+         write(*,'(a,2f7.2,2f11.4)') 'mot. xi,yj,lon,lat', &
+            dumx, dumy, xaux1, yaux1
+
+         iduma = max( 0, ifix(dumx) )
+         idumb = max( 0, ifix(dumy) )
+         do jy = idumb, idumb+1
+         do ix = iduma, iduma+1
+               write(*,'(a,2i7,2f11.4)') 'mother i,j,lon,lat', &
+                  ix, jy, xlon2d(ix,jy), ylat2d(ix,jy)
+         end do
+         end do
+      end if
+
+
+
+! Output of grid info
+!********************
+
+      write(*,'(/a,i2)')  &
+          'gridcheck_nests -- nested domain #: ',l
+      write(*,'(a,f12.1,a1,f12.1,a,f10.1)')  &
+          '  X coordinate range: ', &
+          xmet0n(l),' to ',xmet0n(l)+(nxn(l)-1)*dxn(l), &
+          '   Grid distance: ',dxn(l)
+      write(*,'(a,f12.1,a1,f12.1,a,f10.1)')  &
+          '  Y coordinate range: ', &
+          ymet0n(l),' to ',ymet0n(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=xmet0n(l)
+        xaux2=xmet0n(l)+real(nxn(l)-1)*dxn(l)
+        yaux1=ymet0n(l)
+        yaux2=ymet0n(l)+real(nyn(l)-1)*dyn(l)
+
+        xln(l)=(xaux1-xmet0)/dx
+        xrn(l)=(xaux2-xmet0)/dx
+        yln(l)=(yaux1-ymet0)/dy
+        yrn(l)=(yaux2-ymet0)/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(*,*) 'gridcheck_nests error'
+          write(*,*) 'Nested domain does not fit into mother domain'
+          write(*,*) 'Execution is terminated.'
+          stop
+        endif
+
+
+! check that the map projection routines are working
+      call test_xyindex_to_ll_wrf( l )
+
+
+! 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.
+!*************************************************************
+
+! first read eta_w_wrf_nest, eta_u_wrf_nest, and p_top_wrf_nest 
+! from the netcdf wrfout file
+      itime = 1
+
+      varname = 'ZNW'
+      do i = 1, ndims_max
+          lendim_exp(i) = 0
+          lendim_max(i) = 1
+      end do
+      lendim_exp(1) = nwz
+      lendim_max(1) = nwzmax
+      ndims_exp = 2
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+      	  varname, eta_w_wrf_nest, &
+      	  itime, &
+      	  ndims, ndims_exp, ndims_max, &
+      	  lendim, lendim_exp, lendim_max )
+      if (ierr .ne. 0) then
+          write(*,*)
+          write(*,*) '*** checkgrid -- error doing ncread of ZNW'
+          stop
+      end if
+
+      varname = 'ZNU'
+      do i = 1, ndims_max
+          lendim_exp(i) = 0
+          lendim_max(i) = 1
+      end do
+      lendim_exp(1) = nwz-1
+      lendim_max(1) = nwzmax
+      ndims_exp = 2
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+      	  varname, eta_u_wrf_nest, &
+      	  itime, &
+      	  ndims, ndims_exp, ndims_max, &
+      	  lendim, lendim_exp, lendim_max )
+      if (ierr .ne. 0) then
+          write(*,*)
+          write(*,*) '*** checkgrid -- error doing ncread of ZNU'
+          stop
+      end if
+
+      varname = 'P_TOP'
+      do i = 1, ndims_max
+          lendim_exp(i) = 0
+          lendim_max(i) = 1
+      end do
+      lendim_exp(1) = 1
+      lendim_max(1) = 6
+      ndims_exp = 2
+      if (ext_scalar .lt. 0) ndims_exp=1
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+      	  varname, p_top_wrf_nest, &
+      	  itime, &
+      	  ndims, ndims_exp, ndims_max, &
+      	  lendim, lendim_exp, lendim_max )
+      if (ierr .ne. 0) then
+          write(*,*)
+          write(*,*) '*** checkgrid -- error doing ncread of P_TOP'
+          stop
+      end if
+
+
+      do k = 1, nwz
+          duma = 3.0e-7*max( abs(eta_w_wrf(k)), 1.0e-30 )
+          if (abs(eta_w_wrf(k)-eta_w_wrf_nest(k)) .gt. duma) then
+              write(*,*)  &
+              'FLEXPART gridcheck_nests error for nesting level',l
+              write(*,*)  &
+              'eta_w_wrf are not consistent with the mother domain'
+              write(*,*) 'k, eta_w_wrf(k), eta_w_wrf_nest(k) =', &
+                          k, eta_w_wrf(k), eta_w_wrf_nest(k)
+              stop
+          endif
+      end do
+
+      do k = 1, nwz-1
+          duma = 3.0e-7*max( abs(eta_u_wrf(k)), 1.0e-30 )
+          if (abs(eta_u_wrf(k)-eta_u_wrf_nest(k)) .gt. duma) then
+              write(*,*)  &
+              'FLEXPART gridcheck_nests error for nesting level',l
+              write(*,*)  &
+              'eta_u_wrf are not consistent with the mother domain'
+              write(*,*) 'k, eta_u_wrf(k), eta_u_wrf_nest(k) =', &
+                          k, eta_u_wrf(k), eta_u_wrf_nest(k)
+              stop
+          endif
+      end do
+
+      duma = 3.0e-7*max( abs(p_top_wrf), 1.0e-30 )
+      if (abs(p_top_wrf-p_top_wrf_nest) .gt. duma) then
+          write(*,*)  &
+          'FLEXPART gridcheck_nests error for nesting level',l
+          write(*,*)  &
+          'p_top_wrf are not consistent with the mother domain'
+          write(*,*) 'p_top_wrf, p_top_wrf_nest', &
+                      p_top_wrf, p_top_wrf_nest
+          stop
+      endif
+
+
+!   done with nest l
+      enddo
+
+      return
+
+
+999   write(*,*)  
+      write(*,*) ' ###########################################'// &
+                 '###### '
+      write(*,*) ' FLEXPART_WRF subroutine gridcheck_nests:  ' // &
+                 'nesting level ', l
+      write(*,*) ' can not open input data file '
+      write(*,*) '     '//fnamenc
+      write(*,*) ' or, an error occured in subr. read_ncwrfout_gridinfo'
+      write(*,*) '     with ierr =', ierr
+      write(*,*) ' ###########################################'// &
+                 '###### '
+      stop
+
+end subroutine gridcheck_nests
+
+
Index: /branches/jerome/src_flexwrf_v3.1/hanna.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/hanna.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/hanna.f90	(revision 16)
@@ -0,0 +1,131 @@
+!**********************************************************************
+! 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, &
+   ust,wst,ol,h,zeta,sigu,sigv,tlu,tlv,tlw, &
+   sigw,dsigwdz,dsigw2dz)
+
+  !                 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
+  real :: ust,wst,ol,h,zeta,sigu,sigv,tlu,tlv,tlw
+  real :: sigw,dsigwdz,dsigw2dz
+
+
+
+  !**********************
+  ! 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/jerome/src_flexwrf_v3.1/hanna1.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/hanna1.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/hanna1.f90	(revision 16)
@@ -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/>.   *
+!**********************************************************************
+
+subroutine hanna1(z, &
+  ust,wst,ol,h,zeta,sigu,sigv,tlu,tlv,tlw, & 
+  sigw,dsigwdz,dsigw2dz)
+
+  !                  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
+  real :: ust,wst,ol,h,zeta,sigu,sigv,tlu,tlv,tlw
+  real :: sigw,dsigwdz,dsigw2dz
+
+
+
+  !**********************
+  ! 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/jerome/src_flexwrf_v3.1/hanna_mod.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/hanna_mod.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/hanna_mod.f90	(revision 16)
@@ -0,0 +1,30 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                 *
+!* Jerome Brioude, Delia Arnold, Jerome Fast, 
+!* Andreas Stohl, Petra Seibert, A. Frank, Gerhard Wotawa *
+!* Caroline Forster, Sabine Eckhardt, John Burkhart, Harald Sodemann   *
+!*                                                                     *
+!* This file is part of FLEXPART WRF                                   *
+!*                                                                     *
+!* 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 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/jerome/src_flexwrf_v3.1/hanna_short.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/hanna_short.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/hanna_short.f90	(revision 16)
@@ -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 hanna_short(z, &
+  ust,wst,ol,h,zeta,sigu,sigv,tlu,tlv,tlw, &
+  sigw,dsigwdz,dsigw2dz)
+
+  !                       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
+  real :: ust,wst,ol,h,zeta,sigu,sigv,tlu,tlv,tlw
+  real :: sigw,dsigwdz,dsigw2dz
+
+
+
+  !**********************
+  ! 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/jerome/src_flexwrf_v3.1/init_domainfill.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/init_domainfill.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/init_domainfill.f90	(revision 16)
@@ -0,0 +1,451 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                *
+!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine,       *
+!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
+!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso,          *
+!* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann,   *
+!*                                                                     *
+!* This file is part of FLEXPART WRF                                   *
+!*                                                                     *
+!* 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
+!
+!*******************************************************************************
+!                                                                              *
+!     Note:  This is the FLEXPART_WRF version of subroutine init_domainfill.   *
+!            The computational grid is the WRF x-y grid rather than lat-lon.   *
+!                                                                              *
+! 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                                                          *
+!                                                                              *
+!    26 Oct 2005, R. Easter - changes for gridarea                             *
+!                             associated with WRF horizontal grid.             *
+!                             Also calc. true ylat for pv stuff.               *
+!    11 Nov 2005, R. Easter - fixed error involving xy to latlon               *
+!                                                                              *
+!                                                                              *
+!*******************************************************************************
+!                                                                              *
+! 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
+!,idummy
+
+!     real gridarea(0:nymax-1),pp(nzmax),ylat,ylatp,ylatm,hzone,ran1
+      real :: gridarea(0:nymax-1),pp(nzmax),ylat,                  ran1
+!     real cosfactm,cosfactp,pih,deltacol,dz1,dz2,dz,pnew,fractus
+      real ::                deltacol,dz1,dz2,dz,pnew,fractus
+      real :: xlon
+
+      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
+!10      gridarea(jy)=2.*pi*r_earth*hzone*dx/360.
+
+! for FLEXPART_WRF, dx & dy are in meters, and no cos(lat) is needed
+! ??? should maybe include map factor here ???
+        gridarea(jy)=dx*dy
+         enddo
+! Do the same for the south pole
+
+      if (sglobal) then
+         write(*,*)
+         write(*,*) '*** stopping in init_domainfill ***'
+         write(*,*) '    the s-pole code section should not be active'
+         write(*,*)
+!        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
+         write(*,*)
+         write(*,*) '*** stopping in init_domainfill ***'
+         write(*,*) '    the s-pole code section should not be active'
+         write(*,*)
+!        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)
+        enddo
+        enddo
+               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
+
+! for FLEXPART_WRF, x & y coords are in meters.
+! In the "do 30" loop, ylat is only needed for pv calcs.
+          call xyindex_to_ll_wrf( 0, real(ix), real(jy), xlon, ylat )
+
+          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)
+          enddo
+
+          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
+                  enddo
+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)
+                  enddo
+                  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
+!                 if (((ztra1(numpart+jj).lt.8000.)
+!    +            ).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
+!                  xmass1(numpart+jj,1)*60.*48./29./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
+        enddo
+
+
+
+
+! 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)
+          enddo
+! 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(1)(1:length(1))//'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/jerome/src_flexwrf_v3.1/initial_cond_calc.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/initial_cond_calc.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/initial_cond_calc.f90	(revision 16)
@@ -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/jerome/src_flexwrf_v3.1/initial_cond_output.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/initial_cond_output.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/initial_cond_output.f90	(revision 16)
@@ -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(1)(1:length(1))//'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/jerome/src_flexwrf_v3.1/initialize.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/initialize.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/initialize.f90	(revision 16)
@@ -0,0 +1,328 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                *
+!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine,       *
+!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
+!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso,          *
+!* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann,   *
+!*                                                                     *
+!* This file is part of FLEXPART WRF                                   *
+!*                                                                     *
+!* 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, &
+      ngrid,depoindicator,indzindicator,cpt2,ompid,myid,n_threads,mts )
+!    uprof,vprof,wprof, usigprof,vsigprof,wsigprof, &
+!    rhoprof,rhogradprof, tkeprof,pttprof, &
+!    u,v,w,usig,vsig,wsig,pvi, &
+!!   p1,p2,p3,p4,ddx,ddy,rddx,rddy,dtt,dt1,dt2, &
+!    ix,jy,ixp,jyp,ngrid,indz,indzp, depoindicator, &
+!    indzindicator, &
+!    ust,wst,ol,h,zeta,sigu,sigv,tlu,tlv,tlw, &
+!    sigw,dsigwdz,dsigw2dz,cpt,ompid)
+
+!                             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                                    *
+!                                                                              *
+!*******************************************************************************
+! 12 JUNE 2007 W. Wang
+!              use WRF TKE option to compute turbulence 
+!  Mar 2012: J. Brioude modification to handle openmp.                         *
+! Jan 2013 M. Cassiani modification to use CBL scheme                            
+!*******************************************************************************
+  use par_mod
+  use com_mod
+  use mt_stream
+
+!  use interpol_mod
+!  use hanna_mod
+!  use ran_mod
+  implicit none
+
+  integer :: itime
+  integer :: ldt,nrand,ompid
+!OMP_GET_THREAD_NUM
+  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
+
+  real :: uprof(nzmax),vprof(nzmax),wprof(nzmax)
+  real :: usigprof(nzmax),vsigprof(nzmax),wsigprof(nzmax)
+  real :: rhoprof(nzmax),rhogradprof(nzmax)
+  real :: tkeprof(nzmax),pttprof(nzmax)
+  real :: u,v,w,usig,vsig,wsig,pvi,mu,mv
+
+  real :: p1,p2,p3,p4,ddx,ddy,rddx,rddy,dtt,dt1,dt2
+  integer :: ix,jy,ixp,jyp,ngrid,indz,indzp,cpt2,maxrand2
+  logical :: depoindicator(maxspec)
+  logical :: indzindicator(nzmax)
+
+  real :: ust,wst,ol,h,zeta,sigu,sigv,tlu,tlv,tlw
+  real :: sigw,dsigwdz,dsigw2dz
+
+  real :: dcas,dcas1,dcas2  !modified by  by mc, random number needed in initialize_cbl_vel
+  integer ::  myid,n_threads !added by mc for parallel random number generation
+  integer(4) :: rannum
+  real(4) :: real_rannum
+  type (mt_state) :: mts (0: MAX_STREAM)
+
+
+  idummy=7
+  icbt=1           ! initialize particle to "no reflection"
+
+       if (newrandomgen.eq.0) then
+       cpt2=cpt2+1
+!      cpt=cpt+1000367
+      cpt2=mod(cpt2,maxrand)+1;
+
+!      nrand=int(ran3(idummy,inext,inextp,ma,iff)*real(maxrand-1))+1
+!      nrand=int(ran3(idummy)*real(maxrand-1))+1
+      nrand=cpt2+ompid*maxrand
+       maxrand2=maxrandomp
+       else
+!mc
+!      rannum=genrand_int32(mts(ompid+1+(myid*n_threads)))  !integer random
+!      number at 32 bit resolution
+       rannum=genrand_int32(mts(ompid+1))  !integer random number at 32 bit resolution
+       real_rannum = sngl(0.5_DP + 0.2328306e-9_DP * rannum) !conversion to single precision 32bit real between 0-1
+       nrand=int(real_rannum*real(maxrand-1))+1
+       maxrand2=maxrand
+       endif
+
+!******************************
+! 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)))
+
+! JB 
+      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, &
+    uprof,vprof,wprof, usigprof,vsigprof,wsigprof, &
+    rhoprof,rhogradprof, tkeprof,pttprof, &
+    u,v,w,usig,vsig,wsig,pvi, &
+    p1,p2,p3,p4,ddx,ddy,rddx,rddy,dtt,dt1,dt2, &
+    ix,jy,ixp,jyp,ngrid,indz,indzp, depoindicator, &
+    indzindicator, &
+    ust,wst,ol,h,zeta,sigu,sigv,tlu,tlv,tlw, &
+    sigw,dsigwdz,dsigw2dz,mu,mv)
+
+
+! 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
+!****************************************
+! FLEXPART WRF
+!          write(*,*)'initial.f','turb_option=',turb_option
+!          write(*,*)'turb_option_mytke=',turb_option_mytke
+       if (turb_option .eq. turb_option_mytke) then
+!           write(*,*)'initial.f'
+            call tke_partition_my(zt, &
+   ust,wst,ol,h,zeta,sigu,sigv,tlu,tlv,tlw, &
+   sigw,dsigwdz,dsigw2dz,uprof,vprof,tkeprof,pttprof,indz,indzp)
+       elseif (turb_option .eq. turb_option_tke) then
+              call tke_partition_hanna(zt, &
+   ust,wst,ol,h,zeta,sigu,sigv,tlu,tlv,tlw, &
+   sigw,dsigwdz,dsigw2dz,uprof,vprof,tkeprof,pttprof,indz,indzp)
+       else
+
+         if (turbswitch) then
+           call hanna(zt, &
+   ust,wst,ol,h,zeta,sigu,sigv,tlu,tlv,tlw, &
+   sigw,dsigwdz,dsigw2dz)
+
+         else
+           call hanna1(zt, &
+   ust,wst,ol,h,zeta,sigu,sigv,tlu,tlv,tlw, &
+   sigw,dsigwdz,dsigw2dz)
+         endif
+       endif       
+
+! Determine the new diffusivity velocities
+!*****************************************
+
+        if (nrand+2.gt.maxrand2) nrand=1
+        up=rannumb(nrand)*sigu
+        vp=rannumb(nrand+1)*sigv
+        wp=rannumb(nrand+2)
+        nrand=nrand+2 ! added by mc: it was missing previously a bug I think here and in original flexpart
+
+        if (.not.turbswitch) then     ! modified by mc
+        wp=wp*sigw
+       else if (cblflag.eq.1) then   ! modified by mc
+        if (-h/ol.gt.5) then          !unstable conditions from -h/ol >5 
+        !if (ol.lt.0.) then
+        !if (ol.gt.0.) then !by mc : gt.0 is only for test the correct is lt.0^M
+            dcas=uniform_rannumb(nrand) !uniform^M
+            dcas1=rannumb(nrand)        !gaussian^M
+            nrand=nrand+3
+            call initialize_cbl_vel(idummy,zt,ust,wst,h,sigw,wp,dcas,dcas1,ol)
+        else
+            wp=wp*sigw
+        end if
+       end if
+! 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, &
+    uprof,vprof,wprof, usigprof,vsigprof,wsigprof, &
+    rhoprof,rhogradprof, tkeprof,pttprof, &
+    u,v,w,usig,vsig,wsig,pvi, &
+    p1,p2,p3,p4,ddx,ddy,rddx,rddy,dtt,dt1,dt2, &
+    ix,jy,ixp,jyp,ngrid,indz,indzp, depoindicator, &
+    indzindicator,mu,mv)
+
+
+! Compute everything for above the PBL
+
+! Assume constant turbulent perturbations
+!****************************************
+
+        ldt=abs(lsynctime)
+
+        if (nrand+1.gt.maxrand2) 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.maxrand2) nrand=1
+      usigold=rannumb(nrand)*usig
+      vsigold=rannumb(nrand+1)*vsig
+      wsigold=rannumb(nrand+2)*wsig
+
+end subroutine initialize
+
Index: /branches/jerome/src_flexwrf_v3.1/initialize_cbl_vel.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/initialize_cbl_vel.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/initialize_cbl_vel.f90	(revision 16)
@@ -0,0 +1,119 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                *
+!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine,       *
+!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
+!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso,          *
+!* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann,   *
+!* This file is part of FLEXPART WRF                                   *
+!*                                                                     *
+!* 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_cbl_vel(idum,zp,ust,wst,h,sigmaw,wp,dcas,dcas1,ol)
+!                                  i/o   i  i   i  i     i  o   i    i       i
+! idum: for random number but not usednot used
+! zp: particle psition
+! ust: velocity scale, not used
+! wst: ocnvective velcotiy scale
+! sigmaW: standard deviaiton of vertical velocity
+! wp: particle velocity
+! dcas: for random number
+! dcas1: for random number
+! ol: Obukhov lenght
+!=============== initilization of particle velcoity based on CBL skewed vertical profiles and formulation of LHH 1996 with profile of w3 from lHB 2000         ==================
+!=============== by  Massimo Cassiani ( mc ), NILU,  2012-2013, reference to Cassiani et al. 2013..                                                            ==================
+!================================================================================================================================================================================   
+    use par_mod, only:pi
+    use com_mod, only:ldirect
+!    use ieee_arithmetic
+    
+    implicit none
+
+
+    real :: usurad2,usurad2p,C0,costluar4,eps 
+    parameter  (usurad2=0.7071067812,usurad2p=0.3989422804,C0=2,costluar4=0.66667,eps=0.000001)
+
+    integer idum
+    real :: wp,zp,ust,wst,h,dens,ddens,sigmaw,dsigmawdz,tlw,dcas,dcas1,ran3,gasdev
+    real :: w3,w2
+    real ::  z, &    
+    skew, &
+    skew2, &
+    radw2, &
+    fluarw,fluarw2, &
+    rluarw, &
+    xluarw, &
+    aluarw, &
+    bluarw, &
+    sigmawa, &
+    sigmawb, &  
+    ath, &
+    bth, &
+    wb,wa 
+    real timedir
+    real ol, transition
+    
+    !---------------------------------------------------------------------------  
+         !timedir=dble(ldirect) !direction of time forward (1) or backward(-1)
+     timedir=ldirect !time direction forward (1) or backward(-1)
+	 z=zp/h  !hn is the boundarylayer top
+	 
+     transition=1.
+     if (-h/ol.lt.15) transition=((sin((((-h/ol)+10.)/10.)*pi)))/2.+0.5 !transtion from near neutral to unstable
+     
+     
+     !w2=(1.7*(z*(1.-0.7*z)*(1.-z))**(2./3.))*(wst**2)
+	 w2=sigmaw*sigmaw
+	 !w3=(((1.2*z*((1.-z)**(3./2.)))+eps)*wst**3) *1.5	!the 1.5 is to test with increased skeweness see also cbl.f90
+     w3=(((1.2*z*((1.-z)**(3./2.)))+eps)*wst**3)*transition 
+	 skew=w3/(w2**1.5)
+	 skew2=skew*skew
+     radw2=sqrt(w2) !sigmaw
+     
+     if (skew.ne.0) then      
+     fluarw=costluar4*skew**0.333333333333333
+	 fluarw2=fluarw*fluarw
+	 rluarw=(1.+fluarw2)**3.*skew2/((3.+fluarw2)**2.*fluarw2)  !-> r
+     xluarw=rluarw**0.5 !(1.+fluarw2)**1.5*skew/((3.+fluarw2)*fluarw)    !----> r^1/2
+     else        
+     fluarw=0.
+     fluarw2=0.
+     rluarw=0.        
+     xluarw=0.        
+     end if   
+
+     aluarw=0.5*(1.-xluarw/(4.+rluarw)**0.5)
+	 bluarw=1.-aluarw
+        
+     sigmawa=radw2*(bluarw/(aluarw*(1.+fluarw2)))**0.5
+     sigmawb=radw2*(aluarw/(bluarw*(1.+fluarw2)))**0.5
+
+	 wa=(fluarw*sigmawa)
+	 wb=(fluarw*sigmawb)		
+
+	 !dcas=ran3(idum) !pass from outside
+
+	 if (dcas.le.aluarw) then
+	  !dcas1=gasdev(idum) !pass from outside
+	  wp=timedir*(dcas1*sigmawa+wa)
+	 else
+	  !dcas1=gasdev(idum) !pass from outside
+	  wp=timedir*(dcas1*sigmawb-wb)
+	 end if   
+!    if (ieee_is_nan(wp)) print*,'PROBLEM INIT',wp,timedir, &
+!      dcas1,sigmawa,wa,sigmawb,wb,idum,zp,ust,wst,h,sigmaw,wp,dcas,dcas1,ol    
+    return
+    end
+         
Index: /branches/jerome/src_flexwrf_v3.1/interpol_all.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/interpol_all.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/interpol_all.f90	(revision 16)
@@ -0,0 +1,327 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                *
+!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine,       *
+!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
+!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso,          *
+!* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann,   *
+!*                                                                     *
+!* This file is part of FLEXPART WRF                                   *
+!*                                                                     *
+!* 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, &
+    uprof,vprof,wprof, usigprof,vsigprof,wsigprof, &
+    rhoprof,rhogradprof, tkeprof,pttprof, &
+    u,v,w,usig,vsig,wsig,pvi, &
+    p1,p2,p3,p4,ddx,ddy,rddx,rddy,dtt,dt1,dt2, &
+    ix,jy,ixp,jyp,ngrid,indz,indzp, depoindicator, &
+    indzindicator, &
+   ust,wst,ol,h,zeta,sigu,sigv,tlu,tlv,tlw, &
+   sigw,dsigwdz,dsigw2dz,mu,mv)
+
+!                               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           *
+!                               calculation 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 calculat*
+!                                                                              *
+! Constants:                                                                   *
+!                                                                              *
+!*******************************************************************************
+!     12 JUNE 2007, compute tkeprof,   y4
+!     25 June 2007, compute pttprof,   y5
+!                   compute tkeprof for all levels
+!*******************************************************************************
+  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),y4(2),y5(2)
+      real :: usl,vsl,wsl,usq,vsq,wsq,xaux
+      integer :: i,m,n,indexh,n2
+      real :: tkeprof2
+
+      real,parameter ::eps=1.0e-30
+
+  real :: uprof(nzmax),vprof(nzmax),wprof(nzmax)
+  real :: usigprof(nzmax),vsigprof(nzmax),wsigprof(nzmax)
+  real :: rhoprof(nzmax),rhogradprof(nzmax)
+  real :: tkeprof(nzmax),pttprof(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)
+  real :: ust,wst,ol,h,zeta,sigu,sigv,tlu,tlv,tlw
+  real :: sigw,dsigwdz,dsigw2dz,mu,mv
+
+
+!********************************************
+! 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
+       mu =p1*m_x(ix ,jy ,1) &
+         + p2*m_x(ixp,jy ,1) &
+         + p3*m_x(ix ,jyp,1) &
+         + p4*m_x(ixp,jyp,1)
+       mv =p1*m_y(ix ,jy ,1) &
+         + p2*m_y(ixp,jy ,1) &
+         + p3*m_y(ix ,jyp,1) &
+         + p4*m_y(ixp,jyp,1)
+
+! 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)
+
+
+         enddo
+        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
+
+        enddo
+
+! compute TKE for all levels, used for estimating turb length scale
+         tkeprof2=-999.
+!        tkeprof2=0.
+        do n=1,nz
+         do m=1,2
+          indexh=memind(m)
+         y4(m) =p1*tke(ix ,jy ,n,indexh) &
+                 +p2*tke(ixp,jy ,n,indexh) &
+                 +p3*tke(ix ,jyp,n,indexh) &
+                 +p4*tke(ixp,jyp,n,indexh)
+          y5(m) =p1*ptt(ix ,jy ,n,indexh) &
+                 +p2*ptt(ixp,jy ,n,indexh) &
+                 +p3*ptt(ix ,jyp,n,indexh) &
+                 +p4*ptt(ixp,jyp,n,indexh)
+          enddo
+       tkeprof(n)=(y4(1)*dt2+y4(2)*dt1)*dtt
+       pttprof(n)=(y5(1)*dt2+y5(2)*dt1)*dtt
+!        if (tkeprof(n).gt.tkeprof2) then
+!         tkeprof2=tkeprof(n)
+!         n2=n
+!         endif
+!         if (n.lt.20) then
+!         tkeprof2=tkeprof2+tkeprof(n)
+!         n2=20
+!         endif       
+        enddo 
+!           tkeprof(1)=0.33*tkeprof(1)+0.33*tkeprof(2)+0.33*tkeprof(3)
+!         write(*,*)'interpol_all,itime,xt,yt,zt',itime,xt,yt,zt
+!         write(*,*)(tkeprof(n),n=1,nz)
+
+end subroutine interpol_all
+
Index: /branches/jerome/src_flexwrf_v3.1/interpol_all_nests.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/interpol_all_nests.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/interpol_all_nests.f90	(revision 16)
@@ -0,0 +1,293 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                *
+!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine,       *
+!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
+!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso,          *
+!* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann,   *
+!*                                                                     *
+!* This file is part of FLEXPART WRF                                   *
+!*                                                                     *
+!* 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, &
+    uprof,vprof,wprof, usigprof,vsigprof,wsigprof, &
+    rhoprof,rhogradprof, tkeprof,pttprof, &
+    u,v,w,usig,vsig,wsig,pvi, &
+    p1,p2,p3,p4,ddx,ddy,rddx,rddy,dtt,dt1,dt2, &
+    ix,jy,ixp,jyp,ngrid,indz,indzp, depoindicator, &
+    indzindicator, &
+   ust,wst,ol,h,zeta,sigu,sigv,tlu,tlv,tlw, &
+   sigw,dsigwdz,dsigw2dz,mu,mv)
+
+!                                     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           *
+!                               calculation 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 calculat*
+!                                                                              *
+! Constants:                                                                   *
+!                                                                              *
+!*******************************************************************************
+!     12 JUNE 2007  compute tkeprof,  add a variable y4(2)
+!     25 June 2007  compute pttprof, y5
+!                   compute tkeprof for all levels
+!*******************************************************************************
+  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),y4(2),y5(2)
+  real :: usl,vsl,wsl,usq,vsq,wsq,xaux
+  integer :: i,m,n,indexh
+  real,parameter :: eps=1.0e-30
+  real :: uprof(nzmax),vprof(nzmax),wprof(nzmax)
+  real :: usigprof(nzmax),vsigprof(nzmax),wsigprof(nzmax)
+  real :: rhoprof(nzmax),rhogradprof(nzmax)
+  real :: tkeprof(nzmax),pttprof(nzmax)
+  real :: u,v,w,usig,vsig,wsig,pvi,mu,mv
+
+  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)
+  real :: ust,wst,ol,h,zeta,sigu,sigv,tlu,tlv,tlw
+  real :: sigw,dsigwdz,dsigw2dz
+
+
+!********************************************
+! 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
+       mu =p1*m_xn(ix ,jy ,1,ngrid) &
+         + p2*m_xn(ixp,jy ,1,ngrid) &
+         + p3*m_xn(ix ,jyp,1,ngrid) &
+         + p4*m_xn(ixp,jyp,1,ngrid)
+       mv =p1*m_yn(ix ,jy ,1,ngrid) &
+         + p2*m_yn(ixp,jy ,1,ngrid) &
+         + p3*m_yn(ix ,jyp,1,ngrid) &
+         + p4*m_yn(ixp,jyp,1,ngrid)
+
+
+! 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
+
+! compute tke profile for all levels
+
+        do n=1,nz
+         do m=1,2
+             indexh=memind(m)
+                    y4(m)=p1*tken(ix ,jy ,n,indexh,ngrid) &
+                 +p2*tken(ixp,jy ,n,indexh,ngrid) &
+                 +p3*tken(ix ,jyp,n,indexh,ngrid) &
+                 +p4*tken(ixp,jyp,n,indexh,ngrid)
+          y5(m)=p1*pttn(ix ,jy ,n,indexh,ngrid) &
+                 +p2*pttn(ixp,jy ,n,indexh,ngrid) &
+                 +p3*pttn(ix ,jyp,n,indexh,ngrid) &
+                 +p4*pttn(ixp,jyp,n,indexh,ngrid)
+
+        enddo
+       tkeprof(n)=(y4(1)*dt2+y4(2)*dt1)*dtt
+         pttprof(n)=(y5(1)*dt2+y5(2)*dt1)*dtt
+        enddo
+
+
+     end subroutine interpol_all_nests
+
Index: /branches/jerome/src_flexwrf_v3.1/interpol_hmix.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/interpol_hmix.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/interpol_hmix.f90	(revision 16)
@@ -0,0 +1,106 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                 *
+!* Jerome Brioude, Delia Arnold, Jerome Fast, 
+!* Andreas Stohl, Petra Seibert, A. Frank, Gerhard Wotawa              *
+!* Caroline Forster, Sabine Eckhardt, John Burkhart, Harald Sodemann 
+!* M. Cassiani
+!*                                                                     *
+!* This file is part of FLEXPART WRF                                   *
+!*                                                                     *
+!* 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_hmix(itime,xt,yt,zt,haux, &
+        p1,p2,p3,p4,ddx,ddy,rddx,rddy,dtt,dt1,dt2, &
+    ix,jy,ixp,jyp)
+
+!                               i   i  i  i
+!*******************************************************************************
+!                                                                              *
+!  This subroutine interpolates boundary layer top (h)                          *
+!  dispersion.                                                                 *
+!                                                                              *
+!    Author:M. cassiani 2013                                                   *
+!                                                                              *
+!                                                                              *
+!*******************************************************************************
+  use par_mod
+  use com_mod
+!  use interpol_mod
+!  use hanna_mod
+  implicit none
+
+      integer :: itime
+      real :: xt,yt,zt,h
+
+! Auxiliary variables needed for interpolation
+     
+      integer :: i,m,n,indexh,n2
+      
+      real,parameter ::eps=1.0e-30
+
+ 
+  real :: h1(2),haux
+  real :: p1,p2,p3,p4,ddx,ddy,rddx,rddy,dtt,dt1,dt2
+  integer :: ix,jy,ixp,jyp,ngrid,indz,indzp 
+  logical :: indzindicator(nzmax)
+ 
+
+
+!********************************************
+! 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)
+
+
+
+!*****************************************
+
+! a) Bilinear horizontal interpolation
+
+  do m=1,2
+    indexh=memind(m)
+
+    h1(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
+      
+
+! b) Temporal interpolation
+
+      haux=(h1(1)*dt2+h1(2)*dt1)*dtt     
+
+
+end subroutine interpol_hmix
+
Index: /branches/jerome/src_flexwrf_v3.1/interpol_misslev.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/interpol_misslev.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/interpol_misslev.f90	(revision 16)
@@ -0,0 +1,217 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                *
+!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine,       *
+!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
+!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso,          *
+!* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann,   *
+!*                                                                     *
+!* This file is part of FLEXPART WRF                                   *
+!*                                                                     *
+!* 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,xt,yt,zt,&
+    uprof,vprof,wprof, usigprof,vsigprof,wsigprof, &
+    rhoprof,rhogradprof, tkeprof,pttprof, &
+    u,v,w,usig,vsig,wsig,pvi, &
+    p1,p2,p3,p4,ddx,ddy,rddx,rddy,dtt,dt1,dt2, &
+    ix,jy,ixp,jyp,ngrid,indz,indzp, depoindicator, &
+    indzindicator, &
+   ust,wst,ol,h,zeta,sigu,sigv,tlu,tlv,tlw, &
+   sigw,dsigwdz,dsigw2dz)
+
+
+!                                 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           *
+!                               calculation of standard deviation done in this *
+!                               routine rather than subroutine call in order   *
+!                               to save computation time                       *
+!                                                                              *
+!*******************************************************************************
+!                                                                              *
+! Variables:                                                                   *
+! n                  level                                                     *
+!                                                                              *
+! Constants:                                                                   *
+!                                                                              *
+!*******************************************************************************
+!   12 JUNE 2007  by W Wang 
+!                 compute pttrof , add a variable y4 for interpolation        *
+!*******************************************************************************
+
+  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),y4(2)
+      real :: usl,vsl,wsl,usq,vsq,wsq,xaux
+      integer :: m,n,indexh
+  real,parameter :: eps=1.0e-30
+
+  real :: uprof(nzmax),vprof(nzmax),wprof(nzmax)
+  real :: usigprof(nzmax),vsigprof(nzmax),wsigprof(nzmax)
+  real :: rhoprof(nzmax),rhogradprof(nzmax)
+  real :: tkeprof(nzmax),pttprof(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)
+  real :: ust,wst,ol,h,zeta,sigu,sigv,tlu,tlv,tlw
+  real :: sigw,dsigwdz,dsigw2dz
+
+  real(kind=dp) :: xt,yt
+  real :: zt
+
+!********************************************
+! 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)
+!        y4(m)  =p1*ptt(ix ,jy ,n,indexh) &
+!               +p2*ptt(ixp,jy ,n,indexh) &
+!               +p3*ptt(ix ,jyp,n,indexh) &
+!               +p4*ptt(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
+!      pttprof(n)=(y4(1)*dt2+y4(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/jerome/src_flexwrf_v3.1/interpol_misslev_nests.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/interpol_misslev_nests.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/interpol_misslev_nests.f90	(revision 16)
@@ -0,0 +1,182 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                *
+!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine,       *
+!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
+!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso,          *
+!* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann,   *
+!*                                                                     *
+!* This file is part of FLEXPART WRF                                   *
+!*                                                                     *
+!* 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,xt,yt,zt,&
+    uprof,vprof,wprof, usigprof,vsigprof,wsigprof, &
+    rhoprof,rhogradprof, tkeprof,pttprof, &
+    u,v,w,usig,vsig,wsig,pvi, &
+    p1,p2,p3,p4,ddx,ddy,rddx,rddy,dtt,dt1,dt2, &
+    ix,jy,ixp,jyp,ngrid,indz,indzp, depoindicator, &
+    indzindicator, &
+   ust,wst,ol,h,zeta,sigu,sigv,tlu,tlv,tlw, &
+   sigw,dsigwdz,dsigw2dz)
+
+!                                       i
+!*******************************************************************************
+!                                                                              *
+!  This subroutine interpolates u,v,w, density and density gradients.          *
+!                                                                              *
+!    Author: A. Stohl                                                          *
+!                                                                              *
+!    16 December 1997                                                          *
+!                                                                              *
+!*******************************************************************************
+!                                                                              *
+! Variables:                                                                   *
+! n                  level                                                     *
+!                                                                              *
+! Constants:                                                                   *
+!                                                                              *
+!*******************************************************************************
+!    12 JUNE 2007 W Wang
+!                 compute pttprof,  add a variable y4 for interpolation        *
+!*******************************************************************************
+  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),y4(2)
+      real :: usl,vsl,wsl,usq,vsq,wsq,xaux
+      integer :: m,n,indexh
+  real,parameter :: eps=1.0e-30
+
+  real :: uprof(nzmax),vprof(nzmax),wprof(nzmax)
+  real :: usigprof(nzmax),vsigprof(nzmax),wsigprof(nzmax)
+  real :: rhoprof(nzmax),rhogradprof(nzmax)
+  real :: tkeprof(nzmax),pttprof(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)
+  real :: ust,wst,ol,h,zeta,sigu,sigv,tlu,tlv,tlw
+  real :: sigw,dsigwdz,dsigw2dz
+
+  real(kind=dp) :: xt,yt
+  real :: zt
+
+!********************************************
+! 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)
+!        y4(m)=p1*pttn(ix ,jy ,n,indexh,ngrid) &
+!               +p2*pttn(ixp,jy ,n,indexh,ngrid) &
+!               +p3*pttn(ix ,jyp,n,indexh,ngrid) &
+!               +p4*pttn(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
+!      pttprof(n)=(y4(1)*dt2+y4(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/jerome/src_flexwrf_v3.1/interpol_mod.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/interpol_mod.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/interpol_mod.f90	(revision 16)
@@ -0,0 +1,43 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                *
+!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine,       *
+!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
+!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso,          *
+!* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann,   *
+!*                                                                     *
+!* This file is part of FLEXPART WRF                                   *
+!*                                                                     *
+!* 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 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 :: tkeprof(nzmax),pttprof(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/jerome/src_flexwrf_v3.1/interpol_rain.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/interpol_rain.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/interpol_rain.f90	(revision 16)
@@ -0,0 +1,249 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                *
+!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine,       *
+!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
+!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso,          *
+!* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann,   *
+!*                                                                     *
+!* This file is part of FLEXPART WRF                                   *
+!*                                                                     *
+!* 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,iy1,iy2,nxmax,nymax,nzmax,nx, &
+      ny,memind,xt,yt,level,itime1,itime2,itime,yint1,yint2,yint3,  &
+      intiy1,intiy2,icmv)
+!                               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                                 *
+!                                                                           *
+!   19-Oct-2007   WANG, W  change cumulated rain to hourly rain
+!                 yy1 is accumulated largescale precipitation (mm)
+!                 yy2 is ''''''''''''convective '''''''''''''''''
+!****************************************************************************
+
+      implicit none
+
+      integer :: nx,ny,nxmax,nymax,nzmax,memind(2),m,ix,jy,ixp,jyp
+!      integer :: itime,itime1,itime2,level,indexh,i1,i2
+      integer :: itime,itime1,itime2,level,indexh,i1,i2,ip1,ip2,ip3,ip4
+      integer :: intiy1,intiy2,ipsum,icmv
+
+      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)
+
+      integer :: iy1(0:nxmax-1,0:nymax-1,2),iy2(0:nxmax-1,0:nymax-1,2)
+
+!      real :: ddx,ddy,rddx,rddy,dt1,dt2,dt,y1(2),y2(2),y3(2)
+      real :: ddx,ddy,rddx,rddy,dt1,dt2,dt,y1(2),y2(2),y3(2),yi1(2),yi2(2)
+
+!      real :: xt,yt,yint1,yint2,yint3,p1,p2,p3,p4
+      real :: xt,yt,yint1,yint2,yint3,yint4,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
+!***********************
+ 
+! y1 and y2 are accumulated rain, need change to hourly rain
+
+        i1=memind(1)
+        i2=memind(2)
+!! time interval between two fields, second to hour
+        dt=real(itime2-itime1)/3600.0
+
+
+        yint1=p1*(yy1(ix ,jy ,level,i2)- &
+                  yy1(ix ,jy ,level,i1)) &
+            + p2*(yy1(ixp,jy ,level,i2)- &
+                  yy1(ixp,jy ,level,i1)) &
+            + p3*(yy1(ix ,jyp,level,i2)- &
+                  yy1(ix ,jyp,level,i1)) &
+            + p4*(yy1(ixp,jyp,level,i2)- &
+                  yy1(ixp,jyp,level,i1)) 
+        yint1=yint1/dt
+
+        yint2=p1*(yy2(ix ,jy ,level,i2)- &
+                  yy2(ix ,jy ,level,i1)) &
+            + p2*(yy2(ixp,jy ,level,i2)- &
+                  yy2(ixp,jy ,level,i1)) &
+            + p3*(yy2(ix ,jyp,level,i2)- &
+                  yy2(ix ,jyp,level,i1)) &
+            + p4*(yy2(ixp,jyp,level,i2)- &
+                  yy2(ixp,jyp,level,i1))
+       yint2=yint2/dt
+
+
+! Y3 is cloud fraction in an hour
+      do m=1,2
+        indexh=memind(m)
+        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)
+      enddo
+
+
+! CDA new clouds
+
+      do m=1,2
+        indexh=memind(m)
+
+        ip1=1
+        ip2=1
+        ip3=1
+        ip4=1
+        if (iy1(ix ,jy ,indexh) .eq. icmv) ip1=0
+        if (iy1(ixp,jy ,indexh) .eq. icmv) ip2=0
+        if (iy1(ix ,jyp,indexh) .eq. icmv) ip3=0
+        if (iy1(ixp,jyp,indexh) .eq. icmv) ip4=0
+        ipsum= ip1+ip2+ip3+ip4
+        if (ipsum .eq. 0) then
+          yi1(m)=icmv
+        else
+          yi1(m)=(ip1*p1*iy1(ix ,jy ,indexh) &
+            + ip2*p2*iy1(ixp,jy ,indexh) &
+            + ip3*p3*iy1(ix ,jyp,indexh) &
+            + ip4*p4*iy1(ixp,jyp,indexh))/ipsum
+        endif
+
+        ip1=1
+        ip2=1
+        ip3=1
+        ip4=1
+        if (iy2(ix ,jy ,indexh) .eq. icmv) ip1=0
+        if (iy2(ixp,jy ,indexh) .eq. icmv) ip2=0
+        if (iy2(ix ,jyp,indexh) .eq. icmv) ip3=0
+        if (iy2(ixp,jyp,indexh) .eq. icmv) ip4=0
+        ipsum= ip1+ip2+ip3+ip4
+        if (ipsum .eq. 0) then
+          yi2(m)=icmv
+        else
+          yi2(m)=(ip1*p1*iy2(ix ,jy ,indexh) &
+            + ip2*p2*iy2(ixp,jy ,indexh) &
+            + ip3*p3*iy2(ix ,jyp,indexh) &
+            + ip4*p4*iy2(ixp,jyp,indexh))/ipsum
+        endif
+      enddo 
+!CPS end clouds
+
+
+10    continue
+
+
+!************************************
+! 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
+
+
+!CPS clouds:
+      intiy1=(yi1(1)*dt2 + yi1(2)*dt1)/dt
+      if (yi1(1) .eq. float(icmv)) intiy1=yi1(2)
+      if (yi1(2) .eq. float(icmv)) intiy1=yi1(1)
+
+      intiy2=(yi2(1)*dt2 + yi2(2)*dt1)/dt
+      if (yi2(1) .eq. float(icmv)) intiy2=yi2(2)
+      if (yi2(2) .eq. float(icmv)) intiy2=yi2(1)
+
+      if (intiy1 .ne. icmv .and. intiy2 .ne. icmv) then
+        intiy2 = intiy1 + intiy2 ! convert cloud thickness to cloud top
+      else
+        intiy1=icmv
+        intiy2=icmv
+      endif
+!CPS end clouds
+
+
+
+
+
+ end subroutine interpol_rain
+
Index: /branches/jerome/src_flexwrf_v3.1/interpol_rain_nests.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/interpol_rain_nests.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/interpol_rain_nests.f90	(revision 16)
@@ -0,0 +1,263 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                *
+!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine,       *
+!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
+!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso,          *
+!* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann,   *
+!*                                                                     *
+!* This file is part of FLEXPART WRF                                   *
+!*                                                                     *
+!* 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,iy1,iy2,nxmaxn,nymaxn,nzmax, &
+      maxnests,ngrid,nxn,nyn,memind,xt,yt,level,itime1,itime2,itime, &
+      yint1,yint2,yint3,intiy1,intiy2,icmv)
+!                                     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                                 *
+!                                                                           *
+!  Changed 10/22/2007  yy1,yy2 are accumulated rain (mm)
+!                      convert them into hourly rain (mm/hr)
+!****************************************************************************
+
+    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,i1,i2
+    integer :: ip1,ip2,ip3,ip4
+    integer :: intiy1,intiy2,ipsum,icmv
+    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)
+    integer :: iy1(0:nxmaxn-1,0:nymaxn-1,2,maxnests)
+    integer :: iy2(0:nxmaxn-1,0:nymaxn-1,2,maxnests)
+    real :: ddx,ddy,rddx,rddy,dt1,dt2,dt,y1(2),y2(2),y3(2),yi1(2),yi2(2)
+    real :: xt,yt,yint1,yint2,yint3,yint4,p1,p2,p3,p4
+
+
+
+! If point at border of grid -> small displacement into grid
+!***********************************************************
+
+      if (xt.ge.real(nxn(ngrid)-1)) xt=real(nxn(ngrid)-1)-0.00001
+      if (yt.ge.real(nyn(ngrid)-1)) yt=real(nyn(ngrid)-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
+!***********************
+
+! y1 and y2 are accumulated rain, need change to hourly rain
+ 
+        i1=memind(1)
+        i2=memind(2)
+! time interval between two fields, second to hour
+        dt=real(itime2-itime1)/3600.0
+ 
+        yint1=p1*(yy1(ix ,jy ,level,i2,ngrid)- & 
+                  yy1(ix ,jy ,level,i1,ngrid)) &
+            + p2*(yy1(ixp,jy ,level,i2,ngrid)- &
+                  yy1(ixp,jy ,level,i1,ngrid)) &
+            + p3*(yy1(ix ,jyp,level,i2,ngrid)- &
+                  yy1(ix ,jyp,level,i1,ngrid)) &
+            + p4*(yy1(ixp,jyp,level,i2,ngrid)- &
+                  yy1(ixp,jyp,level,i1,ngrid))
+        yint1=yint1/dt
+ 
+        yint2=p1*(yy2(ix ,jy ,level,i2,ngrid)- &
+                  yy2(ix ,jy ,level,i1,ngrid)) &
+            + p2*(yy2(ixp,jy ,level,i2,ngrid)- &
+                  yy2(ixp,jy ,level,i1,ngrid)) &
+            + p3*(yy2(ix ,jyp,level,i2,ngrid)- &
+                  yy2(ix ,jyp,level,i1,ngrid)) &
+            + p4*(yy2(ixp,jyp,level,i2,ngrid)- &
+                  yy2(ixp,jyp,level,i1,ngrid))
+       yint2=yint2/dt
+ 
+ 
+! Y3 is cloud fraction in an hour
+
+ 
+      do m=1,2
+        indexh=memind(m)
+        
+        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)
+        enddo
+
+
+! CDA new clouds
+
+      do m=1,2
+        indexh=memind(m)
+
+        ip1=1
+        ip2=1
+        ip3=1
+        ip4=1
+        if (iy1(ix ,jy ,indexh,ngrid) .eq. icmv) ip1=0
+        if (iy1(ixp,jy ,indexh,ngrid) .eq. icmv) ip2=0
+        if (iy1(ix ,jyp,indexh,ngrid) .eq. icmv) ip3=0
+        if (iy1(ixp,jyp,indexh,ngrid) .eq. icmv) ip4=0
+        ipsum= ip1+ip2+ip3+ip4
+        if (ipsum .eq. 0) then
+          yi1(m)=icmv
+        else
+          yi1(m)=(ip1*p1*iy1(ix ,jy ,indexh,ngrid) &
+            + ip2*p2*iy1(ixp,jy ,indexh,ngrid) &
+            + ip3*p3*iy1(ix ,jyp,indexh,ngrid) &
+            + ip4*p4*iy1(ixp,jyp,indexh,ngrid))/ipsum
+        endif
+
+        ip1=1
+        ip2=1
+        ip3=1
+        ip4=1
+        if (iy2(ix ,jy ,indexh,ngrid) .eq. icmv) ip1=0
+        if (iy2(ixp,jy ,indexh,ngrid) .eq. icmv) ip2=0
+        if (iy2(ix ,jyp,indexh,ngrid) .eq. icmv) ip3=0
+        if (iy2(ixp,jyp,indexh,ngrid) .eq. icmv) ip4=0
+        ipsum= ip1+ip2+ip3+ip4
+        if (ipsum .eq. 0) then
+          yi2(m)=icmv
+        else
+          yi2(m)=(ip1*p1*iy2(ix ,jy ,indexh,ngrid) &
+            + ip2*p2*iy2(ixp,jy ,indexh,ngrid) &
+            + ip3*p3*iy2(ix ,jyp,indexh,ngrid) &
+            + ip4*p4*iy2(ixp,jyp,indexh,ngrid))/ipsum
+        endif
+        ip1=1
+        ip2=1
+        ip3=1
+        ip4=1
+        if (iy2(ix ,jy ,indexh,ngrid) .eq. icmv) ip1=0
+        if (iy2(ixp,jy ,indexh,ngrid) .eq. icmv) ip2=0
+        if (iy2(ix ,jyp,indexh,ngrid) .eq. icmv) ip3=0
+        if (iy2(ixp,jyp,indexh,ngrid) .eq. icmv) ip4=0
+        ipsum= ip1+ip2+ip3+ip4
+        if (ipsum .eq. 0) then
+          yi2(m)=icmv
+        else
+          yi2(m)=(ip1*p1*iy2(ix ,jy ,indexh,ngrid) &
+            + ip2*p2*iy2(ixp,jy ,indexh,ngrid) &
+            + ip3*p3*iy2(ix ,jyp,indexh,ngrid) &
+            + ip4*p4*iy2(ixp,jyp,indexh,ngrid))/ipsum
+        endif
+      enddo
+!CPS end clouds
+
+
+10    continue
+
+
+!************************************
+! 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
+
+
+!CPS clouds:
+      intiy1=(yi1(1)*dt2 + yi1(2)*dt1)/dt
+      if (yi1(1) .eq. float(icmv)) intiy1=yi1(2)
+      if (yi1(2) .eq. float(icmv)) intiy1=yi1(1)
+
+      intiy2=(yi2(1)*dt2 + yi2(2)*dt1)/dt
+      if (yi2(1) .eq. float(icmv)) intiy2=yi2(2)
+      if (yi2(2) .eq. float(icmv)) intiy2=yi2(1)
+
+      if (intiy1 .ne. icmv .and. intiy2 .ne. icmv) then
+        intiy2 = intiy1 + intiy2 ! convert cloud thickness to cloud top
+      else
+        intiy1=icmv
+        intiy2=icmv
+      endif
+!CPS end clouds
+
+
+end subroutine interpol_rain_nests
+
Index: /branches/jerome/src_flexwrf_v3.1/interpol_vdep.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/interpol_vdep.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/interpol_vdep.f90	(revision 16)
@@ -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 interpol_vdep(level,vdepo,ix,jy,ixp,jyp, &
+                         p1,p2,p3,p4,dt1,dt2,dtt,depoindicator)
+  !                           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
+  real :: p1,p2,p3,p4,dtt,dt1,dt2
+  integer :: ix,jy,ixp,jyp
+  logical :: depoindicator(maxspec)
+
+  ! 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/jerome/src_flexwrf_v3.1/interpol_vdep_nests.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/interpol_vdep_nests.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/interpol_vdep_nests.f90	(revision 16)
@@ -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 interpol_vdep_nests(level,vdepo,ix,jy,ixp,jyp, &
+                         p1,p2,p3,p4,dt1,dt2,dtt,depoindicator,ngrid)
+  !                                 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
+  real :: p1,p2,p3,p4,dtt,dt1,dt2
+  integer :: ix,jy,ixp,jyp,ngrid
+  logical :: depoindicator(maxspec)
+
+  ! 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/jerome/src_flexwrf_v3.1/interpol_wind.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/interpol_wind.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/interpol_wind.f90	(revision 16)
@@ -0,0 +1,263 @@
+!**********************************************************************
+! 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, &
+    uprof,vprof,wprof, usigprof,vsigprof,wsigprof, &
+    rhoprof,rhogradprof, tkeprof,pttprof, &
+    u,v,w,usig,vsig,wsig,pvi, &
+    p1,p2,p3,p4,ddx,ddy,rddx,rddy,dtt,dt1,dt2, &
+    ix,jy,ixp,jyp,ngrid,indz,indzp, depoindicator, &
+    indzindicator,mu,mv)
+
+  !                           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
+
+  real :: uprof(nzmax),vprof(nzmax),wprof(nzmax)
+  real :: usigprof(nzmax),vsigprof(nzmax),wsigprof(nzmax)
+  real :: rhoprof(nzmax),rhogradprof(nzmax)
+  real :: tkeprof(nzmax),pttprof(nzmax)
+  real :: u,v,w,usig,vsig,wsig,pvi,mu,mv
+
+  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)
+
+
+  !********************************************
+  ! 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
+
+
+       mu =p1*m_x(ix ,jy ,1) &
+         + p2*m_x(ixp,jy ,1) &
+         + p3*m_x(ix ,jyp,1) &
+         + p4*m_x(ixp,jyp,1)
+       mv =p1*m_y(ix ,jy ,1) &
+         + p2*m_y(ixp,jy ,1) &
+         + p3*m_y(ix ,jyp,1) &
+         + p4*m_y(ixp,jyp,1)
+
+  ! 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
+  if (usig.gt.1.e6) print*,'pb xaux',usq,usl
+
+  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/jerome/src_flexwrf_v3.1/interpol_wind_nests.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/interpol_wind_nests.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/interpol_wind_nests.f90	(revision 16)
@@ -0,0 +1,245 @@
+!**********************************************************************
+! 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, &
+    uprof,vprof,wprof, usigprof,vsigprof,wsigprof, &
+    rhoprof,rhogradprof, tkeprof,pttprof, &
+    u,v,w,usig,vsig,wsig,pvi, &
+    p1,p2,p3,p4,ddx,ddy,rddx,rddy,dtt,dt1,dt2, &
+    ix,jy,ixp,jyp,ngrid,indz,indzp, depoindicator, &
+    indzindicator,mu,mv)
+  !                                 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
+
+  real :: uprof(nzmax),vprof(nzmax),wprof(nzmax)
+  real :: usigprof(nzmax),vsigprof(nzmax),wsigprof(nzmax)
+  real :: rhoprof(nzmax),rhogradprof(nzmax)
+  real :: tkeprof(nzmax),pttprof(nzmax)
+  real :: u,v,w,usig,vsig,wsig,pvi,mu,mv
+
+  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)
+
+
+  !********************************************
+  ! 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
+
+      mu =p1*m_xn(ix ,jy ,1,ngrid) &
+         + p2*m_xn(ixp,jy ,1,ngrid) &
+         + p3*m_xn(ix ,jyp,1,ngrid) &
+         + p4*m_xn(ixp,jyp,1,ngrid)
+       mv =p1*m_yn(ix ,jy ,1,ngrid) &
+         + p2*m_yn(ixp,jy ,1,ngrid) &
+         + p3*m_yn(ix ,jyp,1,ngrid) &
+         + p4*m_yn(ixp,jyp,1,ngrid)
+
+
+  ! 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/jerome/src_flexwrf_v3.1/interpol_wind_short.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/interpol_wind_short.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/interpol_wind_short.f90	(revision 16)
@@ -0,0 +1,185 @@
+!**********************************************************************
+! 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, &
+    uprof,vprof,wprof, usigprof,vsigprof,wsigprof, &
+    rhoprof,rhogradprof, tkeprof,pttprof, &
+    u,v,w,usig,vsig,wsig,pvi, &
+    p1,p2,p3,p4,ddx,ddy,rddx,rddy,dtt,dt1,dt2, &
+    ix,jy,ixp,jyp,ngrid,indz,indzp, depoindicator, &
+    indzindicator)
+
+  !                                 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
+
+  real :: uprof(nzmax),vprof(nzmax),wprof(nzmax)
+  real :: usigprof(nzmax),vsigprof(nzmax),wsigprof(nzmax)
+  real :: rhoprof(nzmax),rhogradprof(nzmax)
+  real :: tkeprof(nzmax),pttprof(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)
+
+
+
+  !********************************************
+  ! 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
+!!!$OMP CRITICAL
+        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)
+!!!$OMP END CRITICAL
+      else
+!!!$OMP CRITICAL
+        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)
+!!!$OMP END CRITICAL
+      endif
+!!!$OMP CRITICAL
+      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)
+!!!$OMP END CRITICAL
+    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/jerome/src_flexwrf_v3.1/interpol_wind_short_nests.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/interpol_wind_short_nests.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/interpol_wind_short_nests.f90	(revision 16)
@@ -0,0 +1,166 @@
+!**********************************************************************
+! 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, &
+    uprof,vprof,wprof, usigprof,vsigprof,wsigprof, &
+    rhoprof,rhogradprof, tkeprof,pttprof, &
+    u,v,w,usig,vsig,wsig,pvi, &
+    p1,p2,p3,p4,ddx,ddy,rddx,rddy,dtt,dt1,dt2, &
+    ix,jy,ixp,jyp,ngrid,indz,indzp, depoindicator, &
+    indzindicator)
+  !                                      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
+
+  real :: uprof(nzmax),vprof(nzmax),wprof(nzmax)
+  real :: usigprof(nzmax),vsigprof(nzmax),wsigprof(nzmax)
+  real :: rhoprof(nzmax),rhogradprof(nzmax)
+  real :: tkeprof(nzmax),pttprof(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)
+
+
+  !********************************************
+  ! 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/jerome/src_flexwrf_v3.1/isnan_gfortran.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/isnan_gfortran.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/isnan_gfortran.f90	(revision 16)
@@ -0,0 +1,11 @@
+
+       logical function isnan2(a)
+       real :: a
+        if (isnan(a)) then
+       isnan2 = .true.
+       else
+       isnan2 = .false.
+        end if
+        return
+       end
+
Index: /branches/jerome/src_flexwrf_v3.1/isnan_other.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/isnan_other.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/isnan_other.f90	(revision 16)
@@ -0,0 +1,13 @@
+       logical function isnan2(a)
+! use ieee_arithmetic
+       real :: a
+!       if (ieee_is_nan(a)) then
+        if (a.ne.a) then
+       isnan2 = .true.
+       else
+       isnan2 = .false.
+        end if
+        return
+       end
+
+
Index: /branches/jerome/src_flexwrf_v3.1/juldate.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/juldate.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/juldate.f90	(revision 16)
@@ -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/jerome/src_flexwrf_v3.1/kftable_mod.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/kftable_mod.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/kftable_mod.f90	(revision 16)
@@ -0,0 +1,31 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                *
+!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine,       *
+!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
+!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso,          *
+!* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann,   *
+!*                                                                     *
+!* This file is part of FLEXPART WRF                                   *
+!*                                                                     *
+!* 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 kftable_mod
+      INTEGER, PARAMETER :: KFNT=250,KFNP=220
+      REAL, DIMENSION(1:KFNT,1:KFNP) :: TTAB,QSTAB
+      REAL, DIMENSION(1:KFNP) :: THE0K
+      REAL, DIMENSION(1:200) :: ALU
+      REAL  rdpr,rdthk,plutop
+ 
+      end module kftable_mod
Index: /branches/jerome/src_flexwrf_v3.1/makefile.mom
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/makefile.mom	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/makefile.mom	(revision 16)
@@ -0,0 +1,233 @@
+SHELL = /bin/bash
+## name of the executable
+EXECNAME = flexwrf31
+#
+############## NETCDF library path #################
+#NETCDF = /wrk/d0/jbrioude/netcdf-3.6.2/lib
+NETCDF = /usr/local
+
+# NetCDF library version 3 or 4. Version 4 is much better for compression
+NETCDFVERSION=3
+
+############### Specify the compiler you want
+# COMPILER options --- gnu, pgi, intel
+COMPILER = pgi
+
+########  Unless you want to change compiler options, you shouldn't have
+########  to change anything in this section
+################################################################
+GNU_FFLAGS  =  -m64 -mcmodel=medium -fconvert=little-endian -finit-local-zero -fno-range-check
+GNU_LDFLAGS = -m64 -mcmodel=medium -fconvert=little-endian -finit-local-zero -lnetcdf -fno-range-check
+
+#PGI_FFLAGS  = -fastsse -mcmodel=medium -traceback -Mbounds -Mchkfpstk -Mchkptr -Mchkstk  
+#PGI_FFLAGS  = -fastsse -mcmodel=medium -tp=nehalem-64 
+ PGI_FFLAGS  = -fastsse -mcmodel=medium 
+#PGI_LDFLAGS = -fastsse -mcmodel=medium -traceback -Mbounds -Mchkfpstk -Mchkptr -Mchkstk -lnetcdff -Kieee
+#PGI_LDFLAGS = -fastsse -mcmodel=medium -traceback -Mbounds -Mchkfpstk -Mchkptr -Mchkstk -lnetcdff 
+ PGI_LDFLAGS = -fastsse -mcmodel=medium -lnetcdf
+
+INTEL_FFLAGS  = -mcmodel=medium -shared-intel  -debug all
+INTEL_LDFLAGS = -mcmodel=medium -shared-intel -lnetcdff  -debug all
+################################################################
+
+
+##############  You shouldn't need to change anything below here
+#+++++++++++++++++++++++++++++++++++++++++++++++++++++
+
+
+
+
+BASENAME=$(EXECNAME)_$(COMPILER)
+
+ifeq ($(COMPILER), pgi)
+	FCSER      = pgf90 
+	FCOMP      = pgf90 -mp 
+	FCMPI      = pgf90 -mp 
+#        NETCDF = /apps/netcdf/4.1.3-pgi
+
+	FFLAGS= -I${NETCDF}/include $(PGI_FFLAGS)
+ 	LDFLAGS= -L${NETCDF}/lib $(PGI_LDFLAGS)
+        ISNAN_OBJ = isnan_other.o 
+endif
+
+
+ifeq ($(COMPILER), gnu)
+	FCSER      = gfortran
+	FCOMP      = gfortran -fopenmp
+	FCMPI      = gfortran -fopenmp
+#        NETCDF = /apps/netcdf/4.1.3-pgi
+
+	FFLAGS= -I${NETCDF}/include $(GNU_FFLAGS)
+	LDFLAGS= -L${NETCDF}/lib $(GNU_LDFLAGS)
+        ISNAN_OBJ = isnan_gfortran.o 
+endif
+
+
+ifeq ($(COMPILER), intel)
+	FCSER      = ifort
+	FCOMP      = ifort -openmp
+	FCMPI      = ifort -openmp
+#        NETCDF = /apps/netcdf/4.1.3-intel
+
+	FFLAGS= -I${NETCDF}/include $(INTEL_FFLAGS)
+	LDFLAGS= -L${NETCDF}/lib $(INTEL_LDFLAGS)
+        ISNAN_OBJ = isnan_other.o 
+endif
+
+
+NETCDF_OBJ = write_ncheader.o 	write_ncinfo.o \
+
+ifeq ($(NETCDFVERSION), 3)
+
+	NETCDF_OBJ = write_ncheader_v3.o	write_ncinfo_v3.o \
+
+endif
+
+ifeq ($(MAKECMDGOALS),serial)
+	FC=$(FCSER)
+	MAIN=$(BASENAME)_serial
+        FFLAGS2=$(FFLAGS)
+        LDFLAGS2=$(LDFLAGS) 
+endif
+ifeq ($(MAKECMDGOALS),omp)
+	FC=$(FCOMP)
+	MAIN=$(BASENAME)_omp
+        FFLAGS2=$(FFLAGS)
+        LDFLAGS2=$(LDFLAGS) -lpthread 
+endif
+ifeq ($(MAKECMDGOALS),mpi)
+	FC=$(FCMPI)
+	MAIN=$(BASENAME)_mpi
+        FFLAGS2=$(FFLAGS) -I${MPI_ROOT}/include
+        LDFLAGS2=$(LDFLAGS) -lpthread -L${MPI_ROOT}/lib -lmpi
+endif
+
+
+
+#.SUFFIXES: .o .f90
+#
+#.f90.o:
+#	$(FC) -c $(FCFLAGS) $*.f90
+
+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 \
+kftable_mod.o		wrf_map_utils_mod.o \
+ran_mod.o 		mpi_mod.o \
+mt_kind_defs.o		mt_stream.o 
+#
+OBJECTS = assignland.o  writeheader.o \
+calcpar.o               part0.o \
+caldate.o               partdep.o \
+coordtrafo.o            psih.o \
+                        raerod.o \
+dynamic_viscosity.o	random.o \
+initial_cond_output.o	initial_cond_calc.o\
+outgrid_init_irreg.o	outgrid_init_reg.o\
+releaseparticles_irreg.o	releaseparticles_reg.o\
+conccalc_irreg.o	conccalc_reg.o\
+erf.o                   \
+ew.o                    \
+advance.o               readdepo.o \
+psim.o     \
+readlanduse.o \
+getfields.o             init_domainfill.o\
+interpol_wind.o         \
+interpol_all.o          ohreaction.o \
+getrb.o                 get_settling.o \
+getrc.o                 readohfield.o \
+getvdep.o               getvdep_nests.o \
+interpol_misslev.o      readwind.o \
+richardson.o \
+scalev.o \
+pbl_profile.o           \
+juldate.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 \
+cmapf1.0.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 \
+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           \
+openreceptors.o         boundcond_domainfill.o\
+gridcheck_nests.o \
+readwind_nests.o	\
+outgrid_init_nest_reg.o outgrid_init_nest_irreg.o \
+outgrid_init_nest.o     writeheader_nest.o \
+wetdepokernel_nest.o \
+drydepokernel_nest.o	drydepokernel.o \
+concoutput_irreg.o	concoutput_reg.o\
+concoutput_nest_irreg.o	concoutput_nest_reg.o\
+read_ncwrfout.o         map_proj_wrf.o \
+map_proj_wrf_subaa.o	readinput.o \
+tke_partition_hanna.o  tke_partition_my.o \
+redist_kf.o pre_redist_kf.o\
+convection_kfeta.o convmix_kfeta.o \
+readwind_timeav.o \
+readwind_nests_timeav.o  \
+gf2xe.o			f_get_coeff.o \
+ranlux.o \
+initialize_cbl_vel.o \
+gasdevlux.o \
+cbl.o                   re_initialize_particle.o \
+write_ncconc.o \
+check_ncerror.o		
+
+MPI_ONLY_OBJS = sendreal_mpi.o          senddouble_mpi.o \
+		sendint_mpi.o           sendint2_mpi.o \
+		sendreal2d_mpi.o	flexwrf_mpi.o  \
+		timemanager_mpi.o 	senddrydep_mpi.o \
+		senddrydep_nest_mpi.o \
+
+SERIAL_ONLY_OBJS = flexwrf.o          timemanager_serial.o \
+
+OMP_ONLY_OBJS = flexwrf.o          timemanager.o \
+
+
+serial: $(MODOBJS) $(OBJECTS) $(SERIAL_ONLY_OBJS) $(ISNAN_OBJ) $(NETCDF_OBJ)
+#	echo 'Pure serial not supported - use omp'
+#	exit
+	$(FC) *.o -o $(MAIN) $(LDFLAGS2)
+
+omp: $(MODOBJS) $(OBJECTS) $(OMP_ONLY_OBJS) $(ISNAN_OBJ) $(NETCDF_OBJ)
+	$(FC) *.o -o $(MAIN) $(LDFLAGS2)
+
+mpi: $(MODOBJS) $(OBJECTS) $(MPI_ONLY_OBJS) $(ISNAN_OBJ) $(NETCDF_OBJ)
+	echo 'Compiling MPI'
+	$(FC) *.o -o $(MAIN) $(LDFLAGS2)
+
+$(OBJECTS): $(MODOBJS)
+$(MPI_ONLY_OBJECTS): $(MODOBJS)
+$(SERIAL_ONLY_OBJECTS): $(MODOBJS)
+
+%.o: %.f90
+	$(FC) -c $(FFLAGS2) $<
+
+# This is here because of a single source file, erf.f
+%.o: %.f
+	$(FC) -c $(FFLAGS2) $<
+
+clean:
+	rm *.o *.mod 
+
Index: /branches/jerome/src_flexwrf_v3.1/map_proj_wrf.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/map_proj_wrf.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/map_proj_wrf.f90	(revision 16)
@@ -0,0 +1,805 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                *
+!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine,       *
+!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
+!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso,          *
+!* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann,   *
+!*                                                                     *
+!* This file is part of FLEXPART WRF                                   *
+!*                                                                     *
+!* 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/>.   *
+!***********************************************************************
+!**********************************************************************
+! FLEXPART_WRF SOURCE FILE MAP_PROJ_WRF - CONTAINS                    *
+!       subroutine xyindex_to_ll_wrf                                  *
+!       subroutine xymeter_to_ll_wrf                                  *
+!       subroutine ll_to_xyindex_wrf                                  *
+!       subroutine ll_to_xymeter_wrf                                  *
+!       subroutine test_xyindex_to_ll_wrf                             *
+!                                                                     * 
+!**********************************************************************
+!                                                                     * 
+! AUTHOR:      R. Easter & J. Fast, PNNL                              *
+! DATE:        Dec 2005                                               *
+! LAST UPDATE: same                                                   *
+!                                                                     * 
+!**********************************************************************
+!                                                                     *
+! DESCRIPTION:                                                        *
+!                                                                     *
+! Converts between "grid index" or "grid meter" coordinates           *
+! and latitude-longitude (degrees)                                    *
+!                                                                     *
+!**********************************************************************
+
+
+!-----------------------------------------------------------------------
+subroutine xyindex_to_ll_wrf( lgrid, x_i, y_j, x_lon, y_lat )
+!
+!   calculates longitude/latitude from xy "grid index" coordinates
+!
+!   arguments
+!	lgrid - input - grid identifier
+!	x_i, y_j - input = "grid index" coordinates on grid "lgrid".  
+!		x_i ranges from 0 to nx-1.  y_j ranges from 0 to nj-1.
+!	x_lon, y_lat - output = longitude and latitude in degrees
+!
+!   *** note ***
+!	if x_i is outside [-grace,  +grace+nx]
+!	or y_j is outside [-grace,  +grace+ny]
+!   the routine writes an error message and halts
+!
+!	include 'includepar'
+!	include 'includecom'
+  use par_mod
+  use com_mod
+
+!   arguments
+         implicit none
+	integer :: lgrid
+	real :: x_i, y_j, x_lon, y_lat
+
+!   local variables
+	integer :: ia, ib, ja, jb
+	real :: dumxi, dumyj
+	real :: fx, fy
+	real,parameter :: grace=2.01
+
+
+!   first check that x_i & y_j are "within bounds"
+	if (lgrid .le. 0) then
+	    if ((x_i .lt. -grace) .or. (x_i .gt. grace+real(nx-1)) .or. &
+      	        (y_j .lt. -grace) .or. (y_j .gt. grace+real(ny-1))) then
+		write(*,'(/a/a,i4,1p,2e12.3)') &
+      		    '*** xyindex_to_ll_wrf error -- bad inputs', &
+      		    '    lgrid, x_i, y_j =', lgrid, x_i, y_j
+!	stop
+	    end if
+	else 
+	    if ((x_i .lt. -grace                   ) .or.  &
+                (x_i .gt. grace+real(nxn(lgrid)-1)) .or. &
+      	        (y_j .lt. -grace                   ) .or. &
+                (y_j .gt. grace+real(nyn(lgrid)-1))) then
+		write(*,'(/a/a,i4,1p,2e12.3)') &
+      		    '*** xyindex_to_ll_wrf error -- bad inputs', &
+      		    '    lgrid, x_i, y_j =', lgrid, x_i, y_j
+!	stop
+	    end if
+	end if
+
+	if (map_proj_method .gt. 0) then
+	    if (map_proj_id .eq. 1) goto 2000
+	    if (map_proj_id .eq. 2) goto 2000
+	    if (map_proj_id .eq. 3) goto 2000
+	    if (map_proj_id .eq. 4) goto 2000
+	end if
+
+	if (lgrid .le. 0) then
+	    goto 5000
+	else
+	    goto 6000
+	end if
+
+!
+!   use map projection routines in map_proj_wrf_subaa.f
+!
+2000	continue
+	if (lgrid .le. 0) then
+	    dumxi = 1.0 + x_i
+	    dumyj = 1.0 + y_j
+	else
+	    dumxi = 1.0 + (x_i/xresoln(lgrid)) + xln(lgrid)
+	    dumyj = 1.0 + (y_j/yresoln(lgrid)) + yln(lgrid)
+	end if
+        call ij_to_latlon( dumxi, dumyj, y_lat, x_lon )
+	return
+
+
+!
+!   do interpolation using the outer grid xlon2d,ylat2d
+!
+5000	continue
+	if (x_i .le. 0.0) then
+	    ia = 0
+	else if (x_i .ge. real(nxmin1)) then
+	    ia = nxmin1
+	else
+	    ia = ifix( x_i )
+	end if
+	fx = x_i - ia
+	fx = max( -2.0, min( fx, 3.0 ) )
+	ib = ia + 1
+
+	if (y_j .le. 0.0) then
+	    ja = 0
+	else if (y_j .ge. real(nymin1)) then
+	    ja = nymin1
+	else
+	    ja = ifix( y_j )
+	end if
+	fy = y_j - ja
+	fy = max( -2.0, min( fy, 3.0 ) )
+	jb = ja + 1
+
+	x_lon = xlon2d(ia,ja)*(1.0-fx)*(1.0-fy) + &
+      	        xlon2d(ia,jb)*(1.0-fx)*fy       + &
+      	        xlon2d(ib,ja)*fx*(1.0-fy)       + &
+      	        xlon2d(ib,jb)*fx*fy
+
+
+	y_lat = ylat2d(ia,ja)*(1.0-fx)*(1.0-fy) + &
+      	        ylat2d(ia,jb)*(1.0-fx)*fy       + &
+               ylat2d(ib,ja)*fx*(1.0-fy)       + &
+      	        ylat2d(ib,jb)*fx*fy
+
+	return
+
+
+!
+!   do interpolation using the nested grid xlon2dn,ylat2dn
+!
+6000	continue
+	if (x_i .le. 0.0) then
+	    ia = 0
+	else if (x_i .ge. real(nxn(lgrid)-1)) then
+	    ia = nxn(lgrid)-1
+	else
+	    ia = ifix( x_i )
+	end if
+	fx = x_i - ia
+	fx = max( -2.0, min( fx, 3.0 ) )
+	ib = ia + 1
+
+	if (y_j .le. 0.0) then
+	    ja = 0
+	else if (y_j .ge. real(nyn(lgrid)-1)) then
+	    ja = nyn(lgrid)-1
+	else
+	    ja = ifix( y_j )
+	end if
+	fy = y_j - ja
+	fy = max( -2.0, min( fy, 3.0 ) )
+	jb = ja + 1
+
+	x_lon = xlon2dn(ia,ja,lgrid)*(1.0-fx)*(1.0-fy) + &
+      	        xlon2dn(ia,jb,lgrid)*(1.0-fx)*fy       + &
+      	        xlon2dn(ib,ja,lgrid)*fx*(1.0-fy)       + &
+      	        xlon2dn(ib,jb,lgrid)*fx*fy
+
+
+	y_lat = ylat2dn(ia,ja,lgrid)*(1.0-fx)*(1.0-fy) + &
+      	        ylat2dn(ia,jb,lgrid)*(1.0-fx)*fy       + &
+               ylat2dn(ib,ja,lgrid)*fx*(1.0-fy)       + &
+      	        ylat2dn(ib,jb,lgrid)*fx*fy
+
+	return
+
+	end subroutine xyindex_to_ll_wrf
+
+
+!-----------------------------------------------------------------------
+        subroutine xyindex_to_ll_wrf_out(lgrid,x_i,y_j,x_lon,y_lat)
+!
+!   calculates longitude/latitude from xy "grid index" coordinates
+!
+!   arguments
+!	lgrid - input - grid identifier
+!	x_i, y_j - input = "grid index" coordinates on grid "lgrid".  
+!		x_i ranges from 0 to nx-1.  y_j ranges from 0 to nj-1.
+!	x_lon, y_lat - output = longitude and latitude in degrees
+!
+!   *** note ***
+!	if x_i is outside [-grace,  +grace+nx]
+!	or y_j is outside [-grace,  +grace+ny]
+!   the routine writes an error message and halts
+!
+!	include 'includepar'
+!	include 'includecom'
+  use par_mod
+  use com_mod
+
+!   arguments
+         implicit none
+	integer :: lgrid
+	real :: x_i, y_j, x_lon, y_lat
+
+!   local variables
+	integer :: ia, ib, ja, jb
+	real :: dumxi, dumyj
+	real :: fx, fy
+	real,parameter :: grace=2.01
+
+
+!   first check that x_i & y_j are "within bounds"
+!	if (lgrid .le. 0) then
+!	    if ((x_i .lt. -grace) .or. (x_i .gt. grace+real(nx-1)) .or.
+!     &	        (y_j .lt. -grace) .or. (y_j .gt. grace+real(ny-1))) then
+!		write(*,'(/a/a,i4,1p,2e12.3)')
+!     &		    '*** xyindex_to_ll_wrf error -- bad inputs',
+!     &		    '    lgrid, x_i, y_j =', lgrid, x_i, y_j
+!		stop
+!	    end if
+!	else 
+!	    if ((x_i .lt. -grace                   ) .or. 
+!     &          (x_i .gt. grace+real(nxn(lgrid)-1)) .or.
+!     &	        (y_j .lt. -grace                   ) .or. 
+!     &          (y_j .gt. grace+real(nyn(lgrid)-1))) then
+!		write(*,'(/a/a,i4,1p,2e12.3)')
+!     &		    '*** xyindex_to_ll_wrf error -- bad inputs',
+!     &		    '    lgrid, x_i, y_j =', lgrid, x_i, y_j
+!		stop
+!	    end if
+!	end if
+
+	if (map_proj_method .gt. 0) then
+	    if (map_proj_id .eq. 1) goto 2000
+	    if (map_proj_id .eq. 2) goto 2000
+	    if (map_proj_id .eq. 3) goto 2000
+	    if (map_proj_id .eq. 4) goto 2000
+	end if
+
+	if (lgrid .le. 0) then
+	    goto 5000
+	else
+	    goto 6000
+	end if
+
+!
+!   use map projection routines in map_proj_wrf_subaa.f
+!
+2000	continue
+	if (lgrid .le. 0) then
+	    dumxi = 1.0 + x_i
+	    dumyj = 1.0 + y_j
+	else
+	    dumxi = 1.0 + (x_i/xresoln(lgrid)) + xln(lgrid)
+	    dumyj = 1.0 + (y_j/yresoln(lgrid)) + yln(lgrid)
+	end if
+        call ij_to_latlon( dumxi, dumyj, y_lat, x_lon )
+	return
+
+
+!
+!   do interpolation using the outer grid xlon2d,ylat2d
+!
+5000	continue
+	if (x_i .le. 0.0) then
+	    ia = 0
+	else if (x_i .ge. real(nxmin1)) then
+	    ia = nxmin1
+	else
+	    ia = ifix( x_i )
+	end if
+	fx = x_i - ia
+	fx = max( -2.0, min( fx, 3.0 ) )
+	ib = ia + 1
+
+	if (y_j .le. 0.0) then
+	    ja = 0
+	else if (y_j .ge. real(nymin1)) then
+	    ja = nymin1
+	else
+	    ja = ifix( y_j )
+	end if
+	fy = y_j - ja
+	fy = max( -2.0, min( fy, 3.0 ) )
+	jb = ja + 1
+
+	x_lon = xlon2d(ia,ja)*(1.0-fx)*(1.0-fy) + &
+      	        xlon2d(ia,jb)*(1.0-fx)*fy       + &
+      	        xlon2d(ib,ja)*fx*(1.0-fy)       + &
+      	        xlon2d(ib,jb)*fx*fy
+
+
+	y_lat = ylat2d(ia,ja)*(1.0-fx)*(1.0-fy) + &
+      	        ylat2d(ia,jb)*(1.0-fx)*fy       + &
+      	        ylat2d(ib,ja)*fx*(1.0-fy)       + &
+      	        ylat2d(ib,jb)*fx*fy
+
+	return
+
+
+!
+!   do interpolation using the nested grid xlon2dn,ylat2dn
+!
+6000	continue
+	if (x_i .le. 0.0) then
+	    ia = 0
+	else if (x_i .ge. real(nxn(lgrid)-1)) then
+	    ia = nxn(lgrid)-1
+	else
+	    ia = ifix( x_i )
+	end if
+	fx = x_i - ia
+	fx = max( -2.0, min( fx, 3.0 ) )
+	ib = ia + 1
+
+	if (y_j .le. 0.0) then
+	    ja = 0
+	else if (y_j .ge. real(nyn(lgrid)-1)) then
+	    ja = nyn(lgrid)-1
+	else
+	    ja = ifix( y_j )
+	end if
+	fy = y_j - ja
+	fy = max( -2.0, min( fy, 3.0 ) )
+	jb = ja + 1
+
+	x_lon = xlon2dn(ia,ja,lgrid)*(1.0-fx)*(1.0-fy) + &
+      	        xlon2dn(ia,jb,lgrid)*(1.0-fx)*fy       + &
+      	        xlon2dn(ib,ja,lgrid)*fx*(1.0-fy)       + &
+      	        xlon2dn(ib,jb,lgrid)*fx*fy
+
+
+	y_lat = ylat2dn(ia,ja,lgrid)*(1.0-fx)*(1.0-fy) + &
+      	        ylat2dn(ia,jb,lgrid)*(1.0-fx)*fy       + &
+      	        ylat2dn(ib,ja,lgrid)*fx*(1.0-fy)       + &
+      	        ylat2dn(ib,jb,lgrid)*fx*fy
+
+	return
+
+	end subroutine xyindex_to_ll_wrf_out
+
+
+!-----------------------------------------------------------------------
+	subroutine xymeter_to_ll_wrf( xmeter, ymeter, x_lon, y_lat )
+!
+!   calculates longitude/latitude from xy "grid meter" coordinates
+!
+!   arguments
+!	xmeter, ymeter - input = "grid meter" coordinates on the mother grid.  
+!	x_lon, y_lat - output = longitude and latitude in degrees
+!
+!	include 'includepar'
+!	include 'includecom'
+  use par_mod
+  use com_mod
+
+!   arguments
+       implicit none
+	real :: xmeter, ymeter, x_lon, y_lat
+
+!   local variables
+	real :: x_i, y_j
+
+	 x_i = (xmeter - xmet0)/dx
+	 y_j = (ymeter - ymet0)/dy
+	call xyindex_to_ll_wrf( 0, x_i, y_j, x_lon, y_lat )
+
+	return
+	end subroutine xymeter_to_ll_wrf
+
+	subroutine xymeter_to_ll_wrf_out(xmeter,ymeter,x_lon,y_lat)
+!
+!   calculates longitude/latitude from xy "grid meter" coordinates
+!
+!   arguments
+!	xmeter, ymeter - input = "grid meter" coordinates on the mother grid.  
+!	x_lon, y_lat - output = longitude and latitude in degrees
+!
+!	include 'includepar'
+!	include 'includecom'
+  use par_mod
+  use com_mod
+
+!   arguments
+       implicit none
+	real :: xmeter, ymeter, x_lon, y_lat
+
+!   local variables
+	real :: x_i, y_j
+
+	 x_i = (xmeter - xmet0)/dx
+	 y_j = (ymeter - ymet0)/dy
+	call xyindex_to_ll_wrf_out(0,x_i, y_j,x_lon,y_lat )
+
+	return
+	end subroutine xymeter_to_ll_wrf_out
+
+!-----------------------------------------------------------------------
+	subroutine ll_to_xyindex_wrf( x_lon, y_lat, x_i, y_j )
+!
+!   calculates xy "grid index" coordinates from longitude/latitude
+!
+!   arguments
+!	x_lon, y_lat - input - longitude and latitude in degrees
+!	x_i, y_j - output = "grid index" coordinates on the mother grid.  
+!		x_i ranges from 0 to nx-1.  y_j ranges from 0 to nj-1.
+!
+!	include 'includepar'
+!	include 'includecom'
+  use par_mod
+  use com_mod
+       implicit none
+
+!   arguments
+	real :: x_i, y_j, x_lon, y_lat
+
+!   local variables
+	integer :: i, ii, ia, ib, ip, ipass, iijjlohi
+	integer :: j, jj, ja, jb, jp
+	real :: dumcos, dumlat, dumlon
+	real :: dumr2, dumr2min
+	real :: dumxi, dumyj
+	real :: flo, fhi
+	real :: glo, ghi
+	real,parameter :: grace=2.01
+	real :: xxcen, xxcenb, yycen, yycenb
+	real :: xxyydel, xxyydelmin
+	real :: x_lon_sv, y_lat_sv
+
+
+
+	x_lon_sv = x_lon
+	y_lat_sv = y_lat
+	if (map_proj_method .gt. 0) then
+	    if (map_proj_id .eq. 1) goto 2000
+	    if (map_proj_id .eq. 2) goto 2000
+	    if (map_proj_id .eq. 3) goto 2000
+	    if (map_proj_id .eq. 4) goto 2000
+	end if
+	goto 5000
+
+!
+!   use map projection routines in map_proj_wrf_subaa.f
+!
+2000	continue
+
+        call latlon_to_ij( y_lat, x_lon, dumxi, dumyj )
+	x_i = dumxi - 1.0
+	y_j = dumyj - 1.0
+	goto 8000
+
+
+!
+!   do it by search/minimization of distance,
+!   using the outer grid xlon2d/ylat2d values from WRF met file
+!
+5000	continue
+
+!
+!   first locate the i,j for which the lon,lat at
+!   i+0.5,j+0.5 are closest to x_lon, y_lat
+!
+	dumr2min = 1.0e30
+	dumcos = cos( y_lat )
+	do j = 0, ny-1
+	do i = 0, nx-1
+	    dumlat = 0.25*( ylat2d(i,j  ) + ylat2d(i+1,j  ) +  &
+                            ylat2d(i,j+1) + ylat2d(i+1,j+1) )  
+	    dumlon = 0.25*( xlon2d(i,j  ) + xlon2d(i+1,j  ) +  &
+                            xlon2d(i,j+1) + xlon2d(i+1,j+1) )  
+	    dumr2 = (y_lat-dumlat)**2 + ((x_lon-dumlon)*dumcos)**2
+	    if (dumr2 .lt. dumr2min) then
+		dumr2min = dumr2
+		ib = i
+		jb = j
+	    end if
+	end do
+	end do
+	i = ib
+	j = jb
+	ip = i+1
+	jp = j+1
+
+!
+!   next determine the position between i/i+1 & j/j+1
+!   that is closest x_lon, y_lat
+!
+	xxyydelmin = 5.0e-8*max( abs(x_lon), abs(y_lat) )
+	xxyydel = 1.00
+	xxcen = 0.5
+	yycen = 0.5
+	iijjlohi = 3
+	ipass = 0
+
+!	write(*,9510)
+!	write(*,9520) 0, (i+xxcen), (j+yycen), x_lon, y_lat
+9510	format( / 'll_to_xyindex' )
+9520	format( 'ipass, x_i, y_j, lon, lat', i3, 4f14.7 )
+
+5200	ipass = ipass + 1
+	dumr2min = 1.0e30
+	do jj = -iijjlohi, iijjlohi
+	do ii = -iijjlohi, iijjlohi
+	    fhi = xxcen + ii*xxyydel
+	    ghi = yycen + jj*xxyydel
+	    flo = 1.0 - fhi
+	    glo = 1.0 - ghi
+	    dumlat = glo*(flo*ylat2d(i,j ) + fhi*ylat2d(ip,j )) +  &
+                     ghi*(flo*ylat2d(i,jp) + fhi*ylat2d(ip,jp))  
+	    dumlon = glo*(flo*xlon2d(i,j ) + fhi*xlon2d(ip,j )) +  &
+                     ghi*(flo*xlon2d(i,jp) + fhi*xlon2d(ip,jp))  
+	    dumr2 = (y_lat-dumlat)**2 + ((x_lon-dumlon)*dumcos)**2
+	    if (dumr2 .lt. dumr2min) then
+		dumr2min = dumr2
+		xxcenb = fhi
+		yycenb = ghi
+	    end if
+	end do
+	end do
+	xxcen = xxcenb
+	yycen = yycenb
+!	write(*,9520) ipass, (i+xxcen), (j+yycen), dumlon, dumlat
+	if (xxyydel .gt. xxyydelmin) then
+	    xxyydel = xxyydel*0.5
+	    if (ipass .eq. 4) iijjlohi = 2
+	    goto 5200
+	end if
+!	write(*,9520) ipass, (i+xxcen), (j+yycen), dumlon, dumlat
+
+	x_i = i + xxcen
+	y_j = j + yycen
+
+
+!
+!   check for x_i, y_j in bounds before returning
+!
+8000	continue
+	if ((x_i .lt. -grace) .or. (x_i .gt. grace+real(nx-1)) .or. &
+      	    (y_j .lt. -grace) .or. (y_j .gt. grace+real(ny-1))) then
+	    write(*,'(/a/a,1p,2e12.3/a,1p,2e12.3)') &
+      		'*** ll_to_xyindex_wrf error -- x_i, y_j out of bounds', &
+      		'    x_lon, y_lat =', x_lon_sv, y_lat_sv, &
+      		'    x_i,   y_j   =', x_i, y_j
+!     pause
+!        ylat2d(5000,2000)=0.     
+!	    stop
+	end if
+	return
+
+	end subroutine ll_to_xyindex_wrf
+
+
+!-----------------------------------------------------------------------
+	subroutine ll_to_xymeter_wrf( x_lon, y_lat, xmeter, ymeter )
+!
+!   calculates xy "grid meter" coordinates from longitude/latitude
+!
+!   arguments
+!	x_lon, y_lat - input - longitude and latitude in degrees
+!	xmeter, ymeter - output = "grid meter" coordinates on the mother grid.  
+!
+!	include 'includepar'
+!	include 'includecom'
+  use par_mod
+  use com_mod
+        implicit none
+
+!   arguments
+	real :: xmeter, ymeter, x_lon, y_lat
+
+!   local variables
+	real :: x_i, y_j
+
+	call ll_to_xyindex_wrf( x_lon, y_lat, x_i, y_j )
+	xmeter = xmet0 + dx*x_i
+	ymeter = ymet0 + dy*y_j
+
+	return
+	end subroutine ll_to_xymeter_wrf
+
+
+!-----------------------------------------------------------------------
+	subroutine test_xyindex_to_ll_wrf( lgrid )
+!
+!   tests the map projection routines by comparing
+!	lat,lon from projection routine against the
+!	lat,lon from the WRF met. files
+!
+!   arguments
+!	lgrid - input - grid identifier
+!
+!	include 'includepar'
+!	include 'includecom'
+  use par_mod
+  use com_mod
+
+!   arguments
+         implicit none
+	integer :: lgrid
+!   local variables
+	integer :: idum, ix, jdum, jy
+	integer :: map_set_proj_code
+	real :: dumdx, dumxi, dumyj
+	real :: dumlat, dumlatb, dumlon, dumlonb
+	real :: err
+	real :: rmserr
+
+
+
+!
+!   check if map projection is lambert conformal or polar stereographic
+!
+	if (map_proj_id .eq. 1) then
+	    map_set_proj_code = 3    ! lambert conformal
+	else if (map_proj_id .eq. 2) then
+	    map_set_proj_code = 5    ! polar stereographic
+	else if (map_proj_id .eq. 3) then
+	    map_set_proj_code = 1    ! mercator
+	else if (map_proj_id .eq. 4) then
+	    map_set_proj_code = 0    ! lat/lon
+	else
+	    write(*,'(/ 10(a/) )') &
+      	'************************************************************', &
+      	'*                                                          *', &
+      	'*    WARNING - map projection is not polar sterographic    *', &
+        '*              or lambert conformal                        *', &
+      	'*                                                          *', &
+      	'*              x,y <--> lat,lon conversions will be done   *', &
+      	'*              by interpolation & searching, and will      *', &
+      	'*              have limited accuracy near poles            *', &
+      	'*                                                          *', &
+      	'************************************************************'
+	    map_proj_method = 0
+	    return
+	end if
+	if (lgrid .gt. 0) goto 2000
+
+!
+!   make call to map projection setup routine
+!
+!   (The 0.999812 factor is due to different earth_radius
+!    values in wrfsi code (6370.0 vs 6371.2).)
+       dumdx = dx*0.999812  ! WA 2/11/10 is this right?
+!      dumdx = dx*0.9987242 ! WA 2/11/10 is this right?
+!      dumdx = dx*0.9979203 ! WA 2/11/10 is this right?
+       coefdx=0.999812
+!	write(*,'(/2a,2i5)')  &
+ !     		'test_xyindex_to_ll_wrf calling map_set -- ', &
+  !    		'map_proj_id, map_set_proj_code =', &
+  !    		map_proj_id, map_set_proj_code
+        call map_set( map_set_proj_code, &
+      		ylat2d(0,0), xlon2d(0,0), dumdx,    &
+      		map_stdlon, map_truelat1, map_truelat2,   &
+      		nx, ny )
+	map_proj_method = 1
+
+!
+!   compute lat,lon from xi,jy at 9 points (center, 4 corners,
+!	and 4 boundary midpoints)  
+!   compare to lon,lat read from the WRF met. file and report rmserr
+!
+2000	continue
+	rmserr = 0.0
+	do jdum = 0, 2
+	do idum = 0, 2
+	    if (lgrid .le. 0) then
+		jy = nint( 0.5*real((ny-1)*jdum) )
+		ix = nint( 0.5*real((nx-1)*idum) )
+		dumyj = 1 + jy
+		dumxi = 1 + ix
+		dumlatb = ylat2d(ix,jy)
+		dumlonb = xlon2d(ix,jy)
+	    else
+		jy = nint( 0.5*real((nyn(lgrid)-1)*jdum) )
+		ix = nint( 0.5*real((nxn(lgrid)-1)*idum) )
+		dumyj = 1.0 + (jy/yresoln(lgrid)) + yln(lgrid)
+		dumxi = 1.0 + (ix/xresoln(lgrid)) + xln(lgrid)
+		dumlatb = ylat2dn(ix,jy,lgrid)
+		dumlonb = xlon2dn(ix,jy,lgrid)
+	    end if
+            call ij_to_latlon( dumxi, dumyj, dumlat, dumlon )
+	    err = (dumlat-dumlatb)**2 + &
+      			((dumlon-dumlonb)*cos(dumlatb))**2
+!         print*,'err',idum,jdum,dumlat,dumlatb,dumlon,dumlonb
+	    rmserr = rmserr + err
+!       print*,dumxi, dumyj, dumlat, dumlon,dumlatb,dumlonb
+	end do
+	end do
+	rmserr = 111.2*sqrt( rmserr/9.0 )
+!        print*,'rmserr',rmserr
+        if (rmserr .le. 0.02*(1.0e-3*dumdx)) then
+        write(*,'(/a,i3,1pe10.2)')  &
+      	'test_xyindex_to_ll_wrf -- lgrid, rmserr (km) =', lgrid, rmserr
+        endif
+!
+!   if rms error exceeds 0.02*dx, something is wrong
+!   do not use the map projection routines in this case
+!
+        if (rmserr .gt. 0.02*(1.0e-3*dumdx)) then 
+!      print*,'pb with rmserr. try an other earth radius'
+       dumdx = dx  ! try another earth radius 
+       coefdx=1.
+
+	write(*,'(/2a,2i5)')  &
+      		'test_xyindex_to_ll_wrf calling map_set -- ', &
+      		'map_proj_id, map_set_proj_code =', &
+      		map_proj_id, map_set_proj_code
+        call map_set( map_set_proj_code, &
+      		ylat2d(0,0), xlon2d(0,0), dumdx,    &
+      		map_stdlon, map_truelat1, map_truelat2,   &
+      		nx, ny )
+	map_proj_method = 1
+
+!
+!   compute lat,lon from xi,jy at 9 points (center, 4 corners,
+!	and 4 boundary midpoints)  
+!   compare to lon,lat read from the WRF met. file and report rmserr
+!
+	rmserr = 0.0
+	do jdum = 0, 2
+	do idum = 0, 2
+	    if (lgrid .le. 0) then
+		jy = nint( 0.5*real((ny-1)*jdum) )
+		ix = nint( 0.5*real((nx-1)*idum) )
+		dumyj = 1 + jy
+		dumxi = 1 + ix
+		dumlatb = ylat2d(ix,jy)
+		dumlonb = xlon2d(ix,jy)
+	    else
+		jy = nint( 0.5*real((nyn(lgrid)-1)*jdum) )
+		ix = nint( 0.5*real((nxn(lgrid)-1)*idum) )
+		dumyj = 1.0 + (jy/yresoln(lgrid)) + yln(lgrid)
+		dumxi = 1.0 + (ix/xresoln(lgrid)) + xln(lgrid)
+		dumlatb = ylat2dn(ix,jy,lgrid)
+		dumlonb = xlon2dn(ix,jy,lgrid)
+	    end if
+            call ij_to_latlon( dumxi, dumyj, dumlat, dumlon )
+	    err = (dumlat-dumlatb)**2 + &
+      			((dumlon-dumlonb)*cos(dumlatb))**2
+	    rmserr = rmserr + err
+	end do
+	end do
+	rmserr = 111.2*sqrt( rmserr/9.0 )
+
+        write(*,'(/a,i3,1pe10.2)')  &
+      	'test_xyindex_to_ll_wrf -- lgrid, rmserr (km) =', lgrid, rmserr
+
+
+        endif
+
+!
+!   if rms error exceeds 0.02*dx, something is wrong
+!   do not use the map projection routines in this case
+!
+	dumdx = dx
+	if (lgrid .gt. 0) dumdx = dxn(lgrid)
+	if (rmserr .gt. 0.02*(1.0e-3*dumdx)) then
+    	    map_proj_method = 0
+	    write(*,'(/ 9(a/) )') &
+      	'************************************************************', &
+      	'*                                                          *', &
+      	'*  WARNING - the coordinate transfo error exceeds 0.02*dx  *', &
+      	'*                                                          *', &
+      	'************************************************************'
+!     print*,'projection set to',map_proj_method   
+      print*,'problem with the projection. wrf+flexpart stops'
+       stop
+	end if
+
+	return
+	end subroutine test_xyindex_to_ll_wrf
+
+
Index: /branches/jerome/src_flexwrf_v3.1/map_proj_wrf_subaa.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/map_proj_wrf_subaa.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/map_proj_wrf_subaa.f90	(revision 16)
@@ -0,0 +1,1090 @@
+! SUPPORTED PROJECTIONS
+! ---------------------
+! Cylindrical Lat/Lon (code = PROJ_LATLON)
+! Mercator (code = PROJ_MERC)
+! Lambert Conformal (code = PROJ_LC)
+! Polar Stereographic (code = PROJ_PS)
+!
+! REMARKS
+! -------
+! The routines contained within were adapted from routines
+! obtained from the NCEP w3 library.  The original NCEP routines were
+! less
+! flexible (e.g., polar-stereo routines only supported truelat of
+! 60N/60S)
+! than what we needed, so modifications based on equations in Hoke,
+! Hayes, and
+! Renninger (AFGWC/TN/79-003) were added to improve the flexibility.  
+! Additionally, coding was improved to F90 standards and the routines
+! were
+! combined into this module.  
+!-----------------------------------------------------------------------
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!dis   
+!dis    open source license/disclaimer, forecast systems laboratory
+!dis    noaa/oar/fsl, 325 broadway boulder, co 80305
+!dis    
+!dis    this software is distributed under the open source definition,
+!dis    which may be found at http://www.opensource.org/osd.html.
+!dis    
+!dis    in particular, redistribution and use in source and binary forms,
+!dis    with or without modification, are permitted provided that the
+!dis    following conditions are met:
+!dis    
+!dis    - redistributions of source code must retain this notice, this
+!dis    list of conditions and the following disclaimer.
+!dis    
+!dis    - redistributions in binary form must provide access to this
+!dis    notice, this list of conditions and the following disclaimer, and
+!dis    the underlying source code.
+!dis    
+!dis    - all modifications to this software must be clearly documented,
+!dis    and are solely the responsibility of the agent making the
+!dis    modifications.
+!dis    
+!dis    - if significant modifications or enhancements are made to this
+!dis    software, the fsl software policy manager
+!dis    (softwaremgr@fsl.noaa.gov) should be notified.
+!dis    
+!dis    this software and its documentation are in the public domain
+!dis    and are furnished "as is."  the authors, the united states
+!dis    government, its instrumentalities, officers, employees, and
+!dis    agents make no warranty, express or implied, as to the usefulness
+!dis    of the software and documentation for any purpose.  they assume
+!dis    no responsibility (1) for the use of the software and
+!dis    documentation; or (2) to provide technical support to users.
+!dis   
+!dis 
+
+! module that defines constants, data structures, and
+! routines used to convert grid indices to lat/lon
+! and vice versa.   
+!
+! supported projections
+! ---------------------
+! cylindrical lat/lon (code = proj_latlon)
+! mercator (code = proj_merc)
+! lambert conformal (code = proj_lc)
+! polar stereographic (code = proj_ps)
+!
+! remarks
+! -------
+! the routines contained within were adapted from routines
+! obtained from the ncep w3 library.  the original ncep routines were less
+! flexible (e.g., polar-stereo routines only supported truelat of 60n/60s)
+! than what we needed, so modifications based on equations in hoke, hayes, and
+! renninger (afgwc/tn/79-003) were added to improve the flexibility.  
+! additionally, coding was improved to f90 standards and the routines were
+! combined into this module.  
+!
+! assumptions
+! -----------
+!  grid definition:
+!    for mercator, lambert conformal, and polar-stereographic projections,
+!    the routines within assume the following:
+!
+!       1.  grid is dimensioned (i,j) where i is the east-west direction, 
+!           positive toward the east, and j is the north-south direction, 
+!           positive toward the north.  
+!       2.  origin is at (1,1) and is located at the southwest corner,
+!           regardless of hemispere.
+!       3.  grid spacing (dx) is always positive.
+!       4.  values of true latitudes must be positive for nh domains
+!           and negative for sh domains.
+!
+!     for the latlon projection, the grid origin may be at any of the
+!     corners, and the deltalat and deltalon values can be signed to 
+!     account for this using the following convention:
+!       origin location        deltalat sign      deltalon sign
+!       ---------------        -------------      -------------
+!        sw corner                  +                   +
+!        ne corner                  -                   -
+!        nw corner                  -                   +
+!        se corner                  +                   -
+!       
+!  data definitions:
+!       1. any arguments that are a latitude value are expressed in 
+!          degrees north with a valid range of -90 -> 90
+!       2. any arguments that are a longitude value are expressed in
+!          degrees east with a valid range of -180 -> 180.
+!       3. distances are in meters and are always positive.
+!       4. the standard longitude (stdlon) is defined as the longitude
+!          line which is parallel to the y-axis (j-direction), along
+!          which latitude increases (not the absolute value of latitude, but
+!          the actual latitude, such that latitude increases continuously
+!          from the south pole to the north pole) as j increases.  
+!       5. one true latitude value is required for polar-stereographic and
+!          mercator projections, and defines at which latitude the 
+!          grid spacing is true.  for lambert conformal, two true latitude
+!          values must be specified, but may be set equal to each other to
+!          specify a tangent projection instead of a secant projection.  
+!       
+! usage
+! -----
+! to use the routines in this module, the calling routines must have the 
+! following statement at the beginning of its declaration block:
+!   use map_utils
+! 
+! the use of the module not only provides access to the necessary routines,
+! but also defines a structure of type (proj_info) that can be used
+! to declare a variable of the same type to hold your map projection
+! information.  it also defines some integer parameters that contain
+! the projection codes so one only has to use those variable names rather
+! than remembering the acutal code when using them.  the basic steps are
+! as follows:
+!  
+!   1.  ensure the "use map_utils" is in your declarations.
+!   2.  declare the projection information structure as type(proj_info):
+!         type(proj_info) :: proj
+!   3.  populate your structure by calling the map_set routine:
+!         call map_set(code,lat1,lon1,dx,stdlon,truelat1,truelat2,nx,ny,proj)
+!       where:
+!         code (input) = one of proj_latlon, proj_merc, proj_lc, or proj_ps
+!         lat1 (input) = latitude of grid origin point (i,j)=(1,1) 
+!                         (see assumptions!)
+!         lon1 (input) = longitude of grid origin 
+!         dx (input) = grid spacing in meters (ignored for latlon projections)
+!         stdlon (input) = standard longitude for proj_ps and proj_lc, 
+!               deltalon (see assumptions) for proj_latlon, 
+!               ignored for proj_merc
+!         truelat1 (input) = 1st true latitude for proj_ps, proj_lc, and
+!                proj_merc, deltalat (see assumptions) for proj_latlon
+!         truelat2 (input) = 2nd true latitude for proj_lc, 
+!                ignored for all others.
+!         nx = number of points in east-west direction
+!         ny = number of points in north-south direction
+!         proj (output) = the structure of type (proj_info) that will be fully 
+!                populated after this call
+!
+!   4.  now that the proj structure is populated, you may call any 
+!       of the following routines:
+!       
+!       latlon_to_ij(proj, lat, lon, i, j)
+!       ij_to_latlon(proj, i, j, lat, lon)
+!       truewind_to_gridwind(lon, proj, ugrid, vgrid, utrue, vtrue)
+!       gridwind_to_truewind(lon, proj, utrue, vtrue, ugrid, vgrid)
+!       compare_projections(proj1, proj2, same_proj)
+!
+!       it is incumbent upon the calling routine to determine whether or
+!       not the values returned are within your domain bounds.  all values
+!       of i, j, lat, and lon are real values.
+!
+!
+! references
+! ----------
+!  hoke, hayes, and renninger, "map preojections and grid systems for
+!       meteorological applications." afgwc/tn-79/003(rev), air weather
+!       service, 1985.
+!
+!  ncar mm5v3 modeling system, regridder program, module_first_guess_map.f
+!  ncep routines w3fb06, w3fb07, w3fb08, w3fb09, w3fb11, w3fb12
+!
+! history
+! -------
+! 27 mar 2001 - original version
+!               brent l. shaw, noaa/fsl (csu/cira)
+! 02 apr 2001 - added routines to rotate winds from true to grid
+!               and vice versa.
+!               brent l. shaw, noaa/fsl (csu/cira)
+! 09 apr 2001 - added compare_projections routine to compare two
+!               sets of projection parameters.
+!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+
+
+   
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! ! define data structures to define various projections
+!
+! type proj_info
+!
+!   logical        proj_init     ! flag to indicate if this struct is 
+!                                ! ready for use
+!   logical        proj_cyclic   ! flag indicating if this grid
+!                                ! is cyclic in the longitudinal
+!                                ! direction...happens with
+!                                ! global lat/lon grids like gfs/avn
+!   integer        proj_code     ! integer code for projection type
+!   integer        proj_nx
+!   integer        proj_ny
+!   real           proj_lat1    ! sw latitude (1,1) in degrees (-90->90n)
+!   real           proj_lon1    ! sw longitude (1,1) in degrees (-180->180e)
+!   real           proj_dx       ! grid spacing in meters at truelats, used
+!                                ! only for ps, lc, and merc projections
+!   real           proj_dlat     ! lat increment for lat/lon grids
+!   real           proj_dlon     ! lon increment for lat/lon grids
+!   real           proj_clat     ! center latitude of grid
+!   real           proj_clon     ! center longitude of grid
+!   real           proj_stdlon   ! longitude parallel to y-axis (-180->180e)
+!   real           proj_truelat1 ! first true latitude (all projections)
+!   real           proj_truelat2 ! second true lat (lc only)
+!   real           proj_hemi     ! 1 for nh, -1 for sh
+!   real           proj_cone     ! cone factor for lc projections
+!   real           proj_polei    ! computed i-location of pole point
+!   real           proj_polej    ! computed j-location of pole point
+!   real           proj_rsw      ! computed radius to sw corner
+!   real           proj_rebydx   ! earth radius divided by dx
+!
+! end type proj_info
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      subroutine map_init
+    ! initializes the map projection structure to missing values
+
+   use wrf_map_utils_mod
+      implicit none
+
+!      include 'include_wrf_map_utils'
+      pi = 3.1415927
+      deg_per_rad = 180./pi
+      rad_per_deg = pi / 180.
+
+! mean earth radius in m.  the value below is consistent
+! with nceps routines and grids.
+      earth_radius_m = 6370000.
+!     earth_radius_m = 6371200.
+!     earth_radius_m = 6368750.
+
+      proj_latlon = 0
+      proj_merc = 1
+      proj_lc = 3
+      proj_ps = 5
+      proj_rotlat = 203
+
+      proj_lat1 =    -999.9
+      proj_lon1 =    -999.9
+      proj_dx    =    -999.9
+      proj_stdlon =   -999.9
+      proj_truelat1 = -999.9
+      proj_truelat2 = -999.9
+      proj_hemi     = 0.0
+      proj_cone     = -999.9
+      proj_polei    = -999.9
+      proj_polej    = -999.9
+      proj_rsw      = -999.9
+      proj_init     = .false.
+      proj_nx       = -99
+      proj_ny       = -99 
+      proj_cyclic   = .false.
+
+      return
+      end subroutine map_init
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      subroutine map_set( &
+          proj_code_in, lat1, lon1, dx, &
+          stdlon, truelat1, truelat2, &
+          idim, jdim )
+      ! given a partially filled proj_info structure, this routine computes
+      ! polei, polej, rsw, and cone (if lc projection) to complete the 
+      ! structure.  this allows us to eliminate redundant calculations when
+      ! calling the coordinate conversion routines multiple times for the
+      ! same map.
+      ! this will generally be the first routine called when a user wants
+      ! to be able to use the coordinate conversion routines, and it
+      ! will call the appropriate routines based on the 
+      ! proj_code which indicates which projection type  this is.
+   use wrf_map_utils_mod
+
+      implicit none
+      
+      ! declare arguments
+      integer :: proj_code_in
+      real :: lat1
+      real :: lon1
+      real :: dx
+      real :: stdlon
+      real :: truelat1
+      real :: truelat2
+      integer :: idim
+      integer :: jdim
+
+      ! local variables
+      real :: center_i,center_j
+      real :: center_lat, center_lon
+
+!      include 'include_wrf_map_utils'
+
+      ! executable code
+
+      proj_code = proj_code_in
+
+      ! first, check for validity of mandatory variables in proj
+      if ( abs(lat1) .gt. 90.001 ) then
+        print '(a)', 'latitude of origin corner required as follows:'
+        print '(a)', '    -90n <= lat1 < = 90.n'
+        stop 'map_init'
+      endif
+      if ( abs(lon1) .gt. 180.) then
+        print '(a)', 'longitude of origin required as follows:'
+        print '(a)', '   -180e <= lon1 <= 180w'
+        stop 'map_init'
+      endif
+      if ((dx .le. 0.).and.(proj_code .ne. proj_latlon)) then
+        print '(a)', 'require grid spacing (dx) in meters be positive!'
+        stop 'map_init'
+      endif
+      if ((abs(stdlon) .gt. 180.).and.(proj_code .ne. proj_merc)) then
+        print '(a)', 'need orientation longitude (stdlon) as: '
+        print '(a)', '   -180e <= lon1 <= 180w' 
+        stop 'map_init'
+      endif
+      if (abs(truelat1).gt.90.) then
+        print '(a)', 'set true latitude 1 for all projections!'
+        stop 'map_init'
+      endif
+     
+      call map_init       
+      proj_code  = proj_code_in
+      proj_lat1 = lat1
+      proj_lon1 = lon1
+      proj_dx    = dx
+      proj_stdlon = stdlon
+      proj_truelat1 = truelat1
+      proj_truelat2 = truelat2
+      proj_nx = idim
+      proj_ny = jdim
+      if (proj_code .ne. proj_latlon) then
+        proj_dx = dx
+        if (truelat1 .lt. 0.) then
+          proj_hemi = -1.0 
+        else
+          proj_hemi = 1.0
+        endif
+        proj_rebydx = earth_radius_m / dx
+      endif
+
+
+      if (proj_code .eq. proj_ps) then
+          !print '(a)', 'setting up polar stereographic map...'
+          call set_ps
+
+      else if (proj_code .eq. proj_lc) then
+          !print '(a)', 'setting up lambert conformal map...'
+          if (abs(proj_truelat2) .gt. 90.) then
+            print '(a)',  &
+                'second true latitude not set, assuming a tangent'
+            print '(a,f10.3)', 'projection at truelat1: ', proj_truelat1
+            proj_truelat2=proj_truelat1
+          else 
+            ! ensure truelat1 < truelat2
+            proj_truelat1 = min(truelat1,truelat2)
+            proj_truelat2 = max(truelat1,truelat2)
+          endif
+          call set_lc
+     
+      else if (proj_code .eq. proj_merc) then
+          !print '(a)', 'setting up mercator map...'
+          call set_merc
+     
+      else if (proj_code .eq. proj_latlon) then
+          !print '(a)', 'setting up cylindrical equidistant latlon map...'
+          ! convert lon1 to 0->360 notation
+          if (proj_lon1 .lt. 0.) proj_lon1 = proj_lon1 + 360.
+          proj_dlat = truelat1
+          proj_dlon = stdlon 
+          if (nint(proj_dlon*real(proj_nx)) .eq. 360) proj_cyclic = .true.
+
+      else
+          print '(a,i2)', 'unknown projection code: ', proj_code
+          stop 'map_init'
+      
+      end if
+
+      proj_init = .true.
+
+      center_i = real(proj_nx+1)*0.5
+      center_j = real(proj_ny+1)*0.5
+      call ij_to_latlon(center_i,center_j,center_lat,center_lon)
+      proj_clat = center_lat
+      proj_clon = center_lon
+
+      return
+      end subroutine map_set
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      subroutine latlon_to_ij(lat, lon, i, j)
+      ! converts input lat/lon values to the cartesian (i,j) value
+      ! for the given projection. 
+
+   use wrf_map_utils_mod
+      implicit none
+
+      ! arguments
+      real :: lat
+      real :: lon
+      real :: i
+      real :: j
+
+!      include 'include_wrf_map_utils'
+
+      if (.not.proj_init) then
+        print '(a)', 'you have not called map_set for this projection!'
+        stop 'latlon_to_ij'
+      endif
+
+      if (proj_code .eq. proj_ps) then
+          call llij_ps(lat,lon,i,j)
+        
+      else if (proj_code .eq. proj_lc) then
+          call llij_lc(lat,lon,i,j)
+ 
+      else if (proj_code .eq. proj_latlon) then
+          call llij_latlon(lat,lon,i,j)
+!
+      else if (proj_code .eq. proj_merc) then
+          call llij_merc(lat,lon,i,j)
+!
+!     else if (proj_code .eq. proj_rotlat) then
+!	write(6,*)   'doing nothing in latlon_to_ij'
+
+      else 
+          print '(a,i2)','unrecognized map projection code: ', proj_code
+          stop 'latlon_to_ij'
+   
+      end if
+
+      return
+      end subroutine latlon_to_ij
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      subroutine ij_to_latlon(i, j, lat, lon)
+      ! computes geographical latitude and longitude for a given (i,j) point
+      ! in a grid with a projection of proj
+
+   use wrf_map_utils_mod
+      implicit none
+
+      ! arguments
+      real :: i
+      real :: j
+      real :: lat
+      real :: lon
+
+!      include 'include_wrf_map_utils'
+
+      if (.not.proj_init) then
+        print '(a)', 'you have not called map_set for this projection!'
+        stop 'ij_to_latlon'
+      endif
+
+      if (proj_code .eq. proj_ps) then
+          call ijll_ps(i, j, lat, lon)
+
+      else if (proj_code .eq. proj_lc) then
+          call ijll_lc(i, j, lat, lon)
+ 
+      else if (proj_code .eq. proj_latlon) then
+          call ijll_latlon(i, j, lat, lon)
+!
+      else if (proj_code .eq. proj_merc) then
+          call ijll_merc(i, j, lat, lon)
+!
+!     else if (proj_code .eq. proj_rotlat) then
+!	write(6,*)   'doing nothing in ij_to_latlon'
+
+      else
+          print '(a,i2)','unrecognized map projection code: ', proj_code
+          stop 'ij_to_latlon'
+
+      end if
+
+      return
+      end subroutine ij_to_latlon
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      subroutine set_ps
+      ! initializes a polar-stereographic map projection from the partially
+      ! filled proj structure. this routine computes the radius to the
+      ! southwest corner and computes the i/j location of the pole for use
+      ! in llij_ps and ijll_ps.
+
+   use wrf_map_utils_mod
+      implicit none
+   
+      ! local vars
+      real :: ala1
+      real :: alo1
+      real :: reflon
+      real :: scale_top
+      real :: dumlat, dumlon
+
+!      include 'include_wrf_map_utils'
+
+      ! executable code
+      reflon = proj_stdlon + 90.
+    
+      ! cone factor
+      proj_cone = 1.0
+
+      ! compute numerator term of map scale factor
+      scale_top = 1. + proj_hemi * sin(proj_truelat1 * rad_per_deg)
+
+      ! compute radius to lower-left (sw) corner
+      ala1 = proj_lat1 * rad_per_deg
+      proj_rsw =proj_rebydx*cos(ala1)*scale_top/(1.+proj_hemi*sin(ala1))
+
+      ! find the pole point
+      alo1 = (proj_lon1 - reflon) * rad_per_deg
+      proj_polei = 1. - proj_rsw * cos(alo1)
+      proj_polej = 1. - proj_hemi * proj_rsw * sin(alo1)
+!     print '(a,2f14.5)', 'set_ps - computed (i,j) of pole point: ',
+!    &    proj_polei,proj_polej
+
+      return
+      end subroutine set_ps
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      subroutine llij_ps( lat, lon, i, j )
+      ! given latitude (-90 to 90), longitude (-180 to 180), and the
+      ! standard polar-stereographic projection information via the 
+      ! public proj structure, this routine returns the i/j indices which
+      ! if within the domain range from 1->nx and 1->ny, respectively.
+   use wrf_map_utils_mod
+
+      implicit none
+
+      ! delcare input arguments
+      real :: lat
+      real :: lon
+
+      ! declare output arguments     
+      real :: i !(x-index)
+      real :: j !(y-index)
+
+      ! declare local variables
+      real :: reflon
+      real :: scale_top
+      real :: ala
+      real :: alo
+      real :: rm
+
+!      include 'include_wrf_map_utils'
+
+      ! begin code
+    
+      reflon = proj_stdlon + 90.
+     
+      ! compute numerator term of map scale factor
+
+      scale_top = 1. + proj_hemi * sin(proj_truelat1 * rad_per_deg)
+
+      ! find radius to desired point
+      ala = lat * rad_per_deg
+      rm = proj_rebydx * cos(ala) * scale_top/(1. + proj_hemi *sin(ala))
+      alo = (lon - reflon) * rad_per_deg
+      i = proj_polei + rm * cos(alo)
+      j = proj_polej + proj_hemi * rm * sin(alo)
+   
+      return
+      end subroutine llij_ps
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      subroutine ijll_ps( i, j, lat, lon )
+
+      ! this is the inverse routine of llij_ps.  it returns the 
+      ! latitude and longitude of an i/j point given the projection info 
+      ! structure.  
+   use wrf_map_utils_mod
+
+      implicit none
+
+      ! declare input arguments
+      real ::  i    ! column
+      real :: j    ! row
+      
+      ! declare output arguments
+      real :: lat     ! -90 -> 90 north
+      real :: lon     ! -180 -> 180 east
+
+      ! local variables
+      real :: reflon
+      real :: scale_top
+      real :: xx,yy
+      real :: gi2, r2
+      real :: arccos
+
+!      include 'include_wrf_map_utils'
+
+      ! begin code
+
+      ! compute the reference longitude by rotating 90 degrees to the east
+      ! to find the longitude line parallel to the positive x-axis.
+      reflon = proj_stdlon + 90.
+     
+      ! compute numerator term of map scale factor
+      scale_top = 1. + proj_hemi * sin(proj_truelat1 * rad_per_deg)
+
+      ! compute radius to point of interest
+      xx = i - proj_polei
+      yy = (j - proj_polej) * proj_hemi
+      r2 = xx**2 + yy**2
+
+      ! now the magic code
+      if (r2 .eq. 0.) then 
+        lat = proj_hemi * 90.
+        lon = reflon
+      else
+        gi2 = (proj_rebydx * scale_top)**2.
+        lat = deg_per_rad * proj_hemi * asin((gi2-r2)/(gi2+r2))
+        arccos = acos(xx/sqrt(r2))
+        if (yy .gt. 0) then
+          lon = reflon + deg_per_rad * arccos
+        else
+          lon = reflon - deg_per_rad * arccos
+        endif
+      endif
+    
+      ! convert to a -180 -> 180 east convention
+      if (lon .gt. 180.) lon = lon - 360.
+      if (lon .lt. -180.) lon = lon + 360.
+
+      return
+      end subroutine ijll_ps
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      subroutine set_lc      
+      ! initialize the remaining items in the proj structure for a
+      ! lambert conformal grid.
+
+   use wrf_map_utils_mod
+      implicit none
+
+!      include 'include_wrf_map_utils'
+      
+      real :: arg
+      real :: deltalon1
+      real :: tl1r
+      real :: ctl1r
+
+      ! compute cone factor
+      call lc_cone(proj_truelat1, proj_truelat2, proj_cone)
+      ! print '(a,f8.6)', 'computed cone factor: ', proj_cone
+      ! compute longitude differences and ensure we stay out of the
+      ! forbidden "cut zone"
+      deltalon1 = proj_lon1 - proj_stdlon
+      if (deltalon1 .gt. +180.) deltalon1 = deltalon1 - 360.
+      if (deltalon1 .lt. -180.) deltalon1 = deltalon1 + 360.
+
+      ! convert truelat1 to radian and compute cos for later use
+      tl1r = proj_truelat1 * rad_per_deg
+      ctl1r = cos(tl1r)
+
+      ! compute the radius to our known lower-left (sw) corner
+      proj_rsw = proj_rebydx * ctl1r/proj_cone *  &
+             (tan((90.*proj_hemi-proj_lat1)*rad_per_deg/2.) / &
+              tan((90.*proj_hemi-proj_truelat1)*rad_per_deg/2.)) &
+              **proj_cone
+
+      ! find pole point
+      arg = proj_cone*(deltalon1*rad_per_deg)
+      proj_polei = 1. - proj_hemi * proj_rsw * sin(arg)
+      proj_polej = 1. + proj_rsw * cos(arg)  
+      !print '(a,2f10.3)', 'computed pole i/j = ', proj_polei, proj_polej
+
+      return
+      end subroutine set_lc
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      subroutine lc_cone(truelat1, truelat2, cone)
+
+    ! routine to compute the cone factor of a lambert conformal projection
+
+   use wrf_map_utils_mod
+      implicit none
+
+!      include 'include_wrf_map_utils'
+      
+      ! input args
+      real :: truelat1  ! (-90 -> 90 degrees n)
+      real :: truelat2  !   "   "  "   "     "
+
+      ! output args
+      real :: cone
+
+      ! locals
+
+      ! begin code
+
+      ! first, see if this is a secant or tangent projection.  for tangent
+      ! projections, truelat1 = truelat2 and the cone is tangent to the 
+      ! earth surface at this latitude.  for secant projections, the cone
+      ! intersects the earth surface at each of the distinctly different
+      ! latitudes
+      if (abs(truelat1-truelat2) .gt. 0.1) then
+
+        ! compute cone factor following:
+        cone=(alog(cos(truelat1*rad_per_deg)) &
+             -alog(cos(truelat2*rad_per_deg))) / &
+         (alog(tan((90.-abs(truelat1))*rad_per_deg*0.5 ))- &
+          alog(tan((90.-abs(truelat2))*rad_per_deg*0.5 )) )
+      else
+         cone = sin(abs(truelat1)*rad_per_deg )  
+      endif
+
+      return
+      end subroutine lc_cone
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      subroutine ijll_lc( i, j, lat, lon)
+
+    ! routine to convert from the (i,j) cartesian coordinate to the 
+    ! geographical latitude and longitude for a lambert conformal projection.
+
+    ! history:
+    ! 25 jul 01: corrected by b. shaw, noaa/fsl
+    ! 
+   use wrf_map_utils_mod
+      implicit none
+
+!      include 'include_wrf_map_utils'
+
+      ! input args
+      real :: i        ! cartesian x coordinate
+      real :: j        ! cartesian y coordinate
+
+      ! output args                 
+      real :: lat      ! latitude (-90->90 deg n)
+      real :: lon      ! longitude (-180->180 e)
+
+      ! locals 
+      real :: inew
+      real :: jnew
+      real :: r
+      real :: chi,chi1,chi2
+      real :: r2
+      real :: xx
+      real :: yy
+
+      ! begin code
+
+      chi1 = (90. - proj_hemi*proj_truelat1)*rad_per_deg
+      chi2 = (90. - proj_hemi*proj_truelat2)*rad_per_deg
+
+      ! see if we are in the southern hemispere and flip the indices
+      ! if we are. 
+      if (proj_hemi .eq. -1.) then 
+        inew = -i + 2.
+        jnew = -j + 2.
+      else
+        inew = i
+        jnew = j
+      endif
+
+      ! compute radius**2 to i/j location
+      xx = inew - proj_polei
+      yy = proj_polej - jnew
+      r2 = (xx*xx + yy*yy)
+      r = sqrt(r2)/proj_rebydx
+     
+      ! convert to lat/lon
+      if (r2 .eq. 0.) then
+        lat = proj_hemi * 90.
+        lon = proj_stdlon
+      else
+         
+        ! longitude
+        lon = proj_stdlon + deg_per_rad * atan2(proj_hemi*xx,yy) &
+              /proj_cone
+        lon = amod(lon+360., 360.)
+
+        ! latitude.  latitude determined by solving an equation adapted 
+        ! from:
+        !  maling, d.h., 1973: coordinate systems and map projections
+        ! equations #20 in appendix i.  
+          
+        if (chi1 .eq. chi2) then
+          chi = 2.0*atan( ( r/tan(chi1) )**(1./proj_cone)  &
+                * tan(chi1*0.5) )
+        else
+          chi = 2.0*atan( (r*proj_cone/sin(chi1))**(1./proj_cone)  &
+                * tan(chi1*0.5)) 
+        endif
+        lat = (90.0-chi*deg_per_rad)*proj_hemi
+
+      endif
+
+      if (lon .gt. +180.) lon = lon - 360.
+      if (lon .lt. -180.) lon = lon + 360.
+
+      return
+      end subroutine ijll_lc
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+      subroutine llij_lc( lat, lon, i, j)
+
+    ! routine to compute the geographical latitude and longitude values
+    ! to the cartesian x/y on a lambert conformal projection.
+      
+    use wrf_map_utils_mod
+      implicit none
+!
+!      include 'include_wrf_map_utils'
+
+      ! input args
+      real :: lat      ! latitude (-90->90 deg n)
+      real :: lon      ! longitude (-180->180 e)
+
+      ! output args                 
+      real :: i        ! cartesian x coordinate
+      real :: j        ! cartesian y coordinate
+
+      ! locals 
+      real :: arg
+      real :: deltalon
+      real :: tl1r
+      real :: rm
+      real :: ctl1r
+      
+
+      ! begin code
+!         print*,proj_clat, proj_clon,proj_stdlon,proj_truelat1,proj_code,proj_cone
+      ! compute deltalon between known longitude and standard lon and ensure
+      ! it is not in the cut zone
+      deltalon = lon - proj_stdlon
+      if (deltalon .gt. +180.) deltalon = deltalon - 360.
+      if (deltalon .lt. -180.) deltalon = deltalon + 360.
+      
+      ! convert truelat1 to radian and compute cos for later use
+      tl1r = proj_truelat1 * rad_per_deg
+      ctl1r = cos(tl1r)     
+     
+      ! radius to desired point
+      rm = proj_rebydx * ctl1r/proj_cone *  &
+          (tan((90.*proj_hemi-lat)*rad_per_deg/2.) / &
+           tan((90.*proj_hemi-proj_truelat1)*rad_per_deg/2.))**proj_cone
+
+      arg = proj_cone*(deltalon*rad_per_deg)
+      i = proj_polei + proj_hemi * rm * sin(arg)
+      j = proj_polej - rm * cos(arg)
+
+      ! finally, if we are in the southern hemisphere, flip the i/j
+      ! values to a coordinate system where (1,1) is the sw corner
+      ! (what we assume) which is different than the original ncep
+      ! algorithms which used the ne corner as the origin in the 
+      ! southern hemisphere (left-hand vs. right-hand coordinate?)
+      if (proj_hemi .eq. -1.) then
+        i = 2. - i  
+        j = 2. - j
+      endif
+
+      return
+      end subroutine llij_lc
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  SUBROUTINE set_merc
+
+    ! Sets up the remaining basic elements for the mercator projection
+     use wrf_map_utils_mod
+
+    IMPLICIT NONE
+!   TYPE(proj_info), INTENT(INOUT)       :: proj
+    REAL                                 :: clain
+
+    !  Preliminary variables
+
+    clain = COS(rad_per_deg*proj_truelat1)
+    proj_dlon = proj_dx / (earth_radius_m * clain)
+
+    ! Compute distance from equator to origin, and store in the 
+    ! proj%rsw tag.
+
+    proj_rsw = 0.
+    IF (proj_lat1 .NE. 0.) THEN
+      proj_rsw = (ALOG(TAN(0.5*((proj_lat1+90.)*rad_per_deg))))/proj_dlon
+    ENDIF
+    RETURN
+  END SUBROUTINE set_merc
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+  SUBROUTINE llij_merc(lat, lon, i, j)
+
+    ! Compute i/j coordinate from lat lon for mercator projection
+     use wrf_map_utils_mod
+
+    IMPLICIT NONE
+    REAL, INTENT(IN)              :: lat
+    REAL, INTENT(IN)              :: lon
+!   TYPE(proj_info),INTENT(IN)    :: proj
+    REAL,INTENT(OUT)              :: i
+    REAL,INTENT(OUT)              :: j
+    REAL                          :: deltalon
+
+     deltalon = lon - proj_lon1
+!   deltalon = lon - proj_stdlon
+! JB modif
+!   IF (deltalon .LT. -180.) deltalon = deltalon + 360.
+!   IF (deltalon .GT. 180.) deltalon = deltalon - 360.
+    i = 1. + (deltalon/(proj_dlon*deg_per_rad))
+    j = 1. + (ALOG(TAN(0.5*((lat + 90.) * rad_per_deg)))) / &
+           proj_dlon - proj_rsw
+!       print*,'IN MERCATOR',lat,lon,i,j,proj_lon1,deltalon
+!      pause
+    RETURN
+  END SUBROUTINE llij_merc
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  SUBROUTINE ijll_merc(i, j, lat, lon)
+
+    ! Compute the lat/lon from i/j for mercator projection
+     use wrf_map_utils_mod
+
+    IMPLICIT NONE
+    REAL,INTENT(IN)               :: i
+    REAL,INTENT(IN)               :: j
+!   TYPE(proj_info),INTENT(IN)    :: proj
+    REAL, INTENT(OUT)             :: lat
+    REAL, INTENT(OUT)             :: lon
+
+
+    lat = 2.0*ATAN(EXP(proj_dlon*(proj_rsw + j-1.)))*deg_per_rad - 90.
+    lon = (i-1.)*proj_dlon*deg_per_rad + proj_lon1
+    IF (lon.GT.180.) lon = lon - 360.
+    IF (lon.LT.-180.) lon = lon + 360.
+    RETURN
+  END SUBROUTINE ijll_merc
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  SUBROUTINE llij_latlon(lat, lon, i, j)
+
+    ! Compute the i/j location of a lat/lon on a LATLON grid.
+     use wrf_map_utils_mod
+
+    IMPLICIT NONE
+    REAL, INTENT(IN)             :: lat
+    REAL, INTENT(IN)             :: lon
+!   TYPE(proj_info), INTENT(IN)  :: proj
+    REAL, INTENT(OUT)            :: i
+    REAL, INTENT(OUT)            :: j
+
+    REAL                         :: deltalat
+    REAL                         :: deltalon
+    REAL                         :: lon360
+    REAL                         :: latinc
+    REAL                         :: loninc
+
+    ! Extract the latitude and longitude increments for this grid
+    ! (e.g., 2.5 deg for NCEP reanalysis) from the proj structure, where
+    ! loninc is saved in the stdlon tag and latinc is saved in truelat1
+
+    latinc = proj_truelat1
+    loninc = proj_stdlon
+
+    ! Compute deltalat and deltalon as the difference between the input 
+    ! lat/lon and the origin lat/lon
+
+    deltalat = lat - proj_lat1
+    ! To account for issues around the dateline, convert the incoming
+    ! longitudes to be 0->360.
+    IF (lon .LT. 0) THEN
+      lon360 = lon + 360.
+    ELSE
+      lon360 = lon
+    ENDIF
+    deltalon = lon360 - proj_lon1
+    IF (deltalon .LT. 0) deltalon = deltalon + 360.
+
+    ! Compute i/j
+    i = deltalon/loninc + 1.
+    j = deltalat/latinc + 1.
+    RETURN
+    END SUBROUTINE llij_latlon
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  SUBROUTINE ijll_latlon(i, j, lat, lon)
+
+    ! Compute the lat/lon location of an i/j on a LATLON grid.
+     use wrf_map_utils_mod
+
+    IMPLICIT NONE
+    REAL, INTENT(IN)             :: i
+    REAL, INTENT(IN)             :: j
+!   TYPE(proj_info), INTENT(IN)  :: proj
+    REAL, INTENT(OUT)            :: lat
+    REAL, INTENT(OUT)            :: lon
+
+    REAL                         :: deltalat
+    REAL                         :: deltalon
+    REAL                         :: lon360
+    REAL                         :: latinc
+    REAL                         :: loninc
+
+    ! Extract the latitude and longitude increments for this grid
+    ! (e.g., 2.5 deg for NCEP reanalysis) from the proj structure, where
+    ! loninc is saved in the stdlon tag and latinc is saved in truelat1
+
+    latinc = proj_truelat1
+    loninc = proj_stdlon
+
+    ! Compute deltalat and deltalon 
+
+    deltalat = (j-1.)*latinc
+    deltalon = (i-1.)*loninc
+    lat = proj_lat1 + deltalat
+    lon = proj_lon1 + deltalon
+
+    IF ((ABS(lat) .GT. 90.).OR.(ABS(deltalon) .GT.360.)) THEN
+      ! Off the earth for this grid
+      lat = -999.
+      lon = -999.
+    ELSE
+      lon = lon + 360.
+      lon = AMOD(lon,360.)
+      IF (lon .GT. 180.) lon = lon -360.
+    ENDIF
+
+    RETURN
+  END SUBROUTINE ijll_latlon
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+  SUBROUTINE gridwind_to_truewind(lon,ugrid,vgrid,utrue,vtrue)
+
+    ! Subroutine to convert a wind from grid north to true north.
+     use wrf_map_utils_mod
+
+    IMPLICIT NONE
+
+    ! Arguments
+    REAL, INTENT(IN)          :: lon     ! Longitude of point in degrees
+!   TYPE(proj_info),INTENT(IN):: proj    ! Projection info structure 
+    REAL, INTENT(IN)          :: ugrid   ! U-component, grid-relative
+    REAL, INTENT(IN)          :: vgrid   ! V-component, grid-relative
+    REAL, INTENT(OUT)         :: utrue   ! U-component, earth-relative
+    REAL, INTENT(OUT)         :: vtrue   ! V-component, earth-relative
+
+    ! Locals
+    REAL                      :: alpha
+    REAL                      :: diff
+
+    IF ((proj_code .EQ. PROJ_PS).OR.(proj_code .EQ. PROJ_LC))THEN
+      diff = lon - proj_stdlon
+      IF (diff .GT. 180.) diff = diff - 360.
+      IF (diff .LT.-180.) diff = diff + 360.
+      alpha = diff * proj_cone * rad_per_deg * SIGN(1.,proj_truelat1)
+      utrue = vgrid * SIN(alpha) + ugrid * COS(alpha)
+      vtrue = vgrid * COS(alpha) - ugrid * SIN(alpha)
+    ELSEIF ((proj_code .EQ. PROJ_MERC).OR.(proj_code .EQ.PROJ_LATLON))THEN
+      utrue = ugrid
+      vtrue = vgrid
+    ELSE
+      PRINT '(A)', 'Unrecognized projection.'
+      STOP 'GRIDWIND_TO_TRUEWIND'
+    ENDIF
+
+    RETURN
+  END SUBROUTINE gridwind_to_truewind
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
Index: /branches/jerome/src_flexwrf_v3.1/mean.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/mean.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/mean.f90	(revision 16)
@@ -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/jerome/src_flexwrf_v3.1/mpi_mod.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/mpi_mod.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/mpi_mod.f90	(revision 16)
@@ -0,0 +1,43 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                *
+!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine,       *
+!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
+!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso,          *
+!* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann,   *
+!*                                                                     *
+!* This file is part of FLEXPART WRF                                   *
+!*                                                                     *
+!* 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 mpi_mod
+  use par_mod, only: dp
+  !includes OH concentration field as well as the height information
+  !for this field
+
+  implicit none
+  integer,allocatable, dimension (:) :: mpi_npoint,mpi_idt,mpi_itra1, &
+   mpi_itramem,mpi_nclass
+  real,allocatable, dimension (:) :: mpi_uap,mpi_ucp,mpi_uzp,  &
+   mpi_us,mpi_vs,mpi_ws,mpi_ztra1
+  real,allocatable, dimension (:,:) ::  mpi_xmass1
+  real(kind=dp),allocatable, dimension (:) :: mpi_xtra1,mpi_ytra1
+  integer(kind=2),allocatable, dimension (:) ::  mpi_cbt
+  integer :: chunksize2
+  integer, allocatable, dimension (:) :: dummyi2
+  real, allocatable, dimension (:) :: dummyr2
+  real(kind=dp),allocatable, dimension (:) :: dummyr22
+  integer(kind=2),allocatable, dimension (:) :: dummyi22
+end module mpi_mod
+
Index: /branches/jerome/src_flexwrf_v3.1/mt_kind_defs.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/mt_kind_defs.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/mt_kind_defs.f90	(revision 16)
@@ -0,0 +1,7 @@
+module mt_kind_defs
+  implicit none
+  public
+  integer, parameter :: INT32  = selected_int_kind(9)
+  integer, parameter :: INT64  = selected_int_kind(18)
+  integer, parameter :: REAL64 = selected_real_kind(15)
+end module
Index: /branches/jerome/src_flexwrf_v3.1/mt_stream.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/mt_stream.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/mt_stream.f90	(revision 16)
@@ -0,0 +1,788 @@
+!
+! A Fortran90/95 module program for Multiple Stream Mersenne Twister.
+! 2010/02/12, Ken-Ichi Ishikawa [ishikawa[at]theo.phys.sci.hiroshima-u.ac.jp]
+! 2010/07/20, M. S. Briggs, [michael.s.briggs[at]nasa.gov], minor improvements.
+!
+! This module provides the Mersenne Twister pseudo random number generator
+! (MT-PRNG) with multiple stream ability. 
+! A long period MT generaotr (backbone stream) is divided into disjoint streams,
+! and the each stream has continuous stream from the backbone stream.
+! The distance between each stream is chosen to have long enough length.
+! The status and parameters of the each stream are encapsulated in 
+! the f90 type components so that we can use multiple streams simultaneously.
+! The stream length is fixed to 2^nj.
+!
+! This code is converted from original/sample codes located at
+! Mersenne Twister Home Page:
+!               [http://www.math.sci.hiroshima-u.ac.jp/~m-mat/MT/mt.html]
+!
+! For the Original MT PRNG, see also: 
+!  M. Matsumoto and T. Nishimura, 
+!  "Mersenne Twister: A 623-dimensionally equidistributed uniform pseudorandom
+!   number generator", 
+!  ACM Trans. on Modeling and Computer Simulation Vol. 8, No. 1, 
+!  January pp.3-30 (1998) DOI:10.1145/272991.272995.
+!
+! For the jump ahead mechanism, see also: 
+!  H. Haramoto, M. Matsumoto, T. Nishimura, F. Panneton, and P. L'Ecuyer, 
+!  "Efficient Jump Ahead for F_2-Linear Random Number Generators", 
+!  GERAD Report G-2006-62. INFORMS Journal on Computing, 20, 3 (2008), 385-390. 
+!
+! This routine uses;
+!  Fast arithmetic in GF(2)[x], [http://wwwmaths.anu.edu.au/~brent/software.html]
+!  NTL : A Library for doing Number Theory, [http://www.shoup.net/ntl/index.html]
+!
+!
+! Copyright (c) 2010, Ken-Ichi Ishikawa [ishikawa[at]theo.phys.sci.hiroshima-u.ac.jp]
+! All rights reserved.
+! 
+! Redistribution and use in source and binary forms, with or without
+! modification, are permitted provided that the following conditions are
+! met:
+! 
+! * Redistributions of source code must retain the above copyright
+!   notice, this list of conditions and the following disclaimer. 
+!   
+! * Redistributions in binary form must reproduce the above copyright
+!   notice, this list of conditions and the following disclaimer listed
+!   in this license in the documentation and/or other materials
+!   provided with the distribution.
+!   
+! * Neither the name of the copyright holders nor the names of its
+!   contributors may be used to endorse or promote products derived from
+!   this software without specific prior written permission.
+!   
+! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+! "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT  
+! LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+! A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 
+! OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+! SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+! LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+! DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+! THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT  
+! (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+! OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 
+! 
+
+!define _TEMPERING_
+
+!ifdef _DEBUG_
+!module mt_stream_debug
+!else
+ module mt_stream
+!endif
+  use mt_kind_defs
+  implicit none
+  private
+  public :: MTS_SUCCESS
+  public :: MTS_FAIL
+  public :: mt_state
+  public :: new,delete
+  public :: init 
+  public :: print
+  public :: save
+  public :: read
+  public :: set_mt19937
+  public :: create_stream
+  public :: genrand_int32
+  public :: genrand_double1
+  public :: genrand_double2
+  public :: genrand_double3
+  public :: genrand_double4
+
+  integer(INT32), parameter :: MTS_SUCCESS = 0
+  integer(INT32), parameter :: MTS_FAIL    = -1
+!#ifdef _DEBUG_
+!  integer(INT32), parameter :: MT_JUMP_DISTANCE_EXP = 16   ! test jump distance (2^16 steps)
+!#else
+  integer(INT32), parameter :: MT_JUMP_DISTANCE_EXP = 256  ! default jump distance (2^256 steps)
+!#endif
+
+!======================================
+! MT19937 parameters
+!======================================
+  integer(INT32), parameter :: MT19937_N = 624
+  integer(INT32), parameter :: MT19937_M = 397
+  integer(INT32), parameter :: MT19937_W = 32
+  integer(INT32), parameter :: MT19937_R = 31
+  integer(INT32), parameter :: MT19937_MATA  = INT (Z'9908b0df', INT32)
+  integer(INT32), parameter :: MT19937_WMASK = INT (Z'ffffffff', INT32)
+  integer(INT32), parameter :: MT19937_UMASK = INT (Z'80000000', INT32)
+  integer(INT32), parameter :: MT19937_LMASK = INT (Z'7fffffff', INT32)
+  integer(INT32), parameter :: MT19937_SHFT0 = 11
+  integer(INT32), parameter :: MT19937_SHFT1 = 18
+  integer(INT32), parameter :: MT19937_SHFTB =  7
+  integer(INT32), parameter :: MT19937_SHFTC = 15
+  integer(INT32), parameter :: MT19937_MASKB = INT (Z'9d2c5680', INT32)
+  integer(INT32), parameter :: MT19937_MASKC = INT (Z'efc60000', INT32)
+
+!======================================
+! MT state
+! Period = 2^(N*W-R)-1
+!======================================
+  type mt_state
+    private
+    integer(INT32) :: i = -1         ! state vector index
+    integer(INT32) :: stream_id = -1 ! stream ID
+    integer(INT32) :: istatus = -1   ! initialization status
+    integer(INT32) :: nn = -1        ! MT parameter N
+    integer(INT32) :: mm = -1        ! MT parameter M
+    integer(INT32) :: rr = -1        ! MT parameter R
+    integer(INT32) :: ww = -1        ! MT parameter W (width =32)
+    integer(INT32) :: aaa = 0        ! Companion matrix parameter
+    integer(INT32) :: wmask = 0      ! 32-bit mask
+    integer(INT32) :: umask = 0      ! Twist mask x(1)
+    integer(INT32) :: lmask = 0      ! Twist mask x(0)
+    integer(INT32) :: shift0 = 0     ! Temparing parameters ...
+    integer(INT32) :: shift1 = 0
+    integer(INT32) :: maskB  = 0
+    integer(INT32) :: maskC  = 0
+    integer(INT32) :: shiftB = 0
+    integer(INT32) :: shiftC = 0
+    integer(INT32) :: mag(0:1) = 0   ! mag(0) = 0, mag(1) = aaa
+    integer(INT32), pointer :: state(:) => NULL()  ! state vector
+  end type
+
+  type(mt_state), save :: g_mt_master ! this keeps MT parameters
+  integer(INT32), save :: total_stream = 0
+
+  interface new
+    module procedure mt_new
+  end interface
+
+  interface delete
+    module procedure mt_delete
+  end interface
+
+  interface print
+    module procedure mt_print
+  end interface
+
+  interface read
+    module procedure mt_read
+  end interface
+
+  interface save
+    module procedure mt_save
+  end interface
+
+  interface set_mt19937
+    module procedure mt_set_mt19937
+  end interface
+
+  interface init
+    module procedure mt_init_by_scalar
+    module procedure mt_init_by_array
+  end interface
+
+  interface create_stream
+    module procedure mt_create_stream
+  end interface
+
+  interface genrand_int32    
+   ! in [0,0xFFFFFFFF]
+    module procedure mt_genrand_int32
+  end interface
+
+  interface genrand_double1
+   ! in [0,1]  (53-bit resolution)
+    module procedure mt_genrand_double1
+  end interface
+
+  interface genrand_double2
+   ! in [0,1)  (53-bit resolution)
+    module procedure mt_genrand_double2
+  end interface
+
+  interface genrand_double3
+   ! in (0,1)  (52-bit resolution)
+    module procedure mt_genrand_double3
+  end interface
+
+  interface genrand_double4
+   ! in (0,1]  (53-bit resolution)
+    module procedure mt_genrand_double4
+  end interface
+
+contains
+
+subroutine mt_new(this,ierr)
+!
+!= Allocate mt state 
+!
+  implicit none
+  type(mt_state), intent(inout)  :: this
+  integer(INT32), optional, intent(out) :: ierr
+  character(256), parameter :: myname="mt_new"
+  integer(INT32) :: jerr,kerr
+  jerr = MTS_SUCCESS
+  if (0 == g_mt_master%nn) then
+    write(*,'(A,": MT master parameter is not initialized.")')TRIM(myname)
+    write(*,'(A,": Stop!")')TRIM(myname)
+    stop
+  endif
+  call mt_copy(g_mt_master,this)
+  this%stream_id = total_stream
+  total_stream = total_stream + 1
+  if (.not.associated(this%state)) then
+    if (this%nn <= 0) then
+      jerr = MTS_FAIL
+      this%istatus = jerr
+      goto 100
+    endif
+    allocate(this%state(0:this%nn-1),STAT=kerr)
+    if (kerr /= 0) then
+      jerr = MTS_FAIL
+      this%istatus = jerr
+      goto 100
+    endif
+    this%istatus = jerr
+    goto 100
+  endif
+100 if (present(ierr)) then
+    ierr = jerr
+    return
+  else
+    if (jerr /= MTS_SUCCESS) then
+      write(*,'(A,": Something wrong.")')TRIM(myname)
+      write(*,'(A,": Stop!")')TRIM(myname)
+      stop
+    endif
+  endif
+end subroutine
+
+subroutine mt_delete(this)
+!
+!= deallocate state vector
+!
+  implicit none
+  type(mt_state), intent(inout) :: this
+  if (associated(this%state)) then
+    deallocate(this%state)
+  endif
+  total_stream = total_stream - 1 
+  return
+end subroutine
+
+subroutine mt_set_mt19937
+!
+!= set MT19937 parameters on g_mt_master
+!
+  implicit none
+  g_mt_master%nn    = MT19937_N
+  g_mt_master%mm    = MT19937_M
+  g_mt_master%ww    = MT19937_W
+  g_mt_master%rr    = MT19937_R
+  g_mt_master%aaa   = MT19937_MATA
+  g_mt_master%wmask = MT19937_WMASK
+  g_mt_master%umask = MT19937_UMASK
+  g_mt_master%lmask = MT19937_LMASK
+  g_mt_master%shift0 = MT19937_SHFT0
+  g_mt_master%shift1 = MT19937_SHFT1
+  g_mt_master%shiftB = MT19937_SHFTB
+  g_mt_master%shiftC = MT19937_SHFTC
+  g_mt_master%maskB  = MT19937_MASKB
+  g_mt_master%maskC  = MT19937_MASKC
+  g_mt_master%mag(0) = 0
+  g_mt_master%mag(1) = g_mt_master%aaa
+  total_stream = 0
+  return
+end subroutine
+
+subroutine mt_copy(this,that)
+!
+!= duplicate/copy MT paramters
+!
+!  that <= this
+!
+  implicit none
+  type(mt_state), intent(in)  :: this
+  type(mt_state), intent(out) :: that
+  that%i         = this%i
+  that%stream_id = this%stream_id
+  that%istatus   = this%istatus
+  that%nn     = this%nn
+  that%nn     = this%nn
+  that%mm     = this%mm
+  that%ww     = this%ww
+  that%aaa    = this%aaa
+  that%rr     = this%rr
+  that%wmask  = this%wmask
+  that%umask  = this%umask
+  that%lmask  = this%lmask
+  that%shift0 = this%shift0
+  that%shift1 = this%shift1
+  that%shiftB = this%shiftB
+  that%shiftC = this%shiftC
+  that%maskB  = this%maskB
+  that%maskC  = this%maskC
+  that%mag(0) = 0
+  that%mag(1) = that%aaa
+  return
+end subroutine
+
+subroutine mt_save(this,unit)
+!
+!= save MT status to file with unit
+!
+  implicit none
+  type(mt_state), intent(in) :: this
+  integer(INT32), intent(in) :: unit
+  write(unit) this%i
+  write(unit) this%stream_id
+  write(unit) this%istatus
+  write(unit) this%nn
+  write(unit) this%mm
+  write(unit) this%ww
+  write(unit) this%aaa
+  write(unit) this%rr
+  write(unit) this%wmask
+  write(unit) this%umask
+  write(unit) this%lmask
+  write(unit) this%shift0
+  write(unit) this%shift1
+  write(unit) this%shiftB
+  write(unit) this%shiftC
+  write(unit) this%maskB
+  write(unit) this%maskC
+  write(unit) this%mag(:)
+  write(unit) this%state(:)
+  return
+end subroutine
+
+subroutine mt_read(this,unit)
+!
+!= read MT status from file with unit
+!
+  implicit none
+  type(mt_state), intent(inout) :: this
+  integer(INT32), intent(in)    :: unit
+  read(unit) this%i
+  read(unit) this%stream_id
+  read(unit) this%istatus
+  read(unit) this%nn
+  read(unit) this%mm
+  read(unit) this%ww
+  read(unit) this%aaa
+  read(unit) this%rr
+  read(unit) this%wmask
+  read(unit) this%umask
+  read(unit) this%lmask
+  read(unit) this%shift0
+  read(unit) this%shift1
+  read(unit) this%shiftB
+  read(unit) this%shiftC
+  read(unit) this%maskB
+  read(unit) this%maskC
+  read(unit) this%mag(:)
+  if (associated(this%state)) then
+    deallocate(this%state)
+    allocate(this%state(0:this%nn-1))
+  endif
+  read(unit) this%state(:)
+  return
+end subroutine
+
+subroutine mt_print(this)
+!
+!= print MT stream parameter and states
+!
+  implicit none
+  type(mt_state), intent(in)  :: this
+  character(256) :: str
+  write(*,'("===============================================================================")')
+  write(*,'("  MT PARAMETERS")')
+  write(str,*)this%stream_id
+  write(*,'(" STREAMID= ",A)')TRIM(ADJUSTL(str))
+  write(str,*)this%nn*this%ww-this%rr
+  write(*,'("   PERIOD= 2^",A," - 1")')TRIM(ADJUSTL(str))
+  write(*,'("       NN=",I8," MM=",I8," WW=",I3," RR=",I3)')this%nn,this%mm,this%ww,this%rr
+  write(*,'("     AVEC= 0x",Z8.8)', advance='no' )this%aaa
+  write(*,'(" WMASK= 0x",Z8.8)', advance='no' )this%wmask
+  write(*,'(" UMASK= 0x",Z8.8)', advance='no' )this%umask
+  write(*,'(" LMASK= 0x",Z8.8)')  this%lmask
+  write(*,'("      MAG= 0x",Z8.8," 0x",Z8.8)') this%mag
+  write(*,'("    SHFT0=",I3)', advance='no' )this%shift0
+  write(*,'(" SHFT1=",I3)', advance='no' )this%shift1
+  write(*,'(" SHFTB=",I3)', advance='no' )this%shiftB
+  write(*,'(" SHFTC=",I3)', advance='no' )this%shiftC
+  write(*,'("  MASKB= 0x",Z8.8)', advance='no' )this%maskB
+  write(*,'(" MASKC= 0x",Z8.8)')  this%maskC
+  write(str,*)this%i
+  write(*,'("  POINTER= ",A)')TRIM(ADJUSTL(str))
+  write(*,'("===============================================================================")')
+  return
+end subroutine
+
+
+subroutine mt_init_by_scalar(this,iseed,ierr)
+!
+!= initialize MT state by a scalar seed.
+!
+  implicit none
+  type(mt_state), intent(inout) :: this
+  integer(INT32), intent(in) :: iseed
+  integer(INT32), optional, intent(out) :: ierr
+  character(256), parameter :: myname="mt_init_by_scalar"
+  integer(INT32) :: i,jseed,jerr
+  if (.not.associated(this%state)) then
+    jerr = MTS_FAIL
+    goto 100
+  endif
+  jseed = iseed
+  do i=0,this%nn-1
+    this%state(i) = jseed
+    jseed = 1812433253 * IEOR(jseed, ISHFT(jseed,-30)) + i + 1
+  enddo
+  this%i = this%nn
+  do i=0,this%nn-1
+    this%state(i) = IAND(this%state(i),this%wmask)
+  enddo
+  this%mag(0) = 0
+  this%mag(1) = this%aaa
+  jerr = MTS_SUCCESS
+100 if (present(ierr)) then
+    ierr = jerr
+  else
+    if (jerr /= MTS_SUCCESS) then
+      write(*,'(A,": State vector allocation fails.")')TRIM(myname)
+      write(*,'(A,": Stop!")')TRIM(myname)
+      stop
+    endif
+  endif
+  return
+end subroutine
+
+subroutine mt_init_by_array(this,iseed,ierr)
+!
+!= initialize MT state by array seeds.
+!
+  implicit none
+  type(mt_state), intent(inout) :: this
+  integer(INT32), intent(in)    :: iseed(0:)
+  integer(INT32), optional, intent(out) :: ierr
+  integer :: isize,i,j,k,n,jerr
+  character(256), parameter :: myname="mt_init_by_array"
+  integer(INT32), parameter :: ASEED = 19650218
+  
+  call mt_init_by_scalar(this,ASEED,jerr)
+  if (jerr /= MTS_SUCCESS) goto 100
+
+  isize = SIZE(iseed)
+  n = this%nn
+  i = 1
+  j = 0
+  do k = MAX(n,isize),1,-1
+    this%state(i) = IEOR(this%state(i),(IEOR(this%state(i-1),ISHFT(this%state(i-1),-30))*1664525)) + iseed(j) + j
+    this%state(i) = IAND(this%state(i),this%wmask)   ! for WORDSIZE > 32 machines
+    i = i + 1
+    j = j + 1
+    if (i >= n) then
+      this%state(0) = this%state(n-1)
+      i = 1
+    endif
+    if (j >= isize) j = 0
+  enddo
+  do k = n-1,1,-1
+    this%state(i) = IEOR(this%state(i),(IEOR(this%state(i-1),ISHFT(this%state(i-1),-30))*1566083941)) - i
+    this%state(i) = IAND(this%state(i),this%wmask)   ! for WORDSIZE > 32 machines
+    i = i + 1
+    if (i >= n) then
+      this%state(0) = this%state(n-1)
+      i = 1
+    endif
+  enddo
+  this%state(0) = INT (Z'80000000', INT32)    ! MSB is 1; assuring non-zero initial array
+  jerr = MTS_SUCCESS
+100 if (present(ierr)) then
+    ierr = jerr
+  else
+    if (jerr /= MTS_SUCCESS) then
+      write(*,'(A,": mt_init_by_scalar fails.")')TRIM(myname)
+      write(*,'(A,": Stop!")')TRIM(myname)
+      stop
+    endif
+  endif
+  return
+end subroutine
+
+function mt_genrand_int32(this) result(ir)
+!
+!= return a value in [0,0xFFFFFFFF]
+!
+  implicit none
+  type(mt_state), intent(inout) :: this
+  integer(INT32) :: ir
+  integer(INT32) :: umask,lmask,n,m,is
+  integer(INT32) :: k,nm,n1
+  if (this%i >= this%nn) then
+    n = this%nn
+    m = this%mm
+    lmask = this%lmask
+    umask = this%umask
+    nm = n - m
+    n1 = n - 1
+    do k=0,nm-1
+      is = IOR(IAND(this%state(k),umask),IAND(this%state(k+1),lmask))
+      this%state(k) = IEOR(IEOR(this%state(k+m),ISHFT(is,-1)),this%mag(IAND(is,1)))
+    enddo
+    do k=nm,n1-1
+      is = IOR(IAND(this%state(k),umask),IAND(this%state(k+1),lmask))
+      this%state(k) = IEOR(IEOR(this%state(k+m-n),ISHFT(is,-1)),this%mag(IAND(is,1)))
+    enddo
+    is = IOR(IAND(this%state(n-1),umask),IAND(this%state(0),lmask))
+    this%state(n-1) = IEOR(IEOR(this%state(m-1),ISHFT(is,-1)),this%mag(IAND(is,1)))
+    this%i = 0
+  endif
+
+  is = this%state(this%i)
+  this%i = this%i + 1
+!#ifdef _TEMPERING_
+!  is = IEOR(is,ISHFT(is,-this%shift0))
+!  is = IEOR(is,IAND(ISHFT(is, this%shiftB),this%maskB))
+!  is = IEOR(is,IAND(ISHFT(is, this%shiftC),this%maskC))
+!  is = IEOR(is,ISHFT(is,-this%shift1))
+!#endif
+  ir = is
+  return
+end function
+
+subroutine mt_matvec(this,v,w)
+!
+!= Multiply transition matrix on a state vector v
+!
+!  w = B v
+!
+!  this : MT parameters(transition matrix)
+!     v : input vector
+!     w : output vector
+!
+  implicit none
+  type(mt_state), intent(in) :: this
+  integer(INT32), intent(in)  :: v(0:this%nn-1)
+  integer(INT32), intent(out) :: w(0:this%nn-1)
+  integer(INT32) :: umask,lmask,n,m,is
+  integer(INT32) :: k
+  n = this%nn
+  m = this%mm
+  lmask = this%lmask
+  umask = this%umask
+  w(0) = IAND(v(1),umask)
+  do k=1,n-2
+    w(k) = v(k+1)
+  enddo
+      is = IOR(IAND(v(0),umask),IAND(v(1),lmask))
+  w(n-1) = IEOR(IEOR(v(m),ISHFT(is,-1)),this%mag(IAND(is,1)))
+  return
+end subroutine
+
+subroutine mt_create_stream(this,that,id)
+!
+!= Create New stream (that) with distance id*2^(jp) from (this)
+!
+  implicit none
+  type(mt_state), intent(inout) :: this ! input state
+  type(mt_state), intent(inout) :: that ! output state
+  integer(INT32), intent(in) :: id
+  character(256), parameter :: myname="mt_create_stream"
+  integer(INT32), parameter :: jp = MT_JUMP_DISTANCE_EXP
+  if (id < 0) then
+    write(*,'(A,": Positive ID is requried.")')TRIM(myname)
+    write(*,'(A,": Stop!")')TRIM(myname)
+    stop
+  endif
+  call mt_jumpahead(this,that,jp,id)
+  that%stream_id = id
+  total_stream = total_stream + 1 
+  this%i = this%nn
+  return
+end subroutine
+
+subroutine mt_jumpahead(this,that,jp,id)
+!
+!= Jump ahead by (id+1) * 2^jp steps.
+!
+!  this : input state
+!  that : output state, proceeds by id*2^jp steps.
+!
+  implicit none
+  type(mt_state), intent(inout) :: this ! input state
+  type(mt_state), intent(inout) :: that ! output state
+  integer(INT32), intent(in) :: jp     ! exponent (jump step = id*2^jp)
+  integer(INT32), intent(in) :: id     ! id       (jump step = id*2^jp)
+  integer(INT32) :: v(0:this%nn-1)
+  integer(INT32) :: w(0:this%nn-1)
+  integer(INT32) :: s(0:this%nn-1)
+  integer(INT32) :: i,iwp,ibp
+  character(256) :: str,str2
+  integer(INT32) :: p(0:this%nn-1)
+  integer(INT32) :: np
+  !
+  ! external routine in 
+  ! jump_ahead_coeff/get_coeff.cxx
+  !    written in C++ with NTL and gf2x libraries.
+  !
+!#ifdef _NTL_
+!  interface  get_coeff_interface
+!     subroutine get_coeff(nn,mm,rr,ww,avec,nj,id,pp,np) bind (C, name="get_coeff")
+!        use, intrinsic :: iso_c_binding, only: c_int
+!        integer (c_int), intent(in) :: nn,mm,rr,ww,avec,nj,id
+!        integer (c_int), intent(inout) :: pp(0:nn-1),np
+!     end subroutine get_coeff
+!  end interface get_coeff_interface
+!#else
+  interface f_get_coeff_interface
+    subroutine f_get_coeff(nn,mm,rr,ww,avec,nj,id,pp,np)
+      integer, intent(in) :: nn,mm,rr,ww,avec,nj,id
+      integer, intent(inout) :: pp(0:nn-1),np
+    end subroutine f_get_coeff 
+  end interface f_get_coeff_interface
+!#endif
+
+  !==================================
+  ! state copy: this => that
+  !==================================
+  call mt_copy(this,that)
+  
+  write(str,'(I12)')id
+  write(str2,'(I12)')jp
+  write(*,'("# ID ",I12)')id
+  write(*,'("# Jump Ahead by (",A,")*2^",A)')TRIM(ADJUSTL(str)),TRIM(ADJUSTL(str2))
+  if ( this%i /= this%nn) then
+    write(*,'("Error in jumpahead: input state pointer should point nn.")')
+    write(*,'("this%i  = ",I12)')this%i
+    write(*,'("this%nn = ",I12)')this%nn
+    write(str,*)this%i
+    write(str2,*)this%nn-1
+    write(*,'(A,"-",A," random numbers are dropped.")') &
+ &                         TRIM(ADJUSTL(str)),TRIM(ADJUSTL(str2))
+    write(*,'("forced to point nn")')
+    this%i = this%nn
+  endif
+
+  !==================================
+  ! compute jump ahead polynomial
+  ! p(x) coefficients 
+  !         for this MT parameter
+  !==================================
+!#ifdef _NTL_
+!  call get_coeff(this%nn,this%mm,this%rr,this%ww,this%aaa,jp,id,p,np)
+!#else
+  call f_get_coeff(this%nn,this%mm,this%rr,this%ww,this%aaa,jp,id,p,np)
+!#endif
+
+  !==================================
+  ! multiply p(B) on a state vector v
+  !  p(x) : jump ahead polynomial
+  !    B  : transition matrix
+  ! with simple Horner's method
+  !       w = p(B) v = B^(2^jp) v
+  !==================================
+  v(:) = this%state(:)
+  iwp = (np-1)/32
+  ibp = mod(np-1,32)
+  if (BTEST(p(iwp),ibp)) then
+    w(:) = v(:)
+  endif
+  do i=np-2,0,-1
+    iwp = i/32
+    ibp = mod(i,32)
+    call mt_matvec(this,w,s)   ! s = B w
+    if (BTEST(p(iwp),ibp)) then
+      w(:) = IEOR(v(:),s(:))   ! w = 1 v + s
+    else
+      w(:) = s(:)              ! w = 0 v + s
+    endif
+  enddo
+
+  if (.not. associated(that%state)) then
+    allocate(that%state(0:that%nn-1))
+  endif
+  that%state(:) = w(:)
+  that%i = this%nn
+
+  return
+end subroutine
+
+function mt_genrand_double1(this) result(r)
+  !
+  !  r in [0,1]  (53-bit resolution)
+  !
+  implicit none
+  type(mt_state), intent(inout) :: this
+  real(REAL64)   :: r
+  real(REAL64)   :: a,b
+  integer(INT32) :: ia,ib
+  ia = mt_genrand_int32(this)   ! ia in [0,0xFFFFFFFF]
+  ib = mt_genrand_int32(this)   ! ib in [0,0xFFFFFFFF]
+  ia = ISHFT(ia,-5)             ! ia in [0,2^27-1]
+  ib = ISHFT(ib,-6)             ! ib in [0,2^26-1]
+  a = REAL(ia,kind=KIND(r))
+  b = REAL(ib,kind=KIND(r))
+  !===============================
+  ! ( a*2^26 + b ) in [0,2^53-1]
+  ! r = ( a*2^26 + b )/(2^53-1)
+  !===============================
+  r = (a*67108864.0_REAL64 + b)*(1.0_REAL64/9007199254740991.0_REAL64)
+  return
+end function
+
+function mt_genrand_double2(this) result(r)
+  !
+  !  r in [0,1)  (53-bit resolution)
+  !
+  implicit none
+  type(mt_state), intent(inout) :: this
+  real(REAL64)   :: r
+  real(REAL64)   :: a,b
+  integer(INT32) :: ia,ib
+  ia = mt_genrand_int32(this)   ! ia in [0,0xFFFFFFFF]
+  ib = mt_genrand_int32(this)   ! ib in [0,0xFFFFFFFF]
+  ia = ISHFT(ia,-5)             ! ia in [0,2^27-1]
+  ib = ISHFT(ib,-6)             ! ib in [0,2^26-1]
+  a = REAL(ia,kind=KIND(r))
+  b = REAL(ib,kind=KIND(r))
+  !===============================
+  ! ( a*2^26 + b ) in [0,2^53-1]
+  ! r = ( a*2^26 + b )/(2^53)
+  !===============================
+  r = (a*67108864.0_REAL64 + b)*(1.0_REAL64/9007199254740992.0_REAL64)
+  return
+end function
+
+function mt_genrand_double3(this) result(r)
+  !
+  !  r in (0,1)  (52-bit resolution)
+  !
+  implicit none
+  type(mt_state), intent(inout) :: this
+  real(REAL64)   :: r
+  real(REAL64)   :: a,b
+  integer(INT32) :: ia,ib
+  ia = mt_genrand_int32(this)   ! ia in [0,0xFFFFFFFF]
+  ib = mt_genrand_int32(this)   ! ib in [0,0xFFFFFFFF]
+  ia = ISHFT(ia,-6)             ! ia in [0,2^26-1]
+  ib = ISHFT(ib,-6)             ! ib in [0,2^26-1]
+  a = REAL(ia,kind=KIND(r))
+  b = REAL(ib,kind=KIND(r))
+  !===============================
+  ! ( a*2^26 + b ) in [0,2^52-1]
+  ! r = ( a*2^26 + b + 1/2 )/(2^52)
+  !===============================
+  r = (a*67108864.0_REAL64 + b + 0.5_REAL64)*(1.0_REAL64/4503599627370496.0_REAL64)
+  return
+end function
+
+function mt_genrand_double4(this) result(r)
+  !
+  !  r in (0,1]  (53-bit resolution)
+  !
+  implicit none
+  type(mt_state), intent(inout) :: this
+  real(REAL64)   :: r
+  r = 1.0_REAL64 - mt_genrand_double2(this)
+  return
+end function
+
+end module
Index: /branches/jerome/src_flexwrf_v3.1/obukhov.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/obukhov.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/obukhov.f90	(revision 16)
@@ -0,0 +1,86 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                *
+!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine,       *
+!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
+!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso,          *
+!* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann,   *
+!*                                                                     *
+!* This file is part of FLEXPART WRF                                   *
+!*                                                                     *
+!* 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)
+      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                                   *
+!                                                                   *
+!  20 Oct 2005 - R. Easter - pass plev as argument instead of       *
+!                            akm,bkm                                *
+!                                                                   *
+!********************************************************************
+!                                                                   *
+!     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               *
+!                                                                   *
+!********************************************************************
+ 
+!      include 'includepar'
+!     real akm(nwzmax),bkm(nwzmax)
+!      real ps,tsurf,tdsurf,tlev,ustar,hf,e,ew,tv,rhoa,plev
+!      real ak1,bk1,theta,thetastar
+  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
+!     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/jerome/src_flexwrf_v3.1/oh_mod.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/oh_mod.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/oh_mod.f90	(revision 16)
@@ -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/jerome/src_flexwrf_v3.1/ohreaction.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/ohreaction.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/ohreaction.f90	(revision 16)
@@ -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/jerome/src_flexwrf_v3.1/openouttraj.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/openouttraj.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/openouttraj.f90	(revision 16)
@@ -0,0 +1,101 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                *
+!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine,       *
+!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
+!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso,          *
+!* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann,   *
+!*                                                                     *
+!* This file is part of FLEXPART WRF                                   *
+!*                                                                     *
+!* 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
+!*******************************************************************************
+!                                                                              *
+!   Note:  This is the FLEXPART_WRF version of subroutine openouttraj.         *
+!                                                                              *
+!   This routine opens the output file for the plume trajectory output         *
+!   produced by the cluster analysis.                                          *
+!                                                                              *
+!     Author: A. Stohl                                                         *
+!     27 January 2001                                                          *
+!                                                                              *
+!     Dec 2005, R. Easter - changed names of "*lon0*" & "*lat0*" variables     *
+!                                                                              *
+!*******************************************************************************
+!                                                                              *
+! Variables:                                                                   *
+!                                                                              *
+!*******************************************************************************
+
+  use point_mod
+  use par_mod
+  use com_mod
+!      include 'includepar'
+!      include 'includecom'
+      
+      integer i
+      real xp1,yp1,xp2,yp2
+      real xtmp, ytmp
+
+
+! Open output file for trajectory output
+!***************************************
+
+      open(unitouttraj,file=path(1)(1:length(1))//'trajectories.txt', &
+      form='formatted',err=998)
+
+      if (ldirect.eq.1) then
+      write(unitouttraj,'(i8,1x,i6,1x,a)') ibdate,ibtime,'FLEXWRF  V3.0'
+      else
+      write(unitouttraj,'(i8,1x,i6,1x,a)') iedate,ietime,'FLEXWRF  V3.0'
+      endif
+      write(unitouttraj,*) method,lsubgrid,lconvection
+      write(unitouttraj,*) numpoint
+      do i=1,numpoint
+       if (outgrid_option .eq. 0) then
+         xp1=xpoint1(i)*dx+xmet0
+         yp1=ypoint1(i)*dy+ymet0
+         xp2=xpoint2(i)*dx+xmet0
+         yp2=ypoint2(i)*dy+ymet0
+        endif
+       if (outgrid_option .eq. 1) then
+          xtmp = xpoint1(i)*dx+xmet0
+          ytmp = ypoint1(i)*dy+ymet0
+          call xymeter_to_ll_wrf( xtmp, ytmp, xp1, yp1 )
+          xtmp = xpoint2(i)*dx+xmet0
+          ytmp = ypoint2(i)*dy+ymet0
+          call xymeter_to_ll_wrf( xtmp, ytmp, xp2, yp2 )
+        endif
+!jdf    write(unitouttraj,*) ireleasestart(i),ireleaseend(i),
+!jdf +  xp1,yp1,xp2,yp2,zpoint1(i),zpoint2(i),kindz(i),npart(i)
+!jdf    write(unitouttraj,'(a)') compoint(i)(1:40)
+        write(unitouttraj,*) ireleasestart(i),ireleaseend(i), &
+        xp1,yp1,xp2,yp2,zpoint1(i),zpoint2(i),kindz(i),npart(i)
+        write(unitouttraj,'(a20)') compoint(i)(1:20)
+       enddo
+101     format(2i5,4f11.5,2f11.3,2i5)
+
+      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/jerome/src_flexwrf_v3.1/openreceptors.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/openreceptors.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/openreceptors.f90	(revision 16)
@@ -0,0 +1,144 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                *
+!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine,       *
+!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
+!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso,          *
+!* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann,   *
+!*                                                                     *
+!* This file is part of FLEXPART WRF                                   *
+!*                                                                     *
+!* 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
+!*******************************************************************************
+!                                                                              *
+!  Note:  This is the FLEXPART_WRF version of 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                                                            *
+!                                                                              *
+!     Dec 2005, J. Fast - Output files can be either binary or ascii.          *
+!                         Write iomode_xycoord to output files.                *
+!                         Receptor positions can be lat-lon or grid-meters.    *
+!     Dec 2005, R. Easter - changed names of "*lon0*" & "*lat0*" variables     *
+!                                                                              *
+!*******************************************************************************
+!                                                                              *
+! 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
+      real :: xtmp(maxreceptor),ytmp(maxreceptor)
+      real :: xtmpb,ytmpb
+
+
+! 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
+
+        do j = 1, numreceptor
+            xtmp(j) = xreceptor(j)*dx + xmet0
+            ytmp(j) = yreceptor(j)*dy + ymet0
+            if (outgrid_option .eq. 0) then
+               xtmpb = xtmp(j)
+               ytmpb = ytmp(j)
+               call xymeter_to_ll_wrf( xtmpb, ytmpb, xtmp(j), ytmp(j) )
+            endif
+        enddo
+
+! Concentration output
+!*********************
+
+        if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then
+          if (iouttype.eq.0) then 
+          open(unitoutrecept,file=path(1)(1:length(1))//'receptor_conc', &
+          form='unformatted',err=997)
+          write(unitoutrecept) (receptorname(j),j=1,numreceptor)
+          write(unitoutrecept) (xtmp(j),ytmp(j),j=1,numreceptor), &
+             outgrid_option
+          endif
+          if (iouttype.eq.1) then 
+          open(unitoutrecept,file=path(1)(1:length(1))//'receptor_conc', &
+          form='formatted',err=997)
+!         do j = 1, numreceptor
+!           write(unitoutrecept,*) receptorname(j)
+!         enddo
+!         write(unitoutrecept,*) (xtmp(j),ytmp(j),j=1,numreceptor),
+          do j=1,numreceptor
+            write(unitoutrecept,1001) receptorname(j), &
+            xtmp(j),ytmp(j),outgrid_option 
+          enddo
+1001      format(a16,f10.4,f10.4,i5)
+          endif
+        endif
+
+! Mixing ratio output
+!********************
+
+        if ((iout.eq.2).or.(iout.eq.3)) then
+          if (iouttype.eq.0) then 
+          open(unitoutreceptppt,file=path(1)(1:length(1))//'receptor_pptv', &
+          form='unformatted',err=998)
+          write(unitoutreceptppt) (receptorname(j),j=1,numreceptor)
+          write(unitoutreceptppt) (xtmp(j),ytmp(j),j=1,numreceptor), &
+             outgrid_option
+          endif
+          if (iouttype.eq.1) then 
+          open(unitoutreceptppt,file=path(1)(1:length(1))//'receptor_pptv', &
+          form='formatted',err=998)
+!         do j = 1, numreceptor
+!           write(unitoutreceptppt,*) receptorname(j)
+!         enddo
+!         write(unitoutreceptppt,*) (xtmp(j),ytmp(j),j=1,numreceptor),
+          do j=1,numreceptor
+            write(unitoutreceptppt,1001) receptorname(j), &
+            xtmp(j),ytmp(j),outgrid_option
+          enddo
+          endif
+        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/jerome/src_flexwrf_v3.1/outg_mod.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/outg_mod.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/outg_mod.f90	(revision 16)
@@ -0,0 +1,51 @@
+!**********************************************************************
+! 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 (:,:,:,:) :: grid2
+  real,allocatable, dimension (:,:,:,:) :: grid3
+  real,allocatable, dimension (:,:) :: wetgrid
+  real,allocatable, dimension (:,:,:) :: wetgrid2
+  real,allocatable, dimension (:,:) :: drygrid
+  real,allocatable, dimension (:,:,:) :: drygrid2
+  real,allocatable, dimension (:,:,:) :: gridsigma
+  real,allocatable, dimension (:,:) :: drygridsigma
+  real,allocatable, dimension (:,:) :: wetgridsigma
+  real,allocatable, dimension (:) :: sparse_dump_r
+  integer,allocatable, dimension (:) :: sparse_dump_i
+
+end module outg_mod
Index: /branches/jerome/src_flexwrf_v3.1/outgrid_init_irreg.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/outgrid_init_irreg.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/outgrid_init_irreg.f90	(revision 16)
@@ -0,0 +1,591 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                *
+!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine,       *
+!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
+!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso,          *
+!* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann,   *
+!*                                                                     *
+!* This file is part of FLEXPART WRF                                   *
+!*                                                                     *
+!* 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_irreg
+!*******************************************************************************
+!                                                                              *
+!     Note:  This is the FLEXPART_WRF version of subroutine outgrid_init.      *
+!            The computational grid is the WRF x-y grid rather than lat-lon.   *
+!                                                                              *
+!  This routine calculates, for each grid cell of the output grid, the         *
+!  volume, the surface area, and the areas of the northward and eastward       *
+!  facing surfaces.                                                            *
+!                                                                              *
+!     Author: A. Stohl                                                         *
+!                                                                              *
+!     7 August 2002                                                            *
+!                                                                              *
+!    26 Oct 2005, R. Easter - changes in gridarea, areaeast, areanorth         *
+!                             associated with WRF horizontal grid.             *
+!     Dec 2005, R. Easter - changed names of "*lon0*" & "*lat0*" variables     *
+!                                                                              *
+!*******************************************************************************
+!                                                                              *
+! 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
+
+!      include 'includepar'
+!      include 'includecom'
+     implicit none 
+      integer :: ix,jy,kz,k,i,nage,l,iix,jjy,ixp,jyp,i1,j1,j,ngrid
+!     real ylat,gridarea,ylatp,ylatm,hzone,cosfact,cosfactm,cosfactp
+      real :: ymet,gridarea,xl1,xl2,yl1,yl2,m1,m2,tmpx,tmpy
+      real :: xmet,xl,yl,ddx,ddy,rddx,rddy,p1,p2,p3,p4,xtn,ytn,oroh
+  integer :: ks,kp,stat,ix2,jy2
+  real,parameter :: eps=nxmax/3.e5
+      real :: lon2(4),lat2(4)
+      real ( kind = 8 ) :: sphere01_polygon_area,haversine,area1
+
+
+
+! 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,10
+!     print*,areamet(1,jy),areamet(2,jy),areamet2(2,jy)
+!     enddo
+      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
+!
+!C Calculate area of grid cell with formula M=2*pi*R*h*dx/360,
+!C see Netz, Formeln der Mathematik, 5. Auflage (1983), p.90
+!*************************************************************
+!
+!          cosfact=cos(ylat*pi180)*r_earth
+!          cosfactp=cos(ylatp*pi180)*r_earth
+!          cosfactm=cos(ylatm*pi180)*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
+!
+!C Surface are of a grid cell at a latitude ylat
+!***********************************************
+!
+!        gridarea=2.*pi*r_earth*hzone*dxout/360.
+
+! for FLEXPART_WRF, dx & dy are in meters, and no cos(lat) is needed
+! ??? maybe should incorporate map factor here,
+!     and also for areaeast & areanorth ???
+
+        do ix=0,numxgrid-1
+!        gridarea=dxout*dyout ! what is needed is the true area based on map factors
+!JB: find a way to get the area between 2 output grid cell using areamet
+!        xl1=(real(ix)*dxout+out_xm0)/dx
+!        yl1=(real(jy)*dyout+out_ym0)/dy
+!        xl2=(real(ix+1)*dxout+out_xm0)/dx
+!        yl2=(real(jy+1)*dyout+out_ym0)/dy
+!!      xr=out_xm0+real(numxgrid)*dxout
+!        m1=0.5*(m_x(int(xl1),int(yl1),1)+m_x(int(xl2),int(yl1),1))
+!        m2=0.5*(m_y(int(xl1),int(yl1),1)+m_x(int(xl1),int(yl2),1))
+!      area(ix,jy)=dxout*m1*dyout*m2
+
+! A more precise method
+          tmpx=out_xm0+(float(ix))*dxout
+          tmpy=out_ym0+(float(jy))*dyout
+          call xymeter_to_ll_wrf_out(tmpx,tmpy,lon2(1),lat2(1))
+          tmpx=out_xm0+(float(ix+1))*dxout
+          tmpy=out_ym0+(float(jy))*dyout
+          call xymeter_to_ll_wrf_out(tmpx,tmpy,lon2(2),lat2(2))
+          tmpx=out_xm0+(float(ix+1))*dxout
+          tmpy=out_ym0+(float(jy+1))*dyout
+          call xymeter_to_ll_wrf_out(tmpx,tmpy,lon2(3),lat2(3))
+          tmpx=out_xm0+(float(ix))*dxout
+          tmpy=out_ym0+(float(jy+1))*dyout
+          call xymeter_to_ll_wrf_out(tmpx,tmpy,lon2(4),lat2(4))
+        area1=sphere01_polygon_area ( 4, real(lat2,kind=8), real(lon2,kind=8) )
+        area(ix,jy)=real(area1)*6370000.*6370000./coefdx/coefdx
+!
+! Volume = area x box height
+!***************************
+
+          volume(ix,jy,1)=area(ix,jy)*outheight(1)
+
+! for FLEXPART_WRF, dx & dy are in meters, and no cos(lat) is needed
+!          areaeast(ix,jy,1)=dyout*r_earth*pi180*outheight(1)
+!          areanorth(ix,jy,1)=cos(ylat*pi180)*dxout*r_earth*pi180*
+!     +    outheight(1)
+          areaeast(ix,jy,1)=dyout*outheight(1)
+          areanorth(ix,jy,1)=dxout*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))
+            areaeast(ix,jy,kz)=dyout*(outheight(kz)-outheight(kz-1))
+            areanorth(ix,jy,kz)=dxout*(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
+! for FLEXPART_WRF, x & y coords are in meters,
+! and the lon & lat variables below are in meters.
+            ymet=out_ym0+(real(jjy)+real(j1)/10.-0.05)*dyout
+            yl=(ymet-ymet0)/dy
+            do i1=1,10
+              xmet=out_xm0+(real(iix)+real(i1)/10.-0.05)*dxout
+              xl=(xmet-xmet0)/dx
+
+! Determine the nest we are in
+!*****************************
+
+              ngrid=0
+              do j=numbnests,1,-1
+                if ((xl.gt.xln(j)).and.(xl.lt.xrn(j)).and. &
+                (yl.gt.yln(j)).and.(yl.lt.yrn(j))) 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
+!  print*,'gridunc allocated'
+  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)
+  allocate(drygridunc2(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
+
+!  print*,'alloc gridunc',numxgrid-1,numygrid-1,numzgrid,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)
+  allocate(grid2(0:max(numxgrid,numxgridn)-1, &
+       0:max(numygrid,numygridn)-1,numzgrid,maxpointspec_act),stat=stat)
+  allocate(grid3(0:max(numxgrid,numxgridn)-1, &
+       0:max(numygrid,numygridn)-1,numzgrid,maxpointspec_act),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_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)
+     allocate(wetgrid2(0:max(numxgrid,numxgridn)-1, &
+          0:max(numygrid,numygridn)-1,maxpointspec_act),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)
+     allocate(drygrid2(0:max(numxgrid,numxgridn)-1, &
+          0:max(numygrid,numygridn)-1,maxpointspec_act),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.
+!            drygridunc2(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_irreg
+
+function sphere01_polygon_area ( n, lat, lon )
+
+!*****************************************************************************80
+!
+!! SPHERE01_POLYGON_AREA returns the area of a spherical polygon.
+!
+!  Discussion:
+!
+!    On a unit sphere, the area of a spherical polygon with N sides
+!    is equal to the spherical excess:
+!
+!      E = sum ( interior angles ) - ( N - 2 ) * pi.
+!
+!    On a sphere with radius R, the area is the spherical excess multiplied
+!    by R * R.
+!
+!    The code was revised in accordance with suggestions in Carvalho and
+!    Cavalcanti.
+!
+!  Licensing:
+!
+!    This code is distributed under the GNU LGPL license. 
+!
+!  Modified:
+!
+!    12 August 2005
+!
+!  Author:
+!
+!    Original C version by Robert Miller.
+!    FORTRAN90 version by John Burkardt.
+!
+!  Reference:
+!
+!    Paulo Cezar Pinto Carvalho, Paulo Roma Cavalcanti,
+!    Point in Polyhedron Testing Using Spherical Polygons,
+!    in Graphics Gems V,
+!    edited by Alan Paeth,
+!    Academic Press, 1995,
+!    ISBN: 0125434553,
+!    LC: T385.G6975.
+!
+!    Robert Miller,
+!    Computing the Area of a Spherical Polygon,
+!    Graphics Gems, Volume IV, pages 132-138,
+!    Edited by Paul Heckbert,
+!    Academic Press, 1994, T385.G6974.
+!
+!    Eric Weisstein,
+!    "Spherical Polygon",
+!    CRC Concise Encyclopedia of Mathematics,
+!    CRC Press, 1999.
+!
+!  Parameters:
+!
+!    Input, integer ( kind = 4 ) N, the number of vertices.
+!
+!    Input, real ( kind = 8 ) LAT[N], LON[N], the latitudes and longitudes 
+!    of the vertices of the spherical polygon.
+!
+!    Output, real ( kind = 8 ) SPHERE01_POLYGON_AREA, the area of the 
+!    spherical polygon, measured in spherical radians.
+!
+  implicit none
+
+  integer ( kind = 4 ) n
+
+  real ( kind = 8 ) a
+  real ( kind = 8 ) area
+  real ( kind = 8 ) b
+  real ( kind = 8 ) beta1
+  real ( kind = 8 ) beta2
+  real ( kind = 8 ) c
+  real ( kind = 8 ) cos_b1
+  real ( kind = 8 ) cos_b2
+  real ( kind = 8 ) excess
+  real ( kind = 8 ) hav_a
+  real ( kind = 8 ) haversine
+  integer ( kind = 4 ) j
+  integer ( kind = 4 ) k
+  real ( kind = 8 ) lam
+  real ( kind = 8 ) lam1
+  real ( kind = 8 ) lam2
+  real ( kind = 8 ) lat(n)
+  real ( kind = 8 ) lon(n)
+  real ( kind = 8 ), parameter :: pi_half = 1.5707963267948966192313D+00
+  real ( kind = 8 ) s
+  real ( kind = 8 ) sphere01_polygon_area
+  real ( kind = 8 ) t
+  real ( kind = 8 ),parameter :: degrees_to_radians=3.141592653589793D+00 / 180.0D+00
+
+  area = 0.0D+00
+
+  do j=1,n
+  lon(j)=lon(j)*degrees_to_radians
+  lat(j)=lat(j)*degrees_to_radians
+  enddo
+  do j = 1, n + 1
+! do j = 1, n 
+
+    if ( j == 1 ) then
+      lam1 = lon(j)
+      beta1 = lat(j)
+      lam2 = lon(j+1)
+      beta2 = lat(j+1)
+      cos_b1 = cos ( beta1 )
+      cos_b2 = cos ( beta2 )
+    else
+!      k = mod ( j + 1, n + 1 )
+!    k = mod ( j , n )
+      k=j
+      if (j.gt.n) k=1
+      lam1 = lam2
+      beta1 = beta2
+      lam2 = lon(k)
+      beta2 = lat(k)
+! print*,'sphere',n,k,lon(k),lat(k)
+      cos_b1 = cos_b2
+      cos_b2 = cos ( beta2 )
+    end if
+
+    if ( lam1 /= lam2 ) then
+
+      hav_a = haversine ( beta2 - beta1 ) &
+        + cos_b1 * cos_b2 * haversine ( lam2 - lam1 )
+      a = 2.0D+00 * asin ( sqrt ( hav_a ) )
+
+      b = pi_half - beta2
+      c = pi_half - beta1
+      s = 0.5D+00 * ( a + b + c )
+!
+!  Given the three sides of a spherical triangle, we can use a formula
+!  to find the spherical excess.
+!
+      t = tan ( s / 2.0D+00 ) * tan ( ( s - a ) / 2.0D+00 ) &
+        * tan ( ( s - b ) / 2.0D+00 ) * tan ( ( s - c ) / 2.0D+00 )
+
+      excess = abs ( 4.0D+00 * atan ( sqrt ( abs ( t ) ) ) )
+
+      if ( lam1 < lam2 ) then
+        lam = lam2 - lam1
+      else
+        lam = lam2 - lam1 + 4.0D+00 * pi_half
+      end if
+
+      if ( 2.0D+00 * pi_half < lam ) then
+        excess = -excess 
+      end if
+
+      area = area + excess
+
+    end if
+
+  end do
+
+  sphere01_polygon_area = abs ( area )
+
+  return
+end
+
+function haversine ( a )
+
+!*****************************************************************************80
+!
+!! HAVERSINE computes the haversine of an angle.
+!
+!  Discussion:
+!
+!    haversine(A) = ( 1 - cos ( A ) ) / 2
+!
+!    The haversine is useful in spherical trigonometry.
+!
+!  Licensing:
+!
+!    This code is distributed under the GNU LGPL license. 
+!
+!  Modified:
+!
+!    02 July 2001
+!
+!  Author:
+!
+!    John Burkardt
+!
+!  Parameters:
+!
+!    Input, real ( kind = 8 ) A, the angle.
+!
+!    Output, real ( kind = 8 ) HAVERSINE, the haversine of the angle.
+!
+  implicit none
+
+  real ( kind = 8 ) a
+  real ( kind = 8 ) haversine
+
+  haversine = ( 1.0D+00 - cos ( a ) ) / 2.0D+00
+
+  return
+end
Index: /branches/jerome/src_flexwrf_v3.1/outgrid_init_nest_irreg.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/outgrid_init_nest_irreg.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/outgrid_init_nest_irreg.f90	(revision 16)
@@ -0,0 +1,287 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                *
+!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine,       *
+!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
+!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso,          *
+!* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann,   *
+!*                                                                     *
+!* This file is part of FLEXPART WRF                                   *
+!*                                                                     *
+!* 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_irreg
+!*******************************************************************************
+!                                                                              *
+!     Note:  This is the FLEXPART_WRF version of subroutine outgrid_init.      *
+!            The computational grid is the WRF x-y grid rather than lat-lon.   *
+!                                                                              *
+!  This routine calculates, for each grid cell of the output grid, the         *
+!  volume, the surface area, and the areas of the northward and eastward       *
+!  facing surfaces.                                                            *
+!                                                                              *
+!     Author: A. Stohl                                                         *
+!                                                                              *
+!     7 August 2002                                                            *
+!                                                                              *
+!    26 Oct 2005, R. Easter - changes in gridarea, areaeast, areanorth         *
+!                             associated with WRF horizontal grid.             *
+!     Dec 2005, R. Easter - changed names of "*lon0*" & "*lat0*" variables     *
+!                                                                              *
+!*******************************************************************************
+!                                                                              *
+! 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 unc_mod
+  use outg_mod
+  use par_mod
+  use com_mod
+
+!      include 'includepar'
+!      include 'includecom'
+     implicit none 
+      integer :: ix,jy,kz,k,i,nage,l,iix,jjy,ixp,jyp,i1,j1,j,ngrid
+!     real ylat,gridarea,ylatp,ylatm,hzone,cosfact,cosfactm,cosfactp
+      real :: ymet,gridarea,m1,m2,xl1,xl2,yl1,yl2,tmpx,tmpy
+      real :: xmet,xl,yl,ddx,ddy,rddx,rddy,p1,p2,p3,p4,xtn,ytn,oroh
+  integer :: ks,kp,stat
+  real,parameter :: eps=nxmax/3.e5
+      real :: lon2(4),lat2(4)
+      real ( kind = 8 ) :: sphere01_polygon_area,haversine,area1
+
+
+! 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=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
+!
+!C Calculate area of grid cell with formula M=2*pi*R*h*dx/360,
+!C see Netz, Formeln der Mathematik, 5. Auflage (1983), p.90
+!*************************************************************
+!
+!          cosfact=cos(ylat*pi180)*r_earth
+!          cosfactp=cos(ylatp*pi180)*r_earth
+!          cosfactm=cos(ylatm*pi180)*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
+!
+!C Surface are of a grid cell at a latitude ylat
+!***********************************************
+!
+!        gridarea=2.*pi*r_earth*hzone*dxout/360.
+
+! for FLEXPART_WRF, dx & dy are in meters, and no cos(lat) is needed
+! ??? maybe should incorporate map factor here,
+!     and also for areaeast & areanorth ???
+
+!       gridarea=dxoutn*dyoutn
+
+        do ix=0,numxgridn-1
+!        xl1=(real(ix)*dxoutn+out_xm0n)/dx
+!        yl1=(real(jy)*dyoutn+out_ym0n)/dy
+!        xl2=(real(ix+1)*dxoutn+out_xm0n)/dx
+!        yl2=(real(jy+1)*dyoutn+out_ym0n)/dy
+!!      xr=out_xm0+real(numxgrid)*dxout
+!        m1=0.5*(m_x(int(xl1),int(yl1),1)+m_x(int(xl2),int(yl1),1))
+!        m2=0.5*(m_y(int(xl1),int(yl1),1)+m_x(int(xl1),int(yl2),1))
+!      arean(ix,jy)=dxoutn*m1*dyoutn*m2
+
+! A more precise method
+          tmpx=out_xm0n+(float(ix))*dxoutn
+          tmpy=out_ym0n+(float(jy))*dyoutn
+          call xymeter_to_ll_wrf_out(tmpx,tmpy,lon2(1),lat2(1))
+          tmpx=out_xm0n+(float(ix+1))*dxoutn
+          tmpy=out_ym0n+(float(jy))*dyoutn
+          call xymeter_to_ll_wrf_out(tmpx,tmpy,lon2(2),lat2(2))
+          tmpx=out_xm0n+(float(ix+1))*dxoutn
+          tmpy=out_ym0n+(float(jy+1))*dyoutn
+          call xymeter_to_ll_wrf_out(tmpx,tmpy,lon2(3),lat2(3))
+          tmpx=out_xm0n+(float(ix))*dxoutn
+          tmpy=out_ym0n+(float(jy+1))*dyoutn
+          call xymeter_to_ll_wrf_out(tmpx,tmpy,lon2(4),lat2(4))
+        area1=sphere01_polygon_area ( 4, real(lat2,kind=8), real(lon2,kind=8) )
+        arean(ix,jy)=real(area1)*6370000.*6370000./coefdx/coefdx
+
+!         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 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
+! for FLEXPART_WRF, x & y coords are in meters,
+! and the lon & lat variables below are in meters.
+            ymet=out_ym0n+(real(jjy)+real(j1)/10.-0.05)*dyoutn
+            yl=(ymet-ymet0)/dy
+            do i1=1,10
+              xmet=out_xm0n+(real(iix)+real(i1)/10.-0.05)*dxoutn
+              xl=(xmet-xmet0)/dx
+
+! Determine the nest we are in
+!*****************************
+
+              ngrid=0
+              do j=numbnests,1,-1
+                if ((xl.gt.xln(j)).and.(xl.lt.xrn(j)).and. &
+                (yl.gt.yln(j)).and.(yl.lt.yrn(j))) 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
+
+
+  ! 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)
+  allocate(drygriduncn2(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
+
+  !write (*,*) 'Dimensions for fields', numxgrid,numygrid, &
+  !     maxspec,maxpointspec_act,nclassunc,maxageclass
+
+  ! allocate fields for concoutput with maximum dimension of outgrid
+  ! and outgrid_nest
+  ! Initial condition field
+
+  !************************
+  ! Initialize 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_irreg
+
Index: /branches/jerome/src_flexwrf_v3.1/outgrid_init_nest_reg.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/outgrid_init_nest_reg.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/outgrid_init_nest_reg.f90	(revision 16)
@@ -0,0 +1,266 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                *
+!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine,       *
+!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
+!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso,          *
+!* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann,   *
+!*                                                                     *
+!* This file is part of FLEXPART WRF                                   *
+!*                                                                     *
+!* 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_reg
+!*******************************************************************************
+!                                                                              *
+!     Note:  This is the FLEXPART_WRF version of subroutine outgrid_init.      *
+!            The computational grid is the WRF x-y grid rather than lat-lon.   *
+!                                                                              *
+!  This routine calculates, for each grid cell of the output grid, the         *
+!  volume, the surface area, and the areas of the northward and eastward       *
+!  facing surfaces.                                                            *
+!                                                                              *
+!     Author: A. Stohl                                                         *
+!                                                                              *
+!     7 August 2002                                                            *
+!                                                                              *
+!    26 Oct 2005, R. Easter - changes in gridarea, areaeast, areanorth         *
+!                             associated with WRF horizontal grid.             *
+!     Dec 2005, R. Easter - changed names of "*lon0*" & "*lat0*" variables     *
+!     July 2012, J Brioude - modified for regular output grid.                 *
+!*******************************************************************************
+!                                                                              *
+! 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 unc_mod
+  use outg_mod
+  use par_mod
+  use com_mod
+
+!      include 'includepar'
+!      include 'includecom'
+     implicit none 
+      integer :: ix,jy,kz,k,i,nage,l,iix,jjy,ixp,jyp,i1,j1,j,ngrid
+      real :: ylat,gridarea,ylatp,ylatm,hzone,cosfact,cosfactm,cosfactp
+      real :: ymet,xlon
+      real :: xmet,xl,yl,ddx,ddy,rddx,rddy,p1,p2,p3,p4,xtn,ytn,oroh
+  integer :: ks,kp,stat
+  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,numygridn-1
+
+        ylat=outlat0n+(real(jy)+0.5)*dyoutln
+        ylatp=ylat+0.5*dyoutln
+        ylatm=ylat-0.5*dyoutln
+        if ((ylatm.lt.0).and.(ylatp.gt.0.)) then
+          hzone=dyoutln*r_earth*pi180
+        else
+
+!C Calculate area of grid cell with formula M=2*pi*R*h*dx/360,
+!C see Netz, Formeln der Mathematik, 5. Auflage (1983), p.90
+!*************************************************************
+!
+          cosfact=cos(ylat*pi180)*r_earth
+          cosfactp=cos(ylatp*pi180)*r_earth
+          cosfactm=cos(ylatm*pi180)*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
+
+!C Surface are of a grid cell at a latitude ylat
+!***********************************************
+!
+         gridarea=2.*pi*r_earth*hzone*dxoutln/360.
+
+! for FLEXPART_WRF, dx & dy are in meters, and no cos(lat) is needed
+! ??? maybe should incorporate map factor here,
+!     and also for areaeast & areanorth ???
+!       gridarea=dxoutn*dyoutn
+
+        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 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
+! for FLEXPART_WRF, x & y coords are in meters,
+! and the lon & lat variables below are in meters.
+            ylat=outlat0n+(float(jjy)+float(j1)/10.-0.05)*dyoutln !in degrees
+!           ymet=out_ym0n+(real(jjy)+real(j1)/10.-0.05)*dyoutn
+!           yl=(ymet-ymet0)/dy
+            do i1=1,10
+            xlon=outlon0n+(float(iix)+float(i1)/10.-0.05)*dxoutln !in degrees
+!              xmet=out_xm0n+(real(iix)+real(i1)/10.-0.05)*dxoutn
+        call ll_to_xymeter_wrf(xlon,ylat,xmet,ymet)
+           yl=(ymet-ymet0)/dy
+           xl=(xmet-xmet0)/dx
+!             xl=(xmet-xmet0)/dx
+
+! Determine the nest we are in
+!*****************************
+
+              ngrid=0
+              do j=numbnests,1,-1
+                if ((xl.gt.xln(j)).and.(xl.lt.xrn(j)).and. &
+                (yl.gt.yln(j)).and.(yl.lt.yrn(j))) 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
+
+
+  ! 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)
+  allocate(drygriduncn2(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
+
+  !write (*,*) 'Dimensions for fields', numxgrid,numygrid, &
+  !     maxspec,maxpointspec_act,nclassunc,maxageclass
+
+  ! allocate fields for concoutput with maximum dimension of outgrid
+  ! and outgrid_nest
+  ! Initial condition field
+
+  !************************
+  ! Initialize 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_reg
+
Index: /branches/jerome/src_flexwrf_v3.1/outgrid_init_reg.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/outgrid_init_reg.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/outgrid_init_reg.f90	(revision 16)
@@ -0,0 +1,362 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                *
+!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine,       *
+!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
+!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso,          *
+!* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann,   *
+!*                                                                     *
+!* This file is part of FLEXPART WRF                                   *
+!*                                                                     *
+!* 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_reg()
+!*******************************************************************************
+!                                                                              *
+!     Note:  This is the FLEXPART_WRF version of subroutine outgrid_init.      *
+!            The computational grid is the WRF x-y grid rather than lat-lon.   *
+!                                                                              *
+!  This routine calculates, for each grid cell of the output grid, the         *
+!  volume, the surface area, and the areas of the northward and eastward       *
+!  facing surfaces.                                                            *
+!                                                                              *
+!     Author: A. Stohl                                                         *
+!                                                                              *
+!     7 August 2002                                                            *
+!                                                                              *
+!    26 Oct 2005, R. Easter - changes in gridarea, areaeast, areanorth         *
+!                             associated with WRF horizontal grid.             *
+!     Dec 2005, R. Easter - changed names of "*lon0*" & "*lat0*" variables     *
+!    July 2012, J. Brioude - modified for regular output grid                  *
+!*******************************************************************************
+!                                                                              *
+! 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
+
+!      include 'includepar'
+!      include 'includecom'
+     implicit none 
+      integer :: ix,jy,kz,k,i,nage,l,iix,jjy,ixp,jyp,i1,j1,j,ngrid
+      real :: ylat,gridarea,ylatp,ylatm,hzone,cosfact,cosfactm,cosfactp
+      real :: ymet,xlon    
+      real :: xmet,xl,yl,ddx,ddy,rddx,rddy,p1,p2,p3,p4,xtn,ytn,oroh
+  integer :: ks,kp,stat
+  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+(float(jy)+0.5)*dyoutl
+        ylatp=ylat+0.5*dyoutl              
+        ylatm=ylat-0.5*dyoutl              
+        if ((ylatm.lt.0).and.(ylatp.gt.0.)) then    
+          hzone=dyoutl*r_earth*pi180          
+        else                 
+          cosfact=cos(ylat*pi180)*r_earth          
+          cosfactp=cos(ylatp*pi180)*r_earth       
+          cosfactm=cos(ylatm*pi180)*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
+!
+!C Surface are of a grid cell at a latitude ylat
+!***********************************************
+!
+         gridarea=2.*pi*r_earth*hzone*dxoutl/360.
+
+! for FLEXPART_WRF, dx & dy are in meters, and no cos(lat) is needed
+! ??? maybe should incorporate map factor here,
+!     and also for areaeast & areanorth ???
+!       gridarea=dxout*dyout
+
+        do ix=0,numxgrid-1
+          area(ix,jy)=gridarea
+! Volume = area x box height
+!***************************
+
+          volume(ix,jy,1)=area(ix,jy)*outheight(1)
+
+! for FLEXPART_WRF, dx & dy are in meters, and no cos(lat) is needed
+          areaeast(ix,jy,1)=dyoutl*r_earth*pi180*outheight(1)
+          areanorth(ix,jy,1)=cos(ylat*pi180)*dxoutl*r_earth*pi180* &
+          outheight(1)
+!         areaeast(ix,jy,1)=dyout*outheight(1)
+!         areanorth(ix,jy,1)=dxout*outheight(1)
+
+          do kz=2,numzgrid
+
+             areaeast(ix,jy,kz)=dyoutl*r_earth*pi180* &
+             (outheight(kz)-outheight(kz-1))
+             areanorth(ix,jy,kz)=cos(ylat*pi180)*dxoutl*r_earth*pi180* &
+             (outheight(kz)-outheight(kz-1))
+!           areaeast(ix,jy,kz)=dyout*(outheight(kz)-outheight(kz-1))
+!           areanorth(ix,jy,kz)=dxout*(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
+! for FLEXPART_WRF, x & y coords are in meters,
+! and the lon & lat variables below are in meters.
+            ylat=outlat0+(float(jjy)+float(j1)/10.-0.05)*dyoutl !in degrees
+!            ymet=out_ym0+(real(jjy)+real(j1)/10.-0.05)*dyout
+!            yl=(ymet-ymet0)/dy
+            do i1=1,10
+            xlon=outlon0+(float(iix)+float(i1)/10.-0.05)*dxoutl !in degrees
+        call ll_to_xymeter_wrf(xlon,ylat,xmet,ymet)
+           yl=(ymet-ymet0)/dy
+           xl=(xmet-xmet0)/dx
+
+!              xmet=out_xm0+(real(iix)+real(i1)/10.-0.05)*dxout
+!              xl=(xmet-xmet0)/dx
+
+! Determine the nest we are in
+!*****************************
+
+              ngrid=0
+              do j=numbnests,1,-1
+                if ((xl.gt.xln(j)).and.(xl.lt.xrn(j)).and. &
+                (yl.gt.yln(j)).and.(yl.lt.yrn(j))) 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'
+
+   print*,'alloc gridunc',numxgrid-1,numygrid-1,numzgrid,maxspec, &
+          maxpointspec_act,nclassunc,maxageclass
+  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'
+  allocate(drygridunc2(0:numxgrid-1,0:numygrid-1,maxspec, &
+       maxpointspec_act,nclassunc,maxageclass),stat=stat)
+  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)
+  allocate(grid2(0:max(numxgrid,numxgridn)-1, &
+       0:max(numygrid,numygridn)-1,numzgrid,maxpointspec_act),stat=stat)
+  allocate(grid3(0:max(numxgrid,numxgridn)-1, &
+       0:max(numygrid,numygridn)-1,numzgrid,maxpointspec_act),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_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)
+     allocate(wetgrid2(0:max(numxgrid,numxgridn)-1, &
+          0:max(numygrid,numygridn)-1,maxpointspec_act),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)
+     allocate(drygrid2(0:max(numxgrid,numxgridn)-1, &
+          0:max(numygrid,numygridn)-1,maxpointspec_act),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_reg
+
Index: /branches/jerome/src_flexwrf_v3.1/par_mod.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/par_mod.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/par_mod.f90	(revision 16)
@@ -0,0 +1,290 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                *
+!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine,       *
+!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
+!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso,          *
+!* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann,   *
+!                                                                     *
+!* This file is part of FLEXPART WRF                                   *
+!                                                                     *
+! 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 10 August 2000                                            *
+!                                                                              *
+!*******************************************************************************
+
+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=3
+
+  ! 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,weightair=28.97
+  real,parameter :: cpa=1004.6, kappa=0.286, pi180=pi/180., vonkarman=0.4
+  logical        :: strswitch
+  ! 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=364,nymax=244,nuvzmax=45,nwzmax=45,nzmax=45
+  !integer,parameter :: nxmax=454,nymax=334,nuvzmax=45,nwzmax=45,nzmax=45
+  integer,parameter :: nxmax=334,nymax=334,nuvzmax=61,nwzmax=61,nzmax=61
+  !integer,parameter :: nxmax=182,nymax=182,nuvzmax=61,nwzmax=61,nzmax=61
+  !integer,parameter :: nxmax=1081,nymax=260,nuvzmax=89,nwzmax=89,nzmax=89
+
+  !integer,parameter :: nxmax=45,nymax=33,nuvzmax=45,nwzmax=45,nzmax=45
+  !integer,parameter :: nxmax=361,nymax=181,nuvzmax=61,nwzmax=61,nzmax=61
+  !integer,parameter :: nxmax=721,nymax=361,nuvzmax=64,nwzmax=64,nzmax=64
+  !integer,parameter :: nxshift=359  ! for ECMWF
+  integer,parameter :: nxshift=0     ! for GFS
+
+  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=312,nymaxn=312
+  !integer,parameter :: maxnests=1,nxmaxn=312,nymaxn=312
+
+  ! 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=3,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
+
+
+   integer,parameter :: turb_option_none=0
+   integer,parameter :: turb_option_diagnosed=1
+   integer,parameter :: turb_option_tke=2
+   integer,parameter :: turb_option_mytke=3
+   integer,parameter :: sfc_option_diagnosed=0
+   integer,parameter :: sfc_option_wrf=1
+   integer,parameter :: partoutput_use_nested=1
+  !**************************************************
+  ! Maximum number of particles, species, and similar
+  !**************************************************
+
+  integer :: maxpart=1
+  integer,parameter :: maxspec=11
+
+
+  ! 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 :: newrandomgen = 0  !added by mc to select teh new parallel random generator ; 0 is the old one if zero is chosen then adjust teh definition of rannumb and uniform_rannumb in com_mod.f90
+! integer :: newrandomgen = 0  ! JB version
+
+  integer,parameter :: maxrand=5000000 !comment by mc: maximum number of gasussina distributed and random distributed random number for a single mpi_process
+  ! maxrand                 number of random numbers used
+  integer, parameter :: MAX_STREAM = 12 !added by mc : maximum total number of stream initilized (i.e. avilable) for the MT generator.
+
+  integer,parameter :: maxomp=12
+  integer,parameter :: maxrandomp=maxrand*maxomp
+  integer,parameter :: maxrand3=maxrand*(newrandomgen+maxomp*(1-newrandomgen))
+
+  !*****************************************************
+  ! 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=3, unitreleases=1, 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, unitshortpart=95
+  integer,parameter :: unitboundcond=89
+
+  ! CDA implementing a quick fix for the wet deposition scheme
+  !******************************************************
+  ! integer code for missing values, used in wet scavenging (PS, 2012)
+  !******************************************************
+
+      integer icmv
+      parameter(icmv=-9999)
+
+end module par_mod
Index: /branches/jerome/src_flexwrf_v3.1/part0.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/part0.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/part0.f90	(revision 16)
@@ -0,0 +1,135 @@
+!**********************************************************************
+! 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/jerome/src_flexwrf_v3.1/partdep.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/partdep.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/partdep.f90	(revision 16)
@@ -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/jerome/src_flexwrf_v3.1/partoutput.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/partoutput.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/partoutput.f90	(revision 16)
@@ -0,0 +1,328 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                *
+!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine,       *
+!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
+!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso,          *
+!* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann,   *
+!*                                                                     *
+!* This file is part of FLEXPART WRF                                   *
+!*                                                                     *
+!* 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
+!*******************************************************************************
+!                                                                              *
+!     Note:  This is the FLEXPART_WRF version of subroutine partoutput.        *
+!                                                                              *
+!     Dump all particle positions                                              *
+!                                                                              *
+!     Author: A. Stohl                                                         *
+!     12 March 1999                                                            *
+!                                                                              *
+!     Dec 2005, J. Fast - Output files can be either binary or ascii.          *
+!                   Topo,pv,qv,... at particle positions are calculated        *
+!                   using nested fields when (partoutput_use_nested .gt. 0)    *
+!                   Particle xy coords can be either lat-lon or grid-meters.   *
+!                   Changed names of "*lon0*" & "*lat0*" variables             *
+!                                                                              *
+!*******************************************************************************
+!                                                                              *
+! Variables:                                                                   *
+!                                                                              *
+!*******************************************************************************
+
+  use par_mod
+  use com_mod
+
+  implicit none
+!      include 'includepar'
+!      include 'includecom'
+
+  real(kind=dp) :: jul
+      integer :: itime,i,j,jjjjmmdd,ihmmss
+      integer :: ix,jy,ixp,jyp,indexh,m,il,ind,indz,indzp
+      integer :: numpart_out
+      real :: xlon,ylat,xtmp,ytmp
+      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
+
+      integer :: k, ngrid
+      real :: xtn, ytn
+
+
+! Determine current calendar date, needed for the file name
+!**********************************************************
+
+  jul=bdate+real(itime,kind=dp)/86400._dp    ! this is the current day
+
+      call caldate(jul,jjjjmmdd,ihmmss)
+      write(adate,'(i8.8)') jjjjmmdd
+      write(atime,'(i6.6)') ihmmss
+
+
+! Some variables needed for temporal interpolation
+!*************************************************
+
+      dt1=float(itime-memtime(1))
+      dt2=float(memtime(2)-itime)
+      dtt=1./(dt1+dt2)
+
+! Open output file and write the output
+!**************************************
+
+      if (ipout.eq.1) then
+        if (iouttype.eq.0) &
+        open(unitpartout,file=path(1)(1:length(1))//'partposit_'//adate// &
+        atime,form='unformatted')
+        if (iouttype.eq.1) &
+        open(unitpartout,file=path(1)(1:length(1))//'partposit_'//adate// &
+        atime,form='formatted')
+      else
+        if (iouttype.eq.0) &
+        open(unitpartout,file=path(1)(1:length(1))//'partposit_end', &
+        form='unformatted')
+        if (iouttype.eq.1) &
+        open(unitpartout,file=path(1)(1:length(1))//'partposit_end', &
+        form='formatted')
+      endif
+
+! Write current time to file
+!***************************
+
+      numpart_out = 0
+      do i=1,numpart
+        if (itra1(i).eq.itime) numpart_out = numpart_out + 1
+      enddo
+
+      if (iouttype.eq.0) write(unitpartout)   itime, &
+          numpart_out, outgrid_option
+      if (iouttype.eq.1) write(unitpartout,*) itime, &
+          numpart_out, outgrid_option 
+
+      do i=1,numpart
+
+! Take only valid particles
+!**************************
+
+        if (itra1(i).eq.itime) then
+          xlon=xmet0+xtra1(i)*dx
+          ylat=ymet0+ytra1(i)*dy
+
+!*********************************************************************************
+! Interpolate several variables (PV, specific humidity, etc.) to particle position
+!*********************************************************************************
+
+! If partoutput_use_nested=0, set ngrid=0, and use the outermost grid
+!    for calculating topo, pv, qv, ... at the particle position
+! Otherwise, determine the nest we are in
+          ngrid=0
+          if (partoutput_use_nested .gt. 0) then
+          do k=numbnests,1,-1
+             if ((xtra1(i).gt.xln(k)).and. &
+                 (xtra1(i).lt.xrn(k)).and. &
+                 (ytra1(i).gt.yln(k)).and. &
+                 (ytra1(i).lt.yrn(k))) then
+                    ngrid=k
+                    goto 26
+             endif
+          enddo
+26        continue
+          endif
+
+          if (ngrid .le. 0) then
+             ix=int(xtra1(i))
+             jy=int(ytra1(i))
+             ddy=ytra1(i)-float(jy)
+             ddx=xtra1(i)-float(ix)
+          else
+             xtn=(xtra1(i)-xln(ngrid))*xresoln(ngrid)
+             ytn=(ytra1(i)-yln(ngrid))*yresoln(ngrid)
+             ix=int(xtn)
+             jy=int(ytn)
+             ddy=ytn-float(jy)
+             ddx=xtn-float(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
+
+! Topography
+!***********
+          if (ngrid .le. 0) then
+      topo=p1*oro(ix ,jy) &
+           + p2*oro(ixp,jy) &
+           + p3*oro(ix ,jyp) &
+           + p4*oro(ixp,jyp)
+          else
+             topo=p1*oron(ix ,jy ,ngrid) &
+                + p2*oron(ixp,jy ,ngrid) &
+                + p3*oron(ix ,jyp,ngrid) &
+                + p4*oron(ixp,jyp,ngrid)
+          endif
+
+! Potential vorticity, specific humidity, temperature, and density
+!*****************************************************************
+
+          do il=2,nz
+            if (height(il).gt.ztra1(i)) then
+              indz=il-1
+              indzp=il
+              goto 56
+            endif
+          enddo
+56        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)
+
+              if (ngrid .le. 0) then
+  ! 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)
+              else
+              pv1(m)=p1*pvn(ix ,jy ,ind,indexh,ngrid) &
+                    +p2*pvn(ixp,jy ,ind,indexh,ngrid) &
+                    +p3*pvn(ix ,jyp,ind,indexh,ngrid) &
+                    +p4*pvn(ixp,jyp,ind,indexh,ngrid)
+              qv1(m)=p1*qvn(ix ,jy ,ind,indexh,ngrid) &
+                    +p2*qvn(ixp,jy ,ind,indexh,ngrid) &
+                    +p3*qvn(ix ,jyp,ind,indexh,ngrid) &
+                    +p4*qvn(ixp,jyp,ind,indexh,ngrid)
+              tt1(m)=p1*ttn(ix ,jy ,ind,indexh,ngrid) &
+                    +p2*ttn(ixp,jy ,ind,indexh,ngrid) &
+                    +p3*ttn(ix ,jyp,ind,indexh,ngrid) &
+                    +p4*ttn(ixp,jyp,ind,indexh,ngrid)
+              rho1(m)=p1*rhon(ix ,jy ,ind,indexh,ngrid) &
+                     +p2*rhon(ixp,jy ,ind,indexh,ngrid) &
+                     +p3*rhon(ix ,jyp,ind,indexh,ngrid) &
+                     +p4*rhon(ixp,jyp,ind,indexh,ngrid)
+
+              endif
+
+         enddo
+            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
+         enddo
+          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)
+
+            if (ngrid .le. 0) then
+! 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)
+ 
+            else
+            tr(m)=p1*tropopausen(ix ,jy ,1,indexh,ngrid) &
+                + p2*tropopausen(ixp,jy ,1,indexh,ngrid) &
+                + p3*tropopausen(ix ,jyp,1,indexh,ngrid) &
+                + p4*tropopausen(ixp,jyp,1,indexh,ngrid)
+            hm(m)=p1*hmixn(ix ,jy ,1,indexh,ngrid) &
+                + p2*hmixn(ixp,jy ,1,indexh,ngrid) &
+                + p3*hmixn(ix ,jyp,1,indexh,ngrid) &
+                + p4*hmixn(ixp,jyp,1,indexh,ngrid)
+
+            endif
+
+        enddo
+
+          hmixi=(hm(1)*dt2+hm(2)*dt1)*dtt
+          tri=(tr(1)*dt2+tr(2)*dt1)*dtt
+
+
+! Write the output
+!*****************
+
+          if (outgrid_option .eq. 1) then
+             xtmp = xlon
+             ytmp = ylat
+             call xymeter_to_ll_wrf( xtmp, ytmp, xlon, ylat )
+          endif
+          if(iouttype.eq.0)  &   
+          write(unitpartout) npoint(i),xlon,ylat,ztra1(i), &
+          itramem(i),topo,pvi,qvi,rhoi,hmixi,tri,tti, &
+          (xmass1(i,j),j=1,nspec)
+          if(iouttype.eq.1)    &
+          write(unitpartout,101) npoint(i),itramem(i),xlon,ylat, &
+          ztra1(i),topo,pvi,qvi,rhoi,hmixi,tri,tti, &
+          (xmass1(i,j),j=1,nspec)
+        endif
+
+       enddo
+
+      if(iouttype.eq.0)  &
+      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)
+      if(iouttype.eq.1)  &
+      write(unitpartout,101) -99999,-99999,-9999.9,-9999.9,-9999.9, &
+      -9999.9,-9999.9,-9999.9,-9999.9,-9999.9,-9999.9,-9999.9, &
+      (-9999.9,j=1,nspec)
+
+101   format( 2i10, 1p, 21e14.6 )
+
+
+      close(unitpartout)
+
+end subroutine partoutput
+
Index: /branches/jerome/src_flexwrf_v3.1/pbl_profile.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/pbl_profile.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/pbl_profile.f90	(revision 16)
@@ -0,0 +1,134 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                *
+!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine,       *
+!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
+!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso,          *
+!* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann,   *
+!*                                                                     *
+!* This file is part of FLEXPART WRF                                   *
+!                                                                     *
+! 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/jerome/src_flexwrf_v3.1/plumetraj.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/plumetraj.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/plumetraj.f90	(revision 16)
@@ -0,0 +1,290 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                *
+!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine,       *
+!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
+!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso,          *
+!* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann,   *
+!*                                                                     *
+!* This file is part of FLEXPART WRF                                   *
+!*                                                                     *
+!* 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
+!*******************************************************************************
+!                                                                              *
+!     Note:  This is the FLEXPART_WRF version of subroutine plumetraj.         *
+!            The computational grid is the WRF x-y grid rather than lat-lon.   *
+!                                                                              *
+! 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                                                          *
+!                                                                              *
+!    26 Oct 2005, R. Easter - changes associated with WRF horizontal grid.     *
+!                 Calculate the distance between 2 points directly             *
+!                 instead of using the distance function.                      *
+!     Dec 2005, R. Easter - changed names of "*lon0*" & "*lat0*" variables     *
+!     2011 - J brioude: modified to have better output format                  *
+!*******************************************************************************
+!                                                                              *
+! 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
+
+
+      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
+
+      real :: xlon,ylat,xtmp,ytmp
+
+      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)=xmet0+xtra1(i)*dx
+          yl(n)=ymet0+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
+! for FLEXPART_WRF, x,y coords are in meters, so xl,yl are in meters
+!           dist=distance(yl(k),xl(k),ycenter,xcenter)
+!jdf
+!            if (outgrid_option .eq. 1) then
+              dist=sqrt( (yl(k)-ycenter)**2 + (xl(k)-xcenter)**2 )
+              rmsdist=rmsdist+dist*dist
+!            endif
+          enddo
+!            if (outgrid_option .eq. 0) then
+              xtmp = xcenter
+              ytmp = ycenter
+              call xymeter_to_ll_wrf( xtmp, ytmp, xlon, ylat )
+              xcenter = xlon
+              ycenter = ylat
+
+!              xtmp = xl(k)
+!              ytmp = yl(k)
+!              call xymeter_to_ll_wrf( xtmp, ytmp, xlon, ylat )
+!              dist=sqrt( (ylat-ycenter)**2 + (xlon-xcenter)**2 )
+!              rmsdist=rmsdist+dist*dist
+!            endif
+!jdf
+
+!      end do
+          do k=1,ncluster
+!        if (outgrid_option .eq. 0) then
+              xtmp = xclust(k)
+              ytmp = yclust(k)
+              call xymeter_to_ll_wrf( xtmp, ytmp, xlon, ylat )
+              xclust(k) = xlon
+              yclust(k) = ylat
+!         endif
+!      print*,xclust(k),yclust(k)
+          enddo
+          if (rmsdist.gt.0.) rmsdist=sqrt(rmsdist/real(n))
+      rmsdist=max(rmsdist,0.)
+
+! Write out results in trajectory data file
+!******************************************
+
+      write(unitouttraj,'(i5,1x,i8,1x,2f9.4,1x,4f8.1,1x,f8.2,1x,4f8.1,1x,3f6.1,&
+           &5(1x,2f9.3,1x,f7.0,1x,f6.1,1x,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
+        enddo
+
+end subroutine plumetraj
+
Index: /branches/jerome/src_flexwrf_v3.1/point_mod.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/point_mod.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/point_mod.f90	(revision 16)
@@ -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/>.   *
+!**********************************************************************
+
+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 (:) :: xpoint12
+  real,allocatable, dimension (:) :: xpoint22
+  real,allocatable, dimension (:) :: ypoint12
+  real,allocatable, dimension (:) :: ypoint22
+  real,allocatable, dimension (:) :: releases_swlon
+  real,allocatable, dimension (:) :: releases_swlat
+  real,allocatable, dimension (:) :: releases_nelon
+  real,allocatable, dimension (:) :: releases_nelat
+
+  real,allocatable, dimension (:,:) :: xmass
+  real,allocatable, dimension (:) :: rho_rel
+
+end module point_mod
Index: /branches/jerome/src_flexwrf_v3.1/pre_redist_kf.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/pre_redist_kf.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/pre_redist_kf.f90	(revision 16)
@@ -0,0 +1,134 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                *
+!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine,       *
+!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
+!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso,          *
+!* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann,   *
+!*                                                                     *
+!* This file is part of FLEXPART WRF                                   *
+!*                                                                     *
+!* 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/>.   *
+!***********************************************************************
+
+! 8/30/2007 Created by Weiguo Wang 
+! Notes:
+! THIS CODE IS TO prepare meteorology data for REDISTRIBUTing PARTICLES 
+!           INVOLVED IN UPDRAFT OR/AND  DOWDRAFT
+!   Estimate fraction of particles that may be well-mixed (for well-mixing option)
+ 
+!   prob of particle involving in clouds can be pre-computed here. will optimize code later
+
+ 
+! SUBROUTINE NAME: pre_redist_kf
+!   INPUT: 
+!           nuvzmax-- max # of layers of flux
+!           nuvz -- # of layer for work array
+!           umf -- updraft mass flux (kg/s ?)
+!           dmf -- downdraft mass flux
+!           dz   -- different height between full levels (m) 
+!           p1d -- press (pa) 
+!           dx  -- horizontal grid size(m) 
+!           dt  -- time step (s)
+!C          cu_top1  --  cloud top index, zh(cu_top1)
+!C          cu_bot1  --  cloud bottom index, ,zh(cu_bot1)
+!   OUTPUT:
+!            zf -- height above ground level at full levels (ddz)
+!            zh -- height above ground level at half levels
+!       only for option of simple mixing
+!
+!           umfzf -- normalized updraft mass flux*distance,min=0,max=1
+!           dmfzf -- normalized downdraft mass flux*distance
+!           fmix  -- fraction of paricels in cloud levels is mixed
+!   CALLED by convmix_kf.f
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+       Subroutine pre_redist_kf(nuvzmax,nuvz,umf,dmf,dz,p1d,dx,dt, &  ! IN &
+            cu_bot1,cu_top1,    &                      ! IN
+            zf,zh,              &                     ! OUT
+            umfzf,dmfzf,fmix)                        ! OUT
+
+        IMPLICIT NONE
+        integer :: nuvzmax,nuvz,ldirection,n1,i,j,k
+        real :: cu_bot1,cu_top1,dx,dt
+        real,dimension(nuvzmax) :: umf,dmf,dz,umfdz,dmfdz,zh, &
+                                    p1d
+   
+        real,dimension(nuvzmax+1) ::  dmfzf,umfzf,zf 
+        real :: t1,t2,fmix,mass
+
+! Compute flux height, here height is above the ground level
+
+        zf(1)=0.0  ! ground level
+        do i=2,nuvz+1
+          zf(i) = zf(i-1) + dz(i)
+          zh(i-1) = 0.5*( zf(i-1) + zf(i) )
+        enddo 
+
+!! cululative dz in cloud level, for reposition option 'well-mixed'
+        do i=1,nuvz
+          umfdz(i) = 0.0
+          dmfdz(i) = 0.0
+          if(umf(i).ne.0.0 .and. i.le.int(cu_top1) &
+             .and.i.ge.int(cu_bot1)) umfdz(i)=dz(i)    ! mixed within cloud
+!          if(umf(i).ne.0.0 .and. i.le.int(cu_top1)      ! mixed between ground and cloud top
+!     &       ) umfdz(i)=dz(i)
+
+          if(dmf(i).ne.0.0) dmfdz(i)=dz(i)
+        enddo
+! assume zero umf or dmf means no-cloud area
+! Nomalize non-zero values (cloud up/downdraft)
+          t1 = 0.0
+          t2 = 0.0
+         do i=1,nuvz
+           t1=t1+umfdz(i)
+           t2=t2+dmfdz(i) 
+         enddo
+
+         if (t1 .gt. 0.0) then 
+          do i=1,nuvz
+            umfdz(i)=umfdz(i)/t1
+          enddo
+         endif
+         if (t2 .gt. 0.0) then
+          DO i=1,nuvz
+            dmfdz(i)=dmfdz(i)/t2
+          ENDDO
+         endif
+
+! Weighted distance stating 0, ending 1.0
+          umfzf(1)=0.0
+          dmfzf(1)=0.0
+          Do i=2,nuvz+1
+            umfzf(i)=0.0
+            dmfzf(i)=0.0
+           if (i .le. int(cu_top1)) &
+            umfzf(i)=umfzf(i-1)+abs(umfdz(i-1)) 
+    
+            dmfzf(i)=dmfzf(i-1)+abs(dmfdz(i-1))
+            if (i .eq. 2)write(*,*)'int(cu_top1)=',int(cu_top1)
+!             write(*,*)i,umfzf(i),umfdz(i)
+          ENDdo 
+! estimate fraction of particles in the convective column will be mixed by cloud
+!   fmix=updraft flux at cloud base*dt/mass below cloud
+!     fmix*dt=fraction
+          mass=abs(p1d(1)-p1d( int(cu_bot1) ))
+          if (mass .le. 5000.0) mass=5000.0 
+          mass=dx*dx*mass/9.81
+          fmix=abs(umf(int(cu_bot1)))*dt/mass
+          write(*,*)'PRE_redist_kf.f, mass=,fmix=',mass,fmix
+     
+       return
+ end subroutine pre_redist_kf
+
+
Index: /branches/jerome/src_flexwrf_v3.1/psih.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/psih.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/psih.f90	(revision 16)
@@ -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/jerome/src_flexwrf_v3.1/psim.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/psim.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/psim.f90	(revision 16)
@@ -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/jerome/src_flexwrf_v3.1/qvsat.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/qvsat.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/qvsat.f90	(revision 16)
@@ -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/jerome/src_flexwrf_v3.1/raerod.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/raerod.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/raerod.f90	(revision 16)
@@ -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/jerome/src_flexwrf_v3.1/ran_mod.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/ran_mod.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/ran_mod.f90	(revision 16)
@@ -0,0 +1,12 @@
+
+    module ran_mod
+
+  !includes OH concentration field as well as the height information
+  !for this field
+
+  implicit none
+  integer :: inext,inextp,iff
+  integer :: ma(55),idummy
+  common  /random/ inext,inextp,iff,ma,idummy
+end module ran_mod
+
Index: /branches/jerome/src_flexwrf_v3.1/random.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/random.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/random.f90	(revision 16)
@@ -0,0 +1,155 @@
+!**********************************************************************
+! 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,inext,inextp,ma,iff)
+
+  implicit none
+
+  integer :: idum
+  real :: random1, random2, fac, v1, v2, r
+  integer :: inext,inextp,ma(55),iff
+  real, external :: ran3
+
+1   v1=2.*ran3(idum,inext,inextp,ma,iff)-1.
+  v2=2.*ran3(idum,inext,inextp,ma,iff)-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,inext,inextp,ma,iff)
+
+  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 
+
+  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/jerome/src_flexwrf_v3.1/ranlux.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/ranlux.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/ranlux.f90	(revision 16)
@@ -0,0 +1,528 @@
+  
+    MODULE luxury
+
+!     Subtract-and-borrow random number generator proposed by
+!     Marsaglia and Zaman, implemented by F. James with the name
+!     RCARRY in 1991, and later improved by Martin Luescher
+!     in 1993 to produce "Luxury Pseudorandom Numbers".
+!     Fortran 77 coded by F. James, 1993
+
+!  References:
+!  M. Luscher, Computer Physics Communications  79 (1994) 100
+!  F. James, Computer Physics Communications 79 (1994) 111
+
+!   LUXURY LEVELS.
+!   ------ ------      The available luxury levels are:
+
+!  level 0  (p=24): equivalent to the original RCARRY of Marsaglia
+!           and Zaman, very long period, but fails many tests.
+!  level 1  (p=48): considerable improvement in quality over level 0,
+!           now passes the gap test, but still fails spectral test.
+!  level 2  (p=97): passes all known tests, but theoretically still
+!           defective.
+!  level 3  (p=223): DEFAULT VALUE.  Any theoretically possible
+!           correlations have very small chance of being observed.
+!  level 4  (p=389): highest possible luxury, all 24 bits chaotic.
+
+!!!! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+!!!!  Calling sequences for RANLUX:                                  ++
+!!!!      CALL RANLUX (RVEC, LEN)   returns a vector RVEC of LEN     ++
+!!!!                   32-bit random floating point numbers between  ++
+!!!!                   zero (not included) and one (also not incl.). ++
+!!!!      CALL RLUXGO(LUX,INT,K1,K2) initializes the generator from  ++
+!!!!               one 32-bit integer INT and sets Luxury Level LUX  ++
+!!!!               which is integer between zero and MAXLEV, or if   ++
+!!!!               LUX .GT. 24, it sets p=LUX directly.  K1 and K2   ++
+!!!!               should be set to zero unless restarting at a break++
+!!!!               point given by output of RLUXAT (see RLUXAT).     ++
+!!!!      CALL RLUXAT(LUX,INT,K1,K2) gets the values of four integers++
+!!!!               which can be used to restart the RANLUX generator ++
+!!!!               at the current point by calling RLUXGO.  K1 and K2++
+!!!!               specify how many numbers were generated since the ++
+!!!!               initialization with LUX and INT.  The restarting  ++
+!!!!               skips over  K1+K2*E9   numbers, so it can be long.++
+!!!!   A more efficient but less convenient way of restarting is by: ++
+!!!!      CALL RLUXIN(ISVEC)    restarts the generator from vector   ++
+!!!!                   ISVEC of 25 32-bit integers (see RLUXUT)      ++
+!!!!      CALL RLUXUT(ISVEC)    outputs the current values of the 25 ++
+!!!!                 32-bit integer seeds, to be used for restarting ++
+!!!!      ISVEC must be dimensioned 25 in the calling program        ++
+!!!! ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+
+IMPLICIT NONE
+
+INTEGER            :: iseeds(24), isdext(25)
+INTEGER, PARAMETER :: maxlev = 4, lxdflt = 3
+INTEGER            :: ndskip(0:maxlev) = (/ 0, 24, 73, 199, 365 /)
+INTEGER            :: next(24), igiga = 1000000000, jsdflt = 314159265
+REAL, PARAMETER    :: twop12 = 4096.
+INTEGER, PARAMETER :: itwo24 = 2**24, icons = 2147483563
+INTEGER            :: luxlev = lxdflt, nskip, inseed, jseed
+LOGICAL            :: notyet = .true.
+INTEGER            :: in24 = 0, kount = 0, mkount = 0, i24 = 24, j24 = 10
+REAL               :: seeds(24), carry = 0., twom24, twom12
+
+!                            default
+!  Luxury Level     0   1   2  *3*    4
+!    ndskip        /0, 24, 73, 199, 365/
+! Corresponds to p=24  48  97  223  389
+!     time factor   1   2   3    6   10   on slow workstation
+!                   1 1.5   2    3    5   on fast mainframe
+
+PUBLIC notyet, i24, j24, carry, seeds, twom24, twom12, luxlev
+PUBLIC nskip, ndskip, in24, next, kount, mkount, inseed
+
+
+CONTAINS
+
+
+SUBROUTINE ranlux(rvec, lenv)
+
+IMPLICIT NONE
+
+INTEGER, INTENT(IN) :: lenv
+REAL, INTENT(OUT)   :: rvec(lenv)
+
+!     Local variables
+
+INTEGER             :: i, k, lp, ivec, isk
+REAL                :: uni
+
+!  NOTYET is .TRUE. if no initialization has been performed yet.
+!              Default Initialization by Multiplicative Congruential
+
+IF (notyet) THEN
+  notyet = .false.
+  jseed = jsdflt
+  inseed = jseed
+  WRITE (6,'(A,I12)') ' RANLUX DEFAULT INITIALIZATION: ', jseed
+  luxlev = lxdflt
+  nskip = ndskip(luxlev)
+  lp = nskip + 24
+  in24 = 0
+  kount = 0
+  mkount = 0
+  WRITE (6,'(A,I2,A,I4)') ' RANLUX DEFAULT LUXURY LEVEL =  ', luxlev,   &
+                          '    p =', lp
+  twom24 = 1.
+  DO i = 1, 24
+    twom24 = twom24 * 0.5
+    k = jseed / 53668
+    jseed = 40014 * (jseed-k*53668) - k * 12211
+    IF (jseed.LT.0) jseed = jseed + icons
+    iseeds(i) = MOD(jseed,itwo24)
+  END DO
+  twom12 = twom24 * 4096.
+  DO i = 1, 24
+    seeds(i) = REAL(iseeds(i)) * twom24
+    next(i) = i - 1
+  END DO
+  next(1) = 24
+  i24 = 24
+  j24 = 10
+  carry = 0.
+  IF (seeds(24).EQ.0.) carry = twom24
+END IF
+
+!          The Generator proper: "Subtract-with-borrow",
+!          as proposed by Marsaglia and Zaman,
+!          Florida State University, March, 1989
+
+DO ivec = 1, lenv
+  uni = seeds(j24) - seeds(i24) - carry
+  IF (uni.LT.0.) THEN
+    uni = uni + 1.0
+    carry = twom24
+  ELSE
+    carry = 0.
+  END IF
+  seeds(i24) = uni
+  i24 = next(i24)
+  j24 = next(j24)
+  rvec(ivec) = uni
+!  small numbers (with less than 12 "significant" bits) are "padded".
+  IF (uni.LT.twom12) THEN
+    rvec(ivec) = rvec(ivec) + twom24 * seeds(j24)
+!        and zero is forbidden in case someone takes a logarithm
+    IF (rvec(ivec).EQ.0.) rvec(ivec) = twom24 * twom24
+  END IF
+!        Skipping to luxury.  As proposed by Martin Luscher.
+  in24 = in24 + 1
+  IF (in24.EQ.24) THEN
+    in24 = 0
+    kount = kount + nskip
+    DO isk = 1, nskip
+      uni = seeds(j24) - seeds(i24) - carry
+      IF (uni.LT.0.) THEN
+        uni = uni + 1.0
+        carry = twom24
+      ELSE
+        carry = 0.
+      END IF
+      seeds(i24) = uni
+      i24 = next(i24)
+      j24 = next(j24)
+    END DO
+  END IF
+END DO
+kount = kount + lenv
+IF (kount.GE.igiga) THEN
+  mkount = mkount + 1
+  kount = kount - igiga
+END IF
+RETURN
+
+END SUBROUTINE ranlux
+
+
+!           Subroutine to input and float integer seeds from previous run
+SUBROUTINE rluxin
+!     the following IF BLOCK added by Phillip Helbig, based on conversation
+!     with Fred James; an equivalent correction has been published by James.
+
+IMPLICIT NONE
+
+!     Local variables
+
+INTEGER             :: i, isd
+
+IF (notyet) THEN
+  WRITE (6,'(A)') ' Proper results ONLY with initialisation from 25 ',  &
+  'integers obtained with RLUXUT'
+  notyet = .false.
+END IF
+
+twom24 = 1.
+DO i = 1, 24
+  next(i) = i - 1
+  twom24 = twom24 * 0.5
+END DO
+next(1) = 24
+twom12 = twom24 * 4096.
+WRITE (6,'(A)') ' FULL INITIALIZATION OF RANLUX WITH 25 INTEGERS:'
+WRITE (6,'(5X,5I12)') isdext
+DO i = 1, 24
+  seeds(i) = REAL(isdext(i)) * twom24
+END DO
+carry = 0.
+IF (isdext(25).LT.0) carry = twom24
+isd = IABS(isdext(25))
+i24 = MOD(isd,100)
+isd = isd / 100
+j24 = MOD(isd,100)
+isd = isd / 100
+in24 = MOD(isd,100)
+isd = isd / 100
+luxlev = isd
+IF (luxlev.LE.maxlev) THEN
+  nskip = ndskip(luxlev)
+  WRITE (6,'(A,I2)') ' RANLUX LUXURY LEVEL SET BY RLUXIN TO: ', luxlev
+ELSE IF (luxlev.GE.24) THEN
+  nskip = luxlev - 24
+  WRITE (6,'(A,I5)') ' RANLUX P-VALUE SET BY RLUXIN TO:', luxlev
+ELSE
+  nskip = ndskip(maxlev)
+  WRITE (6,'(A,I5)') ' RANLUX ILLEGAL LUXURY RLUXIN: ', luxlev
+  luxlev = maxlev
+END IF
+inseed = -1
+RETURN
+
+END SUBROUTINE rluxin
+
+
+!                    Subroutine to ouput seeds as integers
+SUBROUTINE rluxut
+
+IMPLICIT NONE
+
+!     Local variables
+
+INTEGER             :: i
+
+DO i = 1, 24
+  isdext(i) = INT(seeds(i)*twop12*twop12)
+END DO
+isdext(25) = i24 + 100 * j24 + 10000 * in24 + 1000000 * luxlev
+IF (carry.GT.0.) isdext(25) = -isdext(25)
+RETURN
+
+END SUBROUTINE rluxut
+
+
+!                    Subroutine to output the "convenient" restart point
+SUBROUTINE rluxat(lout, inout, k1, k2)
+
+IMPLICIT NONE
+
+INTEGER, INTENT(OUT) :: lout, inout, k1, k2
+
+lout = luxlev
+inout = inseed
+k1 = kount
+k2 = mkount
+RETURN
+
+END SUBROUTINE rluxat
+
+
+!                    Subroutine to initialize from one or three integers
+SUBROUTINE rluxgo(lux, ins, k1, k2)
+
+IMPLICIT NONE
+
+INTEGER, INTENT(IN) :: lux, ins, k1, k2
+
+!     Local variables
+
+INTEGER             :: ilx, i, iouter, isk, k, inner, izip, izip2
+REAL                :: uni
+
+IF (lux.LT.0) THEN
+  luxlev = lxdflt
+ELSE IF (lux.LE.maxlev) THEN
+  luxlev = lux
+ELSE IF (lux.LT.24.OR.lux.GT.2000) THEN
+  luxlev = maxlev
+  WRITE (6,'(A,I7)') ' RANLUX ILLEGAL LUXURY RLUXGO: ', lux
+ELSE
+  luxlev = lux
+  DO ilx = 0, maxlev
+    IF (lux.EQ.ndskip(ilx)+24) luxlev = ilx
+  END DO
+END IF
+IF (luxlev.LE.maxlev) THEN
+  nskip = ndskip(luxlev)
+  WRITE (6,'(A,I2,A,I4)') ' RANLUX LUXURY LEVEL SET BY RLUXGO :', luxlev,  &
+                          '     P=', nskip + 24
+ELSE
+  nskip = luxlev - 24
+  WRITE (6,'(A,I5)') ' RANLUX P-VALUE SET BY RLUXGO TO:', luxlev
+END IF
+in24 = 0
+IF (ins.LT.0) WRITE (6,'(A)') &
+              ' Illegal initialization by RLUXGO, negative input seed'
+IF (ins.GT.0) THEN
+  jseed = ins
+  WRITE (6,'(A,3I12)') ' RANLUX INITIALIZED BY RLUXGO FROM SEEDS', jseed, k1, k2
+ELSE
+  jseed = jsdflt
+  WRITE (6,'(A)') ' RANLUX INITIALIZED BY RLUXGO FROM DEFAULT SEED'
+END IF
+inseed = jseed
+notyet = .false.
+twom24 = 1.
+DO i = 1, 24
+  twom24 = twom24 * 0.5
+  k = jseed / 53668
+  jseed = 40014 * (jseed-k*53668) - k * 12211
+  IF (jseed.LT.0) jseed = jseed + icons
+  iseeds(i) = MOD(jseed,itwo24)
+END DO
+twom12 = twom24 * 4096.
+DO i = 1, 24
+  seeds(i) = REAL(iseeds(i)) * twom24
+  next(i) = i - 1
+END DO
+next(1) = 24
+i24 = 24
+j24 = 10
+carry = 0.
+IF (seeds(24).EQ.0.) carry = twom24
+!        If restarting at a break point, skip K1 + IGIGA*K2
+!        Note that this is the number of numbers delivered to
+!        the user PLUS the number skipped (if luxury .GT. 0).
+kount = k1
+mkount = k2
+IF (k1+k2.NE.0) THEN
+  DO iouter = 1, k2 + 1
+    inner = igiga
+    IF (iouter.EQ.k2+1) inner = k1
+    DO isk = 1, inner
+      uni = seeds(j24) - seeds(i24) - carry
+      IF (uni.LT.0.) THEN
+        uni = uni + 1.0
+        carry = twom24
+      ELSE
+        carry = 0.
+      END IF
+      seeds(i24) = uni
+      i24 = next(i24)
+      j24 = next(j24)
+    END DO
+  END DO
+!         Get the right value of IN24 by direct calculation
+  in24 = MOD(kount,nskip+24)
+  IF (mkount.GT.0) THEN
+    izip = MOD(igiga, nskip+24)
+    izip2 = mkount * izip + in24
+    in24 = MOD(izip2, nskip+24)
+  END IF
+!       Now IN24 had better be between zero and 23 inclusive
+  IF (in24.GT.23) THEN
+    WRITE (6,'(A/A,3I11,A,I5)') &
+               '  Error in RESTARTING with RLUXGO:', '  The values', ins, &
+               k1, k2, ' cannot occur at luxury level', luxlev
+    in24 = 0
+  END IF
+END IF
+RETURN
+
+END SUBROUTINE rluxgo
+
+
+END MODULE luxury
+
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+subroutine luxtst
+!         Exercise for the RANLUX Pseudorandom number generator.
+
+USE luxury
+
+IMPLICIT NONE
+
+REAL    :: rvec(1000)
+INTEGER :: i1, i2, i3, i4, li
+
+!         check that we get the right numbers (machine-indep.)
+WRITE (6,'(/A)') '  CALL RANLUX(RVEC,100)'
+CALL ranlux(rvec,100)
+WRITE (6,'(A/9X,5F12.8)') ' RANLUX default numbers   1-  5:', rvec(1:5)
+CALL ranlux(rvec,100)
+WRITE (6,'(A/9X,5F12.8)') ' RANLUX default numbers 101-105:', rvec(1:5)
+
+WRITE (6,'(/A)') ' CALL RLUXGO(0,0,0,0)'
+CALL rluxgo(0,0,0,0)
+CALL ranlux(rvec,100)
+WRITE (6,'(A/9X,5F12.8)') ' RANLUX luxury level 0,   1-  5:', rvec(1:5)
+CALL ranlux(rvec,100)
+WRITE (6,'(A/9X,5F12.8)') ' RANLUX luxury level 0, 101-105:', rvec(1:5)
+
+WRITE (6,'(/A)') '   CALL RLUXGO(389,1,0,0)'
+CALL rluxgo(389,1,0,0)
+CALL ranlux(rvec,100)
+WRITE (6,'(A/9X,5F12.8)') ' RANLUX luxury p=389,   1-  5:', rvec(1:5)
+CALL ranlux(rvec,100)
+WRITE (6,'(A/9X,5F12.8)') ' RANLUX luxury p=389, 101-105:', rvec(1:5)
+
+WRITE (6,'(/A)') '  CALL RLUXGO(75,0,0,0)'
+CALL rluxgo(75,0,0,0)
+CALL ranlux(rvec,100)
+WRITE (6,'(A/9X,5F12.8)') ' RANLUX luxury p= 75,   1-  5:', rvec(1:5)
+CALL ranlux(rvec,100)
+WRITE (6,'(A/9X,5F12.8)') ' RANLUX luxury p= 75, 101-105:', rvec(1:5)
+
+WRITE (6,'(/A)') '  test restarting from the full vector'
+CALL rluxut
+WRITE (6,'(/A/(1X,5I14))') '  current RANLUX status saved:', isdext
+CALL ranlux(rvec,100)
+WRITE (6,'(A/9X,5F12.8)') ' RANLUX numbers 1- 5:', rvec(1:5)
+CALL ranlux(rvec,100)
+WRITE (6,'(A/9X,5F12.8)') ' RANLUX numbers 101-105:', rvec(1:5)
+
+WRITE (6,'(/A)') '   previous RANLUX status will be restored'
+CALL rluxin
+CALL ranlux(rvec,100)
+WRITE (6,'(A/9X,5F12.8)') ' RANLUX numbers 1- 5:', rvec(1:5)
+CALL ranlux(rvec,100)
+WRITE (6,'(A/9X,5F12.8)') ' RANLUX numbers 101-105:', rvec(1:5)
+
+WRITE (6,'(/A)') '     test the restarting by skipping'
+CALL rluxgo(4,7674985,0,0)
+CALL rluxat(i1,i2,i3,i4)
+WRITE (6,'(A,4I10)') '  RLUXAT values =', i1, i2, i3, i4
+DO li = 1, 10
+  CALL ranlux(rvec,1000)
+END DO
+CALL rluxat(i1,i2,i3,i4)
+WRITE (6,'(A,4I10)') '  RLUXAT values =', i1, i2, i3, i4
+CALL ranlux(rvec,200)
+WRITE (6,'(A,2F10.6)') '  Next and 200th numbers are:', rvec(1), rvec(200)
+CALL rluxgo(i1,i2,i3,i4)
+CALL ranlux(rvec,200)
+WRITE (6,'(A,2F10.6)') '  Next and 200th numbers are:', rvec(1), rvec(200)
+
+WRITE (6,'(/A)') ' The following should provoke an error message'
+CALL rluxgo(4,11111,31,0)
+STOP
+
+!   OUTPUT FROM THE ABOVE TEST PROGRAM SHOULD BE:
+!   --------------------------------------------
+!  CALL RANLUX(RVEC,100)
+! RANLUX DEFAULT INITIALIZATION:    314159265
+! RANLUX DEFAULT LUXURY LEVEL =   3      p = 223
+! RANLUX default numbers   1-  5:
+!           0.53981817  0.76155043  0.06029940  0.79600263  0.30631220
+! RANLUX default numbers 101-105:
+!           0.43156743  0.03774416  0.24897110  0.00147784  0.90274453
+
+!  CALL RLUXGO(0,0,0,0)
+! RANLUX LUXURY LEVEL SET BY RLUXGO : 0     P=  24
+! RANLUX INITIALIZED BY RLUXGO FROM DEFAULT SEED
+! RANLUX luxury level 0,   1-  5:
+!           0.53981817  0.76155043  0.06029940  0.79600263  0.30631220
+! RANLUX luxury level 0, 101-105:
+!           0.41538775  0.05330932  0.58195311  0.91397446  0.67034441
+
+!   CALL RLUXGO(389,1,0,0)
+! RANLUX LUXURY LEVEL SET BY RLUXGO : 4     P= 389
+! RANLUX INITIALIZED BY RLUXGO FROM SEEDS           1           0           0
+! RANLUX luxury p=389,   1-  5:
+!           0.94589490  0.47347850  0.95152789  0.42971975  0.09127384
+! RANLUX luxury p=389, 101-105:
+!           0.02618265  0.03775346  0.97274780  0.13302165  0.43126065
+
+!  CALL RLUXGO(75,0,0,0)
+! RANLUX P-VALUE SET BY RLUXGO TO:   75
+! RANLUX INITIALIZED BY RLUXGO FROM DEFAULT SEED
+! RANLUX luxury p= 75,   1-  5:
+!           0.53981817  0.76155043  0.06029940  0.79600263  0.30631220
+! RANLUX luxury p= 75, 101-105:
+!           0.25600731  0.23443210  0.59164381  0.59035838  0.07011414
+
+!  test restarting from the full vector
+
+!  current RANLUX status saved:
+!       16156027      16534309      15243811       2751687       6002207
+!        7979506       1301976       4567313       4305996       5872599
+!       12003090       2146823      12606367       4111505       5979640
+!       12739666      10489318      14036909      11729352       8061448
+!        7832659       6069758       3197719       1832730      75080216
+! RANLUX numbers 1- 5:
+!           0.22617835  0.60655993  0.86417443  0.43920082  0.23382509
+! RANLUX numbers 101-105:
+!           0.08107197  0.21466845  0.84856731  0.94078046  0.85626233
+
+!   previous RANLUX status will be restored
+! FULL INITIALIZATION OF RANLUX WITH 25 INTEGERS:
+!         16156027    16534309    15243811     2751687     6002207
+!          7979506     1301976     4567313     4305996     5872599
+!         12003090     2146823    12606367     4111505     5979640
+!         12739666    10489318    14036909    11729352     8061448
+!          7832659     6069758     3197719     1832730    75080216
+! RANLUX P-VALUE SET BY RLUXIN TO:   75
+! RANLUX numbers 1- 5:
+!           0.22617835  0.60655993  0.86417443  0.43920082  0.23382509
+! RANLUX numbers 101-105:
+!           0.08107197  0.21466845  0.84856731  0.94078046  0.85626233
+
+!     test the restarting by skipping
+! RANLUX LUXURY LEVEL SET BY RLUXGO : 4     P= 389
+! RANLUX INITIALIZED BY RLUXGO FROM SEEDS     7674985           0           0
+!  RLUXAT values =         4   7674985         0         0
+!  RLUXAT values =         4   7674985    161840         0
+!  Next and 200th numbers are:  0.019648  0.590586
+! RANLUX LUXURY LEVEL SET BY RLUXGO : 4     P= 389
+! RANLUX INITIALIZED BY RLUXGO FROM SEEDS     7674985      161840           0
+!  Next and 200th numbers are:  0.019648  0.590586
+
+! The following should provoke an error message
+! RANLUX LUXURY LEVEL SET BY RLUXGO : 4     P= 389
+! RANLUX INITIALIZED BY RLUXGO FROM SEEDS       11111          31           0
+!  Error in RESTARTING with RLUXGO:
+!  The values      11111         31          0 cannot occur at luxury level    4
+END subroutine luxtst
+
Index: /branches/jerome/src_flexwrf_v3.1/re_initialize_particle.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/re_initialize_particle.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/re_initialize_particle.f90	(revision 16)
@@ -0,0 +1,134 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                *
+!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine,       *
+!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
+!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso,          *
+!* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann,   *
+!*                                                                     *
+!* This file is part of FLEXPART WRF                                   *
+!*                                                                     *
+!* 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 re_initialize_particle(zp,ust,wst,h,sigmaw,wp,nrand,ol)
+!                                      i   i  i   i  i    i/o  i/o 
+!zp: particle position
+!ust: velocity scale
+!wst: velocity scale
+!sigmaw: vertical velcotiy standard deviation
+!wp: particle velocity
+!nrand: random number counter
+!=============== CBL skewed vertical profiles and formulation of LHH 1996 with profile of w3 from lHB 2000   ================================================================
+!=============== LHH formulation has been modified to account for variable density profiles and backward in time or forward in time simulations                             =                    
+!=============== by  Massimo Cassiani ( mc ) , NILU,  2012-2013                                                                                                             =
+!=============== this routine re-initialize particle velocity if a numerical instability in the cbl scheme met a specific condition                                         =
+!=============== (see routine cbl.f90 and Cassiani et al. 2013                                                                                                              =
+!=============== the particle velocity is extracted from the updraft and downdraft distribution as required                                                                 =
+!=============== this re-initialization si not perfectly consistent with teh well-mixed condition see Cassiani et al. 2013 for details but the error introduced is small    =
+!=============== but for the rpesent this is faste and simpler and shoudl be ok                                                                                             =         
+!============================================================================================================================================================================   
+    use par_mod, only:pi
+    use com_mod, only:ldirect,rannumb
+!    use ieee_arithmetic
+ 
+    implicit none
+
+
+    real :: usurad2,usurad2p,C0,costluar4,eps 
+    parameter  (usurad2=0.7071067812,usurad2p=0.3989422804,C0=2,costluar4=0.66667,eps=0.000001)
+
+    integer idum,nrand
+    real :: wp,zp,ust,wst,h,dens,ddens,sigmaw,dsigmawdz,tlw,dcas,dcas1,ran3,gasdev
+    real :: w3,w2,wpold
+    real ::  z, &    
+    skew, &
+    skew2, &
+    radw2, &
+    fluarw,fluarw2, &
+    rluarw, &
+    xluarw, &
+    aluarw, &
+    bluarw, &
+    sigmawa, &
+    sigmawb, &  
+    ath, &
+    bth, &
+    wb,wa 
+    real timedir
+    real ol,transition
+    !---------------------------------------------------------------------------
+!     print*,'INSIDE INIT',zp,ust,wst,h,sigmaw,wp,nrand
+!   wpold=wp 
+          nrand=nrand+1
+     dcas1=rannumb(nrand)
+     timedir=ldirect !direction of time forward (1) or backward(-1)
+    z=zp/h
+     
+     transition=1.  !comment by mc: in this version added transtion fucntion see Cassiani et al. 2013 
+     if (-h/ol.lt.15) transition=((sin((((-h/ol)+10.)/10.)*pi)))/2.+0.5
+    
+     !   w2=((1.7*(z*(1.-0.7*z)*(1.-z))**(2./3.))+1.e-2)*(wst**2)
+    w2=sigmaw*sigmaw !this is correct and use hanna routine if commented it is for test reason 
+    !w3=(((1.2*z*((1.-z)**(3./2.)))+eps)*wst**3) *1.5	!the 1.5 is to test with increased skeweness see also cbl.f90
+     w3=(((1.2*z*((1.-z)**(3./2.)))+eps)*wst**3) *transition !note added a transition fucntion, comemnt by mc
+    skew=w3/(w2**1.5)
+    skew2=skew*skew
+     radw2=sigmaw !sqrt(w2) 
+    
+     if (skew.ne.0) then   ! the  limit must be considered explicitly to avoid NaN
+     fluarw=costluar4*skew**0.333333333333333
+    fluarw2=fluarw*fluarw
+    rluarw=(1.+fluarw2)**3.*skew2/((3.+fluarw2)**2.*fluarw2)  !-> r
+     xluarw=rluarw**0.5 !(1.+fluarw2)**1.5*skew/((3.+fluarw2)*fluarw)    !----> r^1/2
+     else        
+     fluarw=0.
+     fluarw2=0.
+     rluarw=0.        
+     xluarw=0.        
+     end if     
+     
+     aluarw=0.5*(1.-xluarw/(4.+rluarw)**0.5)
+    bluarw=1.-aluarw
+        
+     sigmawa=radw2*(bluarw/(aluarw*(1.+fluarw2)))**0.5
+     sigmawb=radw2*(aluarw/(bluarw*(1.+fluarw2)))**0.5
+
+    wa=(fluarw*sigmawa)
+    wb=(fluarw*sigmawb)
+
+    
+
+    if ((sign(1.,wp)*timedir).gt.0) then !updraft
+     
+100     wp=(dcas1*sigmawa+wa)
+      if (wp.lt.0)  then
+          nrand=nrand+1
+          dcas1=rannumb(nrand)
+          goto 100
+      end if
+     wp=wp*timedir
+    else if ((sign(1.,wp)*timedir).lt.0) then !downdraft
+101     wp=(dcas1*sigmawb-wb)
+      if (wp.gt.0)  then 
+           nrand=nrand+1
+          dcas1=rannumb(nrand)
+          goto 101
+      end if
+      wp=wp*timedir
+    end if   
+!if (ieee_is_nan(wp)) print*,'PROBLEM INSIDE',dcas1,nrand,sigmawa,fluarw,sigmawb,wb,aluarw,fluarw,xluarw,zp,ust,wst,h,sigmaw,wpold,nrand
+         return
+         end
+         
Index: /branches/jerome/src_flexwrf_v3.1/read_ncwrfout.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/read_ncwrfout.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/read_ncwrfout.f90	(revision 16)
@@ -0,0 +1,1016 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                *
+!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine,       *
+!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
+!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso,          *
+!* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann,   *
+!*                                                                     *
+!* This file is part of FLEXPART WRF                                   *
+!*                                                                     *
+!* 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/>.   *
+!***********************************************************************
+
+!**********************************************************************
+! FLEXPART SOURCE FILE READ_NCWRFOUT - CONTAINS                       *
+!                                                                     *
+!    SUBROUTINE READ_NCWRFOUT_GRIDINFO                                *
+!    SUBROUTINE READ_NCWRFOUT_1REALFIELD                              *
+!    SUBROUTINE READ_NCWRFOUT_1DATETIME                               *
+!                                                                     * 
+!**********************************************************************
+!                                                                     * 
+!             AUTHOR:      R. Easter & J. Fast, PNNL                  *
+!             DATE:        2005-autumn-??                             *
+!             LAST UPDATE: same                                       *
+!                                                                     * 
+!**********************************************************************
+!                                                                     *
+! DESCRIPTION:                                                        *
+!                                                                     *
+! These routines read the netcdf wrf output files.                    *
+!                                                                     *
+!       13 JUNE 2007, add more arguments-- ext_scalar,pbl_physcis
+!**********************************************************************
+
+
+!-----------------------------------------------------------------------
+	subroutine read_ncwrfout_gridinfo( ierr, idiagaa, fnamenc, &
+      	  n_west_east, n_south_north, n_bottom_top,  &
+      	  dx_met, dy_met,  &
+      	  m_grid_id, m_parent_grid_id, m_parent_grid_ratio, &
+      	  i_parent_start, j_parent_start, &
+      	  map_proj_id, map_stdlon, map_truelat1, map_truelat2, &
+          ext_scalar,pbl_physics,microphysics)
+!
+!   reads grid definition information from a netcdf wrf output file
+!
+!   arguments
+!	ierr - output - if non-zero, an error occurred 
+!		while opening or reading from the file
+!	idiagaa - input - if positive, testing diagnostics are printed
+!	fnamenc - input - path+filename of the wrf output file
+!	n_west_east - output - east_west dimension of the "T-grid"
+!	n_south_north - output - south_north dimension of the "T-grid"
+!	n_bottom_top - output - bottom_top dimension of the "T-grid"
+!	dx_met, dy_met - output - horizontal grid spacing (m)
+!	m_grid_id - output - grid id number
+!	m_parent_grid_id - output - grid id number of parent grid
+!	m_parent_grid_ratio - output - ratio of parent grid dxy to current grid dxy
+!	i_parent_start, j_parent_start - output - location of lower left corner
+!		of current grid relative to the parent grid.
+!	(if there is no parent grid, then the above 4 "...parent..." variables
+!		area set to -987.)
+!	map_proj_id - WRF map projection id (2=polar stereographic)
+!	map_stdlon - map projection standard longitude (deg)
+!	map_truelat1, truelat2 - map projection true latitudes (deg)
+!
+!       ext_scalar  -- dimension of ex_scalar
+!       pbl_physics  -- type of PBL scheme
+!       microphysics   -- micorphysice scheme used
+
+ 	include 'netcdf.inc'
+!        use netcdf
+!	implicit none
+
+!   arguments
+	integer :: ierr, idiagaa, &
+        n_west_east, n_south_north, n_bottom_top,  &
+        m_grid_id, m_parent_grid_id, m_parent_grid_ratio, &
+        i_parent_start, j_parent_start, map_proj_id, &
+        ext_scalar,pbl_physics,microphysics
+
+	real :: dx_met, dy_met, map_stdlon, map_truelat1, map_truelat2
+
+	character*(*) fnamenc
+
+!   local variables
+	integer,parameter :: maxdim=20
+	integer,parameter :: ibadaa= -987
+	integer,parameter ::  xbadaa= -987
+
+	integer :: i, iatt, idimid_unlim, idum, iret, ivtype
+	integer :: l, lenatt, lendim(maxdim)
+	integer :: natts_tot, ncid, ndims_tot, nvars_tot
+	integer :: n_west_east_stag, n_south_north_stag, n_bottom_top_stag 
+
+	real :: duma
+	real, allocatable, dimension(:) :: duma_alloc
+
+	character(len=80) :: dimname(maxdim)
+	character(len=80) :: attname
+	character(len=1000) :: dumch1000
+
+!   externals
+!	integer nf_close
+!	integer nf_inq
+!	integer nf_inq_dim
+!	integer nf_open
+
+
+
+!   initialize with "missing values"
+	n_west_east = ibadaa
+	n_south_north = ibadaa
+	n_bottom_top = ibadaa
+	dx_met = xbadaa
+	dy_met = xbadaa
+	m_grid_id = ibadaa
+	m_parent_grid_id = ibadaa
+	m_parent_grid_ratio = ibadaa
+	i_parent_start = ibadaa
+	j_parent_start = ibadaa
+        ext_scalar = ibadaa
+        pbl_physics = ibadaa
+        microphysics = ibadaa
+!
+!   open the netcdf file
+!
+	ncid = 10
+!C          write(*,*)'xxx inside read_ncwrfout.f fnamenc=',fnamenc
+!C          write(*,*)'mp_physics=',microphysics
+
+!       print*,'filename ',fnamenc
+	iret = nf_open( fnamenc, NF_NOWRITE, ncid )
+	if (iret .ne. nf_noerr) then
+	    write(*,9100) 'error doing open 123',fnamenc
+!         print*, NF_NOWRITE, ncid,iret
+	    ierr = -1
+	    return
+	end if
+
+9100  format( / '*** read_ncwrfout_gridinfo -- ', a / &
+        'file = ', a )
+9110  format( / '*** read_ncwrfout_gridinfo -- ', a, 1x, i8 / &
+        'file = ', a )
+9120  format( / '*** read_ncwrfout_gridinfo -- ', a, 2(1x,i8) / &
+        'file = ', a )
+
+90030  format( a, 2i6, 2(2x,a) )
+  
+!
+! get information on dimensions
+!
+        iret = nf_inq( ncid,  &
+      		ndims_tot, nvars_tot, natts_tot, idimid_unlim )
+        if (iret .ne. nf_noerr) then
+	    write(*,9100) 'error inquiring dimensions', fnamenc
+	    ierr = -2
+	    return
+	end if
+
+	n_west_east_stag = ibadaa
+	n_south_north_stag = ibadaa
+	n_bottom_top_stag = ibadaa
+
+        do i = 1, min(ndims_tot,maxdim)
+            iret = nf_inq_dim( ncid, i, dimname(i), lendim(i) )
+            if (iret .ne. nf_noerr) then
+		write(*,9110) 'error inquiring dimensions for dim#', i, fnamenc
+		ierr = -2
+		return
+	    end if
+	end do
+
+        do i = 1, min(ndims_tot,maxdim)
+            if (dimname(i) .eq. 'west_east')    &
+      	                       n_west_east = lendim(i)
+            if (dimname(i) .eq. 'south_north') &
+      	                       n_south_north = lendim(i)
+            if (dimname(i) .eq. 'bottom_top')  &
+      	                       n_bottom_top = lendim(i)
+            if (dimname(i) .eq. 'west_east_stag')   &
+      	                       n_west_east_stag = lendim(i)
+            if (dimname(i) .eq. 'south_north_stag') &
+      	                       n_south_north_stag = lendim(i)
+            if (dimname(i) .eq. 'bottom_top_stag')  &
+      	                       n_bottom_top_stag = lendim(i)
+            if (dimname(i) .eq. 'ext_scalar') &
+                               ext_scalar = lendim(i)
+
+	end do
+
+	if (idiagaa .gt. 0) then
+        write(*,9100) 'diagnostics', fnamenc
+        do i = 1, min(ndims_tot,maxdim)
+            write(*,90030) 'dim #, len, name =',  &
+      		i, lendim(i), dimname(i)
+	end do
+	end if
+
+	if ((n_west_east .le. 0) .or. &
+      	    (n_west_east+1 .ne. n_west_east_stag)) then
+	    write(*,9120) 'bad n_west_east, n_west_east_stag = ',  &
+      		n_west_east, n_west_east_stag, fnamenc
+	    ierr = -3
+	    return
+	end if
+
+	if ((n_south_north .le. 0) .or. &
+      	    (n_south_north+1 .ne. n_south_north_stag)) then
+	    write(*,9120) 'bad n_south_north, n_south_north_stag = ',  &
+      		n_south_north, n_south_north_stag, fnamenc
+	    ierr = -3
+	    return
+	end if
+
+	if ((n_bottom_top .le. 0) .or. &
+      	    (n_bottom_top+1 .ne. n_bottom_top_stag)) then
+	    write(*,9120) 'bad n_bottom_top, n_bottom_top_stag = ',  &
+      		n_bottom_top, n_bottom_top_stag, fnamenc
+	    ierr = -3
+	    return
+	end if
+
+!
+!   get information on global attributes
+!
+
+!   first just do diagnostics
+	if (idiagaa .gt. 0) then
+	    write(*,*)
+	    write(*,*) 'attribute #, name, type, value'
+	end if
+	do iatt = 1, natts_tot
+	    iret = nf_inq_attname( ncid, nf_global, iatt, attname)
+            if (iret .ne. nf_noerr) goto 3600
+	    iret = nf_inq_att( ncid, nf_global, attname, ivtype, lenatt )
+            if (iret .ne. nf_noerr) goto 3600
+	    if (ivtype .eq. 2) then
+		iret = nf_get_att_text( ncid, nf_global, attname, dumch1000 )
+        	if (iret .ne. nf_noerr) goto 3600
+		i = max(1,min(1000,lenatt))
+		if (idiagaa .gt. 0) write(*,91010) &
+      			iatt, attname(1:40), ivtype, lenatt, dumch1000(1:i)
+	    else if (ivtype .eq. 4) then
+		iret = nf_get_att_int( ncid, nf_global, attname, idum )
+        	if (iret .ne. nf_noerr) goto 3600
+		if (idiagaa .gt. 0) write(*,91020) &
+      			iatt, attname(1:40), ivtype, lenatt, idum
+	    else if ((ivtype .eq. 5) .and. (lenatt .eq. 1)) then
+		iret = nf_get_att_real( ncid, nf_global, attname, duma )
+        	if (iret .ne. nf_noerr) goto 3600
+		if (idiagaa .gt. 0) write(*,91030) &
+      			iatt, attname(1:40), ivtype, lenatt, duma
+	    else if ((ivtype .eq. 5) .and. (lenatt .gt. 1)) then
+		allocate( duma_alloc(lenatt) )
+		iret = nf_get_att_real( ncid, nf_global, attname, duma_alloc )
+        	if (iret .ne. nf_noerr) goto 3600
+		if (idiagaa .gt. 0) then
+		    write(*,91010) iatt, attname(1:40), ivtype, lenatt
+		    write(*,91040) (duma_alloc(i), i=1,lenatt)
+		end if
+		deallocate( duma_alloc )
+	    else
+		if (idiagaa .gt. 0) write(*,'(i4,1x,a,2(1x,i6))')  &
+      			iatt, attname(1:40), ivtype, lenatt
+		goto 3400
+	    endif
+
+	    if (attname .eq. 'GRID_ID') then
+		m_grid_id = idum
+	    else if (attname .eq. 'PARENT_ID') then
+		m_parent_grid_id = idum
+	    else if (attname .eq. 'PARENT_GRID_RATIO') then
+		m_parent_grid_ratio = idum
+	    else if (attname .eq. 'I_PARENT_START') then
+		i_parent_start = idum
+	    else if (attname .eq. 'J_PARENT_START') then
+		j_parent_start = idum
+	    else if (attname .eq. 'DX') then
+		dx_met = duma
+	    else if (attname .eq. 'DY') then
+		dy_met = duma
+	    else if (attname .eq. 'MAP_PROJ') then
+		map_proj_id = idum
+	    else if (attname .eq. 'STAND_LON') then
+		map_stdlon = duma
+	    else if (attname .eq. 'TRUELAT1') then
+		map_truelat1 = duma
+	    else if (attname .eq. 'TRUELAT2') then
+		map_truelat2 = duma
+            else if (attname .eq. 'BL_PBL_PHYSICS') then
+                pbl_physics  = idum
+            else if (attname .eq. 'MP_PHYSICS') then
+                microphysics  = idum
+	    end if
+        enddo
+3400	continue
+91010	format( i4, 1x, a, 2(1x,i6), 1x, a )
+91020	format( i4, 1x, a, 2(1x,i6), 1x, i10 )
+91030	format( i4, 1x, a, 2(1x,i6), 1x, 1pe12.4 )
+91040	format(( 12x, 5(1pe12.4) ))
+
+	goto 3900
+
+3600	write(*,9110) 'error inquiring attribute', iatt, fnamenc
+	stop
+
+3900	continue
+
+!C        write(*,*)'mp_physics=',microphysics,pbl_physics
+
+!
+!   close and return
+!
+	iret = nf_close( ncid )
+	ierr = 0
+
+	return
+	end subroutine read_ncwrfout_gridinfo
+
+
+
+!-----------------------------------------------------------------------
+	subroutine read_ncwrfout_1datetime( ierr, fnamenc, &
+     	  itime, jyyyymmdd, jhhmmss )
+!
+!   a wrf output file may contain data at multiple time.  This routine returns
+!	the date & time of the "itime" data group in the file.
+!
+!   arguments
+!	ierr - output - if non-zero, an error occurred 
+!		while opening or reading from the file,
+!		or itime < 0, or itime > number of times in the file.
+!	fnamenc - input - path+filename of the wrf output file
+!	itime - input - specifies which data/time to return.  
+!		1 for first, 2 for second, ...
+!	jyyyymmdd - output - date as 8 decimal digits (yyyymmdd).
+!		yyyy=year, mm=month, dd=day of month.
+!	jhhmmss - output - time of day as 6 decimal digits (hhmmss).
+!		hh=hour, mm=minute, ss=second
+!	if (jyyyymmdd=jhhmmss=-1, then ierr is non-zero, and vice-versa)
+!
+
+!        use netcdf
+	include 'netcdf.inc'
+!implicit none
+
+
+!   arguments
+	integer :: ierr, itime, jyyyymmdd, jhhmmss
+	character*(*) fnamenc
+
+!   local variables
+	integer,parameter :: ndims_maxbb=4 ! max number of dimensions for a variable
+
+	integer :: i, id_var, iret, itype_var
+	integer :: iduma, idumb, idumc
+	integer :: id_dim(ndims_maxbb)
+	integer :: istart(ndims_maxbb), icount(ndims_maxbb)
+	integer :: lendim(ndims_maxbb)
+	integer :: natts_tot, ncid, ndims
+
+	character(len=32) timetext
+	character(len=80) varname, varnamenc
+
+!   externals
+!	integer nf_close
+!	integer nf_inq
+!	integer nf_inq_dim
+!	integer nf_open
+
+
+
+	jyyyymmdd = -1
+	jhhmmss = -1
+
+!
+!   open the netcdf file
+!
+	ncid = 10
+	iret = nf_open( fnamenc, NF_NOWRITE, ncid )
+	if (iret .ne. nf_noerr) then
+	    write(*,9100) 'error doing open 370', fnamenc
+	    ierr = -1
+	    goto 8100
+	end if
+
+9100	format( / '*** read_ncwrfout_1datetime -- ', a / &
+        'file = ', a )
+9110  format( / '*** read_ncwrfout_1datetime -- ', a, 1x, i8 / &
+        'file = ', a )
+9120  format( / '*** read_ncwrfout_1datetime -- ', a, 2(1x,i8) / &
+        'file = ', a )
+9130  format( / '*** read_ncwrfout_1datetime -- ', a, 3(1x,i8) / &
+        'file = ', a )
+9115  format( / '*** read_ncwrfout_1datetime -- ', a / a, 1x, i8 / &
+        'file = ', a )
+9125  format( / '*** read_ncwrfout_1datetime -- ', a / a, 2(1x,i8) / &
+        'file = ', a )
+9135  format( / '*** read_ncwrfout_1datetime -- ', a / a, 3(1x,i8) / &
+        'file = ', a )
+
+90030  format( a, 2i6, 2(2x,a) )
+  
+!
+! get information on the variable
+!
+  varname = 'Times'
+        iret = nf_inq_varid( ncid, varname, id_var )
+        if (iret .ne. nf_noerr) then
+	    write(*,9100) 'error inquiring var id for ' // varname, fnamenc
+	    ierr = -1
+	    goto 8100
+	end if
+
+        iret = nf_inq_var( ncid, id_var,  &
+      		varnamenc, itype_var, ndims, id_dim, natts_tot )
+        if (iret .ne. nf_noerr) then
+	    write(*,9100) 'error inquiring var info for ' // varname, fnamenc
+	    ierr = -1
+	    goto 8100
+	end if
+
+!   check variable type
+	if (itype_var .ne. nf_char) then
+	    write(*,9110) 'var type wrong for ' // varname,  &
+      		itype_var, fnamenc
+	    ierr = -1
+	    goto 8100
+	end if
+
+
+!   check number of dimensions
+	if (ndims .ne. 2) then
+	    write(*,9115) 'var ndims is wrong for ' // varname,  &
+      		'ndims =', ndims, fnamenc
+	    ierr = -1
+	    goto 8100
+	end if
+
+!   get sizes of dimensions
+!   dimension 1 = # of characters in date/time string
+!   dimension 2 = # of times in the file
+	do i = 1, ndims
+	    iret = nf_inq_dimlen( ncid, id_dim(i), lendim(i) )
+	    if (iret .ne. nf_noerr) then
+		write(*,9115) 'error inquiring var dim len for ' // varname, &
+      			'idim =', i, fnamenc
+		ierr = -1
+		goto 8100
+	    end if
+	end do
+
+	if (itime .lt. 1) then
+	    ierr = -11
+	    goto 8100
+	else if (itime .gt. lendim(2)) then
+	    ierr = -12
+	    goto 8100
+        end if
+
+!   get the data and extract the data & time
+	do i = 1, ndims_maxbb
+	    istart(i) = 1
+	    icount(i) = 1
+	end do
+	istart(1) = 1
+	icount(1) = lendim(1)
+	istart(2) = itime
+	icount(2) = 1
+	iret = nf_get_vara_text( ncid, id_var, istart, icount, timetext )
+        if (iret .ne. nf_noerr) then
+	    write(*,9100) 'error reading var data for ' // varname,  &
+      		fnamenc
+	    ierr = -1
+	    goto 8100
+	end if
+
+	read( timetext, '(i4,1x,i2,1x,i2)', iostat=iret )  &
+      		iduma, idumb, idumc
+	if (iret .ne. 0) then
+	    write(*,9125) &
+      		'error reading from timetext = "' // timetext // '"', &
+      		'itime, lendim(1) =', itime, lendim(1), fnamenc
+	    ierr = -1
+	    goto 8100
+	end if
+	jyyyymmdd = iduma*10000 + idumb*100 + idumc
+
+	read( timetext, '(11x,i2,1x,i2,1x,i2)', iostat=iret )  &
+      		iduma, idumb, idumc
+	if (iret .ne. 0) then
+	    write(*,9125) &
+      		'error reading from timetext = "' // timetext // '"', &
+      		'itime, lendim(1) =', itime, lendim(1), fnamenc
+	    ierr = -1
+	    goto 8100
+	end if
+	jhhmmss = iduma*10000 + idumb*100 + idumc
+
+!
+!   success - close and return
+!
+	iret = nf_close( ncid )
+	ierr = 0
+	return
+
+!
+!   failure - close and return
+!
+8100	iret = nf_close( ncid )
+	return
+
+	end subroutine read_ncwrfout_1datetime
+
+
+
+!-----------------------------------------------------------------------
+	subroutine read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+      	  varname, vardata, &
+      	  itime, &
+      	  ndims, ndims_exp, ndims_max, &
+      	  lendim, lendim_exp, lendim_max )
+!
+!   reads of real (single precision) field at one time from a netcdf wrf output file
+!
+!   arguments
+!	ierr - output - if non-zero, an error occurred 
+!		while opening or reading from the file
+!		 -1 = error opening file
+!		 -2 = requested variable is not in the file
+!		 -3 = error while inquiring about the variable
+!		 -4 = variable type is other than real (single precision)
+!		... = check below, in the code, for explanation of other ierr values.
+!	idiagaa - input - if positive, testing diagnostics are printed
+!	fnamenc - input - path+filename of the wrf output file
+!	varname - input - field name
+!	vardata - output - the data for the field
+!	itime - input - specifies which time to read.  
+!		(1 for first time in the file, 2 for second, ...)
+!	ndims - output - number of (netcdf) dimensions of the field.  
+!		This includes the time dimension.
+!	ndims_exp - input - expected number of dimensions of the field.  
+!		An error occurs if ndims .ne. ndims_exp.
+!	ndims_max - input - The dimension/size of the lendim_... arrays.
+!	lendim - output - The size of each of the "ndims" dimensions.
+!	lendim_exp - input - The expected size of each of the "ndims" dimensions.
+!		If lendim_exp .gt. 0, then an error occurs if lendim .ne. lendim_exp.
+!	lendim_max - input - The maximum size of each dimension.  These are
+!		The dimensions of the vardata array.
+!
+!        use netcdf
+	include 'netcdf.inc'
+!implicit none
+
+
+!   arguments
+	integer :: ierr, idiagaa, itime, &
+      	  ndims, ndims_exp, ndims_max, &
+      	  lendim(ndims_max), lendim_exp(ndims_max),   &
+      	  lendim_max(ndims_max)
+
+	real :: vardata( lendim_max(1), lendim_max(2), lendim_max(3) )
+
+	character*(*) fnamenc, varname
+
+!   local variables
+	integer,parameter :: ndims_maxbb=4 ! max number of dimensions for a variable
+	integer,parameter :: ibadaa=-987
+	integer,parameter :: xbadaa=-987
+	integer,parameter :: ijktestmax=500
+
+	integer :: i, iatt, id_var, iret, itype_var
+	integer :: itot, ijktot, ii
+	integer :: id_dim(ndims_maxbb)
+	integer :: istart(ndims_maxbb), icount(ndims_maxbb)
+	integer :: j, jtot, jj
+	integer :: k, ktot, kk
+	integer :: l, lenatt
+	integer :: lendim_use(ndims_maxbb)
+	integer :: m
+	integer :: natts_tot, ncid, ndiffa, ndiffb
+
+	real :: duma, dumb
+	real :: testavg(ijktestmax,3,2), &
+      	    testmin(ijktestmax,3,2), testmax(ijktestmax,3,2)
+
+	character(len=80) varnamenc
+	character(len=80) dimname(ndims_maxbb)
+
+!   externals
+!	integer nf_close
+!	integer nf_inq
+!	integer nf_inq_dim
+!	integer nf_open
+
+!        print*,'dim array',lendim_max(1), lendim_max(2), lendim_max(3)
+
+!
+!   open the netcdf file
+!
+	ncid = 10
+	iret = nf_open( fnamenc, NF_NOWRITE, ncid )
+	if (iret .ne. nf_noerr) then
+	    write(*,9100) 'error doing open 592', fnamenc
+	    ierr = -1
+	    return
+	end if
+
+9100  format( / '*** read_ncwrfout_1realfield -- ', a / &
+        'file = ', a ) 
+9110  format( / '*** read_ncwrfout_1realfield -- ', a, 1x, i8 / &
+        'file = ', a )
+9120  format( / '*** read_ncwrfout_1realfield -- ', a, 2(1x,i8) / &
+        'file = ', a )
+9130  format( / '*** read_ncwrfout_1realfield -- ', a, 3(1x,i8) / &
+        'file = ', a )
+9115  format( / '*** read_ncwrfout_1realfield -- ', a / a, 1x, i8 / &
+       'file = ', a )
+9125  format( / '*** read_ncwrfout_1realfield -- ', a / a, 2(1x,i8) / &
+        'file = ', a )
+9135  format( / '*** read_ncwrfout_1realfield -- ', a / a, 3(1x,i8) / &
+        'file = ', a )
+
+90030  format( a, 2i6, 2(2x,a) )
+  
+!
+! get information on the variable
+!
+        iret = nf_inq_varid( ncid, varname, id_var )
+        if (iret .ne. nf_noerr) then
+!	    write(*,9100) 'error inquiring var id for ' // varname, fnamenc
+	    ierr = -2
+	    goto 8100
+	end if
+
+        iret = nf_inq_var( ncid, id_var,  &
+      		varnamenc, itype_var, ndims, id_dim, natts_tot )
+        if (iret .ne. nf_noerr) then
+	    write(*,9100) 'error inquiring var info for ' // varname, fnamenc
+	    ierr = -3
+	    goto 8100
+	end if
+
+!   check variable type
+	if (itype_var .ne. nf_real) then
+	    write(*,9110) 'var type wrong for ' // varname,  &
+      		itype_var, fnamenc
+	    ierr = -4
+	    goto 8100
+	end if
+
+
+!   check number of dimensions
+	if (ndims_exp .le. 0) then
+	    write(*,9115)  &
+      		'bad ndims_exp for ' // varname,  &
+      		'ndims_exp =', ndims_exp, fnamenc
+	    ierr = -11
+	    goto 8100
+	end if
+	if (ndims .ne. ndims_exp) then
+	    write(*,9125) 'var ndims mismatch for ' // varname,  &
+      		'ndims_exp, ndims =', ndims_exp, ndims, fnamenc
+	    ierr = -12
+	    goto 8100
+	end if
+	if (ndims .gt. ndims_max) then
+	    write(*,9125) 'var ndims > ndims_max for ' // varname,  &
+      		'ndims, ndims_max =', ndims, ndims_max, fnamenc
+	    ierr = -13
+	    goto 8100
+	end if
+	if (ndims .gt. ndims_maxbb) then
+	    write(*,9125) 'var ndims > ndims_maxbb for ' // varname,  &
+      		'ndims, ndims_maxbb =', ndims, ndims_maxbb, fnamenc
+	    ierr = -14
+	    goto 8100
+	end if
+
+!   check size of each dimension
+	do i = 1, ndims_exp
+            iret = nf_inq_dimlen( ncid, id_dim(i), lendim(i) )
+            if (iret .ne. nf_noerr) then
+		write(*,9110) 'error inquiring var dim len for ' // varname, &
+      			i, fnamenc
+		ierr = -15
+		goto 8100
+	    end if
+	    if ((i .lt. ndims_exp) .and. (lendim_exp(i) .gt. 0) .and.  &
+      	        (lendim(i) .ne. lendim_exp(i))) then
+!           print*,i,ndims_exp,lendim_exp(i),lendim(i),lendim_exp(i) 
+		write(*,9130) 'var lendim mismatch for ' // varname,  &
+      		    i, lendim_exp(i), lendim(i), fnamenc
+		ierr = -16
+		goto 8100
+	    end if
+	    if ((i .lt. ndims_exp) .and.  &
+      		(lendim(i) .gt. lendim_max(i))) then
+		write(*,9130) 'var lendim too big for ' // varname,  &
+      		    i, lendim_max(i), lendim(i), fnamenc
+		ierr = -17
+		goto 8100
+	    end if
+	    if ((i .eq. ndims_exp) .and. (lendim(i) .lt. itime)) then  
+		write(*,9130) 'var itime < ntimes for ' // varname,  &
+      		    i, itime, lendim(i), fnamenc
+		ierr = -18
+		goto 8100
+	    end if
+	end do
+
+!   do diagnostics on the dimensions
+	if (idiagaa .gt. 0) then
+	  write(*,'(/a)')  &
+      		'read_ncwrfout_1realfield - dim info for var = ' //  &
+      		varname(1:20)
+	  do i = 1, ndims
+            iret = nf_inq_dim( ncid, id_dim(i), dimname(i), lendim(i) )
+            if (iret .ne. nf_noerr) then
+		write(*,9115) 'error inquiring var dim info for ' // varname, &
+      			'idim =', i, fnamenc
+		ierr = -19
+		goto 8100
+	    end if
+	    write(*,'(a,3i5,2x,a)') '     i,id,len,name =',  &
+      		i, id_dim(i), lendim(i), dimname(i)(1:32)
+	  end do
+	end if
+
+!
+!   get the data
+!
+	do i = 1, ndims_maxbb
+	    istart(i) = 1
+	    icount(i) = 1
+	end do
+	do i = 1, ndims_exp - 1
+	    istart(i) = 1
+	    icount(i) = lendim(i)
+	end do
+!   in wrfout files, the last dimension should always be time
+	istart(ndims_exp) = itime
+	icount(ndims_exp) = 1
+
+	iret = nf_get_vara_real( ncid, id_var, istart, icount, vardata )
+        if (iret .ne. nf_noerr) then
+	    write(*,9120) 'error reading var data for ' // varname,  &
+      		fnamenc
+	    ierr = -21
+	    goto 8100
+	end if
+
+!
+!   reorder the data
+!
+	lendim_use(1) = lendim(1)
+	lendim_use(2) = 1
+	if (ndims_exp .ge. 3) lendim_use(2) = lendim(2)
+	lendim_use(3) = 1
+	if (ndims_exp .ge. 4) lendim_use(3) = lendim(3)
+
+!      print*,'dim to go',lendim_use(1),lendim_use(2),lendim_use(3) 
+!        print*,'value in',lendim_use, lendim_max
+	call reorder_ncwrfout_1realfield( ierr, idiagaa,  &
+      	  varname, vardata, vardata, &
+      	  lendim_use, lendim_max )
+
+	if (ierr .ne. 0) then
+	    print*, 'error re-ordering var data for ', varname,  &
+      		fnamenc
+	    ierr = -22
+	    goto 8100
+	end if
+
+!
+!   success - close and return
+!
+	iret = nf_close( ncid )
+	ierr = 0
+	return
+
+!
+!   error - close and return
+!
+8100	iret = nf_close( ncid )
+	return
+
+	end subroutine read_ncwrfout_1realfield
+
+
+
+!-----------------------------------------------------------------------
+	subroutine reorder_ncwrfout_1realfield( ierr, idiagaa,  &
+      	  varname, vardata_in, vardata_out, &
+      	  lendim_use, lendim_max )
+!
+!   reorders a real (single precision) field 
+!	the nf_get_vara_real loads the data for a field into 
+!	    a contiguous block of memory starting at vardata(1,1,1)
+!	it does not know if perhaps lendim() < lendim_max()
+!	this routine corrects for that, so that the data are
+!	    loaded into non-contiguous blocks when lendim() < lendim_max()
+!
+!   arguments
+!	ierr - output - if non-zero, an error occurred while re-ordering
+!	idiagaa - input - if positive, testing diagnostics are printed
+!	varname - input - field name
+!
+!	vardata_in  - input  - the data for the field
+!	vardata_out - output - the data for the field
+!		In the calling program, vardata_in & vardata_out are usually
+!		the same array.  This routine "pretends" that they are 
+!		different, and specifies their dimensions differently,
+!		to facilitate the reordering.
+!
+!	lendim_use - input - The actual size of the spatial dimensions of the field.
+!	lendim_max - input - The actual spatial dimensions of the vardata array.
+!		Most wrf fields are spatially either 1d (z), 2d (xy), or 3d (xyz).
+!		For a 1d spatial field (e.g., z only), set
+!		    lendim_use(1) = nz,  lendim_max(1) = nz_max
+!		    lendim_use(2) = 1,   lendim_max(2) = 1
+!		    lendim_use(3) = 1,   lendim_max(3) = 1
+!		For a 2d spatial field (e.g., xy only), set
+!		    lendim_use(1) = nx,  lendim_max(1) = nx_max
+!		    lendim_use(2) = ny   lendim_max(2) = ny_max
+!		    lendim_use(3) = 1,   lendim_max(3) = 1
+!		For a 3d spatial field (xyz), set
+!		    lendim_use(1) = nx,  lendim_max(1) = nx_max
+!		    lendim_use(2) = ny   lendim_max(2) = ny_max
+!		    lendim_use(3) = nz   lendim_max(3) = nz_max
+!
+
+!        use netcdf
+	include 'netcdf.inc'
+!implicit none
+
+
+!   arguments
+	integer :: ierr, idiagaa,  &
+      	  lendim_use(3), lendim_max(3)
+
+	real :: vardata_in(  lendim_use(1), lendim_use(2), lendim_use(3) )
+	real :: vardata_out( lendim_max(1), lendim_max(2), lendim_max(3) )
+
+	character*(*) varname
+
+!   local variables
+	integer,parameter :: ijktestmax=500
+	integer,parameter :: check_reordering=1
+
+	integer :: i, j, k, m, n
+	integer :: itestend, jtestend, ktestend
+	integer :: ijk, ijktestend
+	integer :: ndiffa, ndiffb
+
+	real :: duma, dumb
+	real :: testavg(ijktestmax,3,2),  &
+      	    testmin(ijktestmax,3,2), testmax(ijktestmax,3,2)
+
+!
+!   the testavg/min/max are avg, min, and max values for
+!	a i (or j or k) fixed and j,k (or i,k or i,j) varying
+!   they are computed before and after the data has been reordered
+!	then compared at the end
+!   an error occurs if they do not match
+!
+!       print*,'size in out',lendim_use(1), lendim_use(2), lendim_use(3)
+!       print*,'size in out',lendim_max(1), lendim_max(2), lendim_max(3)
+	if (check_reordering .gt. 0) then
+
+	do n = 1, 2
+	do m = 1, 3
+	do i = 1, ijktestmax
+	    testavg(i,m,n) = 0.0
+	    testmin(i,m,n) = +1.0e37
+	    testmax(i,m,n) = -1.0e37
+	end do
+	end do
+	end do
+!          print*,varname
+	ktestend = min( ijktestmax, lendim_use(3) )
+	jtestend = min( ijktestmax, lendim_use(2) )
+	itestend = min( ijktestmax, lendim_use(1) )
+!      print*,'ktestend',ktestend
+!   pass 1 -- compute the test---(:,:,1) from vardata_in
+	do k = 1, ktestend
+	do j = 1, jtestend
+	do i = 1, itestend
+	    duma = vardata_in(i,j,k)
+	    testavg(i,1,1) =      testavg(i,1,1) + duma
+	    testmin(i,1,1) = min( testmin(i,1,1),  duma )
+	    testmax(i,1,1) = max( testmax(i,1,1),  duma )
+	    testavg(j,2,1) =      testavg(j,2,1) + duma
+	    testmin(j,2,1) = min( testmin(j,2,1),  duma )
+	    testmax(j,2,1) = max( testmax(j,2,1),  duma )
+	    testavg(k,3,1) =      testavg(k,3,1) + duma
+	    testmin(k,3,1) = min( testmin(k,3,1),  duma )
+	    testmax(k,3,1) = max( testmax(k,3,1),  duma )
+	end do
+	end do
+	end do
+
+	end if    ! if (check_reordering .gt. 0) then
+
+!   pass 2 -- shift the data values
+!         print*,'max',lendim_max
+	do k = lendim_use(3), 1, -1
+	do j = lendim_use(2), 1, -1
+	do i = lendim_use(1), 1, -1
+!         print*,i,j,k
+	    vardata_out(i,j,k) = vardata_in(i,j,k)
+	end do
+	end do
+	end do
+
+!   pass 3 -- compute the test---(:,:,2) from vardata_out
+	if (check_reordering .gt. 0) then
+
+	do k = 1, ktestend
+	do j = 1, jtestend
+	do i = 1, itestend
+	    duma = vardata_out(i,j,k)
+	    testavg(i,1,2) =      testavg(i,1,2) + duma
+	    testmin(i,1,2) = min( testmin(i,1,2),  duma )
+	    testmax(i,1,2) = max( testmax(i,1,2),  duma )
+	    testavg(j,2,2) =      testavg(j,2,2) + duma
+	    testmin(j,2,2) = min( testmin(j,2,2),  duma )
+	    testmax(j,2,2) = max( testmax(j,2,2),  duma )
+	    testavg(k,3,2) =      testavg(k,3,2) + duma
+	    testmin(k,3,2) = min( testmin(k,3,2),  duma )
+	    testmax(k,3,2) = max( testmax(k,3,2),  duma )
+	end do
+	end do
+	end do
+
+!   now compare the test---(:,:,1) & test---(:,:,2)
+	ndiffb = 0
+	do m = 1, 3
+	    if (m .eq. 1) then
+		ijktestend = itestend
+		duma = 1.0/(jtestend*ktestend)
+		if (idiagaa .gt. 0) write(*,'(a,a)') varname(1:20), &
+      			'i, testavg(i,1), testmin(i,1), testmax(i,1)'
+	    else if (m .eq. 2) then
+		ijktestend = jtestend
+		duma = 1.0/(itestend*ktestend)
+		if (idiagaa .gt. 0) write(*,'(a,a)') varname(1:20), &
+      			'j, testavg(j,2), testmin(j,2), testmax(j,2)'
+	    else
+		ijktestend = ktestend
+		duma = 1.0/(itestend*jtestend)
+		if (idiagaa .gt. 0) write(*,'(a,a)') varname(1:20), &
+      			'k, testavg(k,3), testmin(k,3), testmax(k,3)'
+	    end if
+
+	    ndiffa = 0
+	    do ijk = 1, ijktestend
+		i = ijk
+		dumb = max( abs(testavg(i,m,1)), abs(testavg(i,m,2)) )*2.0e-7
+		if (abs(testavg(i,m,1)-testavg(i,m,2)) .gt. dumb) ndiffa = ndiffa + 1
+		dumb = max( abs(testmin(i,m,1)), abs(testmin(i,m,2)) )*2.0e-7
+		if (abs(testmin(i,m,1)-testmin(i,m,2)) .gt. dumb) ndiffa = ndiffa + 1
+		dumb = max( abs(testmax(i,m,1)), abs(testmax(i,m,2)) )*2.0e-7
+		if (abs(testmax(i,m,1)-testmax(i,m,2)) .gt. dumb) ndiffa = ndiffa + 1
+	    end do
+
+	    if (ndiffa .le. 0) then
+		if (idiagaa .gt. 0) write(*,*) '     *** no differences'
+	    else
+	      do ijk = 1, ijktestend
+		i = ijk
+		if (idiagaa .gt. 0) write(*,'(i3,1p,3(2x,2e11.3))') i, &
+      		    testavg(i,m,1)*duma,  &
+      		    (testavg(i,m,1)-testavg(i,m,2))*duma,  &
+      		    testmin(i,m,1), (testmin(i,m,1)-testmin(i,m,2)), &
+      		    testmax(i,m,1), (testmax(i,m,1)-testmax(i,m,2))
+	      end do
+	    end if
+
+	    ndiffb = ndiffb + ndiffa
+	end do
+
+	if (ndiffb .gt. 0) then
+	    ierr = -12
+	    goto 8100
+	end if
+
+	end if    ! if (check_reordering .gt. 0) then
+
+!
+!   success
+!
+	ierr = 0
+	return
+
+!
+!   error
+!
+8100	return
+
+	end subroutine reorder_ncwrfout_1realfield
+
+
+
Index: /branches/jerome/src_flexwrf_v3.1/readdepo.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/readdepo.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/readdepo.f90	(revision 16)
@@ -0,0 +1,146 @@
+!**********************************************************************
+! 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', &
+   open(unitwesely,file='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/jerome/src_flexwrf_v3.1/readinput.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/readinput.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/readinput.f90	(revision 16)
@@ -0,0 +1,2014 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                *
+!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine,       *
+!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
+!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso,          *
+!* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann,   *
+!*                                                                     *
+!* This file is part of FLEXPART WRF                                   *
+!*                                                                     *
+!* 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 readinput
+!*******************************************************************************
+!                                                                              *
+!     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                                                          *
+!                                                                              *
+!*******************************************************************************
+!                                                                              *
+! Variables:                                                                   *
+! len(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
+      use outg_mod
+      use point_mod
+!      use xmass_mod
+
+      implicit none
+!      include 'includepar'
+!      include 'includecom'
+
+      integer :: i, j, numtable,numpoint2
+      integer :: hhh,mi,ss,pos_spec
+      character(len=50) :: line
+      logical :: old
+      integer :: idiff,ldat,ltim,wftime1(maxwf),numbwfn(maxnests),k
+      integer :: wftime1n(maxnests,maxwf),wftimen(maxnests,maxwf)
+      real(kind=dp) :: jul,juldate,beg,end,jul1,jul2
+!      double precision juldate,jul,beg,end,jul1,jul2
+      character(len=80) :: fname,wfname1(maxwf),wfname1n(maxnests,maxwf)
+      character(len=10) :: spec, wfspec1(maxwf),wfspec1n(maxnests,maxwf)
+      real :: outhelp,xr,xr1,yr,yr1
+      real :: xtmp, xtmp1, xtmp2, ytmp, ytmp1, ytmp2
+! 10-mar-2006 rce - flexpart_wrf - eps should be a small dx/dy value in meters
+!     parameter(eps=1.e-4)
+      real,parameter :: eps=10.0
+      real :: x,y,xm,ym
+      character(len=16) ::  receptor
+      integer :: numpartmax,id1,it1,id2,it2,idow,ihour
+      integer :: emitvar,stat,nparttot,nparttot2,outgriddef,outgriddefn
+      real :: vsh(ni),fracth(ni),schmih(ni),releaserate,releaserate2
+      character(len=3) :: aspecnumb
+      character(len=10) :: specname(maxtable)
+      real :: cun
+      logical :: spec_found
+! Read the pathname information stored in unitpath
+!*************************************************
+      nparttot=0
+!     print*,'path2'
+!     print*,'path',unitpath
+!     open(unitpath,file='flexwrf.input',status='old',err=801)
+      open(unitpath,file=inputname,status='old',err=801)
+
+! jdf start read pathnames
+!*************************************************
+      call skplin(1,unitpath)
+      do i=1,numpath
+        read(unitpath,'(a)',err=800) path(i) 
+        length(i)=index(path(i),' ')-1
+      enddo
+
+! 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
+      enddo
+
+      if (path(numpath+2*(i-1)+1)(1:5).ne.'=====') then
+        write(*,*) ' #### FLEXPART MODEL ERROR! NUMBER OF PATHS   #### '
+        write(*,*) ' #### IN FORMER PATHNAMES FILE GREATER THAN   #### '
+        write(*,*) ' #### MAXNESTS IN PAR_MOD.F90, INCREASE THIS  #### '
+        write(*,*) ' #### OR REMOVE EXTRA PATHS FROM PATHNAMES    #### '
+        stop
+      endif
+
+! Determine number of available nested domains
+!*********************************************
+
+30    numbnests=i-1
+
+! jdf end read pathnames
+!*************************************************
+! jdf start read command
+!*************************************************
+!
+!*******************************************************************************
+!                                                                              *
+!     Note:  This is the FLEXPART_WRF version of subroutine readcommand.       *
+!                                                                              *
+!     This routine reads the user specifications for the current model run.    *
+!                                                                              *
+!     Author: A. Stohl                                                         *
+!                                                                              *
+!     18 May 1996                                                              *
+!                                                                              *
+!     Nov-Dec-2005, R. Easter - input turb_option, add_sfc_level, iouttype     *
+!                                                                              *
+!*******************************************************************************
+!                                                                              *
+! Variables:                                                                   *
+! bdate                beginning date as Julian date                           *
+! ctl                  factor by which time step must be smaller than          *
+!                      Lagrangian time scale                                   *
+! edate                ending date as Julian date                              *
+! hhh                  hour                                                    *
+! 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            *
+! 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     *
+! mi                   minute                                                  *
+! ss                   second                                                  *
+!                                                                              *
+! Constants:                                                                   *
+! unitcommand          unit connected to file COMMAND                          *
+!  
+!  9-10-2007, W Wang                                                                            *
+!  add turb_option_tke and turb_option_mytke
+!  1 Oct, 2007
+!  add dt_conv input,  time intervals to call convection, seconds
+!*******************************************************************************
+
+
+! Open the command file and read user options
+!********************************************
+
+      read(unitcommand,*) ldirect
+      read(unitcommand,*) ibdate,ibtime
+      read(unitcommand,*) iedate,ietime
+      read(unitcommand,*) loutstep
+      read(unitcommand,*) loutaver
+      read(unitcommand,*) loutsample
+      read(unitcommand,*) itsplit
+      read(unitcommand,*) lsynctime
+      read(unitcommand,*) ctl
+      read(unitcommand,*) ifine
+      read(unitcommand,*) iout
+      read(unitcommand,*) ipout
+      read(unitcommand,*) lsubgrid
+      read(unitcommand,*) lconvection
+      read(unitcommand,*) dt_conv
+      read(unitcommand,*) lagespectra
+      read(unitcommand,*) ipin
+      read(unitcommand,*) iflux
+      read(unitcommand,*) ioutputforeachrelease
+      read(unitcommand,*) mdomainfill
+      read(unitcommand,*) ind_source
+      read(unitcommand,*) ind_receptor
+      read(unitcommand,*) nested_output
+      read(unitcommand,*) linit_cond
+!      if(nested_output.ge.1) then
+!        write(*,'(/a/a/a/)') &
+!            '*** Nested grid output is not fully implemented ***', &
+!            '*** Set NESTED_OUTPUT=0 in COMMAND file         ***'
+!        stop
+!      endif
+! FLEXPART_WRF - read turb_option, add_sfc_level
+      read(unitcommand,*) turb_option
+      read(unitcommand,*) cblflag  ! added by mc for cbl option
+!     read(unitcommand,*) add_sfc_level
+      add_sfc_level=1
+      read(unitcommand,*) sfc_option
+      read(unitcommand,*) wind_option
+      read(unitcommand,*) time_option
+      read(unitcommand,*) outgrid_option
+      read(unitcommand,*) numpoint_option
+      read(unitcommand,*) iouttype
+      read(unitcommand,*) ncnumrec
+      read(unitcommand,*) option_verbose
+
+      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 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               #### '
+        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               #### '
+        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.0).or.(iout.gt.5)) then
+!       write(*,*) ' #### FLEXPART MODEL ERROR! FILE COMMAND:     #### '
+!       write(*,*) ' #### IOUT MUST BE 0, 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!             :     #### '
+    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!             :     ####'
+      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!             :     ####'
+      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
+  !*****************************************************************************
+
+!    print*,'ioutput',ioutputforeachrelease,ldirect
+  if ((ldirect.lt.0).and.(ioutputforeachrelease.eq.0)) then
+      write(*,*) '#### FLEXPART MODEL ERROR!             :     ####'
+      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!             :     ####'
+      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!             :     ####'
+      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!             :     ####'
+      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!             :     #### '
+        write(*,*) ' #### IPOUT MUST BE 1, 2 OR 3!                #### '
+        stop
+      endif
+
+      if(lsubgrid.ne.1) then
+        write(*,*) '             ----------------               '
+        write(*,*) ' INFORMATION: SUBGRIDSCALE TERRAIN EFFECT IS'
+        write(*,*) ' NOT PARAMETERIZED DURING THIS SIMULATION.  '
+        write(*,*) '             ----------------               '
+      endif
+   
+  if ((ipout.ne.0).and.(ipout.ne.1).and.(ipout.ne.2)) then
+    write(*,*) ' #### FLEXPART MODEL ERROR!             :     #### '
+    write(*,*) ' #### IPOUT MUST BE 1, 2 OR 3!                #### '
+    stop
+  endif
+
+
+! Check whether convection scheme is either turned on or off
+!***********************************************************
+
+!      if ((lconvection.ne.0).and.(lconvection.ne.1)) then
+       if ((lconvection.lt.0).or. (lconvection.gt.3)) then
+        write(*,*) ' #### FLEXPART MODEL ERROR!             :     #### '
+!        write(*,*) ' #### LCONVECTION MUST BE SET TO EITHER 1 OR 0#### '
+        write(*,*) ' #### LCONVECTION MUST BE SET TO 0 or  3  #### '
+
+        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.      #### '
+        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                            #### '
+        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                            #### '
+        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                            #### '
+        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
+
+      if (ncnumrec.le.0) then
+        write(*,*) ' #### FLEXPART MODEL ERROR! NUMREC MUST       #### '
+        write(*,*) ' #### BE GREATER THAN 0                       #### '
+        stop
+      endif
+
+! FLEXPART_WRF - check turb_option, add_sfc_level
+      if ((turb_option.ne.turb_option_none     ) .and. &
+          (turb_option.ne.turb_option_diagnosed) .and. &
+          (turb_option.ne.turb_option_tke      ) .and. &
+          (turb_option.ne.turb_option_mytke)) then
+        write(*,*) ' #### FLEXPART MODEL ERROR!                   #### '
+        write(*,*) ' #### TURB_OPTION MUST BE ONE OF:             #### '
+        write(*,'(5x,5i5)') turb_option_none, turb_option_diagnosed, &
+                   turb_option_tke,turb_option_mytke
+        write(*,*) ' #### ---------------------------------       #### '
+        stop
+      endif
+
+      if ((add_sfc_level.ne.0) .and. (add_sfc_level.ne.1)) then
+        write(*,*) ' #### FLEXPART MODEL ERROR!                   #### '
+        write(*,*) ' #### ADD_SFC_LAYER MUST BE 0 or 1            #### '
+        stop
+      endif
+
+      if ((sfc_option.ne.sfc_option_diagnosed) .and. &
+          (sfc_option.ne.sfc_option_wrf      )) then
+        write(*,*) ' #### FLEXPART MODEL ERROR!                   #### '
+        write(*,*) ' #### SFC_OPTION MUST BE ONE OF:              #### '
+        write(*,'(5x,5i5)') sfc_option_diagnosed, sfc_option_wrf
+        write(*,*) ' #### ---------------------------------       #### '
+        stop
+      endif
+
+! iouttype -- convert negative values to 0; positive out of range values to 2
+      if (iouttype .lt. 0) iouttype = 0
+      if (iouttype .gt. 2) iouttype = 2
+
+! Conversion of format HHHMISS to seconds
+!****************************************
+
+      hhh=ideltas/10000
+      mi=(ideltas-10000*hhh)/100
+      ss=ideltas-10000*hhh-100*mi
+      ideltas=hhh*3600+60*mi+ss
+
+
+! 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(*,*) ' #### INPUT FILE     MUST BE EITHER -1 OR 1.  #### '
+        stop
+      endif
+
+! jdf end read command
+!*************************************************
+! jdf start read ageclasees
+!*************************************************
+!
+!*******************************************************************************
+!                                                                              *
+!     This routine reads the age classes to be used for the current model run. *
+!                                                                              *
+!     Author: A. Stohl                                                         *
+!                                                                              *
+!     20 March 2000                                                            *
+!                                                                              *
+!*******************************************************************************
+!                                                                              *
+! Variables:                                                                   *
+!                                                                              *
+! Constants:                                                                   *
+!                                                                              *
+!*******************************************************************************
+
+! If age spectra claculation is switched on,
+! open the AGECLASSSES file and read user options
+!************************************************
+
+      call skplin(1,unitpath)
+      read(unitpath,*) nageclass
+      read(unitpath,*) lage(1)
+      if (nageclass.gt.maxageclass) then
+        write(*,*) ' #### FLEXPART MODEL ERROR! NUMBER OF AGE     #### '
+        write(*,*) ' #### CLASSES GREATER THAN MAXIMUM ALLOWED.   #### '
+        write(*,*) ' #### CHANGE SETTINGS IN      AGECLASSES OR   #### '
+        write(*,*) ' #### RECOMPILE WITH LARGER MAXAGECLASS IN    #### '
+        write(*,*) ' #### FILE PAR_MOD.F90                        #### '
+        stop
+      endif
+
+      if (lage(1).le.0) then
+        write(*,*) ' #### FLEXPART MODEL ERROR! AGE OF FIRST      #### '
+        write(*,*) ' #### CLASS MUST BE GREATER THAN ZERO. CHANGE #### '
+        write(*,*) ' #### SETTINGS IN      AGECLASSES.            #### '
+        stop
+      endif
+
+! If age spectra calculation is switched off, set number of age classes
+! to 1 and maximum age to a large number
+!**********************************************************************
+
+ 
+      do i=2,nageclass
+        read(unitpath,*) lage(i)
+!        print*,'age',lage(i),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      AGECLASSES.   #### '
+          stop
+        endif
+      enddo
+      if (lagespectra.ne.1) then
+        nageclass=1
+        lage(nageclass)=999999999
+      endif
+
+! jdf end read ageclasses
+!*************************************************
+! jdf start read available
+!*************************************************
+!
+!*******************************************************************************
+!                                                                              *
+!   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                          *
+!                                                                              *
+!    12 October  2005, R. Easter -                                             *
+!                      fname,wfname1,wfname1n changed from char*10 to char*80; *
+!                      reads from unitavailab changed to free format           *
+!                                                                              *
+!*******************************************************************************
+!                                                                              *
+! 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                        *
+!                                                                              *
+!*******************************************************************************
+
+! 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.                  
+        end=bdate+dble(real(ideltas)/86400.)+dble(real(idiffmax)/ &
+        86400.)
+      else                           ! backward trajectories
+        beg=bdate+dble(real(ideltas)/86400.)-dble(real(idiffmax)/ &
+        86400.)
+        end=bdate+1.
+      endif
+
+! Open the wind field availability file and read available wind fields
+! within the modelling period.
+!*********************************************************************
+
+      open(unitavailab,file=path(3)(1:length(3)),status='old', &
+      err=804)
+
+      do i=1,3
+        read(unitavailab,*)
+      enddo
+      
+      numbwf=0
+100     read(unitavailab,*,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
+          wfspec1(numbwf)=spec
+          wftime1(numbwf)=nint((jul-bdate)*86400.)
+        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
+        open(unitavailab,file=path(numpath+2*(k-1)+2) &
+        (1:length(numpath+2*(k-1)+2)),status='old',err=803)
+
+        do i=1,3
+          read(unitavailab,*)
+        enddo
+
+        numbwfn(k)=0
+700       read(unitavailab,*,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.)
+          endif
+          goto 700       ! next wind field
+
+699     continue
+
+      enddo
+      close(unitavailab)
+
+
+! 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
+      enddo
+
+! 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(*,*) 'FLEXTRA 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
+        enddo
+      enddo
+
+
+! For backward trajectories, reverse the order of the windfields
+!***************************************************************
+
+      do i=1,numbwf
+       wfdt(i)=-999999
+      enddo
+      if (ideltas.ge.0) then
+        do i=1,numbwf
+          wfname(i)=wfname1(i)
+          wfspec(i)=wfspec1(i)
+          wftime(i)=wftime1(i)
+        if(i.gt.1)  wfdt(i)=wftime1(i)-wftime1(i-1)  
+        enddo
+        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)
+        enddo
+        enddo
+      else
+        do i=1,numbwf
+          wfname(numbwf-i+1)=wfname1(i)
+          wfspec(numbwf-i+1)=wfspec1(i)
+          wftime(numbwf-i+1)=wftime1(i)
+!       if(i.lt.numbwf) wfdt(numbwf-i+1)=wftime1(i+1)-wftime1(i)  
+        if(i.gt.1) wfdt(numbwf-i+1)=wftime1(i)-wftime1(i-1)  
+        enddo
+        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)
+        enddo
+        enddo
+      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
+      enddo
+
+      do k=1,numbnests
+        if (numbwfn(k).ne.numbwf) then
+          write(*,*) 'FLEXTRA 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(*,*) 'FLEXTRA 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
+        enddo
+      enddo
+
+! 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
+      enddo
+   
+      call gridcheck()
+      call gridcheck_nests()
+
+! jdf end read available
+!*************************************************
+! jdf start read outgrid
+!*************************************************
+!
+!*******************************************************************************
+!                                                                              *
+!     Note:  This is the FLEXPART_WRF version of subroutine readoutgrid.       *
+!                                                                              *
+!     This routine reads the user specifications for the output grid.          *
+!                                                                              *
+!     Author: A. Stohl                                                         *
+!                                                                              *
+!     4 June 1996                                                              *
+!                                                                              *
+!     Dec 2005, R. Easter -                                                    *
+!             The output grid is defined by specifying its southwest and       *
+!             northease corners, either in degrees-latlon or grid-meters       *
+!             Changes to some read formats (wider fields).                     *
+!             Changed names of "*lon0*" & "*lat0*" variables                   *
+!     10 Mar 2006, R. Easter -                                                 *
+!             Change eps from 1.0e-4 (degrees value) to 10.0 (meters value)    *
+!                                                                              *
+!*******************************************************************************
+!                                                                              *
+! Variables:                                                                   *
+! dxout,dyout          grid distance                                           *
+! numxgrid,numygrid,numzgrid    grid dimensions                                *
+! out_xm0,out_ym0      lower left corner of grid                               *
+! outheight(maxzgrid)  height levels of output grid [m]                        *
+!                                                                              *
+! Constants:                                                                   *
+! unitpath             unit connected to file OUTGRID                          *
+!                                                                              *
+!*******************************************************************************
+
+! Open the OUTGRID file and read output grid specifications
+!**********************************************************
+
+       call skplin(1,unitpath)
+
+
+! 1.  Read horizontal grid specifications
+!
+! *** NOTE ***
+! [xtmp1, ytmp1] are the coordinates of the southwest corner
+!    of the first (i.e., southwest or lower-left) output grid cell
+! [xtmp2, ytmp2] are the coordinates of the northeast corner 
+!    of the last (i.e,, northeast or upper-right) output grid cell
+!****************************************
+
+!      read(unitpath,'(f15.8)') xtmp1
+      read(unitpath,*) xtmp1
+!     read(unitpath,'(f15.8)') ytmp1
+      read(unitpath,*) ytmp1
+!      read(unitpath,'(2x,i7)') numxgrid
+      read(unitpath,*) numxgrid
+!      read(unitpath,'(2x,i7)') numygrid
+      read(unitpath,*) numygrid
+!     read(unitpath,'(2x,i4)') outgriddef 
+      read(unitpath,*) outgriddef 
+      if (outgriddef.eq.1) then 
+!     read(unitpath,'(f15.8)') xtmp2
+      read(unitpath,*) xtmp2
+!     read(unitpath,'(f15.8)') ytmp2
+      read(unitpath,*) ytmp2
+      else
+!      read(unitpath,'(f15.8)') dxout
+!      read(unitpath,'(f15.8)') dyout
+      read(unitpath,*) dxout
+      read(unitpath,*) dyout
+      xtmp2=dxout*real(numxgrid)+xtmp1
+      ytmp2=dyout*real(numygrid)+ytmp1 
+      endif
+ 
+      if (option_verbose.eq. 1) then
+      write(*,'(/a)') 'readoutgrid diagnostics'
+      write(*,'(a,1p,2e18.10)') 'xtmp1, ytmp1 (in)', xtmp1, ytmp1
+      write(*,'(a,1p,2e18.10)') 'xtmp2, ytmp2 (in)', xtmp2, ytmp2
+      endif
+      if (outgrid_option .eq. 1) then
+! In this case, the above inputs are the actual geographical lat/lon
+!   of the southwest & northeast corners of the output grid
+! Need to convert from lat/lon to grid-meters
+         outgrid_swlon = xtmp1
+         outgrid_swlat = ytmp1
+
+         outgrid_nelon = xtmp2
+         outgrid_nelat = ytmp2
+         call ll_to_xymeter_wrf( outgrid_swlon, outgrid_swlat,  &
+            out_xm0, out_ym0 )
+         call ll_to_xymeter_wrf( outgrid_nelon, outgrid_nelat, &
+            xtmp, ytmp )
+! 10-mar-2006 rce
+! If out_xm0 is very close to mother grid sw corner (=xmet0), set it to that
+! If xtmp    is very close to mother grid ne corner (=xmet0+nxmin1*dx), set it to that
+! Do similar for out_ym0 & ytmp
+         if (abs(out_xm0-xmet0) .le. eps) out_xm0 = xmet0
+         if (abs(out_ym0-ymet0) .le. eps) out_ym0 = ymet0
+         xr1 = xmet0 + real(nxmin1)*dx
+         yr1 = ymet0 + real(nymin1)*dy
+         if (abs(xtmp-xr1) .le. eps) xtmp = xr1
+         if (abs(ytmp-yr1) .le. eps) ytmp = yr1
+         dxout = (xtmp - out_xm0)/numxgrid
+         dyout = (ytmp - out_ym0)/numygrid
+       if (outgrid_option.eq.1) then ! regular
+         outlat0=outgrid_swlat
+         outlon0=outgrid_swlon
+         dyoutl=(outgrid_nelat-outgrid_swlat)/numygrid
+         dxoutl= (outgrid_nelon-outgrid_swlon)/numxgrid
+       endif
+      else
+! In this case, the above inputs are in grid-meters 
+! Need to convert from grid-meters to lat/lon
+         out_xm0 = xtmp1
+         out_ym0 = ytmp1
+         dxout = (xtmp2 - xtmp1)/numxgrid
+         dyout = (ytmp2 - ytmp1)/numygrid
+         call xymeter_to_ll_wrf( xtmp1, ytmp1,  &
+            outgrid_swlon, outgrid_swlat )
+         call xymeter_to_ll_wrf( xtmp2, ytmp2,  &
+            outgrid_nelon, outgrid_nelat )
+      if (option_verbose.eq. 1) then
+         write(*,'(f15.10,5x,a)') outgrid_swlon, 'outgrid_swlon'
+         write(*,'(f15.10,5x,a)') outgrid_swlat, 'outgrid_swlat'
+         write(*,'(f15.10,5x,a)') outgrid_nelon, 'outgrid_nelon'
+         write(*,'(f15.10,5x,a)') outgrid_nelat, 'outgrid_nelat'
+       endif
+      end if
+      if (option_verbose.eq. 1) then
+      write(*,'(a,1p,2e18.10)') 'out_xm0, out_ym0 ', out_xm0, out_ym0
+      write(*,'(a,1p,2e18.10)') 'dxout,   dyout   ', dxout, dyout
+      endif
+        
+! Check validity of output grid (shall be within model domain)
+!*************************************************************
+
+      xr=out_xm0+real(numxgrid)*dxout
+      yr=out_ym0+real(numygrid)*dyout
+      xr1=xmet0+real(nxmin1+1)*dx
+      yr1=ymet0+real(nymin1+1)*dy
+      if (outgrid_option.lt.1) then
+!    print*,'nx',nxmin1,nymin1
+      if ((out_xm0+eps.lt.xmet0).or.(out_ym0+eps.lt.ymet0) &
+      .or.(xr.gt.xr1+eps).or.(yr.gt.yr1+eps)) then
+        write(*,*) ' #### FLEXPART MODEL ERROR! PART OF OUTPUT    ####'
+        write(*,*) ' #### GRID IS OUTSIDE MODEL DOMAIN. CHANGE    ####'
+        write(*,*) ' #### OUTGRID IN INPUT FILE                   ####'
+        write(*,'(a)') path(1)(1:length(1))
+        stop
+      endif
+      endif
+!      if ((numxgrid.gt.maxxgrid).or.(numygrid.gt.maxygrid)) then
+!        write(*,*) ' #### FLEXPART MODEL ERROR! DIMENSIONS OF     ####'
+!        write(*,*) ' #### OUTPUT GRID EXCEED MAXIMUM VALUES.      ####'
+!        write(*,*) ' #### CHANGE FILE $FLEXPART/options/OUTGRID.  ####'
+!        stop
+!      endif
+
+! 2. Vertical levels of output grid
+!**********************************
+      
+        read(unitpath,*) numzgrid
+!        if (numzgrid.gt.maxzgrid) then
+!       write(*,*) ' #### FLEXPART MODEL ERROR! TOO MANY HEIGHT   #### ' 
+!       write(*,*) ' #### LEVELS ARE GIVEN FOR OUTPUT GRID.       #### ' 
+!       write(*,*) ' #### MAXIMUM NUMBER IS ',maxzgrid,'          #### ' 
+!       write(*,*) ' #### PLEASE MAKE CHANGES IN FILE OUTGRID.    #### ' 
+!        stop
+!        endif
+
+    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'
+
+    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'
+
+        do j=1,numzgrid
+          read(unitpath,*) outhelp
+          outheight(j)=outhelp
+        enddo
+
+
+! 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  OUTGRID.    #### ' 
+        endif
+      enddo
+
+! 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.
+      enddo
+
+      xoutshift=xmet0-out_xm0
+      youtshift=ymet0-out_ym0
+
+      if(nested_output .eq. 1) then
+        call skplin(1,unitpath)
+!        read(unitpath,'(f15.8)') xtmp1
+!        read(unitpath,'(f15.8)') ytmp1
+!        read(unitpath,'(4x,i5)') numxgridn
+!        read(unitpath,'(4x,i5)') numygridn
+!        read(unitpath,'(2x,i4)') outgriddefn
+        read(unitpath,*) xtmp1
+        read(unitpath,*) ytmp1
+        read(unitpath,*) numxgridn
+        read(unitpath,*) numygridn
+        read(unitpath,*) outgriddefn
+      if (outgriddefn.eq.1) then
+!        read(unitpath,'(f15.8)') xtmp2
+!        read(unitpath,'(f15.8)') ytmp2
+        read(unitpath,*) xtmp2
+        read(unitpath,*) ytmp2
+      else
+!      read(unitpath,'(f15.8)') dxoutn
+!      read(unitpath,'(f15.8)') dyoutn
+      read(unitpath,*) dxoutn
+      read(unitpath,*) dyoutn
+      xtmp2=dxoutn*real(numxgridn)+xtmp1
+      ytmp2=dyoutn*real(numygridn)+ytmp1
+      endif
+
+        write(*,'(/a)') 'readoutgrid_nest diagnostics'
+        write(*,'(a,1p,2e18.10)') 'xtmp1, ytmp1  (in)', xtmp1, ytmp1
+        write(*,'(a,1p,2e18.10)') 'xtmp2, ytmp2  (in)', xtmp2, ytmp2
+        if (outgrid_option .eq. 1) then
+! In this case, the above inputs are the actual geographical lat/lon
+!   of the southwest & northeast corners of the output grid
+! Need to convert from lat/lon to grid-meters
+           outgridn_swlon = xtmp1
+           outgridn_swlat = ytmp1
+           outgridn_nelon = xtmp2
+           outgridn_nelat = ytmp2
+           call ll_to_xymeter_wrf( outgridn_swlon, outgridn_swlat, &
+              out_xm0n, out_ym0n )
+           call ll_to_xymeter_wrf( outgridn_nelon, outgridn_nelat, &
+              xtmp, ytmp )
+           dxoutn = (xtmp - out_xm0n)/numxgridn
+           dyoutn = (ytmp - out_ym0n)/numygridn
+       if (outgrid_option.eq.1) then ! regular
+         outlat0n=outgridn_swlat
+         outlon0n=outgridn_swlon
+         dyoutln=(outgridn_nelat-outgridn_swlat)/numygridn
+         dxoutln= (outgridn_nelon-outgridn_swlon)/numxgridn
+       endif
+
+        else
+! In this case, the above inputs are in grid-meters 
+! Need to convert from grid-meters to lat/lon
+           out_xm0n = xtmp1
+           out_ym0n = ytmp1
+           dxoutn = (xtmp2 - xtmp1)/numxgridn
+           dyoutn = (ytmp2 - ytmp1)/numygridn
+           call xymeter_to_ll_wrf( xtmp1, ytmp1,  &
+              outgridn_swlon, outgridn_swlat )
+           call xymeter_to_ll_wrf( xtmp2, ytmp2,  &
+              outgridn_nelon, outgridn_nelat )
+           write(*,'(f15.10,5x,a)') outgridn_swlon, 'outgridn_swlon'
+           write(*,'(f15.10,5x,a)') outgridn_swlat, 'outgridn_swlat'
+           write(*,'(f15.10,5x,a)') outgridn_nelon, 'outgridn_nelon'
+           write(*,'(f15.10,5x,a)') outgridn_nelat, 'outgridn_nelat'
+        endif
+        write(*,'(a,1p,2e18.10)') 'out_xm0n, out_ym0n',out_xm0n,out_ym0n
+        write(*,'(a,1p,2e18.10)') 'dxoutn,   dyoutn  ',dxoutn,dyoutn
+
+
+! Check validity of output grid (shall be within model domain)
+!*************************************************************
+
+        xr=out_xm0n+real(numxgridn)*dxoutn
+        yr=out_ym0n+real(numygridn)*dyoutn
+        xr1=xmet0+real(nxmin1+1)*dx
+        yr1=ymet0+real(nymin1+1)*dy
+        if ((out_xm0n+eps.lt.xmet0).or.(out_ym0n+eps.lt.ymet0) &
+        .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(*,*) ' ####      OUTGRID                            ####'
+        write(*,'(a)') path(1)(1:length(1))
+        stop
+        endif
+!        if ((numxgridn.gt.maxxgridn).or.(numygridn.gt.maxygridn)) then
+!        write(*,*) ' #### FLEXPART MODEL ERROR! DIMENSIONS OF     ####'
+!        write(*,*) ' #### OUTPUT NEST EXCEED MAXIMUM VALUES.      ####'
+!        write(*,*) ' #### CHANGE FILE $FLEXPART/options/OUTGRID.  ####'
+!        stop
+!        endif
+        xoutshiftn=xmet0-out_xm0n
+        youtshiftn=ymet0-out_ym0n
+    allocate(orooutn(0:numxgridn-1,0:numygridn-1) &
+         ,stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not allocate orooutn'
+    allocate(arean(0:numxgridn-1,0:numygridn-1) &
+         ,stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not allocate arean'
+    allocate(volumen(0:numxgridn-1,0:numygridn-1,numzgrid) &
+         ,stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not allocate volumen'
+
+      endif
+
+! jdf end read outgrid
+!*************************************************
+! jdf start read receptors
+!*************************************************
+!
+!*******************************************************************************
+!                                                                              *
+!     Note:  This is the FLEXPART_WRF version of subroutine assignland.        *
+!            The computational grid is the WRF x-y grid rather than lat-lon.   *
+!                                                                              *
+!     This routine reads the user specifications for the receptor points.      *
+!                                                                              *
+!     Author: A. Stohl                                                         *
+!                                                                              *
+!     1 August 1996                                                            *
+!                                                                              *
+!     Oct 2005, R. Easter - change calc of receptorarea()                      *
+!     Dec 2005, R. Easter - x/yrecptor values may be input either as           *
+!                           degrees-latlon or grid-meters                      *
+!                           Changes to some read formats (wider fields).       *
+!                           Changed names of "*lon0*" & "*lat0*" variables     *
+!                                                                              *
+!*******************************************************************************
+!                                                                              *
+! 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                        *
+!                                                                              *
+!*******************************************************************************
+
+      call skplin(1,unitpath)
+      read(unitpath,*) numreceptor
+! For backward runs, do not allow receptor output. Thus, set number of receptors to zero
+!***************************************************************************************
+
+      if (ldirect.lt.0) then
+        numreceptor=0
+      endif
+
+! Open the RECEPTORS file and read output grid specifications
+!************************************************************
+! Read the names and coordinates of the receptors
+!************************************************
+
+      if (numreceptor.gt.maxreceptor) then
+      write(*,*) ' #### FLEXPART MODEL ERROR! TOO MANY RECEPTOR #### ' 
+      write(*,*) ' #### POINTS ARE GIVEN.                       #### ' 
+      write(*,*) ' #### MAXIMUM NUMBER IS ',maxreceptor,'       #### ' 
+      write(*,*) ' #### PLEASE MAKE CHANGES IN      RECEPTORS   #### ' 
+        stop
+      endif
+      do j=1,numreceptor
+        read(unitpath,'(4x,a16)') receptor
+        read(unitpath,*) x
+        read(unitpath,*) y
+        receptorname(j)=receptor
+
+        write(*,'(/a,i5)') 'readreceptor diagnostics, j =', j
+        write(*,'(a,1p,2e18.10)') 'x, y (in)   ', x, y
+        if (numpoint_option .eq. 1) then
+! In this case, the above inputs are the actual geographical lat/lon
+! Need to convert from lat/lon to grid-index coordinates
+           receptor_lon(j) = x
+           receptor_lat(j) = y
+           call ll_to_xyindex_wrf( receptor_lon(j), receptor_lat(j), &
+              xreceptor(j), yreceptor(j) )
+        else
+! In this case, the above inputs are in grid-meters 
+! Need to convert from grid-meters to grid-index coordinates, then to lat/lon
+           xreceptor(j)=(x-xmet0)/dx
+           yreceptor(j)=(y-ymet0)/dy
+           call xyindex_to_ll_wrf( 0, xreceptor(j), yreceptor(j), &
+              receptor_lon(j), receptor_lat(j) )
+           write(*,'(f15.10,5x,a)') receptor_lon(j), 'receptor_lon'
+           write(*,'(f15.10,5x,a)') receptor_lat(j), 'receptor_lat'
+        end if
+          write(*,'(a,1p,2e18.10)') 'x, yreceptor',  &
+             xreceptor(j), yreceptor(j)
+
+! for FLEXPART_WRF, dx & dy are in meters,
+! receptorarea() appears to be area in m**2 of a mother grid cell
+! centers on x,y
+!       xm=r_earth*cos(y*pi/180.)*dx/180.*pi
+!       ym=r_earth*dy/180.*pi
+        xm=dx
+        ym=dy
+        receptorarea(j)=xm*ym
+      enddo
+
+! jdf end read receptors
+!*************************************************
+! jdf start read species
+!*************************************************
+!
+!*******************************************************************************
+!                                                                              *
+!     This routine reads names and physical constants of chemical species/     *
+!     radionuclides available with FLEXPART.                                   *
+!                                                                              *
+!     Author: A. Stohl                                                         *
+!                                                                              *
+!     11 July 1996                                                             *
+!                                                                              *
+!*******************************************************************************
+!                                                                              *
+! Variables:                                                                   *
+! decaytime(maxtable)  half time for radiological decay                        *
+! specname(maxtable)   names of chemical species, radionuclides                *
+! wetscava, wetscavb   Parameters for determining scavenging coefficient       *
+!                                                                              *
+! Constants:                                                                   *
+!                                                                              *
+!*******************************************************************************
+
+! Open the SPECIES file and read species names and properties
+!************************************************************
+
+      read(unitpath,*)
+      read(unitpath,*) numtable
+      read(unitpath,*)
+
+      do i=1,numtable
+        read(unitpath,21) specname(i),decaytime(i), &
+        wetscava(i),wetscavb(i),drydiff(i),dryhenry(i),dryactiv(i), &
+        partrho(i),partmean(i),partsig(i),dryvelo(i),weightmol(i), &
+        ohreact(i),spec_ass(i),kao(i)
+!       read(unitpath,21) specname(i),decay(i), &
+!       weta(i),wetb(i),reldiff(i),henry(i),f0(i), &
+!       density(i),dquer(i),dsigma(i),dryvel(i),weightmolar(i), &
+!       ohreact(i),spec_ass(i),kao(i)
+     pos_spec=i
+
+     if ((wetscava(i).gt.0.).and.(dryhenry(i).le.0.)) then
+       if (partmean(i).le.0.) goto 996 ! no particle, no henry set
+     endif
+
+
+     if (spec_ass(i).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 (partsig(i).eq.1.) partsig(i)=1.0001   ! avoid realing exception
+        if (partsig(i).eq.0.) partsig(i)=1.0001   ! avoid realing exception
+
+        if ((drydiff(i).gt.0.).and.(partrho(i).gt.0.)) then
+          write(*,*) '#### FLEXPART MODEL ERROR! SPECIES FORMAT    ####'
+          write(*,*) '#### IS CORRUPT. SPECIES CANNOT BE BOTH      ####'
+          write(*,*) '#### PARTICLE AND GAS.                       ####'
+          stop
+        endif
+      enddo
+
+21    format(4x,a10,f10.1,e11.1,f6.2,f7.1,e9.1,f5.1,e10.1,2e8.1,2f8.2, &
+        e18.1,i18,f18.2)
+
+! jdf end read species
+!*************************************************
+! jdf start read releases
+!*************************************************
+!
+!*******************************************************************************
+!                                                                              *
+!     This routine reads the release point specifications for the current      *
+!     model run. Several release points can be used at the same time.          *
+!                                                                              *
+!     Note:  This is the FLEXPART_WRF version of subroutine readreleases.      *
+!            The computational grid is the WRF x-y grid rather than lat-lon.   *
+!                                                                              *
+!     Author: A. Stohl                                                         *
+!     18 May 1996                                                              *
+!                                                                              *
+!     Update: 29 January 2001                                                  *
+!     Release altitude can be either in magl or masl                           *
+!                                                                              *
+!     Nov 2005, R. Easter - Do not adjust xpoint1 & 2 by +/-360 degrees        *
+!     Dec 2005, R. Easter - x/ypoint1/2 values may be input either as          *
+!                           degrees-latlon or grid-meters                      *
+!                                                                              *
+!*******************************************************************************
+!                                                                              *
+! 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 are*
+! weta, wetb          parameters to determine the wet scavenging coefficient   *
+! zpoint1,zpoint2     height range, over which release takes place             *
+!                                                                              *
+!*******************************************************************************
+
+      DEP=.false.
+      DRYDEP=.false.
+      WETDEP=.false.
+      do i=1,maxspec
+        DRYDEPSPEC(i)=.false.
+      enddo
+
+! Open the releases file and read user options
+!*********************************************
+
+! 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(1,unitpath)
+
+! Read the number of species and the link to the species information table
+! Assign species-specific parameters needed for physical processes
+!*************************************************************************
+
+      read(unitpath,*) nspec
+      read(unitpath,*) emitvar
+      if (nspec.gt.maxspec) then 
+      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
+      endif
+      do i=1,nspec
+        read(unitpath,*) link(i)
+        species(i)=specname(link(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
+!*****************
+
+        weightmolar(i)=weightmol(link(i))
+        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/decaytime(link(i)) !conversion half life to decay constant
+
+! Wet deposition
+!***************
+
+        weta(i)=wetscava(link(i))
+        wetb(i)=wetscavb(link(i))
+
+! Dry deposition of gases
+!************************
+
+        reldiff(i)=drydiff(link(i))             ! Diffusivity rel. to H20
+        henry(i)=dryhenry(link(i))              ! Henry constant
+        f0(i)=dryactiv(link(i))                 ! activity
+        if (reldiff(i).gt.0.) &
+        rm(i)=1./(henry(i)/3000.+100.*f0(i))    ! mesophyll resistance
+
+! Dry deposition of particles
+!****************************
+
+        vsetaver(i)=0.
+        density(i)=partrho(link(i))                 ! Particle density
+        dquer(i)=partmean(link(i))*1000000.         ! Conversion m to um
+        dsigma(i)=partsig(link(i))
+        if (density(i).gt.0.) then                  ! Additional parameters
+!          call part0(dquer(i),dsigma(i),density(i),fracth,schmih,vsh)
+          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)
+          enddo
+        endif
+
+! Dry deposition for constant deposition velocity
+!************************************************
+
+        dryvel(i)=dryvelo(link(i))*0.01         ! conversion to m/s
+
+        if (weta(i).gt.0.) WETDEP=.true.
+        if ((reldiff(i).gt.0.).or.(density(i).gt.0.).or. &
+        (dryvel(i).gt.0.)) then
+          DRYDEP=.true.
+          DRYDEPSPEC(i)=.true.
+        endif
+
+
+! 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.
+        enddo
+        do j=1,7
+          area_dow(i,j)=1.
+          point_dow(i,j)=1.
+        enddo
+
+!       write(aspecnumb,'(i3.3)') link(i)
+!       open(unitemissvar,file=path(1)(1:len(1))//'EMISSION_VARIATION_'
+!    +  //aspecnumb//'.dat',status='old',err=35)
+!       read(unitemissvar,*)
+        if(emitvar.eq.1) then
+        do j=1,24     ! 24 hours, starting with 0-1 local time
+          read(unitpath,*) ihour,area_hour(i,j),point_hour(i,j)
+        enddo
+!       read(unitemissvar,*)
+        do j=1,7      ! 7 days of the week, starting with Monday
+          read(unitpath,*) idow,area_dow(i,j),point_dow(i,j)
+        enddo
+!       close(unitemissvar)
+        endif
+
+!35      continue
+        enddo
+        if (WETDEP.or.DRYDEP) DEP=.true.
+
+
+! Read specifications for each release point
+!*******************************************
+
+      numpoint=0
+      numpartmax=0
+      releaserate=0.
+      releaserate2=0.
+      read(unitpath,*) numpoint
+
+!     numpoint2=numpoint+500
+      numpoint2=numpoint+0
+    allocate(ireleasestart(numpoint2) &
+         ,stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not allocate RELEASPOINT'
+    allocate(ireleaseend(numpoint2) &
+         ,stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not allocate RELEASPOINT'
+    allocate(xpoint1(numpoint2) &
+         ,stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not allocate RELEASPOINT'
+    allocate(xpoint12(numpoint2) &
+         ,stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not allocate RELEASPOINT'
+    allocate(xpoint22(numpoint2) &
+         ,stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not allocate RELEASPOINT'
+    allocate(ypoint12(numpoint2) &
+         ,stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not allocate RELEASPOINT'
+    allocate(ypoint22(numpoint2) &
+         ,stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not allocate RELEASPOINT'
+    allocate(releases_swlon(numpoint2) &
+         ,stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not allocate RELEASPOINT'
+    allocate(releases_swlat(numpoint2) &
+         ,stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not allocate RELEASPOINT'
+    allocate(releases_nelon(numpoint2) &
+         ,stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not allocate RELEASPOINT'
+    allocate(releases_nelat(numpoint2) &
+         ,stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not allocate RELEASPOINT'
+    allocate(xpoint2(numpoint2) &
+         ,stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not allocate RELEASPOINT'
+    allocate(ypoint1(numpoint2) &
+         ,stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not allocate RELEASPOINT'
+    allocate(ypoint2(numpoint2) &
+         ,stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not allocate RELEASPOINT'
+    allocate(zpoint1(numpoint2) &
+         ,stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not allocate RELEASPOINT'
+    allocate(zpoint2(numpoint2) &
+         ,stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not allocate RELEASPOINT'
+    allocate(kindz(numpoint2) &
+         ,stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not allocate RELEASPOINT'
+    allocate(xmass(numpoint2,maxspec) &
+         ,stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not allocate RELEASPOINT'
+    allocate(rho_rel(numpoint2) &
+         ,stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not allocate RELEASPOINT'
+    allocate(npart(numpoint2) &
+         ,stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not allocate RELEASPOINT'
+!     print*,'allocate xmassa',numpoint
+     allocate(xmasssave(numpoint2) &
+          ,stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not allocate RELEASPOINT'
+
+      if (option_verbose.eq. 1) then
+    write (*,*) ' Releasepoints allocated: ', numpoint
+       endif
+    do i=1,numpoint
+      xmasssave(i)=0.
+    end do
+
+
+
+!      if (numpoint.gt.maxpoint) goto 997
+      do j=1,numpoint
+        read(unitpath,*) id1,it1
+        read(unitpath,*) id2,it2
+        read(unitpath,*) xpoint1(j)
+        read(unitpath,*) ypoint1(j)
+        read(unitpath,*) xpoint2(j)
+        read(unitpath,*) ypoint2(j)
+        read(unitpath,*) kindz(j)
+        read(unitpath,*) zpoint1(j)
+        read(unitpath,*) zpoint2(j)
+        read(unitpath,*) npart(j)
+        do i=1,nspec
+          read(unitpath,*) xmass(j,i)
+        enddo
+        nparttot=nparttot+npart(j)
+  if (j.le.2000) then
+    read(unitreleases,'(a40)',err=998) compoint(j)(1:40)
+  else
+    read(unitreleases,'(a40)',err=998) compoint(2001)(1:40)
+  endif
+
+!        read(unitpath,'(a20)',err=998) compoint(j)(1:20)
+
+       if(option_verbose.ge.1) print*,'release location=',j
+!     write(*,'(/a,i7)') 'readreleases diagnostics - numpoint = ', j
+!     write(*,'(a,1p,2e18.10)') 'x, ypoint1 (in) ',  &
+!        xpoint1(j), ypoint1(j)
+!     write(*,'(a,1p,2e18.10)') 'x, ypoint2 (in) ',  &
+!        xpoint2(j), ypoint2(j)
+! JB
+! In this case, the above inputs are the actual geographical lat/lon
+!   of the southwest & northeast corners of the release area
+! Need to convert from lat/lon to grid-meters
+!        if (outgrid_option.eq.1) then !regular
+         if (numpoint_option.eq.1) then !regular
+         xpoint12(j)=xpoint1(j)
+         xpoint22(j)=xpoint2(j)
+         ypoint12(j)=ypoint1(j)
+         ypoint22(j)=ypoint2(j)
+
+
+          releases_swlon(j) = xpoint1(j)
+          releases_swlat(j) = ypoint1(j)
+          releases_nelon(j) = xpoint2(j)
+          releases_nelat(j) = ypoint2(j)
+         call ll_to_xymeter_wrf( releases_swlon(j), releases_swlat(j),  &
+            xpoint1(j), ypoint1(j) )
+          call ll_to_xymeter_wrf( releases_nelon(j), releases_nelat(j), &
+            xpoint2(j), ypoint2(j) )
+
+         else
+!        write(*,'(a,1p,2e18.10)') 'x, ypoint1      ', 
+!    &      xpoint1(j), ypoint1(j)
+!        write(*,'(a,1p,2e18.10)') 'x, ypoint2      ', 
+!    &      xpoint2(j), ypoint2(j)
+!      else
+! In this case, the above inputs are in grid-meters 
+! Need to convert from grid-meters to lat/lon
+         call xymeter_to_ll_wrf( xpoint1(j), ypoint1(j), &
+            releases_swlon(j), releases_swlat(j) )
+         call xymeter_to_ll_wrf( xpoint2(j), ypoint2(j), &
+            releases_nelon(j), releases_nelat(j) )
+         endif
+!         write(*,'(f15.10,5x,a)') releases_swlon(j), 'releases_swlon'
+!         write(*,'(f15.10,5x,a)') releases_swlat(j), 'releases_swlat'
+!         write(*,'(f15.10,5x,a)') releases_nelon(j), 'releases_nelon'
+!         write(*,'(f15.10,5x,a)') releases_nelat(j), 'releases_nelat'
+!      end if
+
+! If a release point contains no particles, stop and issue error message
+!***********************************************************************
+
+      if (npart(j).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
+!*********************************************************************
+
+! FLEXPART_WRF - x & y coords are in meters, so the following lines 
+!   (which adjust longitude by +/-360 degrees) are not needed
+!
+!      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)
+      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
+          ireleasestart(j)=int((jul1-bdate)*86400.)
+          ireleaseend(j)=int((jul2-bdate)*86400.)
+        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
+          ireleasestart(j)=int((jul1-bdate)*86400.)
+          ireleaseend(j)=int((jul2-bdate)*86400.)
+        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(j).ne.ireleaseend(j)) then
+        releaserate=releaserate+real(npart(j))/ &
+        real(ireleaseend(j)-ireleasestart(j))
+!       print*,'release',ireleaseend(j),ireleasestart(j)
+      else
+        releaserate=99999999.
+      endif
+         if (ireleaseend(j)-ireleasestart(j).lt.lage(nageclass)) then
+        releaserate2=releaserate2+real(npart(j))
+         else
+        releaserate2=releaserate2+real(npart(j))*real(lage(nageclass))/ &
+        real(ireleaseend(j)-ireleasestart(j))
+         endif
+      numpartmax=numpartmax+npart(j)
+ 
+      if (ioutputforeachrelease.eq.1) then
+      maxpointspec_act=numpoint
+     else
+       maxpointspec_act=1
+      endif
+ 
+      enddo
+
+      maxpart=int(releaserate2*1.1)
+!      print*,'maxpart',maxpart,releaserate2,nparttot
+!     maxpart=40000000
+
+!     print*,'numpoint',numpoint
+!     print*,'NPARTTOT',nparttot,lage(4),lage(5),lage(6),nageclass
+!     print*,'maxpart',maxpart,real(lage(nageclass)),releaserate,releaserate2,real(lage(nageclass))*1.1*releaserate
+!      nparttot2=nparttot+500000
+!      nparttot2=nparttot
+      
+      nparttot2=maxpart
+     allocate(xmass1(nparttot2,nspec) & 
+         ,stat=stat)
+!    allocate(drydep1(nparttot2,nspec) & 
+!        ,stat=stat)
+     if (stat.ne.0) write(*,*)'ERROR: could not allocate xmass1'
+     allocate(itra1(nparttot2) &
+         ,stat=stat)
+     if (stat.ne.0) write(*,*)'ERROR: could not allocate itra1'
+     allocate(npoint(nparttot2) &
+         ,stat=stat)
+     if (stat.ne.0) write(*,*)'ERROR: could not allocate npoint'
+     allocate(nclass(nparttot2) &
+         ,stat=stat)
+     if (stat.ne.0) write(*,*)'ERROR: could not allocate nclass'
+     allocate(idt(nparttot2) &
+         ,stat=stat)
+     if (stat.ne.0) write(*,*)'ERROR: could not allocate idt   '
+     allocate(itramem(nparttot2) &
+         ,stat=stat)
+     if (stat.ne.0) write(*,*)'ERROR: could not allocate itrame'
+     allocate(itrasplit(nparttot2) &
+         ,stat=stat)
+     if (stat.ne.0) write(*,*)'ERROR: could not allocate itrasp'
+     allocate(xtra1(nparttot2) &
+         ,stat=stat)
+     if (stat.ne.0) write(*,*)'ERROR: could not allocate xtra1 '
+     allocate(ytra1(nparttot2) &
+          ,stat=stat)
+     if (stat.ne.0) write(*,*)'ERROR: could not allocate ytra1 '
+     allocate(ztra1(nparttot2) &
+          ,stat=stat)
+     if (stat.ne.0) write(*,*)'ERROR: could not allocate ztra1 '
+
+       do j=1,nparttot2
+         itra1(j)=-999999999
+       enddo
+
+
+      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
+
+
+! Make a consistency check, whether the forward/backward switch is correctly set
+!*******************************************************************************
+
+!      if (ldirect.eq.1) then
+!        if (maxpointspec.lt.nspec) then
+!      write(*,*) '#####################################################'
+!      write(*,*) '#### FLEXPART MODEL SUBROUTINE READRELEASES:     ####'
+!      write(*,*) '####                                             ####'
+!      write(*,*) '#### ERROR - PARAMETER MAXPOINTSPEC IS NOT       ####'
+!      write(*,*) '#### CORRECTLY SET FOR A FORWARD SIMULATION.     ####'
+!      write(*,*) '#### CHANGE APPROPRIATELY IN FILE INCLUDEPAR.    ####'
+!      write(*,*) '#####################################################'
+!        endif
+!      else
+!        if (maxpointspec.lt.numpoint) then
+!      write(*,*) '#####################################################'
+!      write(*,*) '#### FLEXPART MODEL SUBROUTINE READRELEASES:     ####'
+!      write(*,*) '####                                             ####'
+!      write(*,*) '#### ERROR - PARAMETER MAXPOINTSPEC IS NOT       ####'
+!      write(*,*) '#### CORRECTLY SET FOR A BACKWARD SIMULATION.    ####'
+!      write(*,*) '#### CHANGE APPROPRIATELY IN FILE INCLUDEPAR.    ####'
+!      write(*,*) '#####################################################'
+!        endif
+!      endif
+
+      return
+
+! jdf end read releases
+!*************************************************
+
+997   write(*,*) '#####################################################'
+      write(*,*) '#### FLEXPART MODEL SUBROUTINE READRELEASES:     ####'
+      write(*,*) '####                                             ####'
+      write(*,*) '#### ERROR - NUMBER OF RELEASE POINTS SPECIFIED  ####'
+      write(*,*) '#### IN      "RELEASES" EXCEEDS THE MAXIMUM      ####'
+      write(*,*) '#### ALLOWED NUMBER.                             ####'
+      write(*,*) '#####################################################'
+      stop
+
+
+998   write(*,*) '#####################################################'
+      write(*,*) '#### FLEXPART MODEL SUBROUTINE READRELEASES:     ####'
+      write(*,*) '####                                             ####'
+      write(*,*) '#### FATAL ERROR -      "RELEASES" IS            ####'
+      write(*,*) '#### CORRUPT. PLEASE CHECK YOUR INPUTS FOR       ####'
+      write(*,*) '#### MISTAKES OR GET A NEW "RELEASES"-           ####'
+      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
+
+800   write(*,*) ' #### TRAJECTORY MODEL ERROR! ERROR WHILE     #### ' 
+      write(*,*) ' #### READING FILE PATHNAMES.                 #### ' 
+      stop
+
+801   write(*,*) '#### TRAJECTORY MODEL ERROR! FILE '// inputname 
+      write(*,*) '#### CANNOT BE OPENED IN THE CURRENT WORKING #### '
+      write(*,*) '#### DIRECTORY.                              #### '
+      stop
+
+803   write(*,*) ' #### FLEXPART MODEL ERROR! FILE   #### '
+      write(*,'(a)') '     '//path(numpath+2*(k-1)+2) &
+      (1:length(numpath+2*(k-1)+2))
+      write(*,*) ' #### CANNOT BE OPENED             #### '
+      stop
+
+804   write(*,*) ' #### FLEXPART MODEL ERROR! FILE #### '
+      write(*,'(a)') '     '//path(3)(1:length(3)) 
+      write(*,*) ' #### CANNOT BE OPENED           #### '
+      stop
+996   write(*,*) '#####################################################'
+  write(*,*) '#### FLEXPART MODEL ERROR!                      #### '
+  write(*,*) '#### WET DEPOSITION SWITCHED ON, BUT NO HENRYS  #### '
+  write(*,*) '#### CONSTANT IS SET                            ####'
+  write(*,*) '#### PLEASE MODIFY SPECIES DESCR.               #### '
+  write(*,*) '#####################################################'
+  stop
+
+      end
Index: /branches/jerome/src_flexwrf_v3.1/readlanduse.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/readlanduse.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/readlanduse.f90	(revision 16)
@@ -0,0 +1,172 @@
+!**********************************************************************
+!* Copyright 2012,2013                                                *
+!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine,       *
+!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
+!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso,          *
+!* Petra Seibert, Gerard Wotawa, Caroline Forster, 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', &
+  open(unitland,file='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', &
+      open(unitsurfdata,file='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)
+    read(unitsurfdata,'(45x,f4.3)') z0(i)
+  end do
+  close(unitsurfdata)
+
+  return
+
+  ! Issue error messages
+  !*********************
+
+998   write(*,*) ' #### FLEXPART ERROR! FILE CONTAINING          ####'
+  write(*,*) ' #### LANDUSE INVENTORY DOES NOT EXIST         ####'
+  write(*,*) ' #### IT IS NEEDED FOR DRY DEPOSITION          ####'
+  write(*,*) ' #### COPY DATA FROM src_flexwrf_v3.0/data     ####'
+  write(*,*) ' #### IN YOUR CURRENT DIRECTORY                ####'
+  write(*,*) ' #### OR USE A DIFFERENT SPECIES               ####'
+  stop
+
+999   write(*,*) ' #### FLEXPART ERROR! FILE CONTAINING          ####'
+  write(*,*) ' #### RELATION LANDUSE,z0 DOES NOT EXIST       ####'
+  write(*,*) ' #### IT IS NEEDED FOR DRY DEPOSITION          ####'
+  write(*,*) ' #### COPY DATA FROM src_flexwrf_v3.0/data     ####'
+  write(*,*) ' #### IN YOUR CURRENT DIRECTORY                ####'
+  write(*,*) ' #### OR USE A DIFFERENT SPECIES               ####'
+  stop
+
+end subroutine readlanduse
Index: /branches/jerome/src_flexwrf_v3.1/readohfield.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/readohfield.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/readohfield.f90	(revision 16)
@@ -0,0 +1,90 @@
+!**********************************************************************
+! 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', &
+  open(unitOH,file='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                  ####'
+  write(*,*) ' #### IT IS NEEDED FOR OH REACTION             ####'
+  write(*,*) ' #### COPY DATA FROM src_flexwrf_v3.0/data     ####'
+  write(*,*) ' #### IN YOUR CURRENT DIRECTORY                ####'
+  write(*,*) ' #### OR USE A DIFFERENT SPECIES               ####'
+
+  stop
+
+end subroutine readohfield
Index: /branches/jerome/src_flexwrf_v3.1/readpartpositions.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/readpartpositions.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/readpartpositions.f90	(revision 16)
@@ -0,0 +1,270 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                *
+!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine,       *
+!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
+!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso,          *
+!* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann,   *
+!*                                                                     *
+!* This file is part of FLEXPART WRF                                   *
+!*                                                                     *
+!* 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
+!*******************************************************************************
+!                                                                              *
+!   Note:  This is the FLEXPART_WRF version of 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                                                            *
+!                                                                              *
+!     Dec 2005, R. Easter                                                      *
+!             Changed names of "*lon0*" & "*lat0*" variables                   *
+!             Reads either binary or ascii output files from previous run.     *
+!             Particle positions may be in lat-lon or grid-meter units.        *
+!                                                                              *
+!*******************************************************************************
+!                                                                              *
+! Variables:                                                                   *
+!                                                                              *
+!*******************************************************************************
+
+!      include 'includepar'
+!     include 'includecom'
+  use par_mod
+  use com_mod
+
+  implicit none
+      
+      integer :: ibdatein,ibtimein,nspecin,itimein,numpointin,i,j,ix
+      integer :: iomode_xycoord_in, numpart_in
+      integer :: itmp,ntmp, numxgridin,numygridin
+      real :: xlonin,ylatin,ran1,topo,hmixi,pvi,qvi,rhoi,tri,tti
+      real :: xtmp
+      character :: specin*7
+      character :: ctmp*1
+  real(kind=dp) :: julin,julpartin,juldate
+  integer :: idummy = -8
+
+
+! Open and read header file of dumped particle data
+!*****************************************
+
+      if (iouttype .eq. 0) then
+
+      open(unitpartin,file=path(1)(1:length(1))//'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
+      enddo
+ 
+      read(unitpartin) numpointin
+!     if (numpointin.ne.numpoint) goto 995
+      do i=1,numpointin
+        read(unitpartin)
+        read(unitpartin)
+        read(unitpartin)
+        read(unitpartin)
+        do j=1,nspec
+          read(unitpartin)
+          read(unitpartin)
+          read(unitpartin)
+        enddo
+      enddo
+      read(unitpartin)
+      read(unitpartin)
+
+      do ix=0,numxgrid-1
+        read(unitpartin)
+      enddo
+
+      close(unitpartin)
+
+      else    ! (iouttype .eq. 1)
+
+      open(unitpartin,file=path(1)(1:length(1))//'header', &
+      form='formatted',err=998)
+
+! with formatted header file, need to read every variable
+! because some of the "writes" cover multiple lines
+! (and the number of lines is compiler dependent)
+      read(unitpartin,*) ibdatein,ibtimein
+      read(unitpartin,*) ctmp   ! version id
+      read(unitpartin,*) itmp,itmp,itmp,itmp   ! loutstep,loutaver,...
+      read(unitpartin,*) xtmp,xtmp,numxgridin,numygridin,xtmp,xtmp   ! outgrid x,y info
+
+      read(unitpartin,*) ntmp,(xtmp, i=1,ntmp)   ! numzgrid,(outheight(i),i=1,numzgrid)
+      read(unitpartin,*) itmp,itmp   ! jjjjmmdd,ihmmss
+      read(unitpartin,*) nspecin,itmp,itmp
+      nspecin=nspecin/3
+      if ((ldirect.eq.1).and.(nspec.ne.nspecin)) goto 997
+
+      do i=1,nspecin
+        read(unitpartin,*) itmp   ! 1
+        read(unitpartin,*) ctmp   ! "WD" name
+        read(unitpartin,*) itmp   ! 1
+        read(unitpartin,*) ctmp   ! "DD" name
+        read(unitpartin,*) j
+        read(unitpartin,*) specin
+        if ((ldirect.eq.1).and.(species(i)(1:7).ne.specin)) goto 996
+      enddo
+ 
+      read(unitpartin,*) numpointin
+!     if (numpointin.ne.numpoint) goto 995
+      do i=1,numpointin
+        read(unitpartin,*) itmp,itmp,itmp   ! release start,end,kindz
+        read(unitpartin,*) xtmp,xtmp,xtmp,xtmp,xtmp,xtmp   ! release x,y,z info
+        read(unitpartin,*) itmp,itmp   ! npart(i), 1
+        read(unitpartin,*) ctmp   ! compoint(i)
+        do j=1,nspec
+          read(unitpartin,*) xtmp   ! xmass(i,j)
+          read(unitpartin,*) xtmp   ! xmass(i,j)
+          read(unitpartin,*) xtmp   ! xmass(i,j)
+        enddo
+      enddo
+      read(unitpartin,*) itmp,itmp,itmp   ! method,lsubgrid,lconvection
+      read(unitpartin,*) ntmp,(itmp, i=1,ntmp)   ! nageclass,(lage(i),i=1,nageclass)
+
+      do ix=0,numxgridin-1
+        read(unitpartin,*) (xtmp, j=0,numygridin-1)    ! oroout
+      enddo
+
+      close(unitpartin)
+
+      endif   ! (iouttype .eq. 0/1)
+
+
+! Open and read data file of dumped particle data
+!***************************************
+
+      if (iouttype .eq. 0) then
+        open(unitpartin,file=path(1)(1:length(1))//'partposit_end', &
+          form='unformatted',err=998)
+      else
+        open(unitpartin,file=path(1)(1:length(1))//'partposit_end', &
+          form='formatted',err=998)
+      endif
+
+100   continue
+      if (iouttype .eq. 0) then
+        read(unitpartin,end=99) itimein,numpart_in, &
+          iomode_xycoord_in
+      else
+        read(unitpartin,*,end=99) itimein,numpart_in, &
+          iomode_xycoord_in
+      endif
+
+! iomode_xycoord of previous & current runs must match
+      if (iomode_xycoord_in .ne. outgrid_option) then
+         write(*,'(/a/a/)') '*** readpartpositions fatal error', &
+           'outgrid_option from previous & current runs differ'
+         stop
+      end if
+
+      i=0
+200   i=i+1
+      if (iouttype .eq. 0) then
+        read(unitpartin) npoint(i),xlonin,ylatin,ztra1(i),itramem(i), &
+          topo,pvi,qvi,rhoi,hmixi,tri,tti,(xmass1(i,j),j=1,nspec)
+      else
+        read(unitpartin,*) npoint(i),itramem(i),xlonin,ylatin,ztra1(i), &
+          topo,pvi,qvi,rhoi,hmixi,tri,tti,(xmass1(i,j),j=1,nspec)
+      endif
+         
+      if (xlonin.eq.-9999.9) goto 100
+
+      if (outgrid_option .eq. 1) then
+! convert from lat-lon to grid-index coordinates
+        call ll_to_xyindex_wrf( xlonin, ylatin, xtra1(i), ytra1(i) )
+      else
+! convert from grid-meter to grid-index coordinates
+        xtra1(i)=(xlonin-xmet0)/dx
+        ytra1(i)=(ylatin-ymet0)/dy
+      endif
+      goto 200
+
+99    numpart=i-1
+
+      close(unitpartin)
+
+
+! Set nclass, idt, itra1, itramem, itrasplit to be consistent
+! with current run
+!***************************************
+
+  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
+      enddo
+      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.#### '
+      write(*,*) 'julin: ',julin
+      write(*,*) 'bdate: ',bdate
+      stop
+
+995   write(*,*) ' #### FLEXPART MODEL ERROR IN READPARTPOSITIONS#### '
+      write(*,*) ' #### NUMBER OF RELEASE LOCATIONS DOES NOT     #### '
+      write(*,*) ' #### AGREE WITH CURRENT SETTINGS!             #### '
+      stop
+
+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(1)(1:length(1))//'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/jerome/src_flexwrf_v3.1/readwind.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/readwind.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/readwind.f90	(revision 16)
@@ -0,0 +1,1459 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                *
+!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine,       *
+!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
+!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso,          *
+!* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann,   *
+!*                                                                     *
+!* This file is part of FLEXPART WRF                                   *
+!*                                                                     *
+!* 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,divh)
+!**********************************************************************
+!                                                                     * 
+!             TRAJECTORY MODEL SUBROUTINE READWIND                    *
+!                                                                     *
+!**********************************************************************
+!                                                                     * 
+! AUTHOR:      G. WOTAWA                                              *
+! DATE:        1997-08-05                                             *
+! LAST UPDATE: 2000-10-17, Andreas Stohl                              *
+!                                                                     * 
+! Bernd C. Krueger, Feb. 2001:  Variables tth and qvh                 *
+!                               (on eta coordinates) in common block  *
+!                                                                     * 
+! Oct-Dec, 2005: R. Easter.  Major changes for WRF.                   *
+!    06-nov-2005 rce - change uuh,vvh dimension back to original      * 
+!    16-nov-2005 rce - zzh is shifted like pph,tth                    * 
+!                                                                     * 
+!    11-June-2007,   W.WANG -- read TKE, change ndims_exp=1 for P_TOP
+!    19-Oct -2007,             read tcc, RAINC, RAINNC, CLDFRA,W0AVG
+!                              Note RAINC, RAINNC are accumulated prec
+!    Dec 2011, J Brioude: modifications, notably for the mean wind
+!
+! D. Arnold May 2012: quick fix - for CLDFRA
+! CLDFRA was  for sub-grid variability of precipitation
+! within a cell from  Hertel et al., 1995 (grid cells of approx. 150 km)
+! WRF will be typically be run at higher resolutions, therefore
+! we simply skip this condition and consider the maximum fraction
+! no more reading of CLDFRA needed, initialized to 0.
+! Same modifications for the nested domains!
+
+!**********************************************************************
+!                                                                     *
+! Note:  This is the FLEXPART_WRF version of subroutine readwind.     *
+!    The met fields are read from WRF netcdf output files.            *
+!    There are many differences from the FLEXPART version.            *
+!                                                                     *
+! 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 "T-grid" vertical levels wwf model     *
+!                    (the unstaggered "bottom_top" dimension)         *
+! uu,vv,ww           wind fields                                      *
+! tt,qv              temperature and specific humidity                *
+! ps                 surface pressure                                 *
+!                                                                     *
+!**********************************************************************
+!
+
+!      include 'includepar'
+!      include 'includecom'
+  use par_mod
+  use com_mod
+
+! subr arguments
+      integer :: indj, n
+
+      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)
+!     real(kind=4) :: urot(0:nxmax-1,0:nymax-1,nuvzmax)
+!     real(kind=4) :: vrot(0:nxmax-1,0:nymax-1,nuvzmax)
+      real(kind=4) :: divh(0:nxmax-1,0:nymax-1,nuvzmax)
+      real(kind=4) :: mu(0:nxmax-1,0:nymax-1,1),mu2
+      real(kind=4) :: mub(0:nxmax-1,0:nymax-1,1)
+!     real :: utrue1,vtrue1,utrue2,vtrue2,dumy
+!      real(kind=4) :: m_u(0:nxmax-1,0:nymax-1,1)
+!      real(kind=4) :: m_v(0:nxmax-1,0:nymax-1,1)
+!      real(kind=4) :: m_w(0:nxmax-1,0:nymax-1,1)
+
+!     real :: uuh(0:nxmax-1,0:nymax-1,nuvzmax)
+!     real :: vvh(0:nxmax-1,0:nymax-1,nuvzmax)
+!     real :: urot(0:nxmax-1,0:nymax-1,nuvzmax)
+!     real :: vrot(0:nxmax-1,0:nymax-1,nuvzmax)
+!     real :: wwh(0:nxmax-1,0:nymax-1,nwzmax)
+!     real :: divh(0:nxmax-1,0:nymax-1,nuvzmax)
+!     real :: mu(0:nxmax-1,0:nymax-1,1),mu2
+!     real :: mub(0:nxmax-1,0:nymax-1,1)
+!     real :: m_u(0:nxmax-1,0:nymax-1,1)
+!     real :: m_v(0:nxmax-1,0:nymax-1,1)
+!     real :: m_x(0:nxmax-1,0:nymax-1,1)
+!     real :: m_y(0:nxmax-1,0:nymax-1,1)
+!     real :: m_z(0:nxmax-1,0:nymax-1,1)
+
+! local variables
+      integer,parameter :: ndims_max=4
+
+      integer :: i, idiagaa, ierr, ifn, itime
+      integer :: iduma
+      integer :: j, jhhmmss, jyyyymmdd
+      integer :: k, kbgn
+      integer :: lendim(ndims_max), lendim_exp(ndims_max), &
+          lendim_max(ndims_max)
+      integer :: levdiff2
+      integer :: ndims, ndims_exp
+      integer :: n_west_east, n_south_north, n_bottom_top
+      integer :: m_grid_id_dum, m_parent_grid_id_dum, &
+        m_parent_grid_ratio_dum,  &
+        i_parent_start_dum, j_parent_start_dum, &
+        map_proj_id_dum,  &
+        ext_scalar,pbl_physics,mp_physics_dum
+
+      real :: dx_met, dy_met
+      real :: duma, dumb, dumc, dumd, dume
+      real :: dumdz
+!      real(kind=4) :: dumarray_aa(nwzmax+1)
+!      real(kind=4) :: dumarray_pp(0:nxmax-1,0:nymax-1,nwzmax+1)
+      real :: dumarray_aa(nwzmax+1)
+      real :: dumarray_pp(0:nxmax-1,0:nymax-1,nwzmax+1)
+      real :: ewater_mb, esatwater_mb
+      real :: ew      ! this is an external function
+      real :: map_stdlon_dum, map_truelat1_dum, map_truelat2_dum
+      real :: pint
+      real :: toler
+
+!      real(kind=4) :: ewss(0:nxmax-1,0:nymax-1),nsss(0:nxmax-1,0:nymax-1)
+      real :: ewss(0:nxmax-1,0:nymax-1),nsss(0:nxmax-1,0:nymax-1)
+      real :: plev1,pmean,tv,fu,hlev1,ff10m,fflev1
+
+      real(kind=dp) :: jul,juldate
+
+      character(len=160) :: fnamenc, varname,fnamenc2
+
+      logical :: hflswitch
+
+!
+!   get grid info from the wrf netcdf file
+!   and check it for consistency against values from gridcheck
+!
+      fnamenc = path(2)(1:length(2))//wfname(indj)
+      idiagaa = 0
+
+      call read_ncwrfout_gridinfo( ierr, idiagaa, fnamenc, &
+        n_west_east, n_south_north, n_bottom_top, & 
+        dx_met, dy_met,  &
+        m_grid_id_dum, m_parent_grid_id_dum, m_parent_grid_ratio_dum, &
+        i_parent_start_dum, j_parent_start_dum, &
+        map_proj_id_dum, map_stdlon_dum,  &
+        map_truelat1_dum, map_truelat2_dum, &
+        ext_scalar,pbl_physics,mp_physics_dum )
+      if (ierr .ne. 0) then
+          write(*,9100) 'error getting gridinfor for met file', fnamenc
+          stop
+      end if
+
+9100  format( / '*** readwind -- ', a )
+9110   format( / '*** readwind -- ', a, 1x, i8 / &
+     'file = ', a )
+9120 format( / '*** readwind -- ', a, 2(1x,i8) / &
+       'file = ', a )
+9130 format( / '*** readwind -- ', a, 3(1x,i8) / &
+       'file = ', a )
+9115 format( / '*** readwind -- ', a / a, 1x, i8 / &
+       'file = ', a )
+9125 format( / '*** readwind -- ', a / a, 2(1x,i8) / &
+       'file = ', a )
+9135 format( / '*** readwind -- ', a / a, 3(1x,i8) / &
+       'file = ', a )
+
+      toler = 2.0e-7
+
+      if (nx .ne. n_west_east) then
+          write(*,9100) 'nx not consistent', fnamenc
+          stop
+      end if
+      if (ny .ne. n_south_north) then
+          write(*,9100) 'ny not consistent', fnamenc
+          stop
+      end if
+      if (nlev_ec .ne. n_bottom_top) then
+          write(*,9100) 'nlev_ec not consistent', fnamenc
+          stop
+      end if
+      if (nwz .ne. n_bottom_top+1) then
+          write(*,9100) 'nwz not consistent', fnamenc
+          stop
+      end if
+!      if (nuvz .ne. n_bottom_top+1) then
+!          write(*,9100) 'nuvz not consistent', fnamenc
+!          stop
+!      end if
+
+      if (m_grid_id(0) .ne. m_grid_id_dum) then
+          write(*,9100) 'm_grid_id not consistent', fnamenc
+          write(*,*) m_grid_id(0), m_grid_id_dum
+          stop
+      end if
+      if (m_parent_grid_id(0) .ne. m_parent_grid_id_dum) then
+          write(*,9100) 'm_parent_grid_id not consistent', fnamenc
+          stop
+      end if
+      if (m_parent_grid_ratio(0) .ne. m_parent_grid_ratio_dum) then
+          write(*,9100) 'm_parent_grid_ratio not consistent', fnamenc
+          stop
+      end if
+      if (i_parent_start(0) .ne. i_parent_start_dum) then
+          write(*,9100) 'i_parent_start not consistent', fnamenc
+          stop
+      end if
+      if (j_parent_start(0) .ne. j_parent_start_dum) then
+          write(*,9100) 'j_parent_start not consistent', fnamenc
+          stop
+      end if
+
+      if (abs(dx - dx_met) .gt. toler*abs(dx)) then
+          write(*,9100) 'dx not consistent', fnamenc
+          stop
+      end if
+      if (abs(dy - dy_met) .gt. toler*abs(dy)) then
+          write(*,9100) 'dy not consistent', fnamenc
+          stop
+      end if
+
+! locate the date/time in the file
+      itime = 0
+1100  itime = itime + 1
+      call read_ncwrfout_1datetime( ierr, fnamenc, &
+          itime, jyyyymmdd, jhhmmss )
+      if (ierr .eq. -1) then
+          write(*,9100) 'error reading time from met file', fnamenc
+          stop
+      else if (ierr .ne. 0) then
+          write(*,9125) 'unable to locate date/time in met file',  &
+              'indj, itime =', indj, itime, fnamenc
+          stop
+      else 
+          jul = juldate( jyyyymmdd, jhhmmss )
+          duma = (jul-bdate)*86400.
+          iduma = nint(duma)
+          if (iduma .ne. wftime(indj)) goto 1100
+      end if
+      if (option_verbose.eq.1) then
+      write(*,*) 
+      write(*,*) 'readwind processing wrfout file ='
+      write(*,*) fnamenc
+      write(*,*) 'itime, ymd, hms =', itime, jyyyymmdd, jhhmmss
+
+      endif
+! read eta_w_wrf, eta_u_wrf, p_top_wrf, ylat2d, xlon2d from the 
+! netcdf wrfout file and compare to those from the 1st met. file
+
+      varname = 'ZNW'
+      do i = 1, ndims_max
+          lendim_exp(i) = 0
+          lendim_max(i) = 1
+      end do
+      lendim_exp(1) = nwz
+      lendim_max(1) = nwzmax+1
+      ndims_exp = 2
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+      	  varname, dumarray_aa, &
+      	  itime, &
+      	  ndims, ndims_exp, ndims_max, &
+      	  lendim, lendim_exp, lendim_max )
+      if (ierr .ne. 0) then
+        fnamenc2='wrfout_d03_zn.nc'
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc2, &
+          varname, dumarray_aa, &
+          itime, &
+          ndims, ndims_exp, ndims_max, &
+          lendim, lendim_exp, lendim_max )  
+
+      if (ierr .ne. 0) then
+          write(*,9100) 'error doing ncread of ZNW', fnamenc
+          stop
+      end if
+      end if
+      do k = 1, nwz
+          if (abs(eta_w_wrf(k) - dumarray_aa(k))  &
+                  .gt. toler*abs(eta_w_wrf(k))) then
+              write(*,9100) 'eta_w_wrf not consistent', fnamenc
+              stop
+          end if
+      end do
+
+      varname = 'ZNU'
+      lendim_exp(1) = nwz-1
+      lendim_max(1) = nwzmax+1
+      ndims_exp = 2
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+      	  varname, dumarray_aa, &
+      	  itime, &
+      	  ndims, ndims_exp, ndims_max, &
+      	  lendim, lendim_exp, lendim_max )
+      if (ierr .ne. 0) then
+        fnamenc2='wrfout_d03_zn.nc'
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc2, &
+          varname, dumarray_aa, &
+          itime, &
+          ndims, ndims_exp, ndims_max, &
+          lendim, lendim_exp, lendim_max )
+      if (ierr .ne. 0) then
+
+          write(*,9100) 'error doing ncread of ZNU', fnamenc
+          stop
+      end if
+      end if
+      do k = 1, nwz-1
+          if (abs(eta_u_wrf(k) - dumarray_aa(k))  &
+                  .gt. toler*abs(eta_u_wrf(k))) then
+              write(*,9100) 'eta_u_wrf not consistent', fnamenc
+              stop
+          end if
+      end do
+
+!      varname = 'P_TOP'
+!      lendim_exp(1) = 1
+!      lendim_max(1) = 6
+!      ndims_exp = 2
+!      if (ext_scalar .lt. 0) ndims_exp = 1
+!      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+!      	  varname, duma, &
+!      	  itime, &
+!      	  ndims, ndims_exp, ndims_max, &
+!      	  lendim, lendim_exp, lendim_max )
+!      if (ierr .ne. 0) then
+!          write(*,9100) 'error doing ncread of P_TOP', fnamenc
+!          stop
+!      end if
+!      if (abs(p_top_wrf - duma) .gt. toler*abs(p_top_wrf)) then
+!          write(*,9100) 'p_top_wrf not consistent', fnamenc
+!          stop
+!      end if
+
+      varname = 'XLAT'
+      lendim_exp(1) = nx
+      lendim_max(1) = nxmax
+      lendim_exp(2) = ny
+      lendim_max(2) = nymax
+      ndims_exp = 3
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+      	  varname, dumarray_pp, &
+      	  itime, &
+      	  ndims, ndims_exp, ndims_max, &
+      	  lendim, lendim_exp, lendim_max )
+      if (ierr .ne. 0) then
+          write(*,*)
+          write(*,9100) 'error doing ncread of XLAT', fnamenc
+          stop
+      end if
+      toler = 1.0e-6
+      do j = 0, ny-1
+      do i = 0, nx-1
+          if (abs(ylat2d(i,j) - dumarray_pp(i,j,1)) .gt.  &
+                              toler*abs(ylat2d(i,j))) then
+              write(*,9100) 'ylat2d not consistent', fnamenc
+              write(*,'(a,2i5,2f16.6)') 'i,j,ylats =', i, j, &
+                      ylat2d(i,j), dumarray_pp(i,j,1)
+              stop
+          end if
+      end do
+      end do
+
+      varname = 'XLONG'
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+      	  varname, dumarray_pp, &
+      	  itime, &
+      	  ndims, ndims_exp, ndims_max, &
+      	  lendim, lendim_exp, lendim_max )
+      if (ierr .ne. 0) then
+          write(*,*)
+          write(*,9100) 'error doing ncread of XLONG', fnamenc
+          stop
+      end if
+      do j = 0, ny-1
+      do i = 0, nx-1
+          if (abs(xlon2d(i,j) - dumarray_pp(i,j,1)) .gt.  &
+                              toler*abs(xlon2d(i,j))) then
+              write(*,9100) 'xlon2d not consistent', fnamenc
+              write(*,'(a,2i5,2f16.6)') 'i,j,xlons =', i, j, &
+                      xlon2d(i,j), dumarray_pp(i,j,1)
+              stop
+          end if
+      end do
+      end do
+
+
+!
+!
+! now read the data fields for current time
+! the following are read from ecmwf met files
+!       U VELOCITY
+!       V VELOCITY
+!       W VELOCITY
+!       TEMPERATURE
+!       SPEC. HUMIDITY  
+!       SURF. PRESS.
+!       SEA LEVEL PRESS.
+!       10 M U VELOCITY
+!       10 M V VELOCITY
+!       2 M TEMPERATURE
+!       2 M DEW POINT  
+!       SNOW DEPTH
+!       CLOUD COVER
+!       LARGE SCALE PREC.
+!       CONVECTIVE PREC.
+!       SENS. HEAT FLUX
+!       SOLAR RADIATION
+!       EW SURFACE STRESS
+!       NS SURFACE STRESS
+!       ECMWF OROGRAPHY
+!       STANDARD DEVIATION OF OROGRAPHY
+!       ECMWF LAND SEA MASK
+!
+!
+      hflswitch=.false.
+      strswitch=.false.
+      levdiff2=nlev_ec-nwz+1
+
+      kbgn = 1 + add_sfc_level
+! at this point
+!   if add_sfc_level=1, then nuvz=nwz   and kbgn=2
+!   if add_sfc_level=0, then nuvz=nwz-1 and kbgn=1
+
+! u wind velocity
+!   the wrf output file contains (nuvz-add_sfc_level) levels
+!   read the data into k=kbgn,nuvz
+!   (interpolate it from "U-grid" to "T-grid" later)
+      if (wind_option.le.0) varname = 'U'
+      if (wind_option.eq.1) varname = 'AVGFLX_RUM'
+      if (wind_option.eq.2) varname = 'U'
+
+      do i = 1, ndims_max
+          lendim_exp(i) = 0
+          lendim_max(i) = 1
+      end do
+      lendim_exp(1) = nx+1
+      lendim_max(1) = nxmax
+      lendim_exp(2) = ny
+      lendim_max(2) = nymax
+      lendim_exp(3) = nuvz-add_sfc_level
+      lendim_max(3) = nuvzmax
+      ndims_exp = 4
+      if (time_option.eq.0) then
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+      	  varname, uuh(0,0,kbgn), &
+      	  itime, &
+      	  ndims, ndims_exp, ndims_max, &
+      	  lendim, lendim_exp, lendim_max )
+      if (ierr .ne. 0) then
+          write(*,9100) 'error doing ncread of U', fnamenc
+      if (wind_option.le.0) print*,'you asked snapshot winds'
+      if (wind_option.eq.1) print*,'you asked mean winds'
+        print*,'change wind_option'
+
+          stop
+      end if
+
+      endif !test on time_option
+
+! v wind velocity
+!   the wrf output file contains (nuvz-add_sfc_level) levels
+!   read the data into k=kbgn,nuvz
+!   (interpolate it from "V-grid" to "T-grid" later)
+      if (wind_option.le.0) varname = 'V'
+      if (wind_option.eq.1) varname = 'AVGFLX_RVM'
+      if (wind_option.eq.2) varname = 'V'
+      lendim_exp(1) = nx
+      lendim_max(1) = nxmax
+      lendim_exp(2) = ny+1
+      lendim_max(2) = nymax
+      if (time_option.eq.0) then
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+      	  varname, vvh(0,0,kbgn), &
+      	  itime, &
+      	  ndims, ndims_exp, ndims_max, &
+      	  lendim, lendim_exp, lendim_max )
+      if (ierr .ne. 0) then
+          write(*,9100) 'error doing ncread of V', fnamenc
+      if (wind_option.eq.0) print*,'you asked snapshot winds'
+      if (wind_option.eq.1) print*,'you asked mean winds'
+        print*,'change wind_option'
+          stop
+      end if
+
+      endif !test on time_option
+
+! w wind velocity
+!   this is on the "W-grid", and 
+!   the wrf output file contains nwz levels, so no shifting needed
+      if (wind_option.le.0) varname = 'W'
+      if (wind_option.eq.1) varname = 'AVGFLX_WWM'
+      if (wind_option.eq.2) varname = 'WW'
+!     print*,'varname',varname
+      lendim_exp(1) = nx
+      lendim_max(1) = nxmax
+      lendim_exp(2) = ny
+      lendim_max(2) = nymax
+      lendim_exp(3) = nwz
+      lendim_max(3) = nwzmax
+      if (time_option.eq.0) then
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+      	  varname, wwh, &
+      	  itime, &
+      	  ndims, ndims_exp, ndims_max, &
+      	  lendim, lendim_exp, lendim_max )
+      if (ierr .ne. 0) then
+          write(*,9100) 'error doing ncread of W', fnamenc
+      if (wind_option.eq.0) print*,'you asked snapshot winds'
+      if (wind_option.eq.1) print*,'you asked mean winds'
+        print*,'change wind_option'
+          stop
+      end if
+
+      endif !test on time_option
+
+! pressure - read base state and perturbation pressure,
+!     then combine
+!   the wrf output file contains (nuvz-add_sfc_level) levels
+!   read the data into k=kbgn,nuvz
+      varname = 'PB'
+      lendim_exp(3) = nuvz-add_sfc_level
+      lendim_max(3) = nuvzmax
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+      	  varname, pph(0,0,kbgn,n), &
+      	  itime, &
+      	  ndims, ndims_exp, ndims_max, &
+      	  lendim, lendim_exp, lendim_max )
+      if (ierr .ne. 0) then
+          write(*,9100) 'error doing ncread of PB', fnamenc
+          stop
+      end if
+
+      varname = 'P'
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+      	  varname, dumarray_pp(0,0,kbgn), &
+      	  itime, &
+      	  ndims, ndims_exp, ndims_max, &
+      	  lendim, lendim_exp, lendim_max )
+      if (ierr .ne. 0) then
+          write(*,9100) 'error doing ncread of P', fnamenc
+          stop
+      end if
+
+      do k = kbgn, nuvz
+      do j = 0, nymin1
+      do i = 0, nxmin1
+          pph(i,j,k,n) = pph(i,j,k,n) + dumarray_pp(i,j,k)
+      end do
+      end do
+      end do
+
+
+! height - read base state and perturbation geopotential,
+!     then combine and divide by gravity
+!   these are on the "W-grid", and 
+!     the wrf output file contains nwz levels
+!   shift them also so they will be consistent with pph
+      varname = 'PHB'
+      lendim_exp(3) = nwz
+      lendim_max(3) = nwzmax+1
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+      	  varname, zzh(0,0,kbgn,n), &
+      	  itime, &
+      	  ndims, ndims_exp, ndims_max, &
+      	  lendim, lendim_exp, lendim_max )
+      if (ierr .ne. 0) then
+          write(*,9100) 'error doing ncread of PB', fnamenc
+          stop
+      end if
+
+      varname = 'PH'
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+      	  varname, dumarray_pp(0,0,kbgn), &
+      	  itime, &
+      	  ndims, ndims_exp, ndims_max, &
+      	  lendim, lendim_exp, lendim_max )
+      if (ierr .ne. 0) then
+          write(*,9100) 'error doing ncread of P', fnamenc
+          stop
+      end if
+
+      do k = kbgn, nwz+add_sfc_level
+      do j = 0, nymin1
+      do i = 0, nxmin1
+          zzh(i,j,k,n) =  &
+                  (zzh(i,j,k,n) + dumarray_pp(i,j,k))/9.81
+      end do
+      end do
+      end do
+
+! now use dumarray_pp to store 1/density for stress calculation below
+!      if(sfc_option .eq. sfc_option_wrf) then 
+
+!      varname = 'ALT'
+!      lendim_exp(3) = nuvz-add_sfc_level
+!      lendim_max(3) = nwzmax
+!      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+!          varname, dumarray_pp(0,0,kbgn), &
+!          itime, &
+!          ndims, ndims_exp, ndims_max, &
+!          lendim, lendim_exp, lendim_max )
+!      if (ierr .ne. 0) then
+!          write(*,9100) 'error doing ncread of ALT', fnamenc
+!          stop
+!      end if
+
+!      end if
+
+! temperature - read perturbation potential temperature,
+!     add 300. (base value), then add and convert
+!   the wrf output file contains (nuvz-add_sfc_level) levels
+!   read the data into k=kbgn,nuvz
+      varname = 'T'
+      lendim_exp(3) = nuvz-add_sfc_level
+      lendim_max(3) = nuvzmax
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+      	  varname, tth(0,0,kbgn,n), &
+      	  itime, &
+      	  ndims, ndims_exp, ndims_max, &
+      	  lendim, lendim_exp, lendim_max )
+      if (ierr .ne. 0) then
+          write(*,9100) 'error doing ncread of T', fnamenc
+          stop
+      end if
+
+      do k = kbgn, nuvz
+      do j = 0, nymin1
+      do i = 0, nxmin1
+! save potential temperature to ptth
+        ptth(i,j,k,n)=tth(i,j,k,n)+300.                 
+        tth(i,j,k,n) = (tth(i,j,k,n) + 300.) * &
+                  (pph(i,j,k,n)/1.0e5)**0.286
+  
+      end do
+      end do
+      end do
+
+!-
+      if (turb_option .eq. turb_option_tke .or.  &
+          turb_option .eq. turb_option_mytke ) then
+      print*, 'READ TKE',turb_option
+! TKE - read Turbulent Kinetic,
+!   the wrf output file contains (nuvz-add_sfc_level) levels
+!   read the data into k=kbgn,nuvz
+      varname = 'TKE'
+      lendim_exp(3) = nuvz-add_sfc_level
+      lendim_max(3) = nuvzmax
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+          varname, tkeh(0,0,kbgn,n), &
+          itime, &
+          ndims, ndims_exp, ndims_max, &
+          lendim, lendim_exp, lendim_max )
+
+      if (ierr .ne. 0) then
+      print*,'NO TKE available. Try TKE_PBL instead'
+      varname = 'TKE_PBL'
+      lendim_exp(3) = nuvz-add_sfc_level
+      lendim_max(3) = nuvzmax
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+          varname, tkeh(0,0,kbgn,n), &
+          itime, &
+          ndims, ndims_exp, ndims_max, &
+          lendim, lendim_exp, lendim_max )
+      endif
+      if (ierr .ne. 0) then
+      print*,'NO TKE_PBL available. Try QKE instead'
+      varname = 'qke'
+      lendim_exp(3) = nuvz-add_sfc_level
+      lendim_max(3) = nuvzmax
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+          varname, tkeh(0,0,kbgn,n), &
+          itime, &
+          ndims, ndims_exp, ndims_max, &
+          lendim, lendim_exp, lendim_max )
+       tkeh=tkeh/2. !conversion of qke
+      endif
+      if (ierr .ne. 0) then
+      varname = 'QKE'
+      lendim_exp(3) = nuvz-add_sfc_level
+      lendim_max(3) = nuvzmax
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+          varname, tkeh(0,0,kbgn,n), &
+          itime, &
+          ndims, ndims_exp, ndims_max, &
+          lendim, lendim_exp, lendim_max )
+       tkeh=tkeh/2. !conversion of qke
+      endif
+
+      if (ierr .ne. 0) then
+          write(*,9100) 'error doing ncread of TKE', fnamenc
+      write(*,*)'change turb_option NOT to use TKE or change input file'
+          print*,'change SFC_OPTION to 0  as well'
+          stop
+      end if
+
+       endif
+
+
+!-
+
+! specific humidity - read mixing ratio (kg-water-vapor/kg-dry-air),
+!     then convert to (kg-water-vapor/kg-moist-air)
+!   the wrf output file contains (nuvz-add_sfc_level) levels
+!   read the data into k=kbgn,nuvz
+      varname = 'QVAPOR'
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+      	  varname, qvh(0,0,kbgn,n), &
+      	  itime, &
+      	  ndims, ndims_exp, ndims_max, &
+      	  lendim, lendim_exp, lendim_max )
+      if (ierr .ne. 0) then
+          write(*,9100) 'error doing ncread of QVAPOR', fnamenc
+          stop
+      end if
+
+      do k = kbgn, nuvz
+      do j = 0, nymin1
+      do i = 0, nxmin1
+          qvh(i,j,k,n) = max( qvh(i,j,k,n), 0.0 )
+          qvh(i,j,k,n) = qvh(i,j,k,n)/(1.0 + qvh(i,j,k,n))
+      end do
+      end do
+      end do
+
+
+! surface pressure
+      varname = 'PSFC'
+      lendim_exp(3) = 0
+      lendim_max(3) = 1
+      ndims_exp = 3
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+      	  varname, ps(0,0,1,n), &
+      	  itime, &
+      	  ndims, ndims_exp, ndims_max, &
+      	  lendim, lendim_exp, lendim_max )
+      if (ierr .ne. 0) then
+          write(*,9100) 'error doing ncread of PSFC', fnamenc
+          stop
+      end if
+
+! for the mexico city grid 3 simulation, the surface and
+!   level 1 pressures are not as consistent as one would like,
+!   with the problems occuring near the domain boundaries.
+! so do the following
+!   -- calculate surface pressure from lowest level pressure, temp, height
+!   -- use wrf pressures (pph array) wherever possible
+!      (avoid using surface pressure and the akz/bkz, akm/bkm)
+      do j = 0, nymin1
+      do i = 0, nxmin1
+          duma = ps(i,j,1,n)
+          dumdz = 0.5*(zzh(i,j,kbgn+1,n) - zzh(i,j,kbgn,n))
+          tv = tth(i,j,kbgn,n)*(1.+0.61*qvh(i,j,kbgn,n))
+          ps(i,j,1,n) = pph(i,j,kbgn,n)*exp( dumdz*ga/(r_air*tv) )
+      end do
+      end do
+
+
+! 10 meter u velocity
+!   note:  u10 is on the "T-grid" already
+      varname = 'U10'
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+      	  varname, u10(0,0,1,n), &
+      	  itime, &
+      	  ndims, ndims_exp, ndims_max, &
+      	  lendim, lendim_exp, lendim_max )
+      if (ierr .ne. 0) then
+          write(*,9100) 'error doing ncread of U10', fnamenc
+          stop
+      end if
+
+
+! 10 meter v velocity
+!   note:  v10 is on the "T-grid" already
+      varname = 'V10'
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+      	  varname, v10(0,0,1,n), &
+      	  itime, &
+      	  ndims, ndims_exp, ndims_max, &
+      	  lendim, lendim_exp, lendim_max )
+      if (ierr .ne. 0) then
+          write(*,9100) 'error doing ncread of V10', fnamenc
+          stop
+      end if
+
+
+! 2 meter temperature
+      varname = 'T2'
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+      	  varname, tt2(0,0,1,n), &
+      	  itime, &
+      	  ndims, ndims_exp, ndims_max, &
+      	  lendim, lendim_exp, lendim_max )
+      if (ierr .ne. 0) then
+          write(*,9100) 'error doing ncread of T2', fnamenc
+          stop
+      end if
+
+
+! 2 meter dew point - read 2 meter water vapor mixing ratio
+!   then calculate the dew point
+      varname = 'Q2'
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+      	  varname, td2(0,0,1,n), &
+      	  itime, &
+      	  ndims, ndims_exp, ndims_max, &
+      	  lendim, lendim_exp, lendim_max )
+      if (ierr .ne. 0) then
+          write(*,9100) 'error doing ncread of Q2'
+!, fnamenc
+          do j = 0, nymin1
+          do i = 0, nxmin1
+! 29-nov-2005 - changed qvh(i,j,1,n) to qvh(i,j,kbgn,n) here
+              td2(i,j,1,n) = qvh(i,j,kbgn,n)
+          end do
+          end do
+      end if
+
+      if (wind_option.ge.1) then
+!      print*,'mean wind from WRF is used'
+!      print*,'option ',wind_option
+      varname = 'MU'
+
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+          varname, mu(0,0,1), &
+          itime, &
+          ndims, ndims_exp, ndims_max, &
+          lendim, lendim_exp, lendim_max )
+      if (ierr .ne. 0) then
+          write(*,9100) 'error doing MU', fnamenc
+          stop
+      end if
+
+      varname = 'MUB'
+
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+          varname, mub(0,0,1), &
+          itime, &
+          ndims, ndims_exp, ndims_max, &
+          lendim, lendim_exp, lendim_max )
+      if (ierr .ne. 0) then
+          write(*,9100) 'error doing MUV', fnamenc
+          stop
+      end if
+      endif
+
+!      varname = 'MAPFAC_UX'
+!      varname = 'MAPFAC_UY' !try
+!      lendim_exp(1) = nx+1
+!      lendim_max(1) = nxmax
+!      lendim_exp(2) = ny
+!      lendim_max(2) = nymax
+!
+!      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+!          varname, m_u(0,0,1), &
+!          itime, &
+!          ndims, ndims_exp, ndims_max, &
+!          lendim, lendim_exp, lendim_max )
+!      if (ierr .ne. 0) then
+!          write(*,9100) 'error doing MAP U', fnamenc
+!          stop
+!      end if
+!
+!      varname = 'MAPFAC_VY'
+!      varname = 'MAPFAC_VX' !try
+!      lendim_exp(1) = nx
+!      lendim_max(1) = nxmax
+!      lendim_exp(2) = ny+1
+!      lendim_max(2) = nymax
+!
+!      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+!          varname, m_v(0,0,1), &
+!          itime, &
+!          ndims, ndims_exp, ndims_max, &
+!          lendim, lendim_exp, lendim_max )
+!      if (ierr .ne. 0) then
+!          write(*,9100) 'error doing MAP V', fnamenc
+!          stop
+!      end if
+
+!      varname = 'MAPFAC_MX'
+!      lendim_exp(1) = nx
+!      lendim_max(1) = nxmax
+!      lendim_exp(2) = ny
+!      lendim_max(2) = nymax
+!
+!      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+!          varname, m_x(0,0,1), &
+!          itime, &
+!          ndims, ndims_exp, ndims_max, &
+!          lendim, lendim_exp, lendim_max )
+!      if (ierr .ne. 0) then
+!          write(*,9100) 'error doing MAP X', fnamenc
+!      varname = 'MAPFAC_U'
+!      lendim_exp(1) = nx+1
+!      lendim_max(1) = nxmax
+!      lendim_exp(2) = ny
+!      lendim_max(2) = nymax
+!      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+!          varname, m_u(0,0,1), &
+!          itime, &
+!          ndims, ndims_exp, ndims_max, &
+!          lendim, lendim_exp, lendim_max )
+!      do j = 0, nymin1
+!      do i = 0, nxmin1
+!      m_x(i,j,1)=(m_u(i,j,1)+m_u(i+1,j,1))*0.5 
+!      enddo
+!      enddo
+!      if (ierr .ne. 0) then
+!          write(*,9100) 'error doing MAP U', fnamenc
+!          print*,'NO MAP FACTOR IS GOING TO BE USED.'
+!          print*,'LARGE UNCERTAINTIES TO BE EXPECTED'
+!      do j = 0, nymin1
+!      do i = 0, nxmin1
+!      m_x(i,j,1)=1.
+!      enddo
+!      enddo
+!      end if
+!      end if
+
+!      varname = 'MAPFAC_M'
+!      lendim_exp(1) = nx
+!      lendim_max(1) = nxmax
+!      lendim_exp(2) = ny
+!      lendim_max(2) = nymax
+!
+!      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+!          varname, m_z(0,0,1), &
+!          itime, &
+!          ndims, ndims_exp, ndims_max, &
+!          lendim, lendim_exp, lendim_max )
+!      if (ierr .ne. 0) then
+!          write(*,9100) 'error doing MAP W', fnamenc
+!          stop
+!      end if
+
+!      varname = 'MAPFAC_MY'
+!      lendim_exp(1) = nx
+!      lendim_max(1) = nxmax
+!      lendim_exp(2) = ny
+!      lendim_max(2) = nymax
+!
+!      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+!          varname, m_y(0,0,1), &
+!          itime, &
+!          ndims, ndims_exp, ndims_max, &
+!          lendim, lendim_exp, lendim_max )
+!      if (ierr .ne. 0) then
+!          write(*,9100) 'error doing MAP Y', fnamenc
+!      varname = 'MAPFAC_V'
+!      lendim_exp(1) = nx
+!      lendim_max(1) = nxmax
+!      lendim_exp(2) = ny+1
+!      lendim_max(2) = nymax
+!      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+!          varname, m_v(0,0,1), &
+!          itime, &
+!          ndims, ndims_exp, ndims_max, &
+!          lendim, lendim_exp, lendim_max )
+!      do j = 0, nymin1
+!      do i = 0, nxmin1
+!      m_y(i,j,1)=(m_v(i,j,1)+m_v(i,j+1,1))*0.5
+!      enddo
+!      enddo
+!      if (ierr .ne. 0) then
+!          write(*,9100) 'ERROR doing MAP V', fnamenc
+!          print*,'NO MAP FACTOR IS GOING TO BE USED.'
+!          print*,'LARGE UNCERTAINTIES TO BE EXPECTED'
+!      do j = 0, nymin1
+!      do i = 0, nxmin1
+!      m_y(i,j,1)=1.
+!      enddo
+!      enddo
+!      end if
+!      end if
+      lendim_exp(1) = nx
+      lendim_max(1) = nxmax
+      lendim_exp(2) = ny
+      lendim_max(2) = nymax
+
+
+
+! calculate water vapor pressure in mb, from sfc pressure
+!   and 2 m mixing ratio
+      iduma = 0
+      do j = 0, nymin1
+      do i = 0, nxmin1
+! 29-nov-2005 - added this to catch occasional tt2n=0.0 values
+          duma = max( 100.0, tth(i,j,kbgn,n)-50.0 )
+          if (tt2(i,j,1,n) .le. duma) then
+              iduma = iduma + 1
+              if (iduma .eq. 1) then
+                  write(*,*) 'readwind - bad tt2 at'
+                  write(*,*) 'i, j, tt2 =', i, j, tt2(i,j,1,n)
+              end if
+!             stop
+              tt2(i,j,1,n) = tth(i,j,kbgn,n)
+              td2(i,j,1,n) = qvh(i,j,kbgn,n)
+          end if
+          duma = td2(i,j,1,n)/0.622
+          ewater_mb = 0.01*( 0.99976*ps(i,j,1,n)*duma/(1.0+duma) )
+          esatwater_mb = 0.01*ew(tt2(i,j,1,n))
+          ewater_mb = max( 1.0e-10, min( esatwater_mb, ewater_mb ) )
+! then use the following, which is from an old 1970's report
+!   (reference not available, but the formula works)
+!   tdew(in C) = (4318.76/(19.5166 - ln(ewater(in mb)))) - 243.893
+          td2(i,j,1,n) = 273.16 + &
+                 (4318.76/(19.5166 - log(ewater_mb))) - 243.893
+      end do
+      end do
+      if (iduma .gt. 0) write(*,*) &
+          'readwind - bad tt2 count =', iduma
+
+
+! sea level pressure - calculate it from surface pressure and 
+!    ground elevation using standard atmosphere relations
+      do j = 0, nymin1
+      do i = 0, nxmin1
+          msl(i,j,1,n) = ps(i,j,1,n)/ &
+                  ((1.0 - 6.5e-3*oro(i,j)/288.0)**5.2553)
+      end do
+      end do
+
+
+! large scale precipitation
+! convective  precipitation
+!   the wrf output files contain these as "accumulated totals"
+!   I need to find out if these are accumulated over the output
+!       file frequency, or over the total run.
+!   For now, set to zero
+! total cloud cover
+!   Doesn't appear to be any 2-d cloud cover field in the
+!       wrf output.
+!   For now, set to zero
+      do j = 0, nymin1
+      do i = 0, nxmin1
+          lsprec(i,j,1,n) = 0.0
+          convprec(i,j,1,n) = 0.0
+          tcc(i,j,1,n) = 0.0
+      end do
+      end do
+
+!
+! Large-scale precipitation (accumulated rain, mm)
+!    will convert to mm/h  in interpolat_rain.f
+      varname = 'RAINNC'
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+          varname, lsprec(0,0,1,n), &
+          itime, &
+          dims, ndims_exp, ndims_max, &
+          lendim, lendim_exp, lendim_max )
+      if (ierr .ne. 0) then
+     write(*,9100) 'error doing ncread of RAINNC,set to zero', fnamenc
+          do j = 0, nymin1
+          do i = 0, nxmin1
+              lsprec(i,j,1,n) = 0.0
+          end do
+          end do
+      end if
+
+!
+! Convective cumulus precipitation (accumulated rain, mm)
+
+      varname = 'RAINC'
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+          varname, convprec(0,0,1,n), &
+          itime, &
+          ndims, ndims_exp, ndims_max, &
+          lendim, lendim_exp, lendim_max )
+      if (ierr .ne. 0) then
+     write(*,9100) 'error doing ncread of RAINC, set to zero', fnamenc
+          do j = 0, nymin1
+          do i = 0, nxmin1
+              convprec(i,j,1,n) = 0.0
+          end do
+          end do
+      end if
+
+!
+! Clound fraction  (cloud cover)
+!      varname = 'CLDFRA'
+!      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+!          varname, tcc(0,0,1,n), &
+!          itime, &
+!          ndims, ndims_exp, ndims_max, &
+!          lendim, lendim_exp, lendim_max )
+!      if (ierr .ne. 0) then
+!!     write(*,9100) 'error doing ncread of CLDFRA, set to zero'
+!!, fnamenc
+!          do j = 0, nymin1
+!          do i = 0, nxmin1
+!              tcc(i,j,1,n) = 0.0
+!          end do
+!          end do
+!      end if
+!!C        write(*,*)'read CLDFRA 0-sucess ',ierr
+
+!
+
+! snow depth
+      varname = 'SNOWH'
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+      	  varname, sd(0,0,1,n), &
+      	  itime, &
+      	  ndims, ndims_exp, ndims_max, &
+      	  lendim, lendim_exp, lendim_max )
+      if (ierr .ne. 0) then
+!         write(*,9100) 'error doing ncread of SNOWH', fnamenc
+          do j = 0, nymin1
+          do i = 0, nxmin1
+              sd(i,j,1,n) = 0.0
+          end do
+          end do
+      end if
+
+
+! surface sensible heat flux (positive <--> upwards)
+      varname = 'HFX'
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+      	  varname, sshf(0,0,1,n), &
+      	  itime, &
+      	  ndims, ndims_exp, ndims_max, &
+      	  lendim, lendim_exp, lendim_max )
+           do j = 0, nymin1
+           do i = 0, nxmin1
+               sshf(i,j,1,n) = -sshf(i,j,1,n)
+           end do
+           end do
+
+      if (ierr .ne. 0) then
+          write(*,9100) 'error doing ncread of HFX', fnamenc
+          do j = 0, nymin1
+          do i = 0, nxmin1
+              sshf(i,j,1,n) = 0.0
+          end do
+          end do
+          hflswitch=.false.    ! Heat flux is not available
+      else
+          hflswitch=.true.     ! Heat flux is available
+! limit to values to bounds originally used by flexpart?
+!        do 1502 j=0,nymin1
+!        do 1502 i=0,nxmin1
+!           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.
+!1502    continue
+      end if
+
+! ustar
+      varname = 'UST'
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+            varname, ustar(0,0,1,n), &
+            itime, &
+            ndims, ndims_exp, ndims_max, &
+            lendim, lendim_exp, lendim_max )
+      if (ierr .ne. 0) then
+         write(*,9100) 'error doing ncread of UST', fnamenc
+         do j = 0, nymin1
+         do i = 0, nxmin1
+             ustar(i,j,1,n) = 0.0
+         end do
+         end do
+         strswitch=.false.    ! ustar is not available
+      else
+         strswitch=.true.     ! ustar is available
+         do j=0,nymin1
+         do i=0,nxmin1
+!           surfstr(i,j,1,n)=ustar(i,j,1,n)/dumarray_pp(i,j,kbgn)
+         enddo
+         enddo
+      end if
+
+! pblh
+      if(sfc_option .eq. sfc_option_wrf) then
+      varname = 'PBLH'
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+          varname, hmix(0,0,1,n), &
+          itime, &
+          ndims, ndims_exp, ndims_max, &
+          lendim, lendim_exp, lendim_max )
+      if (ierr .ne. 0) then
+          write(*,9100) 'error doing ncread of PBLH', fnamenc
+          stop
+      endif
+
+      endif
+
+! surface solar radiation flux (positive <--> downwards)
+      varname = 'SWDOWN'
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+      	  varname, ssr(0,0,1,n), &
+      	  itime, &
+      	  ndims, ndims_exp, ndims_max, &
+      	  lendim, lendim_exp, lendim_max )
+      if (ierr .ne. 0) then
+          write(*,9100) 'error doing ncread of SWDOWN', fnamenc
+          do j = 0, nymin1
+          do i = 0, nxmin1
+              ssr(i,j,1,n) = 0.0
+          end do
+          end do
+      else
+          do j = 0, nymin1
+          do i = 0, nxmin1
+              ssr(i,j,1,n) = max( ssr(i,j,1,n), 0.0 )
+          end do
+          end do
+      end if
+
+
+! ew & ns surface stress
+!   Doesn't appear to be any 2-d cloud cover field in the
+!       wrf output.
+!   For now, set to zero
+      do j = 0, nymin1
+      do i = 0, nxmin1
+          ewss(i,j) = 0.0
+          nsss(i,j) = 0.0
+      end do
+      end do
+!     strswitch=.false.    ! Surface stress is not available
+
+
+! orography
+! standard deviation of orography
+! land sea mask
+!    these should be fixed during a simulation
+!    so there is no reason to do them again ??
+
+
+! *** done with reading the wrf output file ***
+
+!  print*,'uu out1',uuh(0,259,1:10)
+!  print*,'mu out1',mu(0,259,1),mub(0,259,1)
+!  print*,'m_xn out1',m_x(0,259,1),m_y(0,259,1)
+
+
+! interpolate uuh from the "U-grid" to the "T-grid"
+! interpolate vvh from the "V-grid" to the "T-grid"
+! new: convert mass weighted wind to wind.
+!      print*,'wind_option',wind_option
+      if (wind_option.le.0) then
+!     if (wind_option.eq.-1) then
+!     call calc_uvmet(uuh,vvh,urot,vrot,1)
+!     endif
+      do k = kbgn, nuvz
+      do j = 0, nymin1
+      do i = 0, nxmin1
+! needs to rotate u and v to work. needs read alpha or something like that.
+! if in mercator, no need.
+!     divh(i,j,k)=(uuh(i+1,j,k)-uuh(i,j,k))/dx &
+!      +(vvh(i,j+1,k)-vvh(i,j,k))/dy   
+      if (wind_option.lt.0) then
+      divh(i,j,k)=(uuh(i+1,j,k)-uuh(i,j,k))/dx*m_x(i,j,1) &
+       +(vvh(i,j+1,k)-vvh(i,j,k))/dy*m_y(i,j,1)   
+      endif 
+          uuh(i,j,k) = 0.5*(uuh(i,j,k) + uuh(i+1,j,k))
+          vvh(i,j,k) = 0.5*(vvh(i,j,k) + vvh(i,j+1,k))
+      end do
+      end do
+      end do
+      elseif (wind_option.eq.1) then
+      do k = kbgn, nuvz
+      do j = 0, nymin1
+      do i = 0, nxmin1
+!         uuh(i,j,k) = 0.5*(uuh(i,j,k)*m_u(i,j,1) + uuh(i+1,j,k)*m_u(i+1,j,1))
+!         vvh(i,j,k) = 0.5*(vvh(i,j,k)*m_v(i,j,1) + vvh(i,j+1,k)*m_v(i,j+1,1))
+           uuh(i,j,k) = 0.5*(uuh(i,j,k) + uuh(i+1,j,k))
+           vvh(i,j,k) = 0.5*(vvh(i,j,k) + vvh(i,j+1,k))
+      mu2=mu(i,j,1)+mub(i,j,1)
+!      uuh(i,j,k) = uuh(i,j,k)/mu2!*0.5*(m_u(i,j,1)+m_u(i+1,j,1))
+!      vvh(i,j,k) = vvh(i,j,k)/mu2!*0.5*(m_v(i,j,1)+m_v(i,j+1,1))
+! m_y=0.5*(m_v(i,j,1)+m_v(i,j+1,1))
+      uuh(i,j,k) = uuh(i,j,k)/mu2 !*m_y(i,j,1) !without m=true wind
+      vvh(i,j,k) = vvh(i,j,k)/mu2 !*m_x(i,j,1)
+      wwh(i,j,k) = wwh(i,j,k)/mu2 !*m_y(i,j,1) 
+      end do
+      end do
+      end do
+      elseif (wind_option.eq.2) then
+      do k = kbgn, nuvz
+      do j = 0, nymin1
+      do i = 0, nxmin1
+          uuh(i,j,k) = 0.5*(uuh(i,j,k) + uuh(i+1,j,k))
+          vvh(i,j,k) = 0.5*(vvh(i,j,k) + vvh(i,j+1,k))
+      mu2=mu(i,j,1)+mub(i,j,1)
+      wwh(i,j,k) = wwh(i,j,k)/mu2 !*m_y(i,j,1)
+      end do
+      end do
+      end do
+
+      endif
+
+
+! for ecmwf flexpart, if nwz = nlev_ec+1, then wwh is set
+!   to zero at the top level
+! for wrf, nlev_ec==n_bottom_top and so nwz = nlev_ec+1.
+!   however, it doesn't seem appropriate to zero wwh at 
+!   the model top which might be ~100 hPa.
+! so deactivate this for now
+!      if(levdiff2.eq.0) then
+!        iwmax=nlev_ec+1
+!        do 60 i=0,nxmin1
+!        do 60 j=0,nymin1
+!60      wwh(i,j,nlev_ec+1)=0.
+!      endif
+
+! For global fields, assign the leftmost data column also to the rightmost
+! data column; if required, shift whole grid by nxshift grid points
+!
+! FLEXPART_WRF - all "global" stuff is turned off
+!*************************************************************************
+
+!     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
+
+! CALCULATE SURFSTR
+       if(sfc_option .eq. sfc_option_diagnosed) then
+         do  i=0,nxmin1
+         do  j=0,nymin1
+           surfstr(i,j,1,n)=sqrt(ewss(i,j)**2+nsss(i,j)**2)
+         enddo
+         enddo
+         strswitch=.false.
+       endif
+
+      if ((.not.hflswitch).or.(.not.strswitch)) then
+        write(*,*) 'WARNING: No (or incomplete) flux data ' //  &
+        'contained in WRF output 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 
+!
+! FLEXPART_WRF - use k=(2+add_sfc_level) here instead of k=3
+!***************************************************************************
+
+        k = 2 + add_sfc_level
+        do i=0,nxmin1
+          do j=0,nymin1
+!           plev1=akz(3)+bkz(3)*ps(i,j,1,n)
+            plev1=pph(i,j,k,n)
+            pmean=0.5*(ps(i,j,1,n)+plev1)
+            tv=tth(i,j,k,n)*(1.+0.61*qvh(i,j,k,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,k)**2+vvh(i,j,k)**2)
+            call pbl_profile(ps(i,j,1,n),td2(i,j,1,n),hlev1, &
+                             tt2(i,j,1,n),tth(i,j,k,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.
+           enddo
+           enddo
+      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         
+!
+! Note that the uuh, vvh, tth, & qvh data have already been shifted
+!     upwards by one level, when they were read in.
+!**************************************************************************
+
+      if (add_sfc_level .eq. 1) then
+      do j = 0, nymin1
+      do i = 0, nxmin1
+          uuh(i,j,1)   = u10(i,j,1,n)
+          vvh(i,j,1)   = v10(i,j,1,n)
+          tth(i,j,1,n) = tt2(i,j,1,n)
+         ptth(i,j,1,n) = ptth(i,j,2,n)
+          qvh(i,j,1,n) = qvh(i,j,2,n)
+          tkeh(i,j,1,n)=tkeh(i,j,2,n)
+! pressure at 2 m AGL
+          pph(i,j,1,n) = 0.99976*ps(i,j,1,n)
+! height (MSL) at ground level (shift it down)
+          zzh(i,j,1,n) = zzh(i,j,2,n)
+! height (MSL) at top of the added level
+          zzh(i,j,2,n) = zzh(i,j,1,n) + 4.0
+      if (hmix(i,j,1,n).lt.hmixmin) hmix(i,j,1,n)=hmixmin
+
+      enddo
+      enddo
+      end if
+
+
+       do i=0,nxmax-1
+        do j=0,nymax-1
+         do k=1,nuvzmax
+           u_wrf(i,j,k,n)=uuh(i,j,k)
+           v_wrf(i,j,k,n)=vvh(i,j,k)
+         enddo
+        enddo
+       enddo
+ 
+       do i=0,nxmax-1
+        do j=0,nymax-1
+         do k=1,nwzmax
+           w_wrf(i,j,k,n)=wwh(i,j,k)
+         enddo
+        enddo
+       enddo
+ 
+
+
+
+
+      return    
+      end subroutine readwind
+
Index: /branches/jerome/src_flexwrf_v3.1/readwind_nests.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/readwind_nests.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/readwind_nests.f90	(revision 16)
@@ -0,0 +1,1359 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                *
+!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine,       *
+!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
+!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso,          *
+!* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann,   *
+!*                                                                     *
+!* This file is part of FLEXPART WRF                                   *
+!*                                                                     *
+!* 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,divhn)
+!                                i   i  o    o    o,   o
+!*******************************************************************************
+!                                                                              *
+!     Note:  This is the FLEXPART_WRF version of subroutine readwind_nests.    *
+!            The met fields are read from WRF netcdf output files.             *
+!            There are many differences from the FLEXPART version.             *
+!                                                                              *
+!     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          *
+!                                                                              *
+!     Oct-Dec 2005, R. Easter -- Major changes for WRF.                        *
+!                                                                              *
+!     11 June  2007, input tkehn from WRF
+!     13 JUNE  2007  add ext_scalar, pbl_physics
+!     19 Oct   2007  add RAINC, RAINNC, CLDFRA
+!     Feb 2012, adapt it for mean wind. Jerome Brioude
+!*******************************************************************************
+
+  use par_mod
+  use com_mod
+
+!      include 'includepar'
+!      include 'includecom'
+
+! subr arguments
+      integer :: indj,n
+      real(kind=4) :: uuhn(0:nxmaxn-1,0:nymaxn-1,nuvzmax,maxnests)
+      real(kind=4) :: vvhn(0:nxmaxn-1,0:nymaxn-1,nuvzmax,maxnests)
+      real(kind=4) :: wwhn(0:nxmaxn-1,0:nymaxn-1,nwzmax,maxnests)
+      real(kind=4) :: divhn(0:nxmaxn-1,0:nymaxn-1,nwzmax,maxnests)
+      real(kind=4) ::  mu(0:nxmaxn-1,0:nymaxn-1,1),mu2
+      real(kind=4) :: mub(0:nxmaxn-1,0:nymaxn-1,1)
+!      real(kind=4) :: m_u(0:nxmaxn-1,0:nymaxn-1,1)
+!      real(kind=4) :: m_v(0:nxmaxn-1,0:nymaxn-1,1)
+!      real(kind=4) :: m_w(0:nxmaxn-1,0:nymaxn-1,1)
+!      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)
+!      real :: mu(0:nxmaxn-1,0:nymaxn-1,1),mu2
+!      real :: mub(0:nxmaxn-1,0:nymaxn-1,1)
+!      real(kind=4) :: m_un(0:nxmaxn-1,0:nymaxn-1,1,maxnests)
+!      real(kind=4) :: m_vn(0:nxmaxn-1,0:nymaxn-1,1,maxnests)
+!      real :: m_w(0:nxmaxn-1,0:nymaxn-1,1)
+
+
+! local variables
+      integer,parameter :: ndims_max=4
+
+      integer :: i, idiagaa, ierr, itime
+      integer :: iduma
+      integer :: j, jhhmmss, jyyyymmdd
+      integer :: k, kbgn
+      integer :: l
+      integer :: lendim(ndims_max), lendim_exp(ndims_max), &
+          lendim_max(ndims_max)
+      integer :: m,levdiff2
+      integer :: ndims, ndims_exp, &
+              ext_scalar,pbl_physics,mp_physics_dum
+      integer :: n_west_east, n_south_north, n_bottom_top
+      integer :: m_grid_id_dum, m_parent_grid_id_dum, &
+        m_parent_grid_ratio_dum,  &
+        i_parent_start_dum, j_parent_start_dum, &
+        map_proj_id_dum
+
+      real :: dx_met, dy_met
+      real :: duma, dumb, dumc, dumd, dume
+      real :: dumdz
+      real :: dumarray_aa(nwzmax+1)
+      real(kind=4) :: dumarray_pp(0:nxmaxn-1,0:nymaxn-1,nwzmax+1)
+      real :: ewater_mb, esatwater_mb
+      real :: ew      ! this is an external function
+      real :: map_stdlon_dum, map_truelat1_dum, map_truelat2_dum
+      real :: toler
+
+      real :: ewss(0:nxmaxn-1,0:nymaxn-1),nsss(0:nxmaxn-1,0:nymaxn-1)
+      real :: plev1,pmean,tv,fu,hlev1,ff10m,fflev1
+
+      real(kind=dp) :: jul,juldate
+      character(len=160) :: fnamenc, varname,fnamenc2
+
+      logical :: hflswitch
+
+
+!
+! main loop -- process each nest
+!
+      do l=1,numbnests
+
+!
+!   get grid info from the wrf netcdf file
+!   and check it for consistency against values from gridcheck
+!
+      m = numpath+2*(l-1)+1
+      fnamenc = path(m)(1:length(m)) // wfnamen(l,indj)
+
+      idiagaa = 0
+
+      call read_ncwrfout_gridinfo( ierr, idiagaa, fnamenc, &
+        n_west_east, n_south_north, n_bottom_top,  &
+        dx_met, dy_met,  &
+        m_grid_id_dum, m_parent_grid_id_dum, m_parent_grid_ratio_dum,  &
+        i_parent_start_dum, j_parent_start_dum, &
+        map_proj_id_dum, map_stdlon_dum,  &
+        map_truelat1_dum, map_truelat2_dum, &
+        ext_scalar,pbl_physics,mp_physics_dum )
+      if (ierr .ne. 0) then
+          write(*,9100) l, 'error getting gridinfo for met file',  &
+              fnamenc
+          stop
+      end if
+
+! subtract 1 here because i & j indexing in flexpart always starts at 0
+      i_parent_start_dum = i_parent_start_dum-1
+      j_parent_start_dum = j_parent_start_dum-1
+
+9100	format( / '*** readwind_nests, l=', i2, ' -- ',  &
+            a / 'file = ', a )
+9110	format( / '*** readwind_nests, l=', i2, ' -- ',  &
+            a, 1x, i8 / 'file = ', a )
+9120	format( / '*** readwind_nests, l=', i2, ' -- ',  &
+            a, 2(1x,i8) / 'file = ', a )
+9130	format( / '*** readwind_nests, l=', i2, ' -- ',  &
+            a, 3(1x,i8) / 'file = ', a )
+9115	format( / '*** readwind_nests, l=', i2, ' -- ',  &
+            a / a, 1x, i8 / 'file = ', a )
+9125	format( / '*** readwind_nests, l=', i2, ' -- ',  &
+            a / a, 2(1x,i8) / 'file = ', a )
+9135	format( / '*** readwind_nests, l=', i2, ' -- ',  &
+            a / a, 3(1x,i8) / 'file = ', a )
+
+      toler = 2.0e-7
+
+      if (nxn(l) .ne. n_west_east) then
+          write(*,9100) l, 'nx not consistent', fnamenc
+          stop
+      end if
+      if (nyn(l) .ne. n_south_north) then
+          write(*,9100) l, 'ny not consistent', fnamenc
+          stop
+      end if
+      if (nlev_ec .ne. n_bottom_top) then
+          write(*,9100) l, 'nlev_ec not consistent', fnamenc
+          stop
+      end if
+      if (nwz .ne. n_bottom_top+1) then
+          write(*,9100) l, 'nwz not consistent', fnamenc
+          stop
+      end if
+      if (nuvz .ne. n_bottom_top+add_sfc_level) then
+          write(*,9100) l, 'nuvz not consistent', fnamenc
+          stop
+      end if
+
+      if (m_grid_id(l) .ne. m_grid_id_dum) then
+          write(*,9100) l, 'm_grid_id not consistent', fnamenc
+          write(*,*) m_grid_id(l), m_grid_id_dum
+          stop
+      end if
+      if (m_parent_grid_id(l) .ne. m_parent_grid_id_dum) then
+          write(*,9100) l, 'm_parent_grid_id not consistent', fnamenc
+          stop
+      end if
+      if (m_parent_grid_ratio(l) .ne. m_parent_grid_ratio_dum) then
+          write(*,9100) l, 'm_parent_grid_ratio not consistent', fnamenc
+          stop
+      end if
+      if (i_parent_start(l) .ne. i_parent_start_dum) then
+          write(*,9100) l, 'i_parent_start not consistent', fnamenc
+          stop
+      end if
+      if (j_parent_start(l) .ne. j_parent_start_dum) then
+          write(*,9100) l, 'j_parent_start not consistent', fnamenc
+          stop
+      end if
+
+      if (abs(dxn(l) - dx_met) .gt. toler*abs(dxn(l))) then
+          write(*,9100) l, 'dx not consistent', fnamenc
+          stop
+      end if
+      if (abs(dyn(l) - dy_met) .gt. toler*abs(dyn(l))) then
+          write(*,9100) l, 'dy not consistent', fnamenc
+          stop
+      end if
+
+! locate the date/time in the file
+      itime = 0
+1100  itime = itime + 1
+      call read_ncwrfout_1datetime( ierr, fnamenc, &
+          itime, jyyyymmdd, jhhmmss )
+      if (ierr .eq. -1) then
+          write(*,9100) l, 'error reading time from met file', fnamenc
+          stop
+      else if (ierr .ne. 0) then
+          write(*,9125) l, 'unable to locate date/time in met file',  &
+              'indj, itime =', indj, itime, fnamenc
+          stop
+      else 
+          jul = juldate( jyyyymmdd, jhhmmss )
+          duma = (jul-bdate)*86400.
+          iduma = nint(duma)
+          if (iduma .ne. wftime(indj)) goto 1100
+      end if
+      if (option_verbose.eq.1) then
+
+      write(*,*) 
+      write(*,*) 'readwind_nests processing wrfout file ='
+      write(*,*) fnamenc
+      write(*,*) 'itime, ymd, hms =', itime, jyyyymmdd, jhhmmss
+      endif
+
+! read eta_w_wrf, eta_u_wrf, p_top_wrf, ylat2d, xlon2d from the 
+! netcdf wrfout file and compare to those from the 1st met. file
+
+      varname = 'ZNW'
+      do i = 1, ndims_max
+          lendim_exp(i) = 0
+          lendim_max(i) = 1
+      end do
+      lendim_exp(1) = nwz
+      lendim_max(1) = nwzmax
+      ndims_exp = 2
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+      	  varname, dumarray_aa, &
+      	  itime, &
+      	  ndims, ndims_exp, ndims_max, &
+      	  lendim, lendim_exp, lendim_max )
+      if (ierr .ne. 0) then
+        fnamenc2='wrfout_d03_zn.nc'
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc2, &
+          varname, dumarray_aa, &
+          itime, &
+          ndims, ndims_exp, ndims_max, &
+          lendim, lendim_exp, lendim_max )
+      if (ierr .ne. 0) then
+          write(*,9100) l, 'error doing ncread of ZNW', fnamenc
+          stop
+      end if
+      end if
+      do k = 1, nwz
+          if (abs(eta_w_wrf(k) - dumarray_aa(k))  &
+                  .gt. toler*abs(eta_w_wrf(k))) then
+              write(*,9100) l, 'eta_w_wrf not consistent', fnamenc
+              stop
+          end if
+      end do
+
+      varname = 'ZNU'
+      lendim_exp(1) = nwz-1
+      lendim_max(1) = nwzmax
+      ndims_exp = 2
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+      	  varname, dumarray_aa, &
+      	  itime, &
+      	  ndims, ndims_exp, ndims_max, &
+      	  lendim, lendim_exp, lendim_max )
+      if (ierr .ne. 0) then
+        fnamenc2='wrfout_d03_zn.nc'
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc2, &
+          varname, dumarray_aa, &
+          itime, &
+          ndims, ndims_exp, ndims_max, &
+          lendim, lendim_exp, lendim_max )
+      if (ierr .ne. 0) then
+
+          write(*,9100) l, 'error doing ncread of ZNU', fnamenc
+          stop
+      end if
+      end if
+      do k = 1, nwz-1
+          if (abs(eta_u_wrf(k) - dumarray_aa(k))  &
+                  .gt. toler*abs(eta_u_wrf(k))) then
+              write(*,9100) l, 'eta_u_wrf not consistent', fnamenc
+              stop
+          end if
+      end do
+
+!      varname = 'P_TOP'
+!      lendim_exp(1) = 1
+!      lendim_max(1) = 1
+!      ndims_exp = 2
+!      if (ext_scalar .lt. 0) ndims_exp = 1
+!      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+!      	  varname, duma, &
+!      	  itime, &
+!      	  ndims, ndims_exp, ndims_max, &
+!      	  lendim, lendim_exp, lendim_max )
+!      if (ierr .ne. 0) then
+!          write(*,9100) l, 'error doing ncread of P_TOP', fnamenc
+!          stop
+!      end if
+!      if (abs(p_top_wrf - duma) .gt. toler*abs(p_top_wrf)) then
+!          write(*,9100) l, 'p_top_wrf not consistent', fnamenc
+!          stop
+!      end if
+
+      varname = 'XLAT'
+      lendim_exp(1) = nxn(l)
+      lendim_max(1) = nxmaxn
+      lendim_exp(2) = nyn(l)
+      lendim_max(2) = nymaxn
+      ndims_exp = 3
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+      	  varname, dumarray_pp, &
+      	  itime, &
+      	  ndims, ndims_exp, ndims_max, &
+      	  lendim, lendim_exp, lendim_max )
+      if (ierr .ne. 0) then
+          write(*,*)
+          write(*,9100) 'error doing ncread of XLAT', fnamenc
+          stop
+      end if
+      toler = 1.0e-6
+      do j = 0, nyn(l)-1
+      do i = 0, nxn(l)-1
+          if (abs(ylat2dn(i,j,l) - dumarray_pp(i,j,1)) .gt.  &
+                              toler*abs(ylat2dn(i,j,l))) then
+              write(*,9100) l, 'ylat2dn not consistent', fnamenc
+              write(*,'(a,2i5,2f16.6)') 'i,j,ylats =', i, j, &
+                      ylat2dn(i,j,l), dumarray_pp(i,j,1)
+              stop
+          end if
+      end do
+      end do
+
+      varname = 'XLONG'
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+      	  varname, dumarray_pp, &
+      	  itime, &
+      	  ndims, ndims_exp, ndims_max, &
+      	  lendim, lendim_exp, lendim_max )
+      if (ierr .ne. 0) then
+          write(*,*)
+          write(*,9100) 'error doing ncread of XLONG', fnamenc
+          stop
+      end if
+      do j = 0, nyn(l)-1
+      do i = 0, nxn(l)-1
+          if (abs(xlon2dn(i,j,l) - dumarray_pp(i,j,1)) .gt.  &
+                              toler*abs(xlon2dn(i,j,l))) then
+              write(*,9100) l, 'xlon2dn not consistent', fnamenc
+              write(*,'(a,2i5,2f16.6)') 'i,j,xlons =', i, j, &
+                      xlon2dn(i,j,l), dumarray_pp(i,j,1)
+              stop
+          end if
+      end do
+      end do
+
+
+!
+!
+! now read the data fields for current time
+! the following are read from ecmwf met files
+!       U VELOCITY
+!       V VELOCITY
+!       W VELOCITY
+!       TEMPERATURE
+!       SPEC. HUMIDITY  
+!       SURF. PRESS.
+!       SEA LEVEL PRESS.
+!       10 M U VELOCITY
+!       10 M V VELOCITY
+!       2 M TEMPERATURE
+!       2 M DEW POINT  
+!       SNOW DEPTH
+!       CLOUD COVER
+!       LARGE SCALE PREC.
+!       CONVECTIVE PREC.
+!       SENS. HEAT FLUX
+!       SOLAR RADIATION
+!       EW SURFACE STRESS
+!       NS SURFACE STRESS
+!       ECMWF OROGRAPHY
+!       STANDARD DEVIATION OF OROGRAPHY
+!       ECMWF LAND SEA MASK
+!
+!
+      hflswitch=.false.
+      strswitch=.false.
+! JB
+      levdiff2=nlev_ec-nwz+1
+
+
+      kbgn = 1 + add_sfc_level
+! at this point
+!   if add_sfc_level=1, then nuvz=nwz   and kbgn=2
+!   if add_sfc_level=0, then nuvz=nwz-1 and kbgn=1
+
+! u wind velocity
+!   the wrf output file contains (nuvz-add_sfc_level) levels
+!   read the data into k=kbgn,nuvz
+!   (interpolate it from "U-grid" to "T-grid" later)
+      if (wind_option.le.0) varname = 'U'
+      if (wind_option.eq.1) varname = 'AVGFLX_RUM'
+      if (wind_option.eq.2) varname = 'U'
+
+      do i = 1, ndims_max
+          lendim_exp(i) = 0
+          lendim_max(i) = 1
+      end do
+      lendim_exp(1) = nxn(l)+1
+      lendim_max(1) = nxmaxn
+      lendim_exp(2) = nyn(l)
+      lendim_max(2) = nymaxn
+      lendim_exp(3) = nuvz-add_sfc_level
+      lendim_max(3) = nuvzmax
+      ndims_exp = 4
+      if (time_option.eq.0) then
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+      	  varname, uuhn(0,0,kbgn,l), &
+      	  itime, &
+      	  ndims, ndims_exp, ndims_max, &
+      	  lendim, lendim_exp, lendim_max )
+      if (ierr .ne. 0) then
+          write(*,9100) l, 'error doing ncread of U', fnamenc
+      if (wind_option.le.0) print*,'you asked snapshot winds'
+      if (wind_option.eq.1) print*,'you asked mean winds'
+        print*,'change wind_option'
+          stop
+      end if
+      endif
+
+! v wind velocity
+!   the wrf output file contains (nuvz-add_sfc_level) levels
+!   read the data into k=kbgn,nuvz
+!   (interpolate it from "V-grid" to "T-grid" later)
+      if (wind_option.le.0) varname = 'V'
+      if (wind_option.eq.1) varname = 'AVGFLX_RVM'
+      if (wind_option.eq.2) varname = 'V'
+
+      lendim_exp(1) = nxn(l)
+      lendim_max(1) = nxmaxn
+      lendim_exp(2) = nyn(l)+1
+      lendim_max(2) = nymaxn
+      if (time_option.eq.0) then
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+      	  varname, vvhn(0,0,kbgn,l), &
+      	  itime, &
+      	  ndims, ndims_exp, ndims_max, &
+      	  lendim, lendim_exp, lendim_max )
+      if (ierr .ne. 0) then
+          write(*,9100) l, 'error doing ncread of V', fnamenc
+      if (wind_option.le.0) print*,'you asked snapshot winds'
+      if (wind_option.eq.1) print*,'you asked mean winds'
+        print*,'change wind_option'
+          stop
+      end if
+
+      endif
+! w wind velocity
+!   this is on the "W-grid", and 
+!   the wrf output file contains nwz levels, so no shifting needed
+!     varname = 'W'
+      if (wind_option.le.0) varname = 'W'
+      if (wind_option.eq.1) varname = 'AVGFLX_WWM'
+      if (wind_option.eq.2) varname = 'WW'
+
+      lendim_exp(1) = nxn(l)
+      lendim_max(1) = nxmaxn
+      lendim_exp(2) = nyn(l)
+      lendim_max(2) = nymaxn
+      lendim_exp(3) = nwz
+      lendim_max(3) = nwzmax
+      if (time_option.eq.0) then
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+      	  varname, wwhn(0,0,1,l), &
+      	  itime, &
+      	  ndims, ndims_exp, ndims_max, &
+      	  lendim, lendim_exp, lendim_max )
+      if (ierr .ne. 0) then
+          write(*,9100) l, 'error doing ncread of W', fnamenc
+      if (wind_option.eq.0) print*,'you asked snapshot winds'
+      if (wind_option.eq.1) print*,'you asked mean winds'
+        print*,'change wind_option'
+
+          stop
+      end if
+      endif
+
+! pressure - read base state and perturbation pressure,
+!     then combine
+!   the wrf output file contains (nuvz-add_sfc_level) levels
+!   read the data into k=kbgn,nuvz
+      varname = 'PB'
+      lendim_exp(3) = nuvz-1
+      lendim_max(3) = nuvzmax
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+      	  varname, pphn(0,0,kbgn,n,l), &
+      	  itime, &
+      	  ndims, ndims_exp, ndims_max, &
+      	  lendim, lendim_exp, lendim_max )
+      if (ierr .ne. 0) then
+          write(*,9100) l, 'error doing ncread of PB', fnamenc
+          stop
+      end if
+
+      varname = 'P'
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+      	  varname, dumarray_pp(0,0,kbgn), &
+      	  itime, &
+      	  ndims, ndims_exp, ndims_max, &
+      	  lendim, lendim_exp, lendim_max )
+      if (ierr .ne. 0) then
+          write(*,9100) l, 'error doing ncread of P', fnamenc
+          stop
+      end if
+
+      do k = kbgn, nuvz
+      do j = 0, nyn(l)-1
+      do i = 0, nxn(l)-1
+          pphn(i,j,k,n,l) = pphn(i,j,k,n,l) + dumarray_pp(i,j,k)
+      end do
+      end do
+      end do
+
+
+! height - read base state and perturbation geopotential,
+!     then combine and divide by gravity
+!   these are on the "W-grid", and 
+!     the wrf output file contains nwz levels
+!   shift them also so they will be consistent with pph
+      varname = 'PHB'
+      lendim_exp(3) = nwz
+      lendim_max(3) = nwzmax+1
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+      	  varname, zzhn(0,0,kbgn,n,l), &
+      	  itime, &
+      	  ndims, ndims_exp, ndims_max, &
+      	  lendim, lendim_exp, lendim_max )
+      if (ierr .ne. 0) then
+          write(*,9100) l, 'error doing ncread of PB', fnamenc
+          stop
+      end if
+
+      varname = 'PH'
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+      	  varname, dumarray_pp(0,0,kbgn), &
+      	  itime, &
+      	  ndims, ndims_exp, ndims_max, &
+      	  lendim, lendim_exp, lendim_max )
+      if (ierr .ne. 0) then
+          write(*,9100) l, 'error doing ncread of P', fnamenc
+          stop
+      end if
+
+      do k = kbgn, nwz+add_sfc_level
+      do j = 0, nyn(l)-1
+      do i = 0, nxn(l)-1
+          zzhn(i,j,k,n,l) =  &
+                  (zzhn(i,j,k,n,l) + dumarray_pp(i,j,k))/9.81
+      end do
+      end do
+      end do
+
+! now use dumarray_pp to store 1/density for stress calculation below
+      if(sfc_option .eq. sfc_option_wrf) then
+
+      varname = 'ALT'
+      lendim_exp(3) = nuvz-1
+      lendim_max(3) = nwzmax
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+          varname, dumarray_pp(0,0,kbgn), &
+          itime, &
+          ndims, ndims_exp, ndims_max, &
+          lendim, lendim_exp, lendim_max )
+      if (ierr .ne. 0) then
+          write(*,9100) l, 'error doing ncread of ALT', fnamenc
+          stop
+      end if
+
+      end if
+
+! temperature - read perturbation potential temperature,
+!     add t00 (base value), then add and convert
+!   the wrf output file contains (nuvz-add_sfc_level) levels
+!   read the data into k=kbgn,nuvz
+      varname = 'T'
+      lendim_exp(3) = nuvz-1
+      lendim_max(3) = nuvzmax
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+      	  varname, tthn(0,0,kbgn,n,l), &
+      	  itime, &
+      	  ndims, ndims_exp, ndims_max, &
+      	  lendim, lendim_exp, lendim_max )
+      if (ierr .ne. 0) then
+          write(*,9100) l, 'error doing ncread of T', fnamenc
+          stop
+      end if
+
+      do k = kbgn, nuvz
+      do j = 0, nyn(l)-1
+      do i = 0, nxn(l)-1
+! save pot tempereature to ptthn
+         ptthn(i,j,k,n,l) =  tthn(i,j,k,n,l)+300.
+          tthn(i,j,k,n,l) = (tthn(i,j,k,n,l) + 300.) * &
+                  (pphn(i,j,k,n,l)/1.0e5)**0.286
+      end do
+      end do
+      end do
+
+      if (turb_option .eq. turb_option_tke .or. &
+          turb_option .eq. turb_option_mytke) then
+!-
+! TKE - read TKE
+!   the wrf output file contains (nuvz-add_sfc_level) levels
+!   read the data into k=kbgn,nuvz
+      varname = 'TKE'
+      lendim_exp(3) = nuvz-1
+      lendim_max(3) = nuvzmax
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+          varname, tkehn(0,0,kbgn,n,l), &
+          itime, &
+          ndims, ndims_exp, ndims_max, &
+          lendim, lendim_exp, lendim_max )
+      if (ierr .ne. 0) then
+      varname = 'TKE_PBL'
+      lendim_exp(3) = nuvz-1
+      lendim_max(3) = nuvzmax
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+          varname, tkehn(0,0,kbgn,n,l), &
+          itime, &
+          ndims, ndims_exp, ndims_max, &
+          lendim, lendim_exp, lendim_max )
+      endif
+      if (ierr .ne. 0) then
+!     print*,'NO TKE_PBL available. Try QKE instead'
+      varname = 'qke'
+      lendim_exp(3) = nuvz-1
+      lendim_max(3) = nuvzmax
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+          varname, tkehn(0,0,kbgn,n,l), &
+          itime, &
+          ndims, ndims_exp, ndims_max, &
+          lendim, lendim_exp, lendim_max )
+      tkeh=tkeh/2. !conversion of qke
+      endif
+      if (ierr .ne. 0) then
+          write(*,9100) l, 'error doing ncread of TKE', fnamenc
+      write(*,*)'Change turb_option NOT to use TKE, or change inputfile'
+          print*,'change SFC_OPTION to 0  as well'
+          stop
+      end if
+
+       endif
+!-
+
+
+! specific humidity - read mixing ratio (kg-water-vapor/kg-dry-air),
+!     then convert to (kg-water-vapor/kg-moist-air)
+!   the wrf output file contains (nuvz-add_sfc_level) levels
+!   read the data into k=kbgn,nuvz
+      varname = 'QVAPOR'
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+      	  varname, qvhn(0,0,kbgn,n,l), &
+      	  itime, &
+      	  ndims, ndims_exp, ndims_max, &
+      	  lendim, lendim_exp, lendim_max )
+      if (ierr .ne. 0) then
+          write(*,9100) l, 'error doing ncread of QVAPOR', fnamenc
+          stop
+      end if
+
+      do k = kbgn, nuvz
+      do j = 0, nyn(l)-1
+      do i = 0, nxn(l)-1
+          qvhn(i,j,k,n,l) = max( qvhn(i,j,k,n,l), 0.0 )
+          qvhn(i,j,k,n,l) = qvhn(i,j,k,n,l)/(1.0 + qvhn(i,j,k,n,l))
+      end do
+      end do
+      end do
+
+
+! surface pressure
+      varname = 'PSFC'
+      lendim_exp(3) = 0
+      lendim_max(3) = 1
+      ndims_exp = 3
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+      	  varname, psn(0,0,1,n,l), &
+      	  itime, &
+      	  ndims, ndims_exp, ndims_max, &
+      	  lendim, lendim_exp, lendim_max )
+      if (ierr .ne. 0) then
+          write(*,9100) l, 'error doing ncread of PSFC', fnamenc
+          stop
+      end if
+
+! for the mexico city grid 3 simulation, the surface and
+!   level 1 pressures are not as consistent as one would like,
+!   with the problems occuring near the domain boundaries.
+! so diagnose surface pressure from other variables
+      do j = 0, nyn(l)-1
+      do i = 0, nxn(l)-1
+
+! better fix 
+!   -- calculate surface pressure from lowest level pressure, temp, height
+!   -- use wrf pressures (pph array) wherever possible
+!      (avoid using surface pressure and the akz/bkz, akm/bkm)
+          duma = psn(i,j,1,n,l)
+          dumdz = 0.5*(zzhn(i,j,kbgn+1,n,l) - zzhn(i,j,kbgn,n,l))
+          tv = tthn(i,j,kbgn,n,l)*(1.+0.61*qvhn(i,j,kbgn,n,l))
+          psn(i,j,1,n,l) = pphn(i,j,kbgn,n,l)*exp( dumdz*ga/(r_air*tv) )
+
+      end do
+      end do
+
+
+! 10 meter u velocity
+!   note:  u10 is on the "T-grid" already
+      varname = 'U10'
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+      	  varname, u10n(0,0,1,n,l), &
+      	  itime, &
+      	  ndims, ndims_exp, ndims_max, &
+      	  lendim, lendim_exp, lendim_max )
+      if (ierr .ne. 0) then
+          write(*,9100) l, 'error doing ncread of U10', fnamenc
+          stop
+      end if
+
+
+! 10 meter v velocity
+!   note:  v10 is on the "T-grid" already
+      varname = 'V10'
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+      	  varname, v10n(0,0,1,n,l), &
+      	  itime, &
+      	  ndims, ndims_exp, ndims_max, &
+      	  lendim, lendim_exp, lendim_max )
+      if (ierr .ne. 0) then
+          write(*,9100) l, 'error doing ncread of V10', fnamenc
+          stop
+      end if
+
+
+! 2 meter temperature
+      varname = 'T2'
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+      	  varname, tt2n(0,0,1,n,l), &
+      	  itime, &
+      	  ndims, ndims_exp, ndims_max, &
+      	  lendim, lendim_exp, lendim_max )
+      if (ierr .ne. 0) then
+          write(*,9100) l, 'error doing ncread of T2', fnamenc
+          stop
+      end if
+
+
+! 2 meter dew point - read 2 meter water vapor mixing ratio
+!   then calculate the dew point
+      varname = 'Q2'
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+      	  varname, td2n(0,0,1,n,l), &
+      	  itime, &
+      	  ndims, ndims_exp, ndims_max, &
+      	  lendim, lendim_exp, lendim_max )
+      if (ierr .ne. 0) then
+          write(*,9100) l, 'error doing ncread of Q2', fnamenc
+          do j = 0, nyn(l)-1
+          do i = 0, nxn(l)-1
+! 29-nov-2005 - changed qvhn(i,j,1,n,l) to qvhn(i,j,kbgn,n,l) here
+              td2n(i,j,1,n,l) = qvhn(i,j,kbgn,n,l)
+          end do
+          end do
+      end if
+
+      if (wind_option.ge.1) then
+!      print*,'mean wind from WRF is used'
+      varname = 'MU '
+
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+          varname, mu(0,0,1), &
+          itime, &
+          ndims, ndims_exp, ndims_max, &
+          lendim, lendim_exp, lendim_max )
+      if (ierr .ne. 0) then
+          write(*,9100) 'error doing MU', fnamenc
+          stop
+      end if
+
+      varname = 'MUB'
+
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+          varname, mub(0,0,1), &
+          itime, &
+          ndims, ndims_exp, ndims_max, &
+          lendim, lendim_exp, lendim_max ) 
+      if (ierr .ne. 0) then
+          write(*,9100) 'error doing MUB', fnamenc
+          stop
+      end if
+       endif
+
+!      varname = 'MAPFAC_MX'
+!      lendim_exp(1) = nxn(l)
+!      lendim_max(1) = nxmaxn
+!      lendim_exp(2) = nyn(l)
+!      lendim_max(2) = nymaxn
+!
+!      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+!          varname, m_xn(0,0,1,l), &
+!          itime, &
+!          ndims, ndims_exp, ndims_max, &
+!          lendim, lendim_exp, lendim_max )
+!      if (ierr .ne. 0) then
+!          write(*,9100) 'error doing MAP X', fnamenc
+!      varname = 'MAPFAC_U'
+!      lendim_exp(1) = nxn(l)+1
+!      lendim_max(1) = nxmaxn
+!      lendim_exp(2) = nyn(l)
+!      lendim_max(2) = nymaxn
+!      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+!          varname, m_un(0,0,1,l), &
+!          itime, &
+!          ndims, ndims_exp, ndims_max, &
+!          lendim, lendim_exp, lendim_max )
+!      do j = 0, nyn(l)-1
+!      do i = 0, nxn(l)-1
+!      m_xn(i,j,1,l)=(m_un(i,j,1,l)+m_un(i+1,j,1,l))*0.5
+!      enddo
+!      enddo
+!      if (ierr .ne. 0) then
+!          write(*,9100) 'error doing MAP U', fnamenc
+!          print*,'NO MAP FACTOR IS GOING TO BE USED.'
+!          print*,'LARGE UNCERTAINTIES TO BE EXPECTED'
+!      do j = 0, nyn(l)-1
+!      do i = 0, nxn(l)-1
+!      m_xn(i,j,1)=1.
+!      enddo
+!      enddo
+!      end if
+!      end if
+!
+!      varname = 'MAPFAC_MY'
+!      lendim_exp(1) = nxn(l)
+!      lendim_max(1) = nxmaxn
+!      lendim_exp(2) = nyn(l)
+!      lendim_max(2) = nymaxn
+!
+!      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+!          varname, m_yn(0,0,1,l), &
+!          itime, &
+!          ndims, ndims_exp, ndims_max, &
+!          lendim, lendim_exp, lendim_max )
+!      if (ierr .ne. 0) then
+!          write(*,9100) 'error doing MAP Y', fnamenc
+!      varname = 'MAPFAC_V'
+!      lendim_exp(1) = nxn(l)
+!      lendim_max(1) = nxmaxn
+!      lendim_exp(2) = nyn(l)+1
+!      lendim_max(2) = nymaxn
+!      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+!          varname, m_vn(0,0,1,l), &
+!          itime, &
+!          ndims, ndims_exp, ndims_max, &
+!          lendim, lendim_exp, lendim_max )
+!      do j = 0, nyn(l)-1
+!      do i = 0, nxn(l)-1
+!      m_yn(i,j,1,l)=(m_vn(i,j,1,l)+m_vn(i,j+1,1,l))*0.5
+!      enddo
+!      enddo
+!      if (ierr .ne. 0) then
+!          write(*,9100) 'ERROR doing MAP V', fnamenc
+!          print*,'NO MAP FACTOR IS GOING TO BE USED.'
+!          print*,'LARGE UNCERTAINTIES TO BE EXPECTED'
+!      do j = 0, nyn(l)-1
+!      do i = 0, nxn(l)-1
+!      m_yn(i,j,1,l)=1.
+!      enddo
+!      enddo
+!      end if
+!      end if
+      lendim_exp(1) = nxn(l)
+      lendim_max(1) = nxmaxn
+      lendim_exp(2) = nyn(l)
+      lendim_max(2) = nymaxn
+
+!      varname = 'MAPFAC_U'
+!      lendim_exp(1) = nxn(l)+1
+!      lendim_max(1) = nxmaxn
+!      lendim_exp(2) = nyn(l)
+!      lendim_max(2) = nymaxn
+!
+!      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+!          varname, m_un(0,0,1,l), &
+!          itime, &
+!          ndims, ndims_exp, ndims_max, &
+!          lendim, lendim_exp, lendim_max )
+!      if (ierr .ne. 0) then 
+!          write(*,9100) 'error doing MAP U', fnamenc
+!          stop 
+!      end if
+!
+!      varname = 'MAPFAC_V'
+!      lendim_exp(1) = nxn(l)
+!      lendim_max(1) = nxmaxn
+!      lendim_exp(2) = nyn(l)+1
+!      lendim_max(2) = nymaxn
+!
+!      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+!          varname, m_vn(0,0,1,l), &
+!          itime, &
+!          ndims, ndims_exp, ndims_max, &
+!          lendim, lendim_exp, lendim_max )
+!      if (ierr .ne. 0) then
+!          write(*,9100) 'error doing MAP V', fnamenc
+!          stop
+!      end if
+!
+!      varname = 'MAPFAC_M'
+!      lendim_exp(1) = nxn(l)
+!      lendim_max(1) = nxmaxn
+!      lendim_exp(2) = nyn(l)
+!      lendim_max(2) = nymaxn
+!
+!      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+!          varname, m_w(0,0,1), &
+!          itime, &
+!          ndims, ndims_exp, ndims_max, &
+!          lendim, lendim_exp, lendim_max )
+!      if (ierr .ne. 0) then
+!          write(*,9100) 'error doing MAP W', fnamenc
+!          stop
+!      end if
+
+
+
+
+
+! calculate water vapor pressure in mb, from sfc pressure
+!   and 2 m mixing ratio
+      iduma = 0
+      do j = 0, nyn(l)-1
+      do i = 0, nxn(l)-1
+! 29-nov-2005 - added this to catch occasional tt2n=0.0 values
+          duma = max( 100.0, tthn(i,j,kbgn,n,l)-50.0 )
+          if (tt2n(i,j,1,n,l) .le. duma) then
+              iduma = iduma + 1
+              if (iduma .eq. 1) then
+                  write(*,*) 'readwind_nests - bad tt2n at'
+                  write(*,*) 'l, i, j, tt2n =', l, i, j, tt2n(i,j,1,n,l)
+              end if
+              tt2n(i,j,1,n,l) = tthn(i,j,kbgn,n,l)
+              td2n(i,j,1,n,l) = qvhn(i,j,kbgn,n,l)
+          end if
+          duma = td2n(i,j,1,n,l)/0.622
+          ewater_mb = 0.01*( 0.99976*psn(i,j,1,n,l)*duma/(1.0+duma) )
+          esatwater_mb = 0.01*ew(tt2n(i,j,1,n,l))
+          ewater_mb = max( 1.0e-10, min( esatwater_mb, ewater_mb ) )
+! then use the following, which is from an old 1970's report
+!   (reference not available, but the formula works)
+!   tdew(in C) = (4318.76/(19.5166 - ln(ewater(in mb)))) - 243.893
+          td2n(i,j,1,n,l) = 273.16 + &
+                 (4318.76/(19.5166 - log(ewater_mb))) - 243.893
+      end do
+      end do
+      if (iduma .gt. 0) write(*,*) &
+          'readwind_nests - bad tt2n count =', iduma
+
+
+! sea level pressure - calculate it from surface pressure and 
+!    ground elevation using standard atmosphere relations
+      do j = 0, nyn(l)-1
+      do i = 0, nxn(l)-1
+          msln(i,j,1,n,l) = psn(i,j,1,n,l)/ &
+                  ((1.0 - 6.5e-3*oron(i,j,l)/288.0)**5.2553)
+      end do
+      end do
+
+
+! large scale precipitation
+! convective  precipitation
+!   the wrf output files contain these as "accumulated totals"
+!   I need to find out if these are accumulated over the output
+!       file frequency, or over the total run.
+!   For now, set to zero
+! total cloud cover
+!   Doesn't appear to be any 2-d cloud cover field in the
+!       wrf output.
+!   For now, set to zero
+      do j = 0, nyn(l)-1
+      do i = 0, nxn(l)-1
+          lsprecn(i,j,1,n,l) = 0.0
+          convprecn(i,j,1,n,l) = 0.0
+          tccn(i,j,1,n,l) = 0.0
+      end do
+      end do
+
+!C
+! Large scale precipitation, (accumulated value, mm)
+
+      varname = 'RAINNC'
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+          varname, lsprecn(0,0,1,n,l), &
+          itime, &
+          ndims, ndims_exp, ndims_max, &
+          lendim, lendim_exp, lendim_max )
+      if (ierr .ne. 0) then
+      write(*,9100) l, 'error doing ncread of RAINNC, set to zero', fnamenc
+          do j = 0, nyn(l)-1
+          do i = 0, nxn(l)-1
+              lsprecn(i,j,1,n,l) = 0.0
+          end do
+          end do
+      end if
+
+!
+! Convective precipitation, (accumulated value, mm)
+ 
+      varname = 'RAINC'
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+          varname, convprecn(0,0,1,n,l), &
+          itime, &
+          ndims, ndims_exp, ndims_max, &
+          lendim, lendim_exp, lendim_max )
+      if (ierr .ne. 0) then
+      write(*,9100) l, 'error doing ncread of RAINC, set to zero', fnamenc
+          do j = 0, nyn(l)-1
+          do i = 0, nxn(l)-1
+              convprecn(i,j,1,n,l) = 0.0
+          end do
+          end do
+      end if
+
+! CLOUD FRACTION (clound cover)
+ 
+      varname = 'CLDFRA'
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+          varname, tccn(0,0,1,n,l), &
+          itime, &
+          ndims, ndims_exp, ndims_max, &
+          lendim, lendim_exp, lendim_max )
+      if (ierr .ne. 0) then
+!     write(*,9100) l, 'error doing ncread of CLDFRA, set to zero', fnamenc
+          do j = 0, nyn(l)-1
+          do i = 0, nxn(l)-1
+              tccn(i,j,1,n,l) = 0.0
+          end do
+          end do
+      end if
+
+
+! snow depth
+      varname = 'SNOWH'
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+      	  varname, sdn(0,0,1,n,l), &
+      	  itime, &
+      	  ndims, ndims_exp, ndims_max, &
+      	  lendim, lendim_exp, lendim_max )
+      if (ierr .ne. 0) then
+!         write(*,9100) l, 'error doing ncread of SNOWH', fnamenc
+          do j = 0, nyn(l)-1
+          do i = 0, nxn(l)-1
+              sdn(i,j,1,n,l) = 0.0
+          end do
+          end do
+      end if
+
+
+! surface sensible heat flux (positive <--> upwards)
+      varname = 'HFX'
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+      	  varname, sshfn(0,0,1,n,l), &
+      	  itime, &
+      	  ndims, ndims_exp, ndims_max, &
+      	  lendim, lendim_exp, lendim_max )
+          do j = 0, nyn(l)-1
+          do i = 0, nxn(l)-1
+              sshfn(i,j,1,n,l) = -sshfn(i,j,1,n,l)
+          end do
+          end do
+
+      if (ierr .ne. 0) then
+          write(*,9100) l, 'error doing ncread of HFX', fnamenc
+          do j = 0, nyn(l)-1
+          do i = 0, nxn(l)-1
+              sshfn(i,j,1,n,l) = 0.0
+          end do
+          end do
+          hflswitch=.false.    ! Heat flux is not available
+      else
+          hflswitch=.true.     ! Heat flux is available
+! limit to values to bounds originally used by flexpart?
+!         do 1502 j=0,nyn(l)-1
+!         do 1502 i=0,nxn(l)-1
+!            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.
+!1502     continue
+      end if
+
+! ustar
+      varname = 'UST'
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+          varname, ustarn(0,0,1,n,l), &
+          itime, &
+          ndims, ndims_exp, ndims_max, &
+          lendim, lendim_exp, lendim_max )
+      if (ierr .ne. 0) then
+          write(*,9100) l, 'error doing ncread of UST', fnamenc
+          do j = 0, nyn(l)
+          do i = 0, nxn(l)
+              ustarn(i,j,1,n,l) = 0.0
+          end do
+          end do
+          strswitch=.false.    ! ustar is not available
+      else
+          strswitch=.true.     ! ustar is available
+          do j=0,nyn(l)
+          do i=0,nxn(l)
+            surfstrn(i,j,1,n,l)=ustarn(i,j,1,n,l)/dumarray_pp(i,j,kbgn)
+            enddo
+            enddo
+  
+      end if
+
+      if(sfc_option .eq. sfc_option_wrf) then
+! pblh
+      varname = 'PBLH'
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+          varname, hmixn(0,0,1,n,l), &
+          itime, &
+          ndims, ndims_exp, ndims_max, &
+          lendim, lendim_exp, lendim_max )
+      if (ierr .ne. 0) then
+          write(*,9100) l, 'error doing ncread of PBLH', fnamenc
+          stop
+      endif
+
+      endif
+
+! surface solar radiation flux (positive <--> downwards)
+      varname = 'SWDOWN'
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+      	  varname, ssrn(0,0,1,n,l), &
+      	  itime, &
+      	  ndims, ndims_exp, ndims_max, &
+      	  lendim, lendim_exp, lendim_max )
+      if (ierr .ne. 0) then
+          write(*,9100) l, 'error doing ncread of SWDOWN', fnamenc
+          do j = 0, nyn(l)-1
+          do i = 0, nxn(l)-1
+              ssrn(i,j,1,n,l) = 0.0
+          end do
+          end do
+      else
+          do j = 0, nyn(l)-1
+          do i = 0, nxn(l)-1
+              ssrn(i,j,1,n,l) = max( ssrn(i,j,1,n,l), 0.0 )
+          end do
+          end do
+      end if
+
+
+! ew & ns surface stress
+!   Doesn't appear to be any 2-d cloud cover field in the
+!       wrf output.
+!   For now, set to zero
+      do j = 0, nyn(l)-1
+      do i = 0, nxn(l)-1
+          ewss(i,j) = 0.0
+          nsss(i,j) = 0.0
+      end do
+      end do
+!     strswitch=.false.    ! Surface stress is not available
+
+
+! orography
+! standard deviation of orography
+! land sea mask
+!    these should be fixed during a simulation
+!    so there is no reason to do them again ??
+
+
+! *** done with reading the wrf output file ***
+
+
+!  print*,'uu out1',uuhn(0,259,1:10,1)
+!  print*,'mu out1',mu(0,259,1),mub(0,259,1)
+!  print*,'m_xn out1',m_xn(0,259,1,1),m_yn(0,259,1,1)
+
+
+! interpolate uuh from the "U-grid" to the "T-grid"
+! interpolate vvh from the "V-grid" to the "T-grid"
+      if (wind_option.le.0) then
+      do k = kbgn, nuvz
+      do j = 0, nyn(l)-1
+      do i = 0, nxn(l)-1
+      if (wind_option.lt.0) then
+      divhn(i,j,k,l)=(uuhn(i+1,j,k,l)-uuhn(i,j,k,l))/dxn(l)*m_xn(i,j,1,l) &
+       +(vvhn(i,j+1,k,l)-vvhn(i,j,k,l))/dyn(l)*m_yn(i,j,1,l)
+      endif
+          uuhn(i,j,k,l) = 0.5*(uuhn(i,j,k,l) + uuhn(i+1,j,k,l))
+          vvhn(i,j,k,l) = 0.5*(vvhn(i,j,k,l) + vvhn(i,j+1,k,l))
+      end do
+      end do
+      end do
+      elseif (wind_option.eq.1) then
+      do k = kbgn, nuvz
+      do j = 0, nyn(l)-1
+      do i = 0, nxn(l)-1
+          uuhn(i,j,k,l) = 0.5*(uuhn(i,j,k,l) + uuhn(i+1,j,k,l))
+          vvhn(i,j,k,l) = 0.5*(vvhn(i,j,k,l) + vvhn(i,j+1,k,l))
+      mu2=mu(i,j,1)+mub(i,j,1)
+      uuhn(i,j,k,l) = uuhn(i,j,k,l)/mu2 !*m_yn(i,j,1,l)
+      vvhn(i,j,k,l) = vvhn(i,j,k,l)/mu2 !*m_xn(i,j,1,l)
+      wwhn(i,j,k,l) = wwhn(i,j,k,l)/mu2 !*m_yn(i,j,1,l)
+      end do
+      end do
+      end do
+      elseif (wind_option.eq.2) then
+      do k = kbgn, nuvz
+      do j = 0, nyn(l)-1
+      do i = 0, nxn(l)-1
+          uuhn(i,j,k,l) = 0.5*(uuhn(i,j,k,l) + uuhn(i+1,j,k,l))
+          vvhn(i,j,k,l) = 0.5*(vvhn(i,j,k,l) + vvhn(i,j+1,k,l))
+      mu2=mu(i,j,1)+mub(i,j,1)
+      wwhn(i,j,k,l) = wwhn(i,j,k,l)/mu2 !*m_yn(i,j,1,l)
+      end do
+      end do
+      end do
+
+      endif
+
+!  print*,'uu out2',uuhn(0,259,1:10,1)
+!  print*,'mu out2',mu(0,259,1),mub(0,259,1)
+!  print*,'m_xn out2',m_xn(0,259,1,1),m_yn(0,259,1,1)
+
+! CALCULATE SURFSTR
+      if(sfc_option .eq. sfc_option_diagnosed) then
+        do j=0,nyn(l)-1
+        do i=0,nxn(l)-1
+        surfstrn(i,j,1,n,l)=sqrt(ewss(i,j)**2+nsss(i,j)**2) 
+       enddo
+       enddo
+        strswitch=.false.    ! Surface stress is not available
+      endif
+
+      if ((.not.hflswitch).or.(.not.strswitch)) then
+        write(*,*) 'WARNING: No (or incomplete) flux data ' //  &
+        'contained in WRF output 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 
+!
+! FLEXPART_WRF - use k=(2+add_sfc_level) here instead of k=3
+!***************************************************************************
+        k = 2 + add_sfc_level
+        do j=0,nyn(l)-1
+          do i=0,nxn(l)-1
+!           plev1=akz(3)+bkz(3)*psn(i,j,1,n,l)
+            plev1=pphn(i,j,k,n,l)
+            pmean=0.5*(psn(i,j,1,n,l)+plev1)
+            tv=tthn(i,j,k,n,l)*(1.+0.61*qvhn(i,j,k,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,k,l)**2+vvhn(i,j,k,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,k,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.
+         enddo
+         enddo
+      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         
+!
+! Note that the uuh, vvh, tth, & qvh data have already been shifted
+!     upwards by one level, when they were read in.
+!**************************************************************************
+
+      if (add_sfc_level .eq. 1) then
+      do  j = 0, nyn(l)-1
+      do  i = 0, nxn(l)-1
+          uuhn(i,j,1,l)   = u10n(i,j,1,n,l)
+          vvhn(i,j,1,l)   = v10n(i,j,1,n,l)
+          tthn(i,j,1,n,l) = tt2n(i,j,1,n,l)
+         ptthn(i,j,1,n,l) = ptthn(i,j,2,n,l)
+          qvhn(i,j,1,n,l) = qvhn(i,j,2,n,l)
+         tkehn(i,j,1,n,l) =tkehn(i,j,2,n,l)
+! pressure at 2 m AGL
+          pphn(i,j,1,n,l) = 0.99976*psn(i,j,1,n,l)
+! height (MSL) at ground level (shift it down)
+          zzhn(i,j,1,n,l) = zzhn(i,j,2,n,l)
+! height (MSL) at top of the added level
+          zzhn(i,j,2,n,l) = zzhn(i,j,1,n,l) + 4.0
+      if (hmixn(i,j,1,n,l).lt.hmixmin) hmixn(i,j,1,n,l)=hmixmin
+
+      enddo
+      enddo
+      end if
+
+
+       do i=0,nxn(L)-1
+        do j=0,nyn(L)-1
+         do k=1,nuvzmax
+           un_wrf(i,j,k,n,l)=uuhn(i,j,k,l)
+           vn_wrf(i,j,k,n,l)=vvhn(i,j,k,l)
+         enddo
+        enddo
+       enddo
+ 
+       do i=0,nxn(L)-1
+        do j=0,nyn(L)-1
+         do k=1,nwzmax
+           wn_wrf(i,j,k,n,l)=wwhn(i,j,k,l)
+         enddo
+        enddo
+       enddo
+
+
+
+
+      enddo !loop over the nests
+
+
+
+
+      return    
+      end subroutine readwind_nests
Index: /branches/jerome/src_flexwrf_v3.1/readwind_nests_timeav.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/readwind_nests_timeav.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/readwind_nests_timeav.f90	(revision 16)
@@ -0,0 +1,404 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                *
+!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine,       *
+!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
+!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso,          *
+!* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann,   *
+!*                                                                     *
+!* This file is part of FLEXPART WRF                                   *
+!*                                                                     *
+!* 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_timeav(indj,n,uuhn,vvhn,wwhn)
+!**********************************************************************
+!                                                                     * 
+!             TRAJECTORY MODEL SUBROUTINE READWIND                    *
+!                                                                     *
+!**********************************************************************
+!                                                                     * 
+!  April 2012, J. Brioude: This routine handles the difference in time
+! for time-average fields.
+!**********************************************************************
+!                                                                     *
+! Note:  This is the FLEXPART_WRF version of subroutine readwind.     *
+!    The met fields are read from WRF netcdf output files.            *
+!    There are many differences from the FLEXPART version.            *
+!                                                                     *
+! 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 "T-grid" vertical levels wwf model     *
+!                    (the unstaggered "bottom_top" dimension)         *
+! uu,vv,ww           wind fields                                      *
+! tt,qv              temperature and specific humidity                *
+! ps                 surface pressure                                 *
+!                                                                     *
+!**********************************************************************
+!
+
+!      include 'includepar'
+!      include 'includecom'
+  use par_mod
+  use com_mod
+
+! subr arguments
+      integer :: indj, n
+
+      real(kind=4) :: uuhn(0:nxmaxn-1,0:nymaxn-1,nuvzmax,maxnests)
+      real(kind=4) :: vvhn(0:nxmaxn-1,0:nymaxn-1,nuvzmax,maxnests)
+      real(kind=4) :: wwhn(0:nxmaxn-1,0:nymaxn-1,nwzmax,maxnests)
+      real(kind=4) :: uuhn2(0:nxmaxn-1,0:nymaxn-1,nuvzmax,maxnests)
+      real(kind=4) :: vvhn2(0:nxmaxn-1,0:nymaxn-1,nuvzmax,maxnests)
+      real(kind=4) :: wwhn2(0:nxmaxn-1,0:nymaxn-1,nwzmax,maxnests)
+
+! local variables
+      integer,parameter :: ndims_max=4
+
+      integer :: i, idiagaa, ierr, ifn, itime
+      integer :: iduma,indj2,l
+      integer :: j, jhhmmss, jyyyymmdd
+      integer :: k, kbgn
+      integer :: lendim(ndims_max), lendim_exp(ndims_max), &
+          lendim_max(ndims_max)
+      integer :: levdiff2,deltat,deltat2
+      integer :: ndims, ndims_exp
+      integer :: n_west_east, n_south_north, n_bottom_top
+      integer :: m_grid_id_dum, m_parent_grid_id_dum, &
+        m_parent_grid_ratio_dum,  &
+        i_parent_start_dum, j_parent_start_dum, &
+        map_proj_id_dum,  &
+        ext_scalar,pbl_physics,mp_physics_dum
+
+      real :: dx_met, dy_met
+      real :: duma, dumb, dumc, dumd, dume
+      real :: dumdz
+!      real(kind=4) :: dumarray_aa(nwzmax+1)
+!      real(kind=4) :: dumarray_pp(0:nxmax-1,0:nymax-1,nwzmax+1)
+      real :: dumarray_aa(nwzmax+1)
+      real :: dumarray_pp(0:nxmax-1,0:nymax-1,nwzmax+1)
+      real :: ewater_mb, esatwater_mb
+      real :: ew      ! this is an external function
+      real :: map_stdlon_dum, map_truelat1_dum, map_truelat2_dum
+      real :: pint
+      real :: toler
+
+!      real(kind=4) :: ewss(0:nxmax-1,0:nymax-1),nsss(0:nxmax-1,0:nymax-1)
+      real :: ewss(0:nxmax-1,0:nymax-1),nsss(0:nxmax-1,0:nymax-1)
+      real :: plev1,pmean,tv,fu,hlev1,ff10m,fflev1
+
+      real(kind=dp) :: jul,juldate
+
+      character(len=160) :: fnamenc, varname,fnamenc2
+
+      logical :: hflswitch
+
+!
+!   get grid info from the wrf netcdf file
+!   and check it for consistency against values from gridcheck
+!
+
+!
+! main loop -- process each nest
+!
+      do l=1,numbnests
+
+      m = numpath+2*(l-1)+1
+      fnamenc = path(m)(1:length(m)) // wfnamen(l,indj)
+
+!      fnamenc = path(2)(1:length(2))//wfname(indj)
+      idiagaa = 0
+
+      call read_ncwrfout_gridinfo( ierr, idiagaa, fnamenc, &
+        n_west_east, n_south_north, n_bottom_top, & 
+        dx_met, dy_met,  &
+        m_grid_id_dum, m_parent_grid_id_dum, m_parent_grid_ratio_dum, &
+        i_parent_start_dum, j_parent_start_dum, &
+        map_proj_id_dum, map_stdlon_dum,  &
+        map_truelat1_dum, map_truelat2_dum, &
+        ext_scalar,pbl_physics,mp_physics_dum )
+      if (ierr .ne. 0) then
+          write(*,9100) 'error getting gridinfor for met file', fnamenc
+          stop
+      end if
+
+      i_parent_start_dum = i_parent_start_dum-1
+      j_parent_start_dum = j_parent_start_dum-1
+
+
+9100  format( / '*** readwind -- ', a )
+9110  format( / '*** readwind -- ', a, 1x, i8 / &
+        'file = ', a )
+9120  format( / '*** readwind -- ', a, 2(1x,i8) / &
+        'file = ', a )
+9130  format( / '*** readwind -- ', a, 3(1x,i8) / &
+        'file = ', a )
+9115  format( / '*** readwind -- ', a / a, 1x, i8 / &
+        'file = ', a )
+9125  format( / '*** readwind -- ', a / a, 2(1x,i8) / &
+        'file = ', a )
+9135  format( / '*** readwind -- ', a / a, 3(1x,i8) / &
+        'file = ', a )
+
+
+! READ THE FIRST FILE
+       if (ldirect.eq.1) indj2=indj
+       if (ldirect.eq.-1) indj2=indj
+       deltat=wfdt(indj2)
+      fnamenc = path(m)(1:length(m)) // wfnamen(l,indj2)
+! locate the date/time in the file
+      itime = 0
+1100  itime = itime + 1
+      call read_ncwrfout_1datetime( ierr, fnamenc, &
+          itime, jyyyymmdd, jhhmmss )
+      if (ierr .eq. -1) then
+          write(*,9100) 'error reading time from met file', fnamenc
+          stop
+      else if (ierr .ne. 0) then
+          write(*,9125) 'unable to locate date/time in met file',  &
+              'indj, itime =', indj2, itime, fnamenc
+          stop
+      else 
+          jul = juldate( jyyyymmdd, jhhmmss )
+          duma = (jul-bdate)*86400.
+          iduma = nint(duma)
+          if (iduma .ne. wftime(indj2)) goto 1100
+      end if
+      write(*,*) 
+      write(*,*) 'readwind_nests processing wrfout file ='
+      write(*,*) fnamenc
+      write(*,*) 'itime, ymd, hms =', itime, jyyyymmdd, jhhmmss
+
+      kbgn = 1 + add_sfc_level
+
+      if (wind_option.eq.1) varname = 'AVGFLX_RUM'
+      do i = 1, ndims_max
+          lendim_exp(i) = 0
+          lendim_max(i) = 1
+      end do
+      lendim_exp(1) = nxn(l)+1
+      lendim_max(1) = nxmaxn
+      lendim_exp(2) = nyn(l)
+      lendim_max(2) = nymaxn
+      lendim_exp(3) = nuvz-add_sfc_level
+      lendim_max(3) = nuvzmax
+      ndims_exp = 4
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+      	  varname, uuhn(0,0,kbgn,l), &
+      	  itime, &
+      	  ndims, ndims_exp, ndims_max, &
+      	  lendim, lendim_exp, lendim_max )
+      if (ierr .ne. 0) then
+          write(*,9100) 'error doing ncread of U', fnamenc
+      if (wind_option.le.0) print*,'you asked snapshot winds'
+      if (wind_option.eq.1) print*,'you asked mean winds'
+        print*,'change wind_option'
+
+          stop
+      end if
+
+
+! v wind velocity
+!   the wrf output file contains (nuvz-add_sfc_level) levels
+!   read the data into k=kbgn,nuvz
+!   (interpolate it from "V-grid" to "T-grid" later)
+      if (wind_option.eq.1) varname = 'AVGFLX_RVM'
+      lendim_exp(1) = nxn(l)
+      lendim_max(1) = nxmaxn
+      lendim_exp(2) = nyn(l)+1
+      lendim_max(2) = nymaxn
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+      	  varname, vvhn(0,0,kbgn,l), &
+      	  itime, &
+      	  ndims, ndims_exp, ndims_max, &
+      	  lendim, lendim_exp, lendim_max )
+      if (ierr .ne. 0) then
+          write(*,9100) 'error doing ncread of V', fnamenc
+      if (wind_option.eq.0) print*,'you asked snapshot winds'
+      if (wind_option.eq.1) print*,'you asked mean winds'
+        print*,'change wind_option'
+          stop
+      end if
+
+
+! w wind velocity
+!   this is on the "W-grid", and 
+!   the wrf output file contains nwz levels, so no shifting needed
+      if (wind_option.eq.1) varname = 'AVGFLX_WWM'
+!      print*,'varname',varname
+      lendim_exp(1) = nxn(l)
+      lendim_max(1) = nxmaxn
+      lendim_exp(2) = nyn(l)
+      lendim_max(2) = nymaxn
+      lendim_exp(3) = nwz
+      lendim_max(3) = nwzmax
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+      	  varname, wwhn(0,0,1,l), &
+      	  itime, &
+      	  ndims, ndims_exp, ndims_max, &
+      	  lendim, lendim_exp, lendim_max )
+      if (ierr .ne. 0) then
+          write(*,9100) 'error doing ncread of W', fnamenc
+      if (wind_option.eq.0) print*,'you asked snapshot winds'
+      if (wind_option.eq.1) print*,'you asked mean winds'
+        print*,'change wind_option'
+          stop
+      end if
+
+! READ THE SECOND FILE and average
+! deltat must be equal to deltat2, otherwise the time-average wind cannot be
+! fixed.
+! deltat is assumed to be the same than the WRF output.
+
+       if (ldirect.eq.1) indj2=indj+1
+       if (ldirect.eq.-1) indj2=indj-1
+       deltat2=wfdt(indj2)
+      fnamenc = path(m)(1:length(m)) // wfnamen(l,indj2)
+
+     if (deltat.eq.deltat2 .and. indj2.ge.1 .and.indj2.le.numbwf) then
+! locate the date/time in the file
+      itime = 0
+1101  itime = itime + 1
+      call read_ncwrfout_1datetime( ierr, fnamenc, &
+          itime, jyyyymmdd, jhhmmss )
+      if (ierr .eq. -1) then
+          write(*,9100) 'error reading time from met file', fnamenc
+          stop
+      else if (ierr .ne. 0) then
+          write(*,9125) 'unable to locate date/time in met file',  &
+              'indj, itime =', indj2, itime, fnamenc
+          stop
+      else 
+          jul = juldate( jyyyymmdd, jhhmmss )
+          duma = (jul-bdate)*86400.
+          iduma = nint(duma)
+          if (iduma .ne. wftime(indj2)) goto 1101
+      end if
+      if (option_verbose.eq.1) then
+      write(*,*) 
+      write(*,*) 'readwind processing wrfout file ='
+      write(*,*) fnamenc
+      write(*,*) 'itime, ymd, hms =', itime, jyyyymmdd, jhhmmss
+      endif
+      kbgn = 1 + add_sfc_level
+
+      if (wind_option.eq.1) varname = 'AVGFLX_RUM'
+      do i = 1, ndims_max
+          lendim_exp(i) = 0
+          lendim_max(i) = 1
+      end do
+      lendim_exp(1) = nxn(l)+1
+      lendim_max(1) = nxmaxn
+      lendim_exp(2) = nyn(l)
+      lendim_max(2) = nymaxn
+      lendim_exp(3) = nuvz-add_sfc_level
+      lendim_max(3) = nuvzmax
+      ndims_exp = 4
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+      	  varname, uuhn2(0,0,kbgn,l), &
+      	  itime, &
+      	  ndims, ndims_exp, ndims_max, &
+      	  lendim, lendim_exp, lendim_max )
+      if (ierr .ne. 0) then
+          write(*,9100) 'error doing ncread of U', fnamenc
+      if (wind_option.le.0) print*,'you asked snapshot winds'
+      if (wind_option.eq.1) print*,'you asked mean winds'
+        print*,'change wind_option'
+
+          stop
+      end if
+
+
+! v wind velocity
+!   the wrf output file contains (nuvz-add_sfc_level) levels
+!   read the data into k=kbgn,nuvz
+!   (interpolate it from "V-grid" to "T-grid" later)
+      if (wind_option.eq.1) varname = 'AVGFLX_RVM'
+      lendim_exp(1) = nxn(l)
+      lendim_max(1) = nxmaxn
+      lendim_exp(2) = nyn(l)+1
+      lendim_max(2) = nymaxn
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+      	  varname, vvhn2(0,0,kbgn,l), &
+      	  itime, &
+      	  ndims, ndims_exp, ndims_max, &
+      	  lendim, lendim_exp, lendim_max )
+      if (ierr .ne. 0) then
+          write(*,9100) 'error doing ncread of V', fnamenc
+      if (wind_option.eq.0) print*,'you asked snapshot winds'
+      if (wind_option.eq.1) print*,'you asked mean winds'
+        print*,'change wind_option'
+          stop
+      end if
+
+
+! w wind velocity
+!   this is on the "W-grid", and 
+!   the wrf output file contains nwz levels, so no shifting needed
+      if (wind_option.eq.1) varname = 'AVGFLX_WWM'
+!     print*,'varname',varname
+      lendim_exp(1) = nxn(l)
+      lendim_max(1) = nxmaxn
+      lendim_exp(2) = nyn(l)
+      lendim_max(2) = nymaxn
+      lendim_exp(3) = nwz
+      lendim_max(3) = nwzmax
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+      	  varname, wwhn2(0,0,1,l), &
+      	  itime, &
+      	  ndims, ndims_exp, ndims_max, &
+      	  lendim, lendim_exp, lendim_max )
+      if (ierr .ne. 0) then
+          write(*,9100) 'error doing ncread of W', fnamenc
+      if (wind_option.eq.0) print*,'you asked snapshot winds'
+      if (wind_option.eq.1) print*,'you asked mean winds'
+        print*,'change wind_option'
+          stop
+      end if
+
+
+         do k=1,nuvzmax
+        do j=0,nymax-1
+       do i=0,nxmax-1
+           uuhn(i,j,k,l)=0.5*(uuhn(i,j,k,l)+uuhn2(i,j,k,l))
+           vvhn(i,j,k,l)=0.5*(vvhn(i,j,k,l)+vvhn2(i,j,k,l))
+         enddo
+        enddo
+       enddo
+         do k=1,nwzmax
+        do j=0,nymax-1
+       do i=0,nxmax-1
+           wwhn(i,j,k,l)=0.5*(wwhn(i,j,k,l)+wwhn2(i,j,k,l))
+         enddo
+        enddo
+       enddo
+
+
+      endif ! test on deltat
+
+      enddo ! loop over the nests
+
+      return    
+      end subroutine readwind_nests_timeav
+
Index: /branches/jerome/src_flexwrf_v3.1/readwind_timeav.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/readwind_timeav.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/readwind_timeav.f90	(revision 16)
@@ -0,0 +1,454 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                *
+!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine,       *
+!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
+!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso,          *
+!* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann,   *
+!*                                                                     *
+!* This file is part of FLEXPART WRF                                   *
+!*                                                                     *
+!* 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_timeav(indj,n,uuh,vvh,wwh)
+!**********************************************************************
+!                                                                     * 
+!             TRAJECTORY MODEL SUBROUTINE READWIND                    *
+!                                                                     *
+!**********************************************************************
+!                                                                     * 
+!  April 2012, J. Brioude: This routine handles the difference in time
+! for time-average fields.
+!**********************************************************************
+!                                                                     *
+! Note:  This is the FLEXPART_WRF version of subroutine readwind.     *
+!    The met fields are read from WRF netcdf output files.            *
+!    There are many differences from the FLEXPART version.            *
+!                                                                     *
+! 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 "T-grid" vertical levels wwf model     *
+!                    (the unstaggered "bottom_top" dimension)         *
+! uu,vv,ww           wind fields                                      *
+! tt,qv              temperature and specific humidity                *
+! ps                 surface pressure                                 *
+!                                                                     *
+!**********************************************************************
+!
+
+!      include 'includepar'
+!      include 'includecom'
+  use par_mod
+  use com_mod
+
+! subr arguments
+      integer :: indj, n
+
+      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)
+      real(kind=4) :: uuh2(0:nxmax-1,0:nymax-1,nuvzmax)
+      real(kind=4) :: vvh2(0:nxmax-1,0:nymax-1,nuvzmax)
+      real(kind=4) :: wwh2(0:nxmax-1,0:nymax-1,nwzmax)
+
+! local variables
+      integer,parameter :: ndims_max=4
+
+      integer :: i, idiagaa, ierr, ifn, itime
+      integer :: iduma,indj2
+      integer :: j, jhhmmss, jyyyymmdd
+      integer :: k, kbgn
+      integer :: lendim(ndims_max), lendim_exp(ndims_max), &
+          lendim_max(ndims_max)
+      integer :: levdiff2,deltat,deltat2
+      integer :: ndims, ndims_exp
+      integer :: n_west_east, n_south_north, n_bottom_top
+      integer :: m_grid_id_dum, m_parent_grid_id_dum, &
+        m_parent_grid_ratio_dum,  &
+        i_parent_start_dum, j_parent_start_dum, &
+        map_proj_id_dum,  &
+        ext_scalar,pbl_physics,mp_physics_dum
+
+      real :: dx_met, dy_met
+      real :: duma, dumb, dumc, dumd, dume
+      real :: dumdz
+!      real(kind=4) :: dumarray_aa(nwzmax+1)
+!      real(kind=4) :: dumarray_pp(0:nxmax-1,0:nymax-1,nwzmax+1)
+      real :: dumarray_aa(nwzmax+1)
+      real :: dumarray_pp(0:nxmax-1,0:nymax-1,nwzmax+1)
+      real :: ewater_mb, esatwater_mb
+      real :: ew      ! this is an external function
+      real :: map_stdlon_dum, map_truelat1_dum, map_truelat2_dum
+      real :: pint
+      real :: toler
+
+!      real(kind=4) :: ewss(0:nxmax-1,0:nymax-1),nsss(0:nxmax-1,0:nymax-1)
+      real :: ewss(0:nxmax-1,0:nymax-1),nsss(0:nxmax-1,0:nymax-1)
+      real :: plev1,pmean,tv,fu,hlev1,ff10m,fflev1
+
+      real(kind=dp) :: jul,juldate
+
+      character(len=160) :: fnamenc, varname,fnamenc2
+
+      logical :: hflswitch
+
+!
+!   get grid info from the wrf netcdf file
+!   and check it for consistency against values from gridcheck
+!
+
+!        print*,'entering timeav'
+
+      fnamenc = path(2)(1:length(2))//wfname(indj)
+      idiagaa = 0
+
+      call read_ncwrfout_gridinfo( ierr, idiagaa, fnamenc, &
+        n_west_east, n_south_north, n_bottom_top, & 
+        dx_met, dy_met,  &
+        m_grid_id_dum, m_parent_grid_id_dum, m_parent_grid_ratio_dum, &
+        i_parent_start_dum, j_parent_start_dum, &
+        map_proj_id_dum, map_stdlon_dum,  &
+        map_truelat1_dum, map_truelat2_dum, &
+        ext_scalar,pbl_physics,mp_physics_dum )
+      if (ierr .ne. 0) then
+          write(*,9100) 'error getting gridinfor for met file', fnamenc
+          stop
+      end if
+
+9100  format( / '*** readwind -- ', a )
+9110  format( / '*** readwind -- ', a, 1x, i8 / &
+        'file = ', a )
+9120  format( / '*** readwind -- ', a, 2(1x,i8) / &
+        'file = ', a )
+9130  format( / '*** readwind -- ', a, 3(1x,i8) / &
+        'file = ', a )
+9115  format( / '*** readwind -- ', a / a, 1x, i8 / &
+        'file = ', a )
+9125  format( / '*** readwind -- ', a / a, 2(1x,i8) / &
+        'file = ', a )
+9135  format( / '*** readwind -- ', a / a, 3(1x,i8) / &
+        'file = ', a )
+
+      toler = 2.0e-7
+
+      if (nx .ne. n_west_east) then
+          write(*,9100) 'nx not consistent', fnamenc
+          stop
+      end if
+      if (ny .ne. n_south_north) then
+          write(*,9100) 'ny not consistent', fnamenc
+          stop
+      end if
+      if (nlev_ec .ne. n_bottom_top) then
+          write(*,9100) 'nlev_ec not consistent', fnamenc
+          stop
+      end if
+      if (nwz .ne. n_bottom_top+1) then
+          write(*,9100) 'nwz not consistent', fnamenc
+          stop
+      end if
+!     if (nuvz .ne. n_bottom_top+1) then
+!         write(*,9100) 'nuvz not consistent', fnamenc
+!         stop
+!     end if
+
+      if (m_grid_id(0) .ne. m_grid_id_dum) then
+          write(*,9100) 'm_grid_id not consistent', fnamenc
+          write(*,*) m_grid_id(0), m_grid_id_dum
+          stop
+      end if
+      if (m_parent_grid_id(0) .ne. m_parent_grid_id_dum) then
+          write(*,9100) 'm_parent_grid_id not consistent', fnamenc
+          stop
+      end if
+      if (m_parent_grid_ratio(0) .ne. m_parent_grid_ratio_dum) then
+          write(*,9100) 'm_parent_grid_ratio not consistent', fnamenc
+          stop
+      end if
+      if (i_parent_start(0) .ne. i_parent_start_dum) then
+          write(*,9100) 'i_parent_start not consistent', fnamenc
+          stop
+      end if
+      if (j_parent_start(0) .ne. j_parent_start_dum) then
+          write(*,9100) 'j_parent_start not consistent', fnamenc
+          stop
+      end if
+
+      if (abs(dx - dx_met) .gt. toler*abs(dx)) then
+          write(*,9100) 'dx not consistent', fnamenc
+          stop
+      end if
+      if (abs(dy - dy_met) .gt. toler*abs(dy)) then
+          write(*,9100) 'dy not consistent', fnamenc
+          stop
+      end if
+
+
+! READ THE FIRST FILE
+       if (ldirect.eq.1) indj2=indj
+       if (ldirect.eq.-1) indj2=indj
+       deltat=wfdt(indj2)
+      fnamenc = path(2)(1:length(2))//wfname(indj2)
+! locate the date/time in the file
+      itime = 0
+1100  itime = itime + 1
+      call read_ncwrfout_1datetime( ierr, fnamenc, &
+          itime, jyyyymmdd, jhhmmss )
+      if (ierr .eq. -1) then
+          write(*,9100) 'error reading time from met file', fnamenc
+          stop
+      else if (ierr .ne. 0) then
+          write(*,9125) 'unable to locate date/time in met file',  &
+              'indj, itime =', indj2, itime, fnamenc
+          stop
+      else 
+          jul = juldate( jyyyymmdd, jhhmmss )
+          duma = (jul-bdate)*86400.
+          iduma = nint(duma)
+          if (iduma .ne. wftime(indj2)) goto 1100
+      end if
+      if (option_verbose.eq.1) then
+      write(*,*) 
+      write(*,*) 'readwind processing wrfout file ='
+      write(*,*) fnamenc
+      write(*,*) 'itime, ymd, hms =', itime, jyyyymmdd, jhhmmss
+      endif
+      kbgn = 1 + add_sfc_level
+
+      if (wind_option.eq.1) varname = 'AVGFLX_RUM'
+      do i = 1, ndims_max
+          lendim_exp(i) = 0
+          lendim_max(i) = 1
+      end do
+      lendim_exp(1) = nx+1
+      lendim_max(1) = nxmax
+      lendim_exp(2) = ny
+      lendim_max(2) = nymax
+      lendim_exp(3) = nuvz-add_sfc_level
+      lendim_max(3) = nuvzmax
+      ndims_exp = 4
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+      	  varname, uuh(0,0,kbgn), &
+      	  itime, &
+      	  ndims, ndims_exp, ndims_max, &
+      	  lendim, lendim_exp, lendim_max )
+      if (ierr .ne. 0) then
+          write(*,9100) 'error doing ncread of U', fnamenc
+      if (wind_option.le.0) print*,'you asked snapshot winds'
+      if (wind_option.eq.1) print*,'you asked mean winds'
+        print*,'change wind_option'
+
+          stop
+      end if
+
+
+! v wind velocity
+!   the wrf output file contains (nuvz-add_sfc_level) levels
+!   read the data into k=kbgn,nuvz
+!   (interpolate it from "V-grid" to "T-grid" later)
+      if (wind_option.eq.1) varname = 'AVGFLX_RVM'
+      lendim_exp(1) = nx
+      lendim_max(1) = nxmax
+      lendim_exp(2) = ny+1
+      lendim_max(2) = nymax
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+      	  varname, vvh(0,0,kbgn), &
+      	  itime, &
+      	  ndims, ndims_exp, ndims_max, &
+      	  lendim, lendim_exp, lendim_max )
+      if (ierr .ne. 0) then
+          write(*,9100) 'error doing ncread of V', fnamenc
+      if (wind_option.eq.0) print*,'you asked snapshot winds'
+      if (wind_option.eq.1) print*,'you asked mean winds'
+        print*,'change wind_option'
+          stop
+      end if
+
+
+! w wind velocity
+!   this is on the "W-grid", and 
+!   the wrf output file contains nwz levels, so no shifting needed
+      if (wind_option.eq.1) varname = 'AVGFLX_WWM'
+!     print*,'varname',varname
+      lendim_exp(1) = nx
+      lendim_max(1) = nxmax
+      lendim_exp(2) = ny
+      lendim_max(2) = nymax
+      lendim_exp(3) = nwz
+      lendim_max(3) = nwzmax
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+      	  varname, wwh, &
+      	  itime, &
+      	  ndims, ndims_exp, ndims_max, &
+      	  lendim, lendim_exp, lendim_max )
+      if (ierr .ne. 0) then
+          write(*,9100) 'error doing ncread of W', fnamenc
+      if (wind_option.eq.0) print*,'you asked snapshot winds'
+      if (wind_option.eq.1) print*,'you asked mean winds'
+        print*,'change wind_option'
+          stop
+      end if
+
+! READ THE SECOND FILE and average
+! deltat must be equal to deltat2, otherwise the time-average wind cannot be
+! fixed.
+! deltat is assumed to be the same than the WRF output.
+
+       if (ldirect.eq.1) indj2=indj+1
+       if (ldirect.eq.-1) indj2=indj-1
+       deltat2=wfdt(indj2)
+      fnamenc = path(2)(1:length(2))//wfname(indj2)
+
+!        print*,'test timeav',deltat,deltat2,indj2,numbwf
+     if (deltat.eq.deltat2 .and. indj2.ge.1 .and.indj2.le.numbwf) then
+!        print*,'reading second file in timeav',deltat,deltat2,indj2
+! locate the date/time in the file
+      itime = 0
+1101  itime = itime + 1
+      call read_ncwrfout_1datetime( ierr, fnamenc, &
+          itime, jyyyymmdd, jhhmmss )
+      if (ierr .eq. -1) then
+          write(*,9100) 'error reading time from met file', fnamenc
+          stop
+      else if (ierr .ne. 0) then
+          write(*,9125) 'unable to locate date/time in met file',  &
+              'indj, itime =', indj2, itime, fnamenc
+          stop
+      else 
+          jul = juldate( jyyyymmdd, jhhmmss )
+          duma = (jul-bdate)*86400.
+          iduma = nint(duma)
+          if (iduma .ne. wftime(indj2)) goto 1101
+      end if
+      if (option_verbose.eq.1) then
+      write(*,*) 
+      write(*,*) 'readwind processing wrfout file ='
+      write(*,*) fnamenc
+      write(*,*) 'itime, ymd, hms =', itime, jyyyymmdd, jhhmmss
+       endif
+      kbgn = 1 + add_sfc_level
+
+      if (wind_option.eq.1) varname = 'AVGFLX_RUM'
+!     print*,'varname',varname
+      do i = 1, ndims_max
+          lendim_exp(i) = 0
+          lendim_max(i) = 1
+      end do
+      lendim_exp(1) = nx+1
+      lendim_max(1) = nxmax
+      lendim_exp(2) = ny
+      lendim_max(2) = nymax
+      lendim_exp(3) = nuvz-add_sfc_level
+      lendim_max(3) = nuvzmax
+      ndims_exp = 4
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+      	  varname, uuh2(0,0,kbgn), &
+      	  itime, &
+      	  ndims, ndims_exp, ndims_max, &
+      	  lendim, lendim_exp, lendim_max )
+      if (ierr .ne. 0) then
+          write(*,9100) 'error doing ncread of U', fnamenc
+      if (wind_option.le.0) print*,'you asked snapshot winds'
+      if (wind_option.eq.1) print*,'you asked mean winds'
+        print*,'change wind_option'
+
+          stop
+      end if
+
+
+! v wind velocity
+!   the wrf output file contains (nuvz-add_sfc_level) levels
+!   read the data into k=kbgn,nuvz
+!   (interpolate it from "V-grid" to "T-grid" later)
+      if (wind_option.eq.1) varname = 'AVGFLX_RVM'
+!     print*,'varname',varname
+      lendim_exp(1) = nx
+      lendim_max(1) = nxmax
+      lendim_exp(2) = ny+1
+      lendim_max(2) = nymax
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+      	  varname, vvh2(0,0,kbgn), &
+      	  itime, &
+      	  ndims, ndims_exp, ndims_max, &
+      	  lendim, lendim_exp, lendim_max )
+      if (ierr .ne. 0) then
+          write(*,9100) 'error doing ncread of V', fnamenc
+      if (wind_option.eq.0) print*,'you asked snapshot winds'
+      if (wind_option.eq.1) print*,'you asked mean winds'
+        print*,'change wind_option'
+          stop
+      end if
+
+
+! w wind velocity
+!   this is on the "W-grid", and 
+!   the wrf output file contains nwz levels, so no shifting needed
+      if (wind_option.eq.1) varname = 'AVGFLX_WWM'
+!     print*,'varname',varname
+      lendim_exp(1) = nx
+      lendim_max(1) = nxmax
+      lendim_exp(2) = ny
+      lendim_max(2) = nymax
+      lendim_exp(3) = nwz
+      lendim_max(3) = nwzmax
+      call read_ncwrfout_1realfield( ierr, idiagaa, fnamenc, &
+      	  varname, wwh2, &
+      	  itime, &
+      	  ndims, ndims_exp, ndims_max, &
+      	  lendim, lendim_exp, lendim_max )
+      if (ierr .ne. 0) then
+          write(*,9100) 'error doing ncread of W', fnamenc
+      if (wind_option.eq.0) print*,'you asked snapshot winds'
+      if (wind_option.eq.1) print*,'you asked mean winds'
+        print*,'change wind_option'
+          stop
+      end if
+
+!        print*,'start modif timeav'
+         do k=1,nuvzmax
+        do j=0,nymax-1
+       do i=0,nxmax-1
+           uuh(i,j,k)=0.5*(uuh(i,j,k)+uuh2(i,j,k))
+           vvh(i,j,k)=0.5*(vvh(i,j,k)+vvh2(i,j,k))
+         enddo
+        enddo
+       enddo
+         do k=1,nwzmax
+        do j=0,nymax-1
+       do i=0,nxmax-1
+           wwh(i,j,k)=0.5*(wwh(i,j,k)+wwh2(i,j,k))
+         enddo
+        enddo
+       enddo
+!        print*,'end modif timeav'
+
+
+      endif ! test on deltat
+
+!         print*,'out of entering timeav'
+
+      return    
+      end subroutine readwind_timeav
+
Index: /branches/jerome/src_flexwrf_v3.1/redist.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/redist.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/redist.f90	(revision 16)
@@ -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/jerome/src_flexwrf_v3.1/redist_kf.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/redist_kf.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/redist_kf.f90	(revision 16)
@@ -0,0 +1,272 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                *
+!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine,       *
+!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
+!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso,          *
+!* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann,   *
+!*                                                                     *
+!* This file is part of FLEXPART WRF                                   *
+!*                                                                     *
+!* 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/>.   *
+!***********************************************************************
+
+! THIS CODE IS TO REDISTRIBUTE PARTICLES INVOLVED IN UPDRAFT OR/AND  DOWDRAFT
+! TWO OPTIONS: 2- simply well-mixed inside updraft 
+!                 mixing is based on convective mass flux, downdraft is not considered
+!              3- particle positions based on entrainment/detrainment rates 
+!                 if they are available
+!   0- no convection 
+!   1- has been used by old code
+
+! SUBROUTINE NAME: redist_kf
+!  CALLED by convmix_kf.f
+!  meteoroloy data are from pre_redist_kf.f that is called inside convmix_kf.f
+!
+!   INPUT: 
+!           dx   -- horizontal grid size
+!           nuvzmax   -- # of layer for mass flux
+!           umf -- updraft mass flux
+!           uer -- updraft entrament flux
+!           udr -- updraft detrainment flux
+!           dmf -- downdraft mass flux
+!           der -- downdraft entrainment flux
+!           ddr -- downdraft detrainment flux
+!           rho1d -- air density
+!           dz1d-- delt z between full levels
+!           ldirect -- flag for forward (+1) or backward (-1) run
+!           delt    -- time step (s)
+!           umfzf -- normalized up-mass-flux weighted distance,
+!           dmfzf -- normalized down-mass-flux weighted distance,(not used)
+!           fmix  -- estimated fraction of particles that will be mixed (for LCONVECTION=2)
+!           zf    -- distance above ground at full levels
+!           zh    --  """"""""""""""""""""""""half levels
+
+!   IN/OUTPUT:
+!           zp  -- particle z position  (IN/OUT)
+
+       Subroutine redist_kf(mix_option,ldirect,delt,dx,            & ! IN
+                          dz1d,nuvzmax, nuvz,umf,uer,udr,dmf,      & ! IN
+                            der,ddr,rho1d,                         & ! IN
+                            zf,zh,                                 & ! IN
+                            umfzf,dmfzf,fmix,                      & ! IN
+                            zp)                                      ! IN/OUT
+
+
+        IMPLICIT NONE
+        integer :: nuvzmax,nuvz,ldirect,i,j,k,kk,mix_option
+        integer,parameter :: well_mix=2 
+        integer,parameter :: prob_mix=3
+        real,dimension(nuvzmax):: umf,uer,udr,zh,dz1d
+        real,dimension(nuvzmax):: dmf,der,ddr,rho1d
+        real,dimension(nuvzmax+1):: zf,umfzf,dmfzf
+        real :: zp,delt,dx,fup,fdown,ftotal,totalmass
+        real :: rn,rn1,rn2,ddz,fde,w_sub,ran3,fmix
+        real :: uptop,downtop          ! top of updraft and downdraft
+!        data well_mix,prob_mix/2,3/
+
+! Check if particle position is below convection cloud top
+! find top height of updraft
+        uptop=0.0 
+        do i=nuvz,1,-1
+          if (umf(i) .gt. 1e-20) then
+            if (i .eq. nuvz) uptop = zh(nuvz) 
+            if (i .lt. nuvz) uptop = zh(i+1)
+             goto 81
+            endif
+        enddo
+81        continue                                ! updraft top
+
+        downtop=0.0
+        do i=nuvz,1,-1
+          if (abs(dmf(i)) .gt. 1e-20) then
+             if (i .eq. nuvz) downtop=zh(nuvz)
+             if (i .lt. nuvz) downtop=zh(i+1)
+              goto 82
+          endif
+        enddo
+82       continue                                 ! downdraft top
+
+
+         if (zp .ge. uptop) goto 89   ! no convective adjustment
+
+           DO i=1,nuvz
+             if (zp .ge. zf(i) .and. zp .lt. zf(i+1)) goto 90
+           ENDDO
+90          kk=i  !  kk is grid # of the particle before reposition
+            totalmass=rho1d(kk)*dz1d(kk)*dx*dx   ! air mass kg
+
+
+!+++++++++
+! NOw start to reposition particle
+!  
+! Simply mix all particles by assigning a random position within cloud
+! In this case, backward run is not wroking since this reposition process is not
+!  reversible.
+
+         IF (mix_option .eq. well_mix) then         ! Well-mixed
+
+!!  only consider updraft (usually >> downdraft flux) 
+!! Choose a random # evenly distributed in [0,1]
+            rn=ran3(88)
+     
+            if (rn .le. fmix) then       ! inside cloud 
+              write(*,*)'well mixed, fmix=,rn=',fmix,rn
+!    --|--  umfzf(j),  zf(j)
+!    --|X-  rn2 (particle position)
+!    --|--  umfzf(j-1),zf(j-1)
+
+               rn2=ran3(881)
+
+               do j=2,nuvz+1
+                 if(umfzf(j) .ge. rn2) then 
+                 zp = zf(j)-(umfzf(j)-rn)/ &
+                          (umfzf(j)-umfzf(j-1))*dz1d(j-1)
+                 goto 92
+                 endif
+               enddo
+92             continue
+             write(*,*)'old position=',kk, &
+                       'repositioned at k=,umfzf(j),rn',j,umfzf(j),rn 
+            endif                         ! inside cloud
+         ENDIF                                      ! Well-mixed
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!!!!!!!!!!!!!!!! reposition based on probabilities of entrainment and detrainment
+!!!!!!!!!!!!!!!! FORWARD treatment
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+         IF (mix_option .eq. prob_mix .and. ldirect .gt. 0)then       !! prob_mix+ forward
+           fup = abs(uer(kk))*delt/totalmass
+           fdown=abs(der(kk))*delt/totalmass
+           ftotal=fup+fdown                               ! ignore downward flux if 0*fdown
+           if (ftotal .le. 1e-10) goto 89                    ! return if no cloud
+! pick a random number to see if particle is inside cloud
+            rn = ran3(88)
+          
+
+           if (rn .le. ftotal) then    ! in
+            rn1=ran3(881)              
+             write(*,*)'inside cloud, kk,ftotal,rn=',kk,ftotal,rn
+              if (rn1 .le. fup/ftotal) then   ! updraft
+! parcel will move upward till all particles inside are detrained
+!   umf(k+1)=umf(k)+uer(k+1)-udr(k+1)
+!
+!    ---|--- 
+!    ---|+++ 
+!    ---|--- zf(j+2)
+!    ---|+++ udr(j+1), half level, partile is detrained here
+!    ---|--- zf(j+1)
+!    ........
+!    ---|+++ uer(kk), particle is entrained here
+                   write(*,*)'updraft','fup=',fup,uer(kk)*delt,totalmass
+                   write(*,*)'fdown=',fdown,fdown/ftotal
+                do j=kk,nuvz-1 
+                 rn=ran3(882)
+                 if (umf(j) .eq. 0.0) goto 98
+                 fde = abs(udr(j+1)/umf(j))   ! detrainment probability at level j+1
+                 if (rn .lt. fde .or. zh(j+1) .ge. uptop) goto 98 ! being detrtained from air parcel
+                                                           ! or reach cloud top 
+                enddo
+98              zp=zf(j+1) + rn*(zf(j+2)-zf(j+1)) ! particle is detrained between zf(j+1) and zf(j+2)              
+                 write(*,*)'detrain at',j+1,rn,zp,'old=',zf(kk)
+              else                            !up/down
+! move downward till detrained or get to ground
+                do j=kk,2,-1
+                 rn=ran3(883)
+                 if(dmf(j) .eq. 0.0) goto 102
+                 fde = abs(ddr(j-1)/dmf(j))  ! detrainment at level j-1 
+                 if(rn .lt. fde .or. j .eq. 2) goto 102
+                enddo
+102              zp=zf(j-1)+rn*(zf(j)-zf(j-1))
+
+                 write(*,*)'downward prob,detrain at',fdown/ftotal,j-1
+
+              endif                           ! downdraft
+
+            else                        ! in /OUT
+!! outside cloud
+!! displace particle according to compensating subsidence 
+             w_sub =(abs(umf(kk))-abs(dmf(kk)))/rho1d(kk)/dx/dx
+              zp = zp - w_sub*delt
+             write(*,*)'subsidence== distance(m)',w_sub*delt, &
+                       'rn,ftotal=',rn,ftotal
+            endif                       ! OUT
+         ENDIF                                                    !! prob_mix + forward
+!!!!!!!!!  END OF FORWARD treatment  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+!!!!!!!! -------------------------------------------------------------
+!!!!!!!!  backward 
+!!!!!!!!    reverse all processes, e.g., up --> down, down --> up, entrainment -> detrainment
+!!!!!!!!           detrainment --> entrainment,,,,,,,
+!!!!!!!! -------------------------------------------------------------
+
+         IF (mix_option .eq. prob_mix .and. ldirect .lt. 0) then   !! prob_mix + backward
+           fdown = abs(udr(kk))*delt/totalmass
+           fup   = abs(ddr(kk))*delt/totalmass
+           ftotal=fup+fdown                          !
+!           ftotal=fup                                ! ignore downdraft 
+           if (ftotal .le. 1e-10) goto 89
+
+! pick a random number to see if particle is inside cloud
+            rn = ran3(88)
+            if (rn .le. ftotal) then    ! in
+            rn1=ran3(881)
+              if (rn1 .lt. fup/ftotal) then   ! updraft
+! parcel will move "upward" till all particles inside being detrained
+ 
+                do j=kk,nuvz-1
+                 rn=ran3(j)
+                 if (dmf(j) .eq. 0.0) goto 981
+                 fde = abs(der(j+1)/dmf(j))   ! "detrainment" probability at level j+1
+                 if (rn .lt. fde .or. zh(j+1) .ge. downtop) goto 981 ! being detrtained from air parcel
+                                                           ! or reach cloud top
+                 enddo
+981              zp=zf(j+1) + rn*(zf(j+2)-zf(j+1)) ! partice is detrained between zf(j+1) and j+2
+ 
+              else                            !up/down
+! move downward till detrained or get to ground
+                do j=kk,2,-1
+                 rn=ran3(j)
+                 if (umf(j) .eq. 0.0) goto 1021
+                 fde = abs(uer(j-1)/umf(j))  ! "detrainment" at level j-1
+                 if(rn .lt. fde .or. j .eq. 2) goto 1021
+                enddo
+1021              zp=zf(j-1)+rn*(zf(j)-zf(j-1))
+ 
+              endif                           ! downdraft
+ 
+            else                        ! in /OUT
+!! outside cloud
+!! displace particle according to compensating subsidence
+             w_sub =(abs(dmf(kk))-abs(umf(kk)))/rho1d(kk)/dx/dx
+              zp = zp - w_sub*delt
+            endif                       ! OUT
+         ENDIF                                             !! prob_mix + backward
+
+!-------------- END OF BACKWARD treatment ------------------
+
+
+
+
+
+!+++++++++
+! END OF calculating particle position 
+
+
+89       continue
+
+       return
+       end subroutine redist_kf
+
+
+
Index: /branches/jerome/src_flexwrf_v3.1/releaseparticles_irreg.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/releaseparticles_irreg.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/releaseparticles_irreg.f90	(revision 16)
@@ -0,0 +1,417 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                *
+!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine,       *
+!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
+!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso,          *
+!* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann,   *
+!*                                                                     *
+!* This file is part of FLEXPART WRF                                   *
+!*                                                                     *
+!* 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_irreg(itime)
+!                                   o
+!*******************************************************************************
+!                                                                              *
+!     This subroutine releases particles from the release locations.           *
+!                                                                              *
+!     Note:  This is the FLEXPART_WRF version of subroutine gridcheck.         *
+!            The computational grid is the WRF x-y grid rather than lat-lon.   *
+!                                                                              *
+!     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                                                             *
+!                                                                              *
+!     14 Nov 2005, R. Easter - use xyindex_to_ll_wrf to get lat,lon            *
+!                                                                              *
+!*******************************************************************************
+!                                                                              *
+! 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 par_mod
+  use com_mod
+  use point_mod
+!  use xmass_mod
+
+!      include 'includepar'
+!      include 'includecom'
+
+      real :: xaux,yaux,zaux,ran1,rfraction
+!,xmasssave(maxpoint)
+      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
+      real :: dumx, dumy, ylatav
+      real,parameter :: eps=1.e-8
+      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
+
+  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
+!*********************************
+
+! FLEXPART_WRF - use this routine to get lat,lon
+!         xlonav=xlon0+(xpoint2(i)+xpoint1(i))/2.*dx  ! longitude needed to determine local time
+          dumx = (xpoint2(i)+xpoint1(i))*0.5
+          dumy = (ypoint2(i)+ypoint1(i))*0.5
+          call xyindex_to_ll_wrf( 0, dumx, dumy, xlonav, ylatav )
+
+          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)
+           enddo
+          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
+                enddo
+! Assign certain properties to particle
+!**************************************
+
+                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
+                enddo
+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.eps) ztra1(ipart)=eps   ! Minimum starting height is eps
+                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
+                  enddo
+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)
+                  enddo
+                  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)
+                  enddo
+                  endif
+                  rhoout=(dz2*rhoaux(1)+dz1*rhoaux(2))*dz
+
+
+! Multiply "mass" (i.e., mass mixing ratio in forward runs) with density
+!********************************************************************
+
+                  do k=1,nspec
+                  xmass1(ipart,k)=xmass1(ipart,k)*rhoout
+                   enddo
+                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
+!           print*,'numpart release',numpart,ipart,maxpart
+
+      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_irreg
+
Index: /branches/jerome/src_flexwrf_v3.1/releaseparticles_reg.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/releaseparticles_reg.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/releaseparticles_reg.f90	(revision 16)
@@ -0,0 +1,432 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                *
+!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine,       *
+!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
+!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso,          *
+!* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann,   *
+!*                                                                     *
+!* This file is part of FLEXPART WRF                                   *
+!*                                                                     *
+!* 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_reg(itime)
+!                                   o
+!*******************************************************************************
+!                                                                              *
+!     This subroutine releases particles from the release locations.           *
+!                                                                              *
+!     Note:  This is the FLEXPART_WRF version of subroutine gridcheck.         *
+!            The computational grid is the WRF x-y grid rather than lat-lon.   *
+!                                                                              *
+!     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                                                             *
+!                                                                              *
+!     14 Nov 2005, R. Easter - use xyindex_to_ll_wrf to get lat,lon            *
+!     July 2012, J. Brioude: regular lat/lon grid coordinates                  *
+!*******************************************************************************
+!                                                                              *
+! 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 par_mod
+  use com_mod
+  use point_mod
+!  use xmass_mod
+
+!      include 'includepar'
+!      include 'includecom'
+
+      real :: xaux,yaux,zaux,ran1,rfraction
+!,xmasssave(maxpoint)
+      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,xlon,ylat,x1,y1
+      real :: dumx, dumy, ylatav,xaux2,yaux2
+      real,parameter :: eps=1.e-8
+      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
+
+  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
+!    print*,'test rel time',itime,itra1(2),itra1(2000),itra1(4000)
+      do i=1,numpoint
+!           print*,'numpoint',numpoint,itime,ireleasestart(i)      
+        if ((itime.ge.ireleasestart(i)).and.   &         ! are we within release interval?
+        (itime.le.ireleaseend(i))) then
+
+! Determine the local day and time
+!*********************************
+
+! FLEXPART_WRF - use this routine to get lat,lon
+!         xlonav=xlon0+(xpoint2(i)+xpoint1(i))/2.*dx  ! longitude needed to determine local time
+          dumx = (xpoint2(i)+xpoint1(i))*0.5
+          dumy = (ypoint2(i)+ypoint1(i))*0.5
+          call xyindex_to_ll_wrf( 0, dumx, dumy, xlonav, ylatav )
+
+          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)
+           enddo
+          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
+!            rfraction=rfraction+xmasssave(1)  ! number to be released at this time
+            numrel=int(rfraction)
+            xmasssave(i)=rfraction-real(numrel)
+!            xmasssave(1)=rfraction-real(numrel)
+          else
+            numrel=npart(i)
+          endif
+
+!          xaux=xpoint2(i)-xpoint1(i)
+!          yaux=ypoint2(i)-ypoint1(i)
+          xaux2=xpoint22(i)-xpoint12(i)
+          yaux2=ypoint22(i)-ypoint12(i)
+          zaux=zpoint2(i)-zpoint1(i)
+!           print*,'numrel',numrel,numpart
+          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
+!*****************************************************************************************
+!              print*,'empty',ipart,itra1(ipart),itime
+! Determine horizontal particle position
+!***************************************
+
+!                xtra1(ipart)=xpoint1(i)+ran1(idummy)*xaux
+                xlon=xpoint12(i)+ran1(idummy)*xaux2
+                ylat=ypoint12(i)+ran1(idummy)*yaux2
+!JB: a tester
+!       print*,'map_std',map_stdlon
+        call ll_to_xymeter_wrf(xlon,ylat,x1,y1)
+                xtra1(ipart)=(x1-xmet0)/dx
+                ytra1(ipart)=(y1-ymet0)/dy
+
+                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
+                enddo
+! Assign certain properties to particle
+!**************************************
+
+                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
+!          print*,'ipart 1',ipart,ztra1(ipart)
+! 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
+                enddo
+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.eps) ztra1(ipart)=eps   ! Minimum starting height is eps
+                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
+                  enddo
+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)
+                  enddo
+                  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)
+                  enddo
+                  endif
+                  rhoout=(dz2*rhoaux(1)+dz1*rhoaux(2))*dz
+
+
+! Multiply "mass" (i.e., mass mixing ratio in forward runs) with density
+!********************************************************************
+
+                  do k=1,nspec
+                  xmass1(ipart,k)=xmass1(ipart,k)*rhoout
+                   enddo
+                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
+!       print*,'numpart in rel',numpart
+!         print*,'test rel0',npoint(5139),npoint(6002),npoint(100003)
+!           print*,'numpart release',numpart,ipart,maxpart
+
+      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_reg
+
Index: /branches/jerome/src_flexwrf_v3.1/richardson.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/richardson.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/richardson.f90	(revision 16)
@@ -0,0 +1,250 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                *
+!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine,       *
+!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
+!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso,          *
+!* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann,   *
+!*                                                                     *
+!* This file is part of FLEXPART WRF                                   *
+!*                                                                     *
+!* 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, &
+        pplev,hf,tt2,td2,h,wst,hmixplus,ierr,sfc_option)
+!     subroutine richardson(psurf,ust,ttlev,qvlev,ulev,vlev,nuvz,
+!    +akz,bkz,hf,tt2,td2,h,wst,hmixplus,ierr)
+
+!                             i    i    i     i    i    i    i
+!      i   i  i   i   i  o  o     o
+!****************************************************************************
+!                                                                           *
+!     Note:  This is the FLEXPART_WRF version of subroutine richardson.     *
+!                                                                           *
+!     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.                              *
+!                                                                           *
+!     17 Oct 2005 - R. Easter - added ierr status flag (0=ok, -1=fail)      *
+!     15 Nov 2005 - R. Easter - use pplev instead of akz,bkz                *
+!                                                                           *
+!****************************************************************************
+!                                                                           *
+! 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                     *
+!                                                                           *
+!****************************************************************************
+
+!      include 'includepar'
+
+!      integer ierr
+!      integer i,k,nuvz,itmax,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         pplev(nuvz),ulev(nuvz),vlev(nuvz),hf,wst,tt2,td2,ew
+!      real psurf,ust,ttlev(nuvz),qvlev(nuvz),h,const,ric,b,excess,bs
+!      real thetaold,zl,ul,vl,thetal,ril,hmixplus,wspeed,bvfsq,bvf
+!      real f_qvsat,rh,rhold,rhl,theta1,theta2,zl1,zl2,thetam
+!      parameter(const=r_air/ga,ric=0.25,b=100.,bs=8.5,itmax=3)
+
+  use par_mod
+  
+  implicit none
+  
+  integer :: i,k,nuvz,iter,ierr
+  real :: tv,tvold,zref,z,zold,pint,pold,theta,thetaref,ri
+  real :: pplev(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
+
+  real :: duma
+  integer :: sfc_option
+
+      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
+        pint=pplev(k)             ! 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
+
+        if (k .ge. nuvz) then
+            write(*,*) 'richardson not working -- k = nuvz'
+            ierr = -10
+            goto 7000
+        end if
+      
+20    continue
+ 
+! Determine Richardson number between the critical levels
+!********************************************************
+
+      zl1=zold
+      theta1=thetaold
+      do i=1,20
+        zl=zold+float(i)/20.*(z-zold)
+        ul=ulev(k-1)+float(i)/20.*(ulev(k)-ulev(k-1))
+        vl=vlev(k-1)+float(i)/20.*(vlev(k)-vlev(k-1))
+        thetal=thetaold+float(i)/20.*(theta-thetaold)
+        rhl=rhold+float(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
+        enddo 
+ 
+25    continue
+! if sfc_option = sfc_option_wrf, 
+! pbl heights are read from WRF met. files and put into hmix (=h)
+!JB
+!     h=zl
+      if(sfc_option .eq. sfc_option_diagnosed) h=zl
+      if (h .le. 0.0) then
+          write(*,*) 'richardson not working -- bad h =', h
+          ierr = -20
+          goto 7000
+!     else if (h .lt. 10.0) then
+!         write(*,*) 'richardson not working -- too small h =', h
+!         ierr = +20
+!         return
+      end if
+      
+      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                ! keconv = kinetic energy
+      endif                                       ! used for lifting
+
+ 
+! 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
+
+      ierr = 0
+      return
+
+! Fatal error -- print the inputs
+7000  continue
+      write(*,'(a         )') 'nuvz'
+      write(*,'(i5        )')  nuvz
+      write(*,'(a         )') 'psurf,ust,hf,tt2,td2,h,wst,hmixplus'
+      write(*,'(1p,4e18.10)')  psurf,ust,hf,tt2,td2,h,wst,hmixplus
+      write(*,'(a         )') 'ttlev'
+      write(*,'(1p,4e18.10)')  ttlev
+      write(*,'(a         )') 'qvlev'
+      write(*,'(1p,4e18.10)')  qvlev
+      write(*,'(a         )') 'ulev'
+      write(*,'(1p,4e18.10)')  ulev
+      write(*,'(a         )') 'vlev'
+      write(*,'(1p,4e18.10)')  vlev
+      write(*,'(a         )') 'pplev'
+      write(*,'(1p,4e18.10)')  pplev
+      return
+
+end subroutine richardson
+
Index: /branches/jerome/src_flexwrf_v3.1/scalev.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/scalev.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/scalev.f90	(revision 16)
@@ -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/jerome/src_flexwrf_v3.1/senddouble_mpi.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/senddouble_mpi.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/senddouble_mpi.f90	(revision 16)
@@ -0,0 +1,114 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                *
+!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine,       *
+!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
+!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso,          *
+!* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann,   *
+!*                                                                     *
+!* This file is part of FLEXPART WRF                                   *
+!*                                                                     *
+!* 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/>.   *
+!***********************************************************************
+
+  !   routine used to send double precision vectors by MPI
+  !    Author: J. Brioude                                                      *
+  !    March 2012                                                           *
+  !                                                                            *
+
+         subroutine senddouble_mpi(tag,numpart2,chunksize,direc)
+
+      use mpi_mod
+      use com_mod
+          implicit none
+      include 'mpif.h'
+
+!      character :: varname*20
+       integer :: chunksize,numpart2,jj1
+!      real(kind=dp) :: dummyr(numpart2),
+!      real(kind=dp) :: dummyr22(chunksize)
+       integer :: myid,ierr,ntasks,ii,jdeb,jfin,jj,direc,tag
+!      integer :: MPI_COMM_WORLD
+
+       integer :: jj2,from,jj3   
+  integer, dimension(MPI_STATUS_SIZE) :: status
+       
+      call MPI_COMM_RANK ( MPI_COMM_WORLD, myid, ierr )
+      call MPI_COMM_SIZE ( MPI_COMM_WORLD, ntasks, ierr )
+     if (direc.eq.0) then ! the slaves get
+
+      if (myid.eq.0) then
+       do ii=1,ntasks-1
+       do jj2=1,chunksize
+        jj=(jj2-1)*ntasks+ii+1
+!       do jj=ii+1,numpart2+ii,ntasks
+!        jj2=(jj-ii-1)/ntasks+1
+!        dummyr2(jj2)=dummyr(jj)
+         if (tag.eq.11) dummyr22(jj2)=xtra1(jj)
+         if (tag.eq.12) dummyr22(jj2)=ytra1(jj)
+        enddo
+       call MPI_SEND(dummyr22, chunksize, MPI_DOUBLE_PRECISION, ii,tag, MPI_COMM_WORLD, ierr)
+       enddo
+!      chunksize2=int((numpart2-1)/ntasks)+1
+!     chunksize2=chunksize
+      ii=0
+      do jj=1,numpart2,ntasks
+      ii=ii+1
+      jj2=jj
+      enddo
+      chunksize2=ii+numpart2-jj2
+
+    if (tag.eq.11) then
+     do jj=1,numpart2,ntasks
+      jj3=(jj-1)/ntasks+1
+     mpi_xtra1(jj3)=xtra1(jj)
+     enddo
+     mpi_xtra1(jj3:chunksize2)=xtra1(jj2:numpart2)
+    elseif (tag.eq.12) then
+     do jj=1,numpart2,ntasks
+      jj3=(jj-1)/ntasks+1
+     mpi_ytra1(jj3)=ytra1(jj)
+     enddo
+     mpi_ytra1(jj3:chunksize2)=ytra1(jj2:numpart2)
+    endif 
+
+   else ! the slaves receive
+    if (tag.eq.11) call MPI_RECV(mpi_xtra1, chunksize, MPI_DOUBLE_PRECISION, 0,11, MPI_COMM_WORLD,status, ierr)
+    if (tag.eq.12) call MPI_RECV(mpi_ytra1, chunksize, MPI_DOUBLE_PRECISION, 0,12, MPI_COMM_WORLD,status, ierr)
+   endif
+
+   else ! the master is going to get 
+
+   if (myid.gt.0) then !slaves send
+   if (tag.eq.11) call MPI_SEND(mpi_xtra1, chunksize, MPI_DOUBLE_PRECISION, 0,11, MPI_COMM_WORLD, ierr)
+   if (tag.eq.12) call MPI_SEND(mpi_ytra1, chunksize, MPI_DOUBLE_PRECISION, 0,12, MPI_COMM_WORLD, ierr)
+
+    else ! the master gets
+
+     do from =1,ntasks-1
+    call MPI_RECV(dummyr22, chunksize, MPI_DOUBLE_PRECISION, from,tag, MPI_COMM_WORLD,status,ierr)
+          jj1=(from-1)*chunksize+1
+          jj2=from*chunksize
+         if (tag.eq.11) xtra1(jj1:jj2)=dummyr22(1:chunksize)
+         if (tag.eq.12) ytra1(jj1:jj2)=dummyr22(1:chunksize)
+     enddo
+
+     if (tag.eq.11) xtra1(jj2+1:numpart2)=mpi_xtra1(1:chunksize2)
+     if (tag.eq.12) ytra1(jj2+1:numpart2)=mpi_ytra1(1:chunksize2)
+
+
+    endif
+
+   endif
+
+       end subroutine senddouble_mpi
Index: /branches/jerome/src_flexwrf_v3.1/senddrydep_mpi.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/senddrydep_mpi.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/senddrydep_mpi.f90	(revision 16)
@@ -0,0 +1,77 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                *
+!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine,       *
+!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
+!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso,          *
+!* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann,   *
+!*                                                                     *
+!* This file is part of FLEXPART WRF                                   *
+!*                                                                     *
+!* 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/>.   *
+!***********************************************************************
+
+  !   routine used to send real array of dry deposition by MPI
+  !    Author: J. Brioude                                                      *
+  !    January 2013                                                           *
+        subroutine senddrydep_mpi(chunksize)
+
+      use mpi_mod
+      use com_mod
+      use unc_mod, only: drygridunc2 
+      use par_mod, only: nclassunc
+          implicit none
+      include 'mpif.h'
+!      character :: varname*20
+       integer :: chunksize,numpart2,ks
+!      real :: dummyr(numpart2,nspec2),
+       real :: dummyr(chunksize)
+       integer :: myid,ierr,ntasks,ii,jdeb,jfin,jj,tag,direc
+!      integer :: MPI_COMM_WORLD
+
+       integer :: tag2,nspec2,ix,jy,l,nage,kp
+       integer :: jj2,from       
+  integer, dimension(MPI_STATUS_SIZE) :: status
+
+      call MPI_COMM_RANK ( MPI_COMM_WORLD, myid, ierr )
+      call MPI_COMM_SIZE ( MPI_COMM_WORLD, ntasks, ierr )
+
+!    chunksize=numxgrid*numygrid
+  do ks=1,nspec
+   do kp=1,maxpointspec_act
+    do nage=1,nageclass
+     do l=1,nclassunc
+      tag=ks*1000000+kp*10000+nage*100+l
+
+   if (myid.gt.0) then !slaves send
+
+    call MPI_SEND(drygridunc2(0,0,ks,kp,l,nage), chunksize, MPI_REAL,0,tag, MPI_COMM_WORLD, ierr)
+
+   else ! the master gets
+     do from =1,ntasks-1
+    call MPI_RECV(dummyr, chunksize, MPI_REAL, from,tag, MPI_COMM_WORLD,status,ierr)
+       do jy=0,numygrid-1
+        do ix=0,numxgrid-1
+         drygridunc2(ix,jy,ks,kp,l,nage)=drygridunc2(ix,jy,ks,kp,l,nage)+ &
+           dummyr(ix+1+jy*numxgrid)
+        enddo
+       enddo
+     enddo
+
+   endif
+
+    enddo
+    enddo
+    enddo
+    enddo
+       end subroutine senddrydep_mpi
Index: /branches/jerome/src_flexwrf_v3.1/senddrydep_nest_mpi.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/senddrydep_nest_mpi.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/senddrydep_nest_mpi.f90	(revision 16)
@@ -0,0 +1,77 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                *
+!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine,       *
+!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
+!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso,          *
+!* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann,   *
+!*                                                                     *
+!* This file is part of FLEXPART WRF                                   *
+!*                                                                     *
+!* 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/>.   *
+!***********************************************************************
+
+  !   routine used to send real array of dry deposition by MPI
+  !    Author: J. Brioude                                                      *
+  !    January 2013                                                           *
+        subroutine senddrydep_nest_mpi(chunksize)
+
+      use mpi_mod
+      use com_mod
+      use unc_mod, only: drygriduncn2
+      use par_mod, only: nclassunc
+          implicit none
+      include 'mpif.h'
+!      character :: varname*20
+       integer :: chunksize,numpart2,ks
+!      real :: dummyr(numpart2,nspec2),
+       real :: dummyr(chunksize)
+       integer :: myid,ierr,ntasks,ii,jdeb,jfin,jj,tag,direc
+!      integer :: MPI_COMM_WORLD
+
+       integer :: tag2,nspec2,ix,jy,l,nage,kp
+       integer :: jj2,from       
+  integer, dimension(MPI_STATUS_SIZE) :: status
+
+      call MPI_COMM_RANK ( MPI_COMM_WORLD, myid, ierr )
+      call MPI_COMM_SIZE ( MPI_COMM_WORLD, ntasks, ierr )
+
+!    chunksize=numxgrid*numygrid
+  do ks=1,nspec
+   do kp=1,maxpointspec_act
+    do nage=1,nageclass
+     do l=1,nclassunc
+      tag=ks*1000000+kp*10000+nage*100+l
+
+   if (myid.gt.0) then !slaves send
+
+    call MPI_SEND(drygriduncn2(0,0,ks,kp,l,nage), chunksize, MPI_REAL,0,tag, MPI_COMM_WORLD, ierr)
+
+   else ! the master gets
+     do from =1,ntasks-1
+    call MPI_RECV(dummyr, chunksize, MPI_REAL, from,tag, MPI_COMM_WORLD,status,ierr)
+       do jy=0,numygridn-1
+        do ix=0,numxgridn-1
+         drygriduncn2(ix,jy,ks,kp,l,nage)=drygriduncn2(ix,jy,ks,kp,l,nage)+ &
+           dummyr(ix+1+jy*numxgridn)
+        enddo
+       enddo
+     enddo
+
+   endif
+
+    enddo
+    enddo
+    enddo
+    enddo
+       end subroutine senddrydep_nest_mpi
Index: /branches/jerome/src_flexwrf_v3.1/sendint2_mpi.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/sendint2_mpi.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/sendint2_mpi.f90	(revision 16)
@@ -0,0 +1,99 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                *
+!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine,       *
+!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
+!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso,          *
+!* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann,   *
+!*                                                                     *
+!* This file is part of FLEXPART WRF                                   *
+!*                                                                     *
+!* 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/>.   *
+!***********************************************************************
+
+  !   routine used to send integer*2 vectors by MPI
+  !    Author: J. Brioude                                                      *
+  !    March 2012                                                           *
+         subroutine sendint2_mpi(tag,numpart2,chunksize,direc)
+
+      use mpi_mod
+      use com_mod
+
+          implicit none
+      include 'mpif.h'
+
+!      character :: varname*20
+       integer :: chunksize,numpart2,jj1
+!      integer(kind=2) :: dummyi(numpart2),
+!      integer(kind=2) :: dummyi22(numpart2)
+       integer :: myid,ierr,ntasks,ii,jdeb,jfin,jj,direc,tag
+!      integer :: MPI_COMM_WORLD
+
+       integer :: jj2,from,jj3   
+  integer, dimension(MPI_STATUS_SIZE) :: status
+       
+      call MPI_COMM_RANK ( MPI_COMM_WORLD, myid, ierr )
+      call MPI_COMM_SIZE ( MPI_COMM_WORLD, ntasks, ierr )
+     if (direc.eq.0) then ! the slaves get
+
+      if (myid.eq.0) then
+       do ii=1,ntasks-1
+       do jj2=1,chunksize
+        jj=(jj2-1)*ntasks+ii+1
+!       do jj=ii+1,numpart2+ii,ntasks
+!        jj2=(jj-ii-1)/ntasks+1
+!        dummyi2(jj2)=dummyi(jj)
+        if (tag.eq.13) dummyi22(jj2)=cbt(jj)
+        enddo
+    call MPI_SEND(dummyi22, chunksize, MPI_INTEGER2, ii,tag, MPI_COMM_WORLD, ierr)
+       enddo
+!     chunksize2=int((numpart2-1)/ntasks)+1
+!     chunksize2=chunksize
+      ii=0
+      do jj=1,numpart2,ntasks
+      ii=ii+1
+      jj2=jj
+      enddo
+      chunksize2=ii+numpart2-jj2
+
+    if (tag.eq.13) then
+     do jj=1,numpart2,ntasks
+      jj3=(jj-1)/ntasks+1
+     mpi_cbt(jj3)=cbt(jj)
+     enddo
+     mpi_cbt(jj3:chunksize2)=cbt(jj2:numpart2)
+
+    endif
+
+   else ! the slaves receive
+    if (tag.eq.13) call MPI_RECV(mpi_cbt, chunksize, MPI_INTEGER2, 0,13, MPI_COMM_WORLD,status, ierr)
+   endif
+
+   else ! the master is going to get 
+   if (myid.gt.0) then !slaves send
+   if (tag.eq.13) call MPI_SEND(mpi_cbt, chunksize, MPI_INTEGER2, 0,13, MPI_COMM_WORLD, ierr)
+
+    else ! the master gets
+     do from =1,ntasks-1
+    call MPI_RECV(dummyi22, chunksize, MPI_INTEGER2, from,tag, MPI_COMM_WORLD,status,ierr)
+          jj1=(from-1)*chunksize+1
+          jj2=from*chunksize
+       if (tag.eq.13) cbt(jj1:jj2)=dummyi22(1:chunksize)
+     enddo
+     if (tag.eq.13) cbt(jj2+1:numpart2)=mpi_cbt(1:chunksize2)
+
+    endif
+
+   endif
+
+       end subroutine sendint2_mpi
Index: /branches/jerome/src_flexwrf_v3.1/sendint_mpi.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/sendint_mpi.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/sendint_mpi.f90	(revision 16)
@@ -0,0 +1,142 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                *
+!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine,       *
+!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
+!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso,          *
+!* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann,   *
+!*                                                                     *
+!* This file is part of FLEXPART WRF                                   *
+!*                                                                     *
+!* 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/>.   *
+!***********************************************************************
+
+  !   routine used to send integer vectors by MPI
+  !    Author: J. Brioude                                                      *
+  !    March 2012                                                           *
+         subroutine sendint_mpi(tag,numpart2,chunksize,direc)
+
+      use mpi_mod
+      use com_mod
+          implicit none
+      include 'mpif.h'
+
+!      character :: varname*20
+       integer :: chunksize,numpart2,jj1
+!      integer :: dummyi(numpart2),
+!      integer :: dummyi2(chunksize),
+!      integer :: MPI_COMM_WORLD
+       integer :: myid,ierr,ntasks,ii,jdeb,jfin,jj,direc,tag
+       integer :: jj2,from,jj3
+  integer, dimension(MPI_STATUS_SIZE) :: status
+       
+      call MPI_COMM_RANK ( MPI_COMM_WORLD, myid, ierr )
+      call MPI_COMM_SIZE ( MPI_COMM_WORLD, ntasks, ierr )
+     if (direc.eq.0) then ! the slaves get
+
+     if (myid.eq.0) then
+      do ii=1,ntasks-1
+       do jj2=1,chunksize
+        jj=(jj2-1)*ntasks+ii+1
+
+!      do jj=ii+1,numpart2+ii+1,ntasks
+!       jj2=(jj-ii-1)/ntasks+1
+!       dummyi2(jj2)=dummyi(jj)
+       if (tag.eq.1)  dummyi2(jj2)=npoint(jj)
+       if (tag.eq.2)  dummyi2(jj2)=idt(jj)
+       if (tag.eq.3)  dummyi2(jj2)=itra1(jj)
+       if (tag.eq.14)  dummyi2(jj2)=itramem(jj)
+       if (tag.eq.15)  dummyi2(jj2)=nclass(jj)
+       enddo
+       call MPI_SEND(dummyi2, chunksize, MPI_INTEGER, ii,tag, MPI_COMM_WORLD, ierr)
+      enddo
+
+!     chunksize2=int((numpart2-1)/ntasks)+1
+!     chunksize2=chunksize
+      ii=0
+      do jj=1,numpart2,ntasks
+      ii=ii+1 
+      jj2=jj
+      enddo
+      chunksize2=ii+numpart2-jj2
+    if (tag.eq.1) then
+     do jj=1,numpart2,ntasks
+      jj3=(jj-1)/ntasks+1
+     mpi_npoint(jj3)=npoint(jj)
+     enddo
+     mpi_npoint(jj3:chunksize2)=npoint(jj2:numpart2)
+    elseif (tag.eq.2) then
+     do jj=1,numpart2,ntasks
+      jj3=(jj-1)/ntasks+1
+     mpi_idt(jj3)=idt(jj)
+     enddo
+     mpi_idt(jj3:chunksize2)=idt(jj2:numpart2)
+    elseif (tag.eq.3) then
+     do jj=1,numpart2,ntasks
+      jj3=(jj-1)/ntasks+1
+     mpi_itra1(jj3)=itra1(jj)
+     enddo
+     mpi_itra1(jj3:chunksize2)=itra1(jj2:numpart2)
+    elseif (tag.eq.14) then
+     do jj=1,numpart2,ntasks
+      jj3=(jj-1)/ntasks+1
+     mpi_itramem(jj3)=itramem(jj)
+     enddo
+     mpi_itramem(jj3:chunksize2)=itramem(jj2:numpart2)
+    elseif (tag.eq.15) then
+     do jj=1,numpart2,ntasks
+      jj3=(jj-1)/ntasks+1
+     mpi_nclass(jj3)=nclass(jj)
+     enddo
+     mpi_nclass(jj3:chunksize2)=nclass(jj2:numpart2)
+    endif 
+
+    else ! the slaves receive
+     if (tag.eq.1) call MPI_RECV(mpi_npoint, chunksize, MPI_INTEGER, 0,1,MPI_COMM_WORLD,status, ierr)
+     if (tag.eq.2) call MPI_RECV(mpi_idt, chunksize, MPI_INTEGER, 0,2,MPI_COMM_WORLD,status, ierr)
+     if (tag.eq.3) call MPI_RECV(mpi_itra1, chunksize, MPI_INTEGER, 0,3,MPI_COMM_WORLD,status, ierr)
+     if (tag.eq.14) call MPI_RECV(mpi_itramem, chunksize, MPI_INTEGER, 0,14,MPI_COMM_WORLD,status, ierr)
+     if (tag.eq.15) call MPI_RECV(mpi_nclass, chunksize, MPI_INTEGER, 0,15,MPI_COMM_WORLD,status, ierr)
+    endif
+
+   else ! the master is going to get 
+   if (myid.gt.0) then !slaves send
+   if (tag.eq.1) call MPI_SEND(mpi_npoint, chunksize, MPI_INTEGER, 0,1, MPI_COMM_WORLD, ierr)
+   if (tag.eq.2) call MPI_SEND(mpi_idt, chunksize, MPI_INTEGER, 0,2, MPI_COMM_WORLD, ierr)
+   if (tag.eq.3) call MPI_SEND(mpi_itra1, chunksize, MPI_INTEGER, 0,3, MPI_COMM_WORLD, ierr)
+   if (tag.eq.14) call MPI_SEND(mpi_itramem, chunksize, MPI_INTEGER, 0,14, MPI_COMM_WORLD, ierr)
+   if (tag.eq.15) call MPI_SEND(mpi_nclass, chunksize, MPI_INTEGER, 0,15, MPI_COMM_WORLD, ierr)
+
+    else ! the master gets
+
+     do from =1,ntasks-1
+    call MPI_RECV(dummyi2, chunksize, MPI_INTEGER, from,tag, MPI_COMM_WORLD,status,ierr)
+          jj1=(from-1)*chunksize+1
+          jj2=from*chunksize
+       if (tag.eq.1) npoint(jj1:jj2)=dummyi2(1:chunksize)
+       if (tag.eq.2) idt(jj1:jj2)=dummyi2(1:chunksize)
+       if (tag.eq.3) itra1(jj1:jj2)=dummyi2(1:chunksize)
+       if (tag.eq.14) itramem(jj1:jj2)=dummyi2(1:chunksize)
+       if (tag.eq.15) nclass(jj1:jj2)=dummyi2(1:chunksize)
+     enddo
+     if (tag.eq.1) npoint(jj2+1:numpart2)=mpi_npoint(1:chunksize2)
+     if (tag.eq.2) idt(jj2+1:numpart2)=mpi_idt(1:chunksize2)
+     if (tag.eq.3) itra1(jj2+1:numpart2)=mpi_itra1(1:chunksize2)
+     if (tag.eq.14) itramem(jj2+1:numpart2)=mpi_itramem(1:chunksize2)
+     if (tag.eq.15) nclass(jj2+1:numpart2)=mpi_nclass(1:chunksize2)
+
+    endif
+
+   endif
+
+       end subroutine sendint_mpi
Index: /branches/jerome/src_flexwrf_v3.1/sendreal2d_mpi.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/sendreal2d_mpi.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/sendreal2d_mpi.f90	(revision 16)
@@ -0,0 +1,104 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                *
+!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine,       *
+!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
+!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso,          *
+!* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann,   *
+!*                                                                     *
+!* This file is part of FLEXPART WRF                                   *
+!*                                                                     *
+!* 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/>.   *
+!***********************************************************************
+
+  !   routine used to send 2D real array by MPI
+  !    Author: J. Brioude                                                      *
+  !    March 2012                                                           *
+        subroutine sendreal2d_mpi(tag2,numpart2,nspec2,chunksize,direc)
+
+      use mpi_mod
+      use com_mod
+          implicit none
+      include 'mpif.h'
+
+!      character :: varname*20
+       integer :: chunksize,numpart2,ks,jj1
+!      real :: dummyr(numpart2,nspec2),
+!      real :: dummyr2(chunksize)
+       integer :: myid,ierr,ntasks,ii,jdeb,jfin,jj,tag,direc
+!      integer :: MPI_COMM_WORLD
+
+       integer :: tag2,nspec2 
+       integer :: jj2,from,jj3   
+  integer, dimension(MPI_STATUS_SIZE) :: status
+
+      call MPI_COMM_RANK ( MPI_COMM_WORLD, myid, ierr )
+      call MPI_COMM_SIZE ( MPI_COMM_WORLD, ntasks, ierr )
+
+      do ks=1,nspec2
+      tag=100+ks
+
+     if (direc.eq.0) then ! the slaves get
+
+      if (myid.eq.0) then
+       do ii=1,ntasks-1
+       do jj2=1,chunksize
+        jj=(jj2-1)*ntasks+ii+1
+!       do jj=ii+1,numpart2+ii,ntasks
+!        jj2=(jj-ii-1)/ntasks+1
+!        dummyr2(jj2)=dummyr(jj,ks)
+         dummyr2(jj2)=xmass1(jj,ks)
+        enddo
+       call MPI_SEND(dummyr2, chunksize, MPI_REAL, ii,tag,MPI_COMM_WORLD, ierr)
+       enddo
+
+!     chunksize2=int((numpart2-1)/ntasks)+1
+!     chunksize2=chunksize
+      ii=0
+      do jj=1,numpart2,ntasks
+      ii=ii+1
+      jj2=jj
+      enddo
+      chunksize2=ii+numpart2-jj2
+     do jj=1,numpart2,ntasks
+      jj3=(jj-1)/ntasks+1
+     mpi_xmass1(jj3,ks)=xmass1(jj,ks)
+     enddo
+     mpi_xmass1(jj3:chunksize2,ks)=xmass1(jj2:numpart2,ks)
+
+   else ! slave receive
+    call MPI_RECV(mpi_xmass1(1,ks), chunksize, MPI_REAL, 0,tag, MPI_COMM_WORLD,status, ierr)
+   endif
+
+   else ! the master is going to get 
+
+   if (myid.gt.0) then !slaves send
+
+   call MPI_SEND(mpi_xmass1(1,ks), chunksize, MPI_REAL,0,tag, MPI_COMM_WORLD, ierr)
+
+    else ! the master gets
+     do from =1,ntasks-1
+    call MPI_RECV(dummyr2, chunksize, MPI_REAL, from,tag, MPI_COMM_WORLD,status,ierr)
+          jj1=(from-1)*chunksize+1
+          jj2=from*chunksize
+        xmass1(jj1:jj2,ks)=dummyr2(1:chunksize)
+     enddo
+     xmass1(jj2+1:numpart2,ks)=mpi_xmass1(1:chunksize2,ks)
+
+    endif
+
+   endif
+
+
+    enddo
+       end subroutine sendreal2d_mpi
Index: /branches/jerome/src_flexwrf_v3.1/sendreal_mpi.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/sendreal_mpi.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/sendreal_mpi.f90	(revision 16)
@@ -0,0 +1,175 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                *
+!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine,       *
+!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
+!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso,          *
+!* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann,   *
+!*                                                                     *
+!* This file is part of FLEXPART WRF                                   *
+!*                                                                     *
+!* 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/>.   *
+!***********************************************************************
+
+  !   routine used to send real vectors by MPI
+  !    Author: J. Brioude                                                      *
+  !    March 2012                                                           *
+         subroutine sendreal_mpi(tag,numpart2,chunksize,direc)
+
+      use mpi_mod
+      use com_mod
+          implicit none
+      include 'mpif.h'
+
+!      character :: varname*20
+       integer :: chunksize,numpart2,jj1
+!      real :: dummyr(numpart),
+!      real :: dummyr2(chunksize)
+       integer :: myid,ierr,ntasks,ii,jdeb,jfin,jj,direc,tag
+!      integer :: MPI_COMM_WORLD
+       integer :: jj2,from,jj3
+  integer, dimension(MPI_STATUS_SIZE) :: status
+
+      call MPI_COMM_RANK ( MPI_COMM_WORLD, myid, ierr )
+      call MPI_COMM_SIZE ( MPI_COMM_WORLD, ntasks, ierr )
+
+     if (direc.eq.0) then ! the slaves get
+
+     if (myid.eq.0) then ! master sends
+      do ii=1,ntasks-1
+!      jdeb=(ii-1)*chunksize+1
+!      jfin=(ii)*chunksize
+!      do jj=jdeb,jfin
+!      do jj=ii+1,numpart2+ii,ntasks
+       do jj2=1,chunksize
+!       jj2=jj-jdeb+1
+!       jj2=(jj-ii-1)/ntasks+1
+        jj=(jj2-1)*ntasks+ii+1
+!       dummyr2(jj2)=dummyr(jj)
+       if (tag.eq.4)  dummyr2(jj2)=uap(jj)
+       if (tag.eq.5)  dummyr2(jj2)=ucp(jj)
+       if (tag.eq.6)  dummyr2(jj2)=uzp(jj)
+       if (tag.eq.7)  dummyr2(jj2)=us(jj)
+       if (tag.eq.8)  dummyr2(jj2)=vs(jj)
+       if (tag.eq.9)  dummyr2(jj2)=ws(jj)
+       if (tag.eq.10)  dummyr2(jj2)=ztra1(jj)
+       enddo
+       call MPI_SEND(dummyr2, chunksize, MPI_REAL, ii,tag, MPI_COMM_WORLD, ierr)
+      enddo
+
+!     jdeb=(ntasks-1)*chunksize+1
+!     jfin=numpart
+!     chunksize2=jfin-jdeb+1
+!     chunksize2=int((numpart2-1)/ntasks)+1
+!      chunksize2=chunksize
+      ii=0
+      do jj=1,numpart2,ntasks
+      ii=ii+1
+      jj2=jj
+      enddo
+      chunksize2=ii+numpart2-jj2
+
+    if (tag.eq.4) then
+     do jj=1,numpart2,ntasks
+      jj3=(jj-1)/ntasks+1
+     mpi_uap(jj3)=uap(jj)
+     enddo
+     mpi_uap(jj3:chunksize2)=uap(jj2:numpart2)
+    elseif (tag.eq.5) then
+     do jj=1,numpart2,ntasks
+      jj3=(jj-1)/ntasks+1
+     mpi_ucp(jj3)=ucp(jj)
+     enddo
+     mpi_ucp(jj3:chunksize2)=ucp(jj2:numpart2)
+    elseif (tag.eq.6) then
+     do jj=1,numpart2,ntasks
+      jj3=(jj-1)/ntasks+1
+     mpi_uzp(jj3)=uzp(jj)
+     enddo
+     mpi_uzp(jj3:chunksize2)=uzp(jj2:numpart2)
+    elseif (tag.eq.7) then
+     do jj=1,numpart2,ntasks
+      jj3=(jj-1)/ntasks+1
+     mpi_us(jj3)=us(jj)
+     enddo
+     mpi_us(jj3:chunksize2)=us(jj2:numpart2)
+    elseif (tag.eq.8) then
+     do jj=1,numpart2,ntasks
+      jj3=(jj-1)/ntasks+1
+     mpi_vs(jj3)=vs(jj)
+     enddo
+     mpi_vs(jj3:chunksize2)=vs(jj2:numpart2)
+    elseif (tag.eq.9) then
+     do jj=1,numpart2,ntasks
+      jj3=(jj-1)/ntasks+1
+     mpi_ws(jj3)=ws(jj)
+     enddo
+     mpi_ws(jj3:chunksize2)=ws(jj2:numpart2)
+    elseif (tag.eq.10) then
+     do jj=1,numpart2,ntasks
+      jj3=(jj-1)/ntasks+1
+     mpi_ztra1(jj3)=ztra1(jj)
+     enddo
+     mpi_ztra1(jj3:chunksize2)=ztra1(jj2:numpart2)
+    endif
+    
+     else ! the slaves receive
+    if (tag.eq.4) call MPI_RECV(mpi_uap, chunksize, MPI_REAL, 0,4,MPI_COMM_WORLD,status, ierr)
+    if (tag.eq.5) call MPI_RECV(mpi_ucp, chunksize, MPI_REAL, 0,5,MPI_COMM_WORLD,status, ierr)
+    if (tag.eq.6) call MPI_RECV(mpi_uzp, chunksize, MPI_REAL, 0,6,MPI_COMM_WORLD,status, ierr)
+    if (tag.eq.7) call MPI_RECV(mpi_us, chunksize, MPI_REAL, 0,7,MPI_COMM_WORLD,status, ierr)
+    if (tag.eq.8) call MPI_RECV(mpi_vs, chunksize, MPI_REAL, 0,8,MPI_COMM_WORLD,status, ierr)
+    if (tag.eq.9) call MPI_RECV(mpi_ws, chunksize, MPI_REAL, 0,9,MPI_COMM_WORLD,status, ierr)
+    if (tag.eq.10) call MPI_RECV(mpi_ztra1, chunksize, MPI_REAL, 0,10,MPI_COMM_WORLD,status, ierr)
+   endif
+
+   else ! the master is going to get 
+
+   if (myid.gt.0) then !slaves send
+
+   if (tag.eq.4) call MPI_SEND(mpi_uap, chunksize, MPI_REAL, 0,4, MPI_COMM_WORLD, ierr)
+   if (tag.eq.5) call MPI_SEND(mpi_ucp, chunksize, MPI_REAL, 0,5, MPI_COMM_WORLD, ierr)
+   if (tag.eq.6) call MPI_SEND(mpi_uzp, chunksize, MPI_REAL, 0,6, MPI_COMM_WORLD, ierr)
+   if (tag.eq.7) call MPI_SEND(mpi_us, chunksize, MPI_REAL, 0,7, MPI_COMM_WORLD, ierr)
+   if (tag.eq.8) call MPI_SEND(mpi_vs, chunksize, MPI_REAL, 0,8, MPI_COMM_WORLD, ierr)
+   if (tag.eq.9) call MPI_SEND(mpi_ws, chunksize, MPI_REAL, 0,9, MPI_COMM_WORLD, ierr)
+   if (tag.eq.10) call MPI_SEND(mpi_ztra1, chunksize, MPI_REAL, 0,10, MPI_COMM_WORLD, ierr)
+
+    else ! the master gets
+
+     do from =1,ntasks-1
+    call MPI_RECV(dummyr2, chunksize, MPI_REAL, from,tag, MPI_COMM_WORLD,status,ierr)
+          jj1=(from-1)*chunksize+1
+          jj2=from*chunksize
+       if (tag.eq.4) uap(jj1:jj2)=dummyr2(1:chunksize)
+       if (tag.eq.5) ucp(jj1:jj2)=dummyr2(1:chunksize)
+       if (tag.eq.6) uzp(jj1:jj2)=dummyr2(1:chunksize)
+       if (tag.eq.7) us(jj1:jj2)=dummyr2(1:chunksize)
+       if (tag.eq.8) vs(jj1:jj2)=dummyr2(1:chunksize)
+       if (tag.eq.9) ws(jj1:jj2)=dummyr2(1:chunksize)
+       if (tag.eq.10) ztra1(jj1:jj2)=dummyr2(1:chunksize)
+
+     enddo
+     if (tag.eq.4) uap(jj2+1:numpart2)=mpi_uap(1:chunksize2)
+     if (tag.eq.5) ucp(jj2+1:numpart2)=mpi_ucp(1:chunksize2)
+     if (tag.eq.6) uzp(jj2+1:numpart2)=mpi_uzp(1:chunksize2)
+     if (tag.eq.7) us(jj2+1:numpart2)=mpi_us(1:chunksize2)
+     if (tag.eq.8) vs(jj2+1:numpart2)=mpi_vs(1:chunksize2)
+     if (tag.eq.9) ws(jj2+1:numpart2)=mpi_ws(1:chunksize2)
+     if (tag.eq.10) ztra1(jj2+1:numpart2)=mpi_ztra1(1:chunksize2)
+
+
+    endif
+
+   endif
+       end subroutine sendreal_mpi
Index: /branches/jerome/src_flexwrf_v3.1/shift_field.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/shift_field.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/shift_field.f90	(revision 16)
@@ -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/jerome/src_flexwrf_v3.1/shift_field_0.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/shift_field_0.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/shift_field_0.f90	(revision 16)
@@ -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/jerome/src_flexwrf_v3.1/skplin.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/skplin.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/skplin.f90	(revision 16)
@@ -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/jerome/src_flexwrf_v3.1/sort2.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/sort2.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/sort2.f90	(revision 16)
@@ -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/jerome/src_flexwrf_v3.1/timemanager.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/timemanager.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/timemanager.f90	(revision 16)
@@ -0,0 +1,1050 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                *
+!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine,       *
+!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
+!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso,          *
+!* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann,   *
+!*                                                                     *
+!* This file is part of FLEXPART WRF                                   *
+!*                                                                     *
+!* 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(mts)
+
+!*******************************************************************************
+!                                                                              *
+! 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                                                              *
+!                                                                              *
+!     Dec 2005, J. Fast - Only call conccalc & concoutput when (iout.ge.1)     *
+!     Aug 2007, W. Wang - call KFeta convection scheme (lconvection=2or3)
+!                       Note, backward is unavailabe for lconvection=2
+!     Mar 2012, J. Brioude: modifications to handle openmp and mpi             *
+!*******************************************************************************
+!  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                                          *
+! jtime [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 interpolation *
+! xtra1(maxpart), ytra1(maxpart), ztra1(maxpart) =                             *
+!                    spatial positions of trajectories                         *
+!                                                                              *
+! Constants:                                                                   *
+! maxpart            maximum number of trajectories                            *
+!                                                                              *
+!*******************************************************************************
+
+!      include 'includepar'
+!      include 'includecom'
+  use unc_mod
+  use point_mod
+!  use xmass_mod
+  use flux_mod
+  use outg_mod
+  use oh_mod
+  use par_mod
+  use com_mod
+  use mpi_mod
+ use mt_stream
+
+!  use ran_mod
+!  use interpol_mod
+
+      implicit none
+
+! include 'mpif.h'
+
+  integer :: ix,jy,j,ks,kp,l,n,jtime,nstop,nstop1
+!,MPI_COMM_WORLD
+! integer :: ksp
+  integer :: loutnext,loutstart,loutend,jj,chunksize
+!,chunksize2
+  integer :: chunksize3,omp_get_num_threads
+  integer :: ldeltat,itage,nage,th_itra1,i
+  real :: outnum,weight,prob(maxspec),nrand,decfact
+!  real :: uap(maxpart),ucp(maxpart),uzp(maxpart)
+!  real :: us(maxpart),vs(maxpart),ws(maxpart)
+!  integer(kind=2) :: cbt(maxpart)
+!  real,allocatable, dimension (:) :: uap,ucp,uzp
+!  real,allocatable, dimension (:) :: us,vs,ws
+!  integer(kind=2),allocatable, dimension (:) :: cbt
+  real :: drydeposit(maxspec),gridtotalunc,wetgridtotalunc
+  real :: drygridtotalunc,xold,yold,zold,xmassfract
+!      integer j,k,l,n,jtime,nstop,nstop1
+!      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),cbt(maxpart)
+!     real drydeposit(maxspec),gridtotalunc,wetgridtotalunc
+!      real drygridtotalunc,xold,yold,zold
+!     real xm,xm1
+
+
+  integer :: th_npoint,th_idt,th_itramem,jdeb,jfin,stat,th_nclass
+  integer,save :: cpt(maxomp)=0
+! integer,save :: cpt(24)=0
+  real(kind=dp) :: th_xtra1,th_ytra1
+  real :: th_ztra1,th_uap,th_ucp,th_uzp
+  real :: th_us,th_vs,th_ws,ran3
+  integer(kind=2) :: th_cbt
+  integer :: OMP_GET_THREAD_NUM,from
+
+  real :: p1,p2,p3,p4,ddx,ddy,rddx,rddy,dtt,dt1,dt2
+  integer :: ixp,jyp,ngrid,indz,indzp,nbp,jj2,ii,offset
+  logical :: depoindicator(maxspec)
+  logical,save :: indzindicator(nzmax)
+  real :: ust,wst,ol,h,zeta,sigu,sigv,tlu,tlv,tlw
+  real :: sigw,dsigwdz,dsigw2dz,th_xmass1(maxspec)
+  real :: start, finish
+  real :: uprof(nzmax),vprof(nzmax),wprof(nzmax)
+  real :: usigprof(nzmax),vsigprof(nzmax),wsigprof(nzmax)
+  real :: rhoprof(nzmax),rhogradprof(nzmax)
+  real :: tkeprof(nzmax),pttprof(nzmax)
+  real :: u,v,w,usig,vsig,wsig,pvi
+  integer*4 :: now(3)
+  integer :: ttime,cpttra
+!  integer, dimension(MPI_STATUS_SIZE) :: status
+! integer, dimension(MPI_STATUS_SIZE) :: status
+  integer :: myid,ntasks,ierr,islave,tag2,ompid,n_threads,tag3,i_omp
+  type (mt_state) :: mts (0: MAX_STREAM)
+
+!************************
+
+!JB
+!  call MPI_COMM_RANK ( MPI_COMM_WORLD, myid, ierr )
+!  call MPI_COMM_SIZE ( MPI_COMM_WORLD, ntasks, ierr )
+! myid gives the info on the node id
+      ntasks=1
+      myid=0
+      loutnext=loutstep/2
+      outnum=0.
+      loutstart=loutnext-loutaver/2
+      loutend=loutnext+loutaver/2
+
+!   if (myid.eq.0) then
+    allocate(uap(maxpart) ,stat=stat)
+    allocate(ucp(maxpart) ,stat=stat)
+    allocate(uzp(maxpart) ,stat=stat)
+    allocate(us(maxpart) ,stat=stat)
+    allocate(vs(maxpart) ,stat=stat)
+    allocate(ws(maxpart) ,stat=stat)
+    allocate(cbt(maxpart) ,stat=stat)
+!   endif
+
+!**********************************************************************
+! Loop over the whole modelling period in time steps of mintime seconds
+!**********************************************************************
+
+!     print*,'time',myid,ideltas,lsynctime
+      do jtime=0,ideltas,lsynctime
+
+
+!         print*,'jtime',jtime
+! Computation of wet deposition 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. jtime .ne. 0 .and. numpart .gt. 0) &
+          call wetdepo(jtime,lsynctime,loutnext)
+
+    if (OHREA .and. jtime .ne. 0 .and. numpart .gt. 0) &
+         call ohreaction(jtime,lsynctime,loutnext)
+
+! compute convection for backward runs
+!*************************************
+
+!          if ((ldirect.eq.-1).and.(lconvection.eq.1).and.(jtime.lt.0))
+!    &    call convmix(jtime)
+
+           if ((ldirect.eq.-1).and.(jtime.lt.0)) then 
+             if (lconvection .eq. 1) call convmix(jtime)
+             if (lconvection .eq. 2 .or. lconvection .eq. 3) &
+                call convmix_kfeta(jtime)
+           endif
+
+! Get necessary wind fields if not available
+!*******************************************
+
+!        call itime(now)
+!        ttime=now(1)*3600+now(2)*60+now(3)
+        call cpu_time(start)  
+        call getfields(jtime,nstop1)
+        if (nstop1.gt.1) stop 'NO METEO FIELDS AVAILABLE'
+!        call itime(now)
+!        ttime=now(1)*3600+now(2)*60+now(3)-ttime
+        call cpu_time(finish)  
+!      print*,'read wind time',ttime
+
+! Release particles
+!******************
+
+!JB
+     if (myid.eq.0) then ! I let only the master thread releasing the particles and calculate the output
+!        call itime(now)
+        call cpu_time(start)  
+        if (mdomainfill.ge.1) then
+          if (jtime.eq.0) then
+            call init_domainfill()
+          else
+            call boundcond_domainfill(jtime,loutend)
+          endif
+        else
+        if (numpoint_option.eq.0) then
+          call releaseparticles_irreg(jtime)
+         elseif (numpoint_option.eq.1) then
+!      print*,'avant release'
+          call releaseparticles_reg(jtime) 
+          endif
+        endif
+!           do i=1,numpart
+!         print*,'ipart 2',myid,i,ztra1(i)
+!            enddo
+!        print*,'test rel',npoint(1),npoint(2),npoint(3)
+
+!         print*,'test rel1',npoint(5139),npoint(6002),npoint(100003)
+! 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)) &
+!           call convmix(jtime)
+
+          if (ldirect.eq.1) then 
+           if (lconvection.eq.1)call convmix(jtime)
+           if (lconvection.eq.2 .or. lconvection .eq. 3) &
+             call convmix_kfeta(jtime)
+          endif
+
+! If middle of averaging period of output fields is reached, accumulated
+! deposited mass radioactively decays 
+!***********************************************************************
+
+    if (DEP.and.(jtime.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 (mod(jtime,loutsample).eq.0) then 
+!          xm=0.
+!          xm1=0.
+!          do 247 j=1,numpart
+!47          if (itra1(j).eq.jtime) xm1=xm1+xmass1(j,1)
+!          xm=xm1
+!          do 248 nage=1,nageclass
+!            do 248 ix=0,numxgrid-1
+!              do 248 jy=0,numygrid-1
+!                do 248 l=1,nclassunc
+!48        xm=xm+wetgridunc(ix,jy,1,l,nage)+drygridunc(ix,jy,1,l,nage)
+!          write(*,'(i6,4f10.3)') jtime,xm,xm1
+!       endif
+!!! CHANGE
+
+          
+! Check whether concentrations are to be calculated
+!**************************************************
+
+        if ((ldirect*jtime.ge.ldirect*loutstart).and. &
+        (ldirect*jtime.le.ldirect*loutend)) then ! add to grid
+          if (mod(jtime-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 ((jtime.eq.loutstart).or.(jtime.eq.loutend)) then
+              weight=0.5
+            else
+              weight=1.0
+            endif
+            outnum=outnum+weight
+            if(iout.ge.1) then 
+             if (outgrid_option.eq.0) then 
+             call conccalc_irreg(jtime,weight)
+             elseif (outgrid_option.eq.1) then
+             call conccalc_reg(jtime,weight)
+             endif
+            endif
+          endif
+
+
+!         if ((mquasilag.eq.1).and.(jtime.eq.(loutstart+loutend)/2)) &
+!         call partoutput_short(jtime)    ! dump particle positions in extremely compressed format
+
+
+! Output and reinitialization of grid
+! If necessary, first sample of new grid is also taken
+!*****************************************************
+
+          if ((jtime.eq.loutend).and.(outnum.gt.0.)) then
+!            print*,'iout',iout,ipout,outgrid_option
+            if ((iout.le.3.).or.(iout.eq.5)) then 
+             if(iout.ge.1) then
+             if (outgrid_option.eq.0) then
+             call concoutput_irreg(jtime,outnum,gridtotalunc, &
+              wetgridtotalunc,drygridtotalunc)
+       if (nested_output.eq.1) call concoutput_nest_irreg(jtime,outnum)
+             elseif (outgrid_option.eq.1) then
+             call concoutput_reg(jtime,outnum,gridtotalunc, &
+              wetgridtotalunc,drygridtotalunc)
+       if (nested_output.eq.1) call concoutput_nest_reg(jtime,outnum)
+             endif
+            endif
+
+!             if (nested_output.eq.1.and.iout.ge.1)
+!    +           call concoutput_nest(jtime,outnum)
+              outnum=0.
+            endif
+            if ((iout.eq.4).or.(iout.eq.5)) call plumetraj(jtime)
+            if (iflux.eq.1) call fluxoutput(jtime)
+            write(*,45) jtime,numpart,gridtotalunc,wetgridtotalunc, &
+            drygridtotalunc
+45          format(i9,' SECONDS SIMULATED: ',i9, &
+            ' PARTICLES:    Uncertainty: ',3f7.3)
+            if (ipout.ge.1) call partoutput(jtime)    ! dump particle positions
+            loutnext=loutnext+loutstep
+            loutstart=loutnext-loutaver/2
+            loutend=loutnext+loutaver/2
+            if (jtime.eq.loutstart) then
+              weight=0.5
+              outnum=outnum+weight
+              if(iout.ge.1) then
+               if (outgrid_option.eq.0) then
+               call conccalc_irreg(jtime,weight)
+               elseif (outgrid_option.eq.1) then
+               call conccalc_reg(jtime,weight)
+               endif
+             endif
+            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*jtime.ge.ldirect*itsplit) then
+          n=numpart
+          do j=1,numpart
+            if (ldirect*jtime.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
+        
+
+
+
+! Loop over all particles
+!************************
+
+
+      chunksize=int(numpart/ntasks)  !if sent homogeneously
+!        call itime(now)
+!        ttime=now(1)*3600+now(2)*60+now(3)-ttime
+        call cpu_time(finish)  
+
+!      print*,'processing time',ttime
+   endif !over myid
+!JB
+! at this stage, I assume that each node has the same shared memory because they run getfields.
+! now we need to split the trajectories into pieces for each node
+!   if (myid.eq.0) then
+
+        if (jtime.eq.ideltas) exit    
+
+! Compute interval since radioactive decay of deposited mass was computed
+!************************************************************************
+
+        if (jtime.lt.loutnext) then
+          ldeltat=jtime-(loutnext-loutstep)
+        else                                  ! first half of next interval
+          ldeltat=jtime-loutnext
+        endif
+
+
+!  if (myid.eq.0) then
+!       call itime(now)
+!        ttime=now(1)*3600+now(2)*60+now(3)
+        call cpu_time(start)  
+!   do ii=1,ntasks-1
+!    call MPI_SEND(chunksize,1, MPI_INTEGER, ii,3001, MPI_COMM_WORLD, ierr)
+!    call MPI_SEND(numpart,1, MPI_INTEGER, ii,3002, MPI_COMM_WORLD, ierr)
+!   enddo 
+!   else
+!    call MPI_RECV(chunksize,1, MPI_INTEGER, 0,3001, MPI_COMM_WORLD,status, ierr)
+!    call MPI_RECV(numpart,1, MPI_INTEGER, 0,3002, MPI_COMM_WORLD,status, ierr)
+!   endif
+!  print*,'numpart',numpart
+     chunksize2=chunksize
+      if (chunksize2.eq.0) chunksize2=1
+!    print*,'chunk',myid,chunksize2,numpart
+!     if (ntasks.gt.1) then
+!    allocate(mpi_npoint(chunksize2) ,stat=stat)
+!    if (stat.ne.0) write(*,*)'ERROR: could not 1'
+!    allocate(mpi_idt(chunksize2) ,stat=stat)
+!    if (stat.ne.0) write(*,*)'ERROR: could not 2'
+!    allocate(mpi_itra1(chunksize2) ,stat=stat)
+!    allocate(mpi_itramem(chunksize2) ,stat=stat)
+!    if (stat.ne.0) write(*,*)'ERROR: could not 3'
+!    allocate(mpi_uap(chunksize2) ,stat=stat)
+!    if (stat.ne.0) write(*,*)'ERROR: could not 4'
+!    allocate(mpi_ucp(chunksize2) ,stat=stat)
+!    if (stat.ne.0) write(*,*)'ERROR: could not 5'
+!    allocate(mpi_uzp(chunksize2) ,stat=stat)
+!    if (stat.ne.0) write(*,*)'ERROR: could not 6'
+!    allocate(mpi_us(chunksize2) ,stat=stat)
+!    if (stat.ne.0) write(*,*)'ERROR: could not 7'
+!    allocate(mpi_vs(chunksize2) ,stat=stat)
+!    if (stat.ne.0) write(*,*)'ERROR: could not 8'
+!    allocate(mpi_ws(chunksize2) ,stat=stat)
+!    if (stat.ne.0) write(*,*)'ERROR: could not 82'
+!    allocate(mpi_xtra1(chunksize2) ,stat=stat)
+!    if (stat.ne.0) write(*,*)'ERROR: could not 9'
+!    allocate(mpi_ytra1(chunksize2) ,stat=stat)
+!    if (stat.ne.0) write(*,*)'ERROR: could not10'
+!    allocate(mpi_ztra1(chunksize2) ,stat=stat)
+!    if (stat.ne.0) write(*,*)'ERROR: could not11'
+!    allocate(mpi_cbt(chunksize2) ,stat=stat)
+!    if (stat.ne.0) write(*,*)'ERROR: could not12'
+!    allocate(mpi_xmass1(chunksize2,nspec) ,stat=stat)
+!    if (stat.ne.0) write(*,*)'ERROR: could not13'
+!    allocate(mpi_nclass(chunksize2) ,stat=stat)
+!    chunksize2=chunksize
+!     endif
+!JB
+! here I am going to send the infos to each slave nodes.
+!     if (numpart.gt.0 .and. ntasks.gt.1 ) then
+!    call MPI_BARRIER(MPI_COMM_WORLD,ierr)
+!
+!    call sendint_mpi(1,npoint(1:numpart),numpart,chunksize,0)
+!    call sendint_mpi(2,idt(1:numpart),numpart,chunksize,0)
+!    call sendint_mpi(3,itra1(1:numpart),numpart,chunksize,0)
+!    call sendreal_mpi(4,uap(1:numpart),numpart,chunksize,0)
+!    call sendreal_mpi(5,ucp(1:numpart),numpart,chunksize,0)
+!    call sendreal_mpi(6,uzp(1:numpart),numpart,chunksize,0)
+!    call sendreal_mpi(7,us(1:numpart),numpart,chunksize,0)
+!    call sendreal_mpi(8,vs(1:numpart),numpart,chunksize,0)
+!    call sendreal_mpi(9,ws(1:numpart),numpart,chunksize,0)
+!    call sendreal_mpi(10,ztra1(1:numpart),numpart,chunksize,0)
+!    call senddouble_mpi(11,xtra1(1:numpart),numpart,chunksize,0)
+!    call senddouble_mpi(12,ytra1(1:numpart),numpart,chunksize,0)
+!    call sendint2_mpi(13,cbt(1:numpart),numpart,chunksize,0)
+!    call sendint_mpi(14,itramem(1:numpart),numpart,chunksize,0)
+!    call sendint_mpi(15,nclass(1:numpart),numpart,chunksize,0)
+!    call sendreal2d_mpi(99,xmass1(1:numpart,1:nspec),numpart,nspec,chunksize,0)
+!
+!   if (myid.eq.0) then
+!!        call itime(now)
+!!        ttime=now(1)*3600+now(2)*60+now(3)-ttime
+!        call cpu_time(finish)  
+!
+!!       print*,'sending time',ttime
+!       print*,'sending time',finish-start
+!    endif
+!    endif !if statement on numpart et ntasks
+
+!    sigw,dsigwdz,dsigw2dz,cpt(nbp),ompid)
+
+! initialize the temporary drydeposition grid
+
+            if (DRYDEP.and.ldirect.gt.0) then
+  do ks=1,nspec
+  do kp=1,maxpointspec_act
+    do nage=1,nageclass
+      do jy=0,numygrid-1
+        do ix=0,numxgrid-1
+          do l=1,nclassunc
+            drygridunc2(ix,jy,ks,kp,l,nage)=0.
+          end do
+        end do
+      end do
+    if (nested_output.eq.1) then
+      do jy=0,numygridn-1
+        do ix=0,numxgridn-1
+          do l=1,nclassunc
+            drygriduncn2(ix,jy,ks,kp,l,nage)=0.
+          end do
+        end do
+      end do
+    endif
+    end do
+  end do
+  end do
+   endif
+
+!JB
+! now we are entering the openmp zone.
+
+!        print*,'continue',myid,chunksize2
+!!!$OMP PARALLEL NUM_THREADS(10) DEFAULT(SHARED) &
+!$OMP PARALLEL DEFAULT(SHARED) &
+!$OMP PRIVATE(jj, th_npoint, th_idt, th_uap, th_ucp,  &
+!$OMP th_uzp, th_us, th_vs, th_ws, th_xtra1, th_ytra1, th_ztra1,decfact, &
+!$OMP th_cbt, xold, yold, zold, kp, itage, prob, nstop, xmassfract, &
+!$OMP th_nclass,chunksize3,start,finish,ngrid,ompid,depoindicator,nbp, &
+!$OMP indzindicator,cpttra,th_xmass1,th_itra1,th_itramem,drydeposit,n_threads) &
+!$OMP SHARED(height,rho,tt,vsetaver,dquer,xtra1,ytra1,ztra1, &
+!$OMP density,cunningham,itra1,ioutputforeachrelease,cbt,iflux, &
+!$OMP uun,vvn,wwn,ustar,wstar,oli,uupol,vvpol,uu,vv,ww,drhodz,ptt,tke, &
+!$OMP rhon,drhodzn,pttn,tken,vdep,vdepn,itramem,nageclass,lage, &
+!$OMP jtime,ldirect,memind,nglobal,switchnorthg,m_x,m_y,m_xn,m_yn, &
+!$OMP switchsouthg,numbnests,xln,xrn,yln,yrn,memtime,xresoln, &
+!$OMP yresoln,hmix,hmixn,tropopause, & 
+!$OMP tropopausen,lsynctime,dxconst,dyconst,mdomainfill, &
+!$OMP turb_option,turbswitch,ifine,chunksize,chunksize2, &
+!!!maxrand, &
+!$OMP xmass,xmass1,DRYDEP,DRYDEPSPEC,nspec,rannumb,uniform_rannumb,cpt, &
+!$OMP lwindinterv,npart,npoint,idt,uap,ucp,uzp,us,vs,ws, &
+!$OMP linit_cond,decay,ldeltat,nclass,nested_output,numpart, &
+!$OMP  mpi_npoint,mpi_idt, mpi_uap, mpi_ucp, mpi_uzp, mpi_us, mpi_vs, &
+!$OMP  mpi_ws, mpi_xtra1, mpi_ytra1, mpi_ztra1, &
+!$OMP mpi_cbt,drygridunc2,drygriduncn2, & 
+!$OMP  mpi_xmass1, mpi_itra1,myid,mpi_itramem,mpi_nclass, &
+!$OMP  mts)
+
+!        call itime(now)
+!        ttime=now(1)*3600+now(2)*60+now(3)
+        call cpu_time(start)  
+!       chunksize3=int(chunksize2/omp_get_num_threads())+1
+        n_threads=omp_get_num_threads()
+        ompid=OMP_GET_THREAD_NUM()
+        chunksize3=int(real(chunksize2)/real(n_threads)/20.)+1 !more efficient
+
+        if (ompid+1.gt.maxomp) then
+        print*,'problem with maxomp. modify par_mod.f90',maxomp,ompid+1
+        stop
+        endif
+
+        cpttra=0
+!        print*,'chunksi',chunksize2,myid
+        if (chunksize2.gt.0 .and. numpart.gt.0 ) then
+!         print*,'test rel2',npoint(5139),npoint(6002),npoint(100003)
+!!!$OMP DO  SCHEDULE(STATIC,10)
+!$OMP DO  SCHEDULE(STATIC,chunksize3)
+!!!$OMP DO SCHEDULE(GUIDED,1)
+!!!$OMP DO 
+!        do jj=1,numpart
+!        do jj=numpart,1,-1
+!        print*,jj
+        do jj=1,chunksize2
+
+! If integration step is due, do it
+!**********************************
+!$OMP CRITICAL 
+!         if (ntasks.gt.1) then
+!        th_itra1=mpi_itra1(jj)
+!        th_itramem=mpi_itramem(jj)
+!        th_npoint=mpi_npoint(jj)
+!            else
+         th_itra1=itra1(jj)
+         th_itramem=itramem(jj)
+         th_npoint=npoint(jj)
+!        endif
+!$OMP END CRITICAL
+!          if (th_itra1(jj).eq.jtime) then
+          if (th_itra1.eq.jtime .and. th_npoint.gt.0 .and. th_npoint.le.numpoint) then
+           cpttra=cpttra+1
+
+!       print*,'avant init',j
+! Initialize newly released particle
+!***********************************
+!$OMP CRITICAL 
+!          if (ntasks.eq.1) then
+          th_npoint=npoint(jj)
+          th_idt=idt(jj)
+          th_uap=uap(jj)
+          th_ucp=ucp(jj)
+          th_uzp=uzp(jj)
+          th_us=us(jj)
+          th_vs=vs(jj)
+          th_ws=ws(jj)
+          th_xtra1=xtra1(jj)
+          th_ytra1=ytra1(jj)
+          th_ztra1=ztra1(jj)
+          th_nclass=nclass(jj)
+          th_cbt=cbt(jj)
+        do ks=1,nspec
+         th_xmass1(ks)=xmass1(jj,ks)
+        enddo
+!         else
+!         th_npoint=mpi_npoint(jj)
+!         th_idt=mpi_idt(jj)
+!         th_uap=mpi_uap(jj)
+!         th_ucp=mpi_ucp(jj)
+!         th_uzp=mpi_uzp(jj)
+!         th_us=mpi_us(jj)
+!         th_vs=mpi_vs(jj)
+!         th_ws=mpi_ws(jj)
+!         th_xtra1=mpi_xtra1(jj)
+!         th_ytra1=mpi_ytra1(jj)
+!         th_ztra1=mpi_ztra1(jj)
+!         th_nclass=mpi_nclass(jj)
+!         th_cbt=mpi_cbt(jj)
+!     do ks=1,nspec
+!         th_xmass1(ks)=mpi_xmass1(jj,ks)
+!        enddo
+!         endif
+!$OMP END CRITICAL 
+        if (ioutputforeachrelease.eq.1) then
+            kp=npoint(jj)
+        else
+            kp=1
+        endif
+
+! Determine age class of the particle
+!            itage=abs(itra1(jj)-itramem(jj))
+            itage=abs(th_itra1-th_itramem)
+            do nage=1,nageclass
+              if (itage.lt.lage(nage)) exit
+         enddo
+!      if (jj.lt.5) print*,'xmass1',th_xmass1(1)
+!            nbp=OMP_GET_THREAD_NUM()+1
+             nbp=ompid+1
+!         print*,th_npoint,jj,npoint(jj)
+!     print*,'befo',th_xtra1,th_ytra1,th_ztra1
+!          iff=0
+!            if ((itramem(jj).eq.jtime).or.(jtime.eq.0)) &
+!       if (jj.eq.103) print*,th_xtra1,th_ytra1,th_ztra1
+            if ((th_itramem.eq.jtime).or.(jtime.eq.0)) then 
+!           call initialize(jtime,idt(j),uap(j),ucp(j),uzp(j), &
+!           us(j),vs(j),ws(j),xtra1(j),ytra1(j),ztra1(j),cbt(j))
+            call initialize(jtime,th_idt,th_uap,th_ucp,th_uzp, &
+            th_us,th_vs,th_ws,th_xtra1,th_ytra1,th_ztra1,th_cbt, &
+      ngrid,depoindicator,indzindicator,cpt(nbp),ompid,myid,n_threads,mts )
+             endif
+
+!     print*,'after',th_xtra1,th_ytra1,th_ztra1
+! Memorize particle positions
+!****************************
+
+!            xold=xtra1(j)
+!            yold=ytra1(j)
+!            zold=ztra1(j)
+            xold=th_xtra1
+            yold=th_ytra1
+            zold=th_ztra1
+! Integrate Lagevin equation for lsynctime seconds
+!*************************************************
+!              write(*,*)'numpart,jtime, particle #=',numpart,jtime,j
+
+!        call advance(jtime,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))
+!       if (jj.eq.103) print*,'bef',th_xtra1,th_ytra1,th_ztra1
+        call advance(jtime,th_npoint,th_idt,th_uap,th_ucp,th_uzp, &
+            th_us,th_vs,th_ws,nstop,th_xtra1,&
+            th_ytra1,th_ztra1,prob,th_cbt, &
+      ngrid,depoindicator,indzindicator,cpt(nbp),ompid,myid,n_threads,mts )
+!       if (jj.eq.103) print*,'aft',th_xtra1,th_ytra1,th_ztra1
+! Calculate the gross fluxes across layer interfaces
+!***************************************************
+
+
+            if (iflux.eq.1) call calcfluxes(nage,jj,xold,yold,zold)
+
+!      if (jj.lt.5) print*,'coord after',myid,th_itra1,th_xmass1(1),DRYDEPSPEC(ks)
+
+! Determine, when next time step is due
+! If trajectory is terminated, mark it
+!**************************************
+         do ks=1,nspec
+     drydeposit(ks)=0.
+          enddo
+
+        if (nstop.gt.1) then
+          if (linit_cond.ge.1) call initial_cond_calc(jtime,jj)
+!              itra1(jj)=-999999999
+              th_itra1=-999999999
+            else
+!              itra1(jj)=jtime+lsynctime
+              th_itra1=jtime+lsynctime
+
+
+!      if (jj.lt.5) print*,'coord after2',myid,th_itra1,th_xmass1(1),DRYDEPSPEC(ks)
+! Dry deposition and radioactive decay for each species
+!******************************************************
+          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
+                  drydeposit(ks)=th_xmass1(ks)*prob(ks)*decfact
+!                  xmass1(j,ks)=xmass1(j,ks)*(1.-prob(ks))*decfact
+                  th_xmass1(ks)=th_xmass1(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
+                  th_xmass1(ks)=th_xmass1(ks)*decfact
+                endif
+!      if (jj.lt.5) print*,'coord after3',myid,th_itra1,th_xmass1(1),DRYDEPSPEC(ks),xmass(th_npoint,1)
+
+            if (mdomainfill.eq.0) then
+              if (xmass(th_npoint,ks).gt.0.) &
+!                  xmassfract=max(xmassfract,real(npart(npoint(jj)))* &
+                   xmassfract=max(xmassfract,real(npart(th_npoint))* &
+!                   xmass1(j,ks)/xmass(npoint(j),ks))
+                   th_xmass1(ks)/xmass(th_npoint,ks))
+            else
+              xmassfract=1.
+            endif
+
+            end do
+
+          if (xmassfract.lt.0.000001) then   ! terminate all particles carrying less mass
+!            itra1(jj)=-999999999
+            th_itra1=-999999999
+          endif
+
+  !        Sabine Eckhardt, June 2008
+  !        don't create depofield for backward runs
+          if (DRYDEP.AND.(ldirect.eq.1)) then
+!           call drydepokernel(nclass(jj),drydeposit,real(xtra1(jj)), &
+            call drydepokernel(th_nclass,drydeposit,real(th_xtra1), &
+!                real(ytra1(jj)),nage,kp)
+                 real(th_ytra1),itage,nage,kp)
+            if (nested_output.eq.1) call drydepokernel_nest( &
+!                nclass(jj),drydeposit,real(xtra1(jj)),real(ytra1(jj)), &
+              th_nclass,drydeposit,real(th_xtra1),real(th_ytra1), &
+                 itage,nage,kp)
+          endif
+
+  ! Terminate trajectories that are older than maximum allowed age
+  !***************************************************************
+
+!          if (abs(itra1(jj)-itramem(jj)).ge.lage(nageclass)) then
+          if (abs(th_itra1-th_itramem).ge.lage(nageclass)) then
+            if (linit_cond.ge.1) &
+                  call initial_cond_calc(jtime+lsynctime,jj)
+!            itra1(jj)=-999999999
+            th_itra1=-999999999
+          endif
+      endif
+!!     print*,xtra1(j),th_xtra1,OMP_GET_THREAD_NUM()
+!$OMP CRITICAL 
+!         if (ntasks.eq.1) then
+    npoint(jj)=th_npoint
+    idt(jj)=th_idt
+     uap(jj)=th_uap
+     ucp(jj)=th_ucp
+     uzp(jj)=th_uzp
+     us(jj)=th_us
+     vs(jj)=th_vs
+     ws(jj)=th_ws
+     xtra1(jj)=th_xtra1
+     ytra1(jj)=th_ytra1
+     ztra1(jj)=th_ztra1
+     cbt(jj)=th_cbt 
+    do ks=1,nspec
+    xmass1(jj,ks)=th_xmass1(ks)
+    enddo
+ !    itramem(jj)=th_itramem
+     itra1(jj)=th_itra1
+!    else
+!   mpi_npoint(jj)=th_npoint
+!   mpi_idt(jj)=th_idt
+!   mpi_uap(jj)=th_uap
+!   mpi_ucp(jj)=th_ucp
+!   mpi_uzp(jj)=th_uzp
+!   mpi_us(jj)=th_us
+!   mpi_vs(jj)=th_vs
+!   mpi_ws(jj)=th_ws
+!   mpi_xtra1(jj)=th_xtra1
+!   mpi_ytra1(jj)=th_ytra1
+!   mpi_ztra1(jj)=th_ztra1
+!!  mpi_nclass(jj)=th_nclass
+!   mpi_cbt(jj)=th_cbt
+!   do ks=1,nspec
+!   mpi_xmass1(jj,ks)=th_xmass1(ks)
+!   enddo
+!!  mpi_itramem(jj)=th_itramem
+!   mpi_itra1(jj)=th_itra1 
+!    endif
+!      if (jj.lt.5) print*,'coord cont',th_itra1
+
+!$OMP END CRITICAL
+
+      endif
+
+    end do !loop over particles
+!$OMP END DO 
+    endif
+!!!$OMP
+!!!$OMP FLUSH(npoint,idt,uap,ucp,uzp,us,vs,ws,xtra1,ytra1,ztra1,cbt,xmass1,itra1)
+!!!$OMP FLUSH
+!        call itime(now)
+!        ttime=now(1)*3600+now(2)*60+now(3)-ttime
+        call cpu_time(finish)  
+!      print*,'time',ttime,cpttra,myid,OMP_GET_THREAD_NUM()
+             if (option_verbose.eq.1) then
+       print*,'time',finish-start,cpttra,myid,ompid 
+           endif
+!$OMP END PARALLEL
+!JB 
+! the openmp is done. the output above gives how long it takes to finish the loop over the particles. good benchmark
+ 
+
+! here we use mpi to use the mpi_* arrays to update the big ones in the master
+! thread
+  
+!   call MPI_REDUCE (mypi ,pi ,1, MPI_DOUBLE_PRECISION , MPI_SUM ,0, &
+!    MPI_COMM_WORLD , ierr )
+!  print*,'after loop',myid,chunksize
+   if (chunksize.gt.0 .and. ntasks.gt.1) then
+
+!JB
+! I need a barrier so each node is a the same place
+! I am going to send the new results to the master thread now.
+!    call MPI_BARRIER(MPI_COMM_WORLD,ierr)
+   if (myid.eq.0) then
+!        call itime(now)
+!        ttime=now(1)*3600+now(2)*60+now(3)
+        call cpu_time(start)  
+   endif
+!    call sendint_mpi(1,npoint(1:numpart),numpart,chunksize,1)
+!    call sendint_mpi(2,idt(1:numpart),numpart,chunksize,1)
+!    call sendint_mpi(3,itra1(1:numpart),numpart,chunksize,1)
+!    call sendreal_mpi(4,uap(1:numpart),numpart,chunksize,1)
+!    call sendreal_mpi(5,ucp(1:numpart),numpart,chunksize,1)
+!    call sendreal_mpi(6,uzp(1:numpart),numpart,chunksize,1)
+!    call sendreal_mpi(7,us(1:numpart),numpart,chunksize,1)
+!    call sendreal_mpi(8,vs(1:numpart),numpart,chunksize,1)
+!    call sendreal_mpi(9,ws(1:numpart),numpart,chunksize,1)
+!    call sendreal_mpi(10,ztra1(1:numpart),numpart,chunksize,1)
+!    call senddouble_mpi(11,xtra1(1:numpart),numpart,chunksize,1)
+!    call senddouble_mpi(12,ytra1(1:numpart),numpart,chunksize,1)
+!    call sendint2_mpi(13,cbt(1:numpart),numpart,chunksize,1)
+!    call sendint_mpi(14,itramem(1:numpart),numpart,chunksize,1)
+!!   call sendint_mpi(15,nclass(1:numpart),numpart,chunksize2,1)
+!    call sendreal2d_mpi(99,xmass1(1:numpart,1:nspec),numpart,nspec,chunksize,1)
+
+   if (myid.eq.0) then
+!        call itime(now)
+!        ttime=now(1)*3600+now(2)*60+now(3)-ttime
+        call cpu_time(finish)  
+!      print*,'receiving time',ttime
+             if (option_verbose.eq.1) then
+       print*,'receiving time',finish-start
+             endif
+    endif 
+    endif !finish transfering between nodes  
+!    if (ntasks.gt.1) then
+!!  print*,'before dealloc',myid
+!   deallocate(mpi_npoint,mpi_idt,mpi_itra1)
+!!  print*,'after dealloc, part1',myid
+!   deallocate(mpi_uap,mpi_ucp,mpi_uzp)
+!!  print*,'after dealloc, part12',myid
+!   deallocate(mpi_us,mpi_vs,mpi_ws,mpi_ztra1)
+!!  print*,'after dealloc, part2',myid
+!   deallocate(mpi_xtra1,mpi_ytra1)
+!!  print*,'after dealloc, part3',myid
+!   deallocate(mpi_cbt)
+!!  print*,'after dealloc, part4',myid
+!   deallocate(mpi_xmass1)
+!!  print*,'after dealloc',myid
+!   endif
+! update the drydepo
+            if (DRYDEP.and.ldirect.gt.0) then
+  do ks=1,nspec
+  do kp=1,maxpointspec_act
+    do nage=1,nageclass
+
+      do jy=0,numygrid-1
+        do ix=0,numxgrid-1
+          do l=1,nclassunc
+       drygridunc(ix,jy,ks,kp,l,nage)=drygridunc(ix,jy,ks,kp,l,nage) &
+               +drygridunc2(ix,jy,ks,kp,l,nage)
+          end do
+        end do
+      end do
+    if (nested_output.eq.1) then
+      do jy=0,numygridn-1
+        do ix=0,numxgridn-1
+          do l=1,nclassunc
+       drygriduncn(ix,jy,ks,kp,l,nage)=drygriduncn(ix,jy,ks,kp,l,nage) &
+               +drygriduncn2(ix,jy,ks,kp,l,nage)
+          end do
+        end do
+      end do
+    endif
+
+    end do
+  end do
+  end do
+  endif
+
+  end do !loop over time 
+
+
+  ! Complete the calculation of initial conditions for particles not yet terminated
+  !*****************************************************************************
+
+  do j=1,numpart
+    if (linit_cond.ge.1) call initial_cond_calc(jtime,j)
+  end do
+
+  if (ipout.eq.2) call partoutput(jtime)     ! dump particle positions
+
+  if (linit_cond.ge.1) call initial_cond_output(jtime)   ! 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
+  deallocate(gridunc)
+  deallocate(xpoint1,xpoint2,ypoint1,ypoint2,zpoint1,zpoint2,xmass)
+  deallocate(ireleasestart,ireleaseend,npart,kindz)
+!  deallocate(xmasssave)
+  if (myid.eq.0) then
+  if (nested_output.eq.1) then
+     deallocate(orooutn, arean, volumen)
+     if (ldirect.gt.0) then
+     deallocate(griduncn,drygriduncn,wetgriduncn,drygriduncn2)
+     endif
+  endif
+  if (ldirect.gt.0) then
+      if (allocated(drygridunc)) deallocate(drygridunc)
+      if (allocated(wetgridunc)) deallocate(wetgridunc)
+      if (allocated(drygridunc2)) deallocate(drygridunc2)
+      if (allocated(drygriduncn2)) deallocate(drygriduncn2)
+  endif
+  deallocate(outheight,outheighthalf)
+  deallocate(oroout, area, volume)
+  endif
+end subroutine timemanager
+
+
+
Index: /branches/jerome/src_flexwrf_v3.1/timemanager_mpi.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/timemanager_mpi.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/timemanager_mpi.f90	(revision 16)
@@ -0,0 +1,1148 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                *
+!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine,       *
+!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
+!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso,          *
+!* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann,   *
+!*                                                                     *
+!* This file is part of FLEXPART WRF                                   *
+!*                                                                     *
+!* 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_mpi(mts)
+
+!*******************************************************************************
+!                                                                              *
+! 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                                                              *
+!                                                                              *
+!     Dec 2005, J. Fast - Only call conccalc & concoutput when (iout.ge.1)     *
+!     Aug 2007, W. Wang - call KFeta convection scheme (lconvection=2or3)
+!                       Note, backward is unavailabe for lconvection=2
+!     Mar 2012, J. Brioude: modifications to handle openmp and mpi             *
+!*******************************************************************************
+!  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                                          *
+! jtime [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 interpolation *
+! xtra1(maxpart), ytra1(maxpart), ztra1(maxpart) =                             *
+!                    spatial positions of trajectories                         *
+!                                                                              *
+! Constants:                                                                   *
+! maxpart            maximum number of trajectories                            *
+!                                                                              *
+!*******************************************************************************
+
+!      include 'includepar'
+!      include 'includecom'
+  use unc_mod
+  use point_mod
+!  use xmass_mod
+  use flux_mod
+  use outg_mod
+  use oh_mod
+  use par_mod
+  use com_mod
+  use mpi_mod
+ use mt_stream
+
+!  use ran_mod
+!  use interpol_mod
+
+      implicit none
+
+  include 'mpif.h'
+
+  integer :: ix,jy,j,ks,kp,l,n,jtime,nstop,nstop1
+!  integer :: MPI_COMM_WORLD
+! integer :: ksp
+  integer :: loutnext,loutstart,loutend,jj,chunksize
+!,chunksize2
+  integer :: chunksize3,omp_get_num_threads
+  integer :: ldeltat,itage,nage,th_itra1,i
+  real :: outnum,weight,prob(maxspec),nrand,decfact
+!  real :: uap(maxpart),ucp(maxpart),uzp(maxpart)
+!  real :: us(maxpart),vs(maxpart),ws(maxpart)
+!  integer(kind=2) :: cbt(maxpart)
+! real,allocatable, dimension (:) :: uap,ucp,uzp
+! real,allocatable, dimension (:) :: us,vs,ws
+! integer(kind=2),allocatable, dimension (:) :: cbt
+  real :: drydeposit(maxspec),gridtotalunc,wetgridtotalunc
+  real :: drygridtotalunc,xold,yold,zold,xmassfract
+!      integer j,k,l,n,jtime,nstop,nstop1
+!      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),cbt(maxpart)
+!     real drydeposit(maxspec),gridtotalunc,wetgridtotalunc
+!      real drygridtotalunc,xold,yold,zold
+!     real xm,xm1
+
+
+  integer :: th_npoint,th_idt,th_itramem,jdeb,jfin,stat,th_nclass
+! integer,save :: cpt(24)=0
+  integer,save :: cpt(maxomp)=0
+
+  real(kind=dp) :: th_xtra1,th_ytra1
+  real :: th_ztra1,th_uap,th_ucp,th_uzp
+  real :: th_us,th_vs,th_ws,ran3
+  integer(kind=2) :: th_cbt
+  integer :: OMP_GET_THREAD_NUM,from
+
+  real :: p1,p2,p3,p4,ddx,ddy,rddx,rddy,dtt,dt1,dt2
+  integer :: ixp,jyp,ngrid,indz,indzp,nbp,jj2,ii,offset
+  logical :: depoindicator(maxspec)
+  logical,save :: indzindicator(nzmax)
+  real :: ust,wst,ol,h,zeta,sigu,sigv,tlu,tlv,tlw
+  real :: sigw,dsigwdz,dsigw2dz,th_xmass1(maxspec)
+  real :: start, finish
+  real :: uprof(nzmax),vprof(nzmax),wprof(nzmax)
+  real :: usigprof(nzmax),vsigprof(nzmax),wsigprof(nzmax)
+  real :: rhoprof(nzmax),rhogradprof(nzmax)
+  real :: tkeprof(nzmax),pttprof(nzmax)
+  real :: u,v,w,usig,vsig,wsig,pvi
+  integer*4 :: now(3)
+  integer :: ttime,cpttra
+  integer, dimension(MPI_STATUS_SIZE) :: status
+  integer :: myid,ntasks,ierr,islave,tag2,ompid,n_threads,tag3,i_omp
+  type (mt_state) :: mts (0: MAX_STREAM)
+!************************
+
+!JB
+  call MPI_COMM_RANK ( MPI_COMM_WORLD, myid, ierr )
+  call MPI_COMM_SIZE ( MPI_COMM_WORLD, ntasks, ierr )
+! myid gives the info on the node id
+
+      loutnext=loutstep/2
+      outnum=0.
+      loutstart=loutnext-loutaver/2
+      loutend=loutnext+loutaver/2
+
+!   if (myid.eq.0) then
+    allocate(uap(maxpart) ,stat=stat)
+    allocate(ucp(maxpart) ,stat=stat)
+    allocate(uzp(maxpart) ,stat=stat)
+    allocate(us(maxpart) ,stat=stat)
+    allocate(vs(maxpart) ,stat=stat)
+    allocate(ws(maxpart) ,stat=stat)
+    allocate(cbt(maxpart) ,stat=stat)
+!   endif
+!     if (chunksize2.eq.0) chunksize2=1
+      chunksize2=int(maxpart/ntasks)+1  !if sent homogeneously
+!    print*,'chunk',myid,chunksize2,numpart
+     if (ntasks.gt.1) then
+    allocate(mpi_npoint(chunksize2) ,stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not 1'
+    allocate(mpi_idt(chunksize2) ,stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not 2'
+    allocate(mpi_itra1(chunksize2) ,stat=stat)
+    allocate(mpi_itramem(chunksize2) ,stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not 3'
+    allocate(mpi_uap(chunksize2) ,stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not 4'
+    allocate(mpi_ucp(chunksize2) ,stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not 5'
+    allocate(mpi_uzp(chunksize2) ,stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not 6'
+    allocate(mpi_us(chunksize2) ,stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not 7'
+    allocate(mpi_vs(chunksize2) ,stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not 8'
+    allocate(mpi_ws(chunksize2) ,stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not 82'
+    allocate(mpi_xtra1(chunksize2) ,stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not 9'
+    allocate(mpi_ytra1(chunksize2) ,stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not10'
+    allocate(mpi_ztra1(chunksize2) ,stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not11'
+    allocate(mpi_cbt(chunksize2) ,stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not12'
+    allocate(mpi_xmass1(chunksize2,nspec) ,stat=stat)
+!   allocate(mpi_drydep1(chunksize2,nspec) ,stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not13'
+    allocate(mpi_nclass(chunksize2) ,stat=stat)
+    allocate(dummyi2(chunksize2) ,stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not14'
+    allocate(dummyr2(chunksize2) ,stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not15'
+    allocate(dummyi22(chunksize2) ,stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not16'
+    allocate(dummyr22(chunksize2) ,stat=stat)
+    if (stat.ne.0) write(*,*)'ERROR: could not17'
+    chunksize2=chunksize
+     endif
+
+!**********************************************************************
+! Loop over the whole modelling period in time steps of mintime seconds
+!**********************************************************************
+
+!     print*,'time',myid,ideltas,lsynctime
+      do jtime=0,ideltas,lsynctime
+
+
+
+!         print*,'jtime',jtime
+! Computation of wet deposition 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. jtime .ne. 0 .and. numpart .gt. 0) &
+          call wetdepo(jtime,lsynctime,loutnext)
+
+    if (OHREA .and. jtime .ne. 0 .and. numpart .gt. 0) &
+         call ohreaction(jtime,lsynctime,loutnext)
+
+! compute convection for backward runs
+!*************************************
+
+!          if ((ldirect.eq.-1).and.(lconvection.eq.1).and.(jtime.lt.0))
+!    &    call convmix(jtime)
+
+           if ((ldirect.eq.-1).and.(jtime.lt.0)) then 
+             if (lconvection .eq. 1) call convmix(jtime)
+             if (lconvection .eq. 2 .or. lconvection .eq. 3) &
+                call convmix_kfeta(jtime)
+           endif
+
+! Get necessary wind fields if not available
+!*******************************************
+
+!        call itime(now)
+!        ttime=now(1)*3600+now(2)*60+now(3)
+        call cpu_time(start)  
+        call getfields(jtime,nstop1)
+        if (nstop1.gt.1) stop 'NO METEO FIELDS AVAILABLE'
+!        call itime(now)
+!        ttime=now(1)*3600+now(2)*60+now(3)-ttime
+        call cpu_time(finish)  
+!      print*,'read wind time',ttime
+             if (option_verbose.eq.1) then
+       print*,'read wind time',finish-start
+         endif
+! Release particles
+!******************
+
+!JB
+     if (myid.eq.0) then ! I let only the master thread releasing the particles and calculate the output
+!        call itime(now)
+        call cpu_time(start)  
+        if (mdomainfill.ge.1) then
+          if (jtime.eq.0) then
+            call init_domainfill()
+          else
+            call boundcond_domainfill(jtime,loutend)
+          endif
+        else
+        if (numpoint_option.eq.0) then
+          call releaseparticles_irreg(jtime)
+         elseif (numpoint_option.eq.1) then
+!      print*,'avant release'
+          call releaseparticles_reg(jtime) 
+          endif
+        endif
+!           do i=1,numpart
+!         print*,'ipart 2',myid,i,ztra1(i)
+!            enddo
+!        print*,'test rel',npoint(1),npoint(2),npoint(3)
+
+!         print*,'test rel1',npoint(5139),npoint(6002),npoint(100003)
+! 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)) &
+!           call convmix(jtime)
+
+          if (ldirect.eq.1) then 
+           if (lconvection.eq.1)call convmix(jtime)
+           if (lconvection.eq.2 .or. lconvection .eq. 3) &
+             call convmix_kfeta(jtime)
+          endif
+!      print*,'intermediaire'
+
+! If middle of averaging period of output fields is reached, accumulated
+! deposited mass radioactively decays 
+!***********************************************************************
+
+    if (DEP.and.(jtime.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 (mod(jtime,loutsample).eq.0) then 
+!          xm=0.
+!          xm1=0.
+!          do 247 j=1,numpart
+!47          if (itra1(j).eq.jtime) xm1=xm1+xmass1(j,1)
+!          xm=xm1
+!          do 248 nage=1,nageclass
+!            do 248 ix=0,numxgrid-1
+!              do 248 jy=0,numygrid-1
+!                do 248 l=1,nclassunc
+!48        xm=xm+wetgridunc(ix,jy,1,l,nage)+drygridunc(ix,jy,1,l,nage)
+!          write(*,'(i6,4f10.3)') jtime,xm,xm1
+!       endif
+!!! CHANGE
+
+          
+! Check whether concentrations are to be calculated
+!**************************************************
+
+        if ((ldirect*jtime.ge.ldirect*loutstart).and. &
+        (ldirect*jtime.le.ldirect*loutend)) then ! add to grid
+          if (mod(jtime-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 ((jtime.eq.loutstart).or.(jtime.eq.loutend)) then
+              weight=0.5
+            else
+              weight=1.0
+            endif
+!      print*,'avant conccalc'
+            outnum=outnum+weight
+            if(iout.ge.1) then 
+             if (outgrid_option.eq.0) then 
+             call conccalc_irreg(jtime,weight)
+             elseif (outgrid_option.eq.1) then
+             call conccalc_reg(jtime,weight)
+             endif
+            endif
+          endif
+
+!      print*,'apres conccalc'
+
+!         if ((mquasilag.eq.1).and.(jtime.eq.(loutstart+loutend)/2)) &
+!         call partoutput_short(jtime)    ! dump particle positions in extremely compressed format
+
+
+! Output and reinitialization of grid
+! If necessary, first sample of new grid is also taken
+!*****************************************************
+
+          if ((jtime.eq.loutend).and.(outnum.gt.0.)) then
+!            print*,'iout',iout,ipout,outgrid_option
+            if ((iout.le.3.).or.(iout.eq.5)) then 
+             if(iout.ge.1) then
+             if (outgrid_option.eq.0) then
+             call concoutput_irreg(jtime,outnum,gridtotalunc, &
+              wetgridtotalunc,drygridtotalunc)
+       if (nested_output.eq.1) call concoutput_nest_irreg(jtime,outnum)
+             elseif (outgrid_option.eq.1) then
+             call concoutput_reg(jtime,outnum,gridtotalunc, &
+              wetgridtotalunc,drygridtotalunc)
+       if (nested_output.eq.1) call concoutput_nest_reg(jtime,outnum)
+             endif
+            endif
+
+!      print*,'apres concout'
+!             if (nested_output.eq.1.and.iout.ge.1)
+!    +           call concoutput_nest(jtime,outnum)
+              outnum=0.
+            endif
+            if ((iout.eq.4).or.(iout.eq.5)) call plumetraj(jtime)
+            if (iflux.eq.1) call fluxoutput(jtime)
+            write(*,45) jtime,numpart,gridtotalunc,wetgridtotalunc, &
+            drygridtotalunc
+45          format(i9,' SECONDS SIMULATED: ',i9, &
+            ' PARTICLES:    Uncertainty: ',3f7.3)
+            if (ipout.ge.1) call partoutput(jtime)    ! dump particle positions
+            loutnext=loutnext+loutstep
+            loutstart=loutnext-loutaver/2
+            loutend=loutnext+loutaver/2
+            if (jtime.eq.loutstart) then
+              weight=0.5
+              outnum=outnum+weight
+              if(iout.ge.1) then
+               if (outgrid_option.eq.0) then
+               call conccalc_irreg(jtime,weight)
+               elseif (outgrid_option.eq.1) then
+               call conccalc_reg(jtime,weight)
+               endif
+             endif
+            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*jtime.ge.ldirect*itsplit) then
+          n=numpart
+          do j=1,numpart
+            if (ldirect*jtime.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
+        
+
+
+
+! Loop over all particles
+!************************
+
+
+!     chunksize=int(numpart/ntasks)+1  !if sent homogeneously
+      chunksize=int(numpart/ntasks)  !if sent homogeneously
+!        call itime(now)
+!        ttime=now(1)*3600+now(2)*60+now(3)-ttime
+        call cpu_time(finish)  
+
+!      print*,'processing time',ttime 
+             if (option_verbose.eq.1) then
+       print*,'processing time',finish-start
+        endif
+   endif !over myid
+!JB
+! at this stage, I assume that each node has the same shared memory because they run getfields.
+! now we need to split the trajectories into pieces for each node
+!   if (myid.eq.0) then
+
+        if (jtime.eq.ideltas) exit    
+
+! Compute interval since radioactive decay of deposited mass was computed
+!************************************************************************
+
+        if (jtime.lt.loutnext) then
+          ldeltat=jtime-(loutnext-loutstep)
+        else                                  ! first half of next interval
+          ldeltat=jtime-loutnext
+        endif
+
+
+   if (myid.eq.0) then
+!       call itime(now)
+!        ttime=now(1)*3600+now(2)*60+now(3)
+        call cpu_time(start)  
+   do ii=1,ntasks-1
+    call MPI_SEND(chunksize,1, MPI_INTEGER, ii,3001, MPI_COMM_WORLD, ierr)
+    call MPI_SEND(numpart,1, MPI_INTEGER, ii,3002, MPI_COMM_WORLD, ierr)
+   enddo 
+   else
+    call MPI_RECV(chunksize,1, MPI_INTEGER, 0,3001, MPI_COMM_WORLD,status, ierr)
+    call MPI_RECV(numpart,1, MPI_INTEGER, 0,3002, MPI_COMM_WORLD,status, ierr)
+   endif
+!  print*,'numpart',numpart
+!    chunksize2=chunksize
+!        print*,'chunksize 0',chunksize2,ntasks
+!JB
+! here I am going to send the infos to each slave nodes.
+     if (numpart.gt.0 .and. ntasks.gt.1 ) then
+    call MPI_BARRIER(MPI_COMM_WORLD,ierr)
+
+    call sendint_mpi(1,numpart,chunksize,0)
+!    print*,'after npoint',myid,numpart,chunksize
+    call sendint_mpi(2,numpart,chunksize,0)
+!    print*,'after idt',myid,numpart,chunksize
+    call sendint_mpi(3,numpart,chunksize,0)
+!    print*,'after itra1',myid,numpart,chunksize
+    call sendreal_mpi(4,numpart,chunksize,0)
+!    print*,'after uap',myid,numpart,chunksize
+    call sendreal_mpi(5,numpart,chunksize,0)
+!    print*,'after ucp',myid,numpart,chunksize
+    call sendreal_mpi(6,numpart,chunksize,0)
+!    print*,'after uzp',myid,numpart,chunksize
+    call sendreal_mpi(7,numpart,chunksize,0)
+!    print*,'after us',myid,numpart,chunksize
+    call sendreal_mpi(8,numpart,chunksize,0)
+!    print*,'after vs',myid,numpart,chunksize
+    call sendreal_mpi(9,numpart,chunksize,0)
+!    print*,'after ws',myid,numpart,chunksize
+    call sendreal_mpi(10,numpart,chunksize,0)
+!    print*,'after ztra1',myid,numpart,chunksize
+    call senddouble_mpi(11,numpart,chunksize,0)
+!    print*,'after xtra1',myid,numpart,chunksize
+    call senddouble_mpi(12,numpart,chunksize,0)
+!    print*,'after ytra1',myid,numpart,chunksize
+    call sendint2_mpi(13,numpart,chunksize,0)
+!    print*,'after cbt',myid,numpart,chunksize
+    call sendint_mpi(14,numpart,chunksize,0)
+!    print*,'after itramem',myid,numpart,chunksize
+    call sendint_mpi(15,numpart,chunksize,0)
+!    print*,'after nclass',myid,numpart,chunksize
+    call sendreal2d_mpi(20,numpart,nspec,chunksize,0)
+!    print*,'after xmass1',myid,numpart,chunksize
+   if (myid.eq.0) then
+!        call itime(now)
+!        ttime=now(1)*3600+now(2)*60+now(3)-ttime
+        call cpu_time(finish)  
+
+!       print*,'sending time',ttime
+           if (option_verbose.eq.1) then
+       print*,'sending time',finish-start
+          endif
+    else
+    chunksize2=chunksize
+    endif
+    endif !if statement on numpart et ntasks
+
+!   print*,'debut chunksize',chunksize,chunksize2,myid
+!    sigw,dsigwdz,dsigw2dz,cpt(nbp),ompid)
+
+! initialize the temporary drydeposition grid
+
+            if (DRYDEP.and.ldirect.gt.0) then
+  do ks=1,nspec
+  do kp=1,maxpointspec_act
+    do nage=1,nageclass
+      do jy=0,numygrid-1
+        do ix=0,numxgrid-1
+          do l=1,nclassunc
+            drygridunc2(ix,jy,ks,kp,l,nage)=0.
+          end do
+        end do
+      end do
+    if (nested_output.eq.1) then
+      do jy=0,numygridn-1
+        do ix=0,numxgridn-1
+          do l=1,nclassunc
+            drygriduncn2(ix,jy,ks,kp,l,nage)=0.
+          end do
+        end do
+      end do
+    endif
+    end do
+  end do
+  end do
+   endif
+       
+!
+!JB
+! now we are entering the openmp zone.
+!    if (myid.eq.0) then
+!    print*,'itra11',numpart,itra1(numpart-2:numpart+2)
+!    print*,'itra12',chunksize2,mpi_itra1(chunksize2-2:chunksize2+1)
+!    else
+!    print*,'itra13',mpi_itra1(chunksize-2:chunksize+1)
+!    endif
+
+!        print*,'continue',myid,chunksize2
+!!!$OMP PARALLEL NUM_THREADS(10) DEFAULT(SHARED) &
+!$OMP PARALLEL DEFAULT(SHARED) &
+!$OMP PRIVATE(jj, th_npoint, th_idt, th_uap, th_ucp,  &
+!$OMP th_uzp, th_us, th_vs, th_ws, th_xtra1, th_ytra1, th_ztra1,decfact, &
+!$OMP th_cbt, xold, yold, zold, kp, itage, prob, nstop, xmassfract, &
+!$OMP th_nclass,chunksize3,start,finish,ngrid,ompid,depoindicator,nbp, &
+!$OMP indzindicator,cpttra,th_xmass1,th_itra1,th_itramem,drydeposit,n_threads) &
+!$OMP SHARED(height,rho,tt,vsetaver,dquer,xtra1,ytra1,ztra1, &
+!$OMP density,cunningham,itra1,ioutputforeachrelease,cbt,iflux, &
+!$OMP uun,vvn,wwn,ustar,wstar,oli,uupol,vvpol,uu,vv,ww,drhodz,ptt,tke, &
+!$OMP rhon,drhodzn,pttn,tken,vdep,vdepn,itramem,nageclass,lage, &
+!$OMP jtime,ldirect,memind,nglobal,switchnorthg,m_x,m_y,m_xn,m_yn, &
+!$OMP switchsouthg,numbnests,xln,xrn,yln,yrn,memtime,xresoln, &
+!$OMP yresoln,hmix,hmixn,tropopause, & 
+!$OMP tropopausen,lsynctime,dxconst,dyconst,mdomainfill, &
+!$OMP turb_option,turbswitch,ifine,chunksize,chunksize2, &
+!!!maxrand, &
+!$OMP xmass,xmass1,DRYDEP,DRYDEPSPEC,nspec,rannumb,uniform_rannumb,cpt, &
+!$OMP lwindinterv,npart,npoint,idt,uap,ucp,uzp,us,vs,ws, &
+!$OMP linit_cond,decay,ldeltat,nclass,nested_output,numpart, &
+!$OMP  mpi_npoint,mpi_idt, mpi_uap, mpi_ucp, mpi_uzp, mpi_us, mpi_vs, &
+!$OMP  mpi_ws, mpi_xtra1, mpi_ytra1, mpi_ztra1, &
+!$OMP mpi_cbt,drygridunc2,drygriduncn2, & 
+!$OMP  mpi_xmass1, mpi_itra1,myid,mpi_itramem,mpi_nclass, &
+!$OMP  mts)
+
+!        call itime(now)
+!        ttime=now(1)*3600+now(2)*60+now(3)
+        call cpu_time(start)  
+!       chunksize3=int(chunksize2/omp_get_num_threads())+1
+        n_threads=omp_get_num_threads()
+
+!       ompid=omp_get_num_threads()
+        ompid=OMP_GET_THREAD_NUM()
+        chunksize3=int(real(chunksize2)/real(n_threads)/20.)+1 !more efficient
+
+        if (ompid+1.gt.maxomp) then
+        print*,'problem with maxomp. modify par_mod.f90',maxomp,ompid+1
+        stop
+        endif
+        cpttra=0
+!        print*,'chunksi',chunksize2,chunksize3,myid
+        if (chunksize2.gt.0 .and. numpart.gt.0) then
+!         print*,'test rel2',npoint(5139),npoint(6002),npoint(100003)
+!!!$OMP DO  SCHEDULE(STATIC,10)
+!$OMP DO  SCHEDULE(STATIC,chunksize3)
+!!!$OMP DO SCHEDULE(GUIDED,1)
+!!!$OMP DO 
+!        do jj=1,numpart
+!        do jj=numpart,1,-1
+!        print*,jj
+        do jj=1,chunksize2
+
+! If integration step is due, do it
+!**********************************
+!$OMP CRITICAL 
+          if (ntasks.gt.1) then
+         th_itra1=mpi_itra1(jj)
+         th_itramem=mpi_itramem(jj)
+         th_npoint=mpi_npoint(jj) 
+             else
+         th_itra1=itra1(jj)
+         th_itramem=itramem(jj)
+         th_npoint=npoint(jj) 
+         endif
+
+!$OMP END CRITICAL
+!          if (th_itra1(jj).eq.jtime) then
+!        if (mod(jj,30000).eq.1) print*,'middle',jj,th_itra1,jtime
+!       if (th_itra1.lt.-9999) print*,'middle',jj,th_itra1,jtime
+!         if (th_itra1.eq.jtime) then
+!         if (th_itra1.eq.jtime .and. th_npoint.gt.0 .and. th_npoint.le.numpoint) then
+          if (th_itra1.eq.jtime ) then
+           cpttra=cpttra+1
+
+!       print*,'avant init',j
+! Initialize newly released particle
+!***********************************
+!$OMP CRITICAL 
+          if (ntasks.eq.1) then
+!         th_npoint=npoint(jj)
+          th_idt=idt(jj)
+          th_uap=uap(jj)
+          th_ucp=ucp(jj)
+          th_uzp=uzp(jj)
+          th_us=us(jj)
+          th_vs=vs(jj)
+          th_ws=ws(jj)
+          th_xtra1=xtra1(jj)
+          th_ytra1=ytra1(jj)
+          th_ztra1=ztra1(jj)
+         th_nclass=nclass(jj)
+          th_cbt=cbt(jj)
+        do ks=1,nspec
+         th_xmass1(ks)=xmass1(jj,ks)
+        enddo
+        if (ioutputforeachrelease.eq.1) then
+            kp=npoint(jj)
+        else
+            kp=1
+        endif
+         else
+!        th_npoint=mpi_npoint(jj)
+         th_idt=mpi_idt(jj)
+         th_uap=mpi_uap(jj)
+         th_ucp=mpi_ucp(jj)
+         th_uzp=mpi_uzp(jj)
+         th_us=mpi_us(jj)
+         th_vs=mpi_vs(jj)
+         th_ws=mpi_ws(jj)
+         th_xtra1=mpi_xtra1(jj)
+         th_ytra1=mpi_ytra1(jj)
+         th_ztra1=mpi_ztra1(jj)
+         th_nclass=mpi_nclass(jj)
+         th_cbt=mpi_cbt(jj)
+     do ks=1,nspec
+         th_xmass1(ks)=mpi_xmass1(jj,ks)
+        enddo
+        if (ioutputforeachrelease.eq.1) then
+            kp=mpi_npoint(jj)
+        else
+            kp=1
+        endif
+         endif
+!$OMP END CRITICAL 
+
+! Determine age class of the particle
+!            itage=abs(itra1(jj)-itramem(jj))
+            itage=abs(th_itra1-th_itramem)
+            do nage=1,nageclass
+              if (itage.lt.lage(nage)) exit
+         enddo
+!      if (jj.lt.5) print*,'xmass1',th_xmass1(1)
+!            ompid=OMP_GET_THREAD_NUM()
+             nbp=ompid+1
+!         print*,th_npoint,jj,npoint(jj)
+!     print*,'befo',th_xtra1,th_ytra1,th_ztra1
+!          iff=0
+!            if ((itramem(jj).eq.jtime).or.(jtime.eq.0)) &
+            if ((th_itramem.eq.jtime).or.(jtime.eq.0)) then 
+!           call initialize(jtime,idt(j),uap(j),ucp(j),uzp(j), &
+!           us(j),vs(j),ws(j),xtra1(j),ytra1(j),ztra1(j),cbt(j))
+            call initialize(jtime,th_idt,th_uap,th_ucp,th_uzp, &
+            th_us,th_vs,th_ws,th_xtra1,th_ytra1,th_ztra1,th_cbt, &
+      ngrid,depoindicator,indzindicator,cpt(nbp),ompid,myid,n_threads,mts )
+             endif
+
+!     print*,'after',th_xtra1,th_ytra1,th_ztra1
+! Memorize particle positions
+!****************************
+!         if (mod(jj,100000).eq.1) print*,'middle',jj,myid,ompid
+!            xold=xtra1(j)
+!            yold=ytra1(j)
+!            zold=ztra1(j)
+            xold=th_xtra1
+            yold=th_ytra1
+            zold=th_ztra1
+
+! Integrate Lagevin equation for lsynctime seconds
+!*************************************************
+!              write(*,*)'numpart,jtime, particle #=',numpart,jtime,j
+
+!        call advance(jtime,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))
+!     if ( abs(xold).gt.1000. .or. xold.ne.xold .or. th_xtra1.ne.th_xtra1 )  &
+!    print*,'pb avant 0',xold,yold,th_itramem, &
+!      jtime,jj,chunksize2
+!        print*,'npoint',mpi_npoint(jj),th_npoint,jj
+        call advance(jtime,th_npoint,th_idt,th_uap,th_ucp,th_uzp, &
+            th_us,th_vs,th_ws,nstop,th_xtra1,&
+            th_ytra1,th_ztra1,prob,th_cbt, &
+      ngrid,depoindicator,indzindicator,cpt(nbp),ompid,myid,n_threads,mts )
+
+!     if ( abs(xold).gt.1000. .or. xold.ne.xold .or. th_xtra1.ne.th_xtra1 )  &
+!    print*,'pb avant 1',xold,yold,th_itramem, &
+!      jtime,jj,chunksize2
+! Calculate the gross fluxes across layer interfaces
+!***************************************************
+
+
+            if (iflux.eq.1) call calcfluxes(nage,jj,xold,yold,zold)
+
+!      if (jj.lt.5) print*,'coord after',myid,th_itra1,th_xmass1(1),DRYDEPSPEC(ks)
+
+! Determine, when next time step is due
+! If trajectory is terminated, mark it
+!**************************************
+!!!$OMP CRITICAL 
+         do ks=1,nspec
+     drydeposit(ks)=0.
+          enddo
+        if (nstop.gt.1) then
+          if (linit_cond.ge.1) call initial_cond_calc(jtime,jj)
+!              itra1(jj)=-999999999
+              th_itra1=-999999999
+       if (option_verbose.gt.1) print*,'out of domain',th_xtra1,th_ytra1,th_ztra1
+
+            else
+!              itra1(jj)=jtime+lsynctime
+              th_itra1=jtime+lsynctime
+
+
+!      if (jj.lt.5) print*,'coord after2',myid,th_itra1,th_xmass1(1),DRYDEPSPEC(ks)
+! Dry deposition and radioactive decay for each species
+!******************************************************
+          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
+                  drydeposit(ks)=th_xmass1(ks)*prob(ks)*decfact
+!                  xmass1(j,ks)=xmass1(j,ks)*(1.-prob(ks))*decfact
+                  th_xmass1(ks)=th_xmass1(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
+                  th_xmass1(ks)=th_xmass1(ks)*decfact
+                endif
+!      if (jj.lt.5) print*,'coord after3',myid,th_itra1,th_xmass1(1),DRYDEPSPEC(ks),xmass(th_npoint,1)
+
+            if (mdomainfill.eq.0) then
+              if (xmass(th_npoint,ks).gt.0.) &
+!                  xmassfract=max(xmassfract,real(npart(npoint(jj)))* &
+                   xmassfract=max(xmassfract,real(npart(th_npoint))* &
+!                   xmass1(j,ks)/xmass(npoint(j),ks))
+                   th_xmass1(ks)/xmass(th_npoint,ks))
+            else
+              xmassfract=1.
+            endif
+
+            end do
+
+         if (ipin.eq.0 .and. xmassfract.lt.0.000001) then   ! terminate all particles carrying less mass
+!           itra1(jj)=-999999999
+           th_itra1=-999999999
+         endif
+
+  !        Sabine Eckhardt, June 2008
+  !        don't create depofield for backward runs
+          if (DRYDEP.AND.(ldirect.eq.1)) then
+!           call drydepokernel(nclass(jj),drydeposit,real(xtra1(jj)), &
+            call drydepokernel(th_nclass,drydeposit,real(th_xtra1), &
+!                real(ytra1(jj)),nage,kp)
+                 real(th_ytra1),itage,nage,kp)
+            if (nested_output.eq.1) call drydepokernel_nest( &
+!                nclass(jj),drydeposit,real(xtra1(jj)),real(ytra1(jj)), &
+              th_nclass,drydeposit,real(th_xtra1),real(th_ytra1), &
+                 itage,nage,kp)
+          endif
+
+  ! Terminate trajectories that are older than maximum allowed age
+  !***************************************************************
+
+!          if (abs(itra1(jj)-itramem(jj)).ge.lage(nageclass)) then
+          if (abs(th_itra1-th_itramem).ge.lage(nageclass)) then
+            if (linit_cond.ge.1) &
+                  call initial_cond_calc(jtime+lsynctime,jj)
+!            itra1(jj)=-999999999
+            th_itra1=-999999999
+          endif
+      endif
+!!     print*,xtra1(j),th_xtra1,OMP_GET_THREAD_NUM()
+!$OMP CRITICAL 
+          if (ntasks.eq.1) then
+    npoint(jj)=th_npoint
+    idt(jj)=th_idt
+     uap(jj)=th_uap
+     ucp(jj)=th_ucp
+     uzp(jj)=th_uzp
+     us(jj)=th_us
+     vs(jj)=th_vs
+     ws(jj)=th_ws
+     xtra1(jj)=th_xtra1
+     ytra1(jj)=th_ytra1
+     ztra1(jj)=th_ztra1
+     cbt(jj)=th_cbt 
+    do ks=1,nspec
+    xmass1(jj,ks)=th_xmass1(ks)
+!   drydep1(jj,ks)=drydeposit(ks)
+    enddo
+!    itramem(jj)=th_itramem
+     itra1(jj)=th_itra1
+     else
+    mpi_npoint(jj)=th_npoint
+    mpi_idt(jj)=th_idt
+    mpi_uap(jj)=th_uap
+    mpi_ucp(jj)=th_ucp
+    mpi_uzp(jj)=th_uzp
+    mpi_us(jj)=th_us
+    mpi_vs(jj)=th_vs
+    mpi_ws(jj)=th_ws
+    mpi_xtra1(jj)=th_xtra1
+    mpi_ytra1(jj)=th_ytra1
+    mpi_ztra1(jj)=th_ztra1
+!   mpi_nclass(jj)=th_nclass
+    mpi_cbt(jj)=th_cbt
+    do ks=1,nspec
+    mpi_xmass1(jj,ks)=th_xmass1(ks)
+!   mpi_drydep1(jj,ks)=drydeposit(ks)
+    enddo
+!   mpi_itramem(jj)=th_itramem
+    mpi_itra1(jj)=th_itra1 
+     endif
+!      if (jj.lt.5) print*,'coord cont',th_itra1
+
+!$OMP END CRITICAL
+
+      endif
+
+    end do !loop over particles
+!$OMP END DO 
+    endif
+!!!$OMP
+!!!$OMP FLUSH(npoint,idt,uap,ucp,uzp,us,vs,ws,xtra1,ytra1,ztra1,cbt,xmass1,itra1)
+!!!$OMP FLUSH
+!        call itime(now)
+!        ttime=now(1)*3600+now(2)*60+now(3)-ttime
+        call cpu_time(finish)  
+!      print*,'time',ttime,cpttra,myid,OMP_GET_THREAD_NUM()
+            if (option_verbose.eq.1) then
+       print*,'time',finish-start,cpttra,myid,ompid 
+           endif
+!$OMP END PARALLEL
+!JB 
+! the openmp is done. the output above gives how long it takes to finish the loop over the particles. good benchmark
+ 
+! here we use mpi to use the mpi_* arrays to update the big ones in the master
+! thread
+  
+!   call MPI_REDUCE (mypi ,pi ,1, MPI_DOUBLE_PRECISION , MPI_SUM ,0, &
+!    MPI_COMM_WORLD , ierr )
+!  print*,'after loop',myid,chunksize
+   if (chunksize.gt.0 .and. ntasks.gt.1) then
+
+!JB
+! I need a barrier so each node is a the same place
+! I am going to send the new results to the master thread now.
+    call MPI_BARRIER(MPI_COMM_WORLD,ierr)
+   if (myid.eq.0) then
+!        call itime(now)
+!        ttime=now(1)*3600+now(2)*60+now(3)
+        call cpu_time(start)  
+   endif
+    call sendint_mpi(1,numpart,chunksize,1)
+    call sendint_mpi(2,numpart,chunksize,1)
+    call sendint_mpi(3,numpart,chunksize,1)
+    call sendreal_mpi(4,numpart,chunksize,1)
+    call sendreal_mpi(5,numpart,chunksize,1)
+    call sendreal_mpi(6,numpart,chunksize,1)
+    call sendreal_mpi(7,numpart,chunksize,1)
+    call sendreal_mpi(8,numpart,chunksize,1)
+    call sendreal_mpi(9,numpart,chunksize,1)
+    call sendreal_mpi(10,numpart,chunksize,1)
+    call senddouble_mpi(11,numpart,chunksize,1)
+    call senddouble_mpi(12,numpart,chunksize,1)
+    call sendint2_mpi(13,numpart,chunksize,1)
+    call sendint_mpi(14,numpart,chunksize,1)
+!   call sendint_mpi(15,nclass(1:numpart),numpart,chunksize2,1)
+    call sendreal2d_mpi(99,numpart,nspec,chunksize,1)
+!   if (DRYDEP) call sendreal2d_mpi(21,numpart,nspec,chunksize,1)
+    if (DRYDEP.and.(ldirect.eq.1)) call senddrydep_mpi(numxgrid*numygrid) 
+    if (DRYDEP.and.(ldirect.eq.1).and.nested_output.eq.1)  &
+      call senddrydep_nest_mpi(numxgridn*numygridn) 
+!   print*,'size of vector',chunksize,chunksize2,myid,numpart
+!   
+!    if (myid.eq.0) then
+!    print*,'itra1',numpart,itra1(numpart-2:numpart+2)
+!    print*,'itra2',chunksize2,mpi_itra1(chunksize2-2:chunksize2+1)
+!    else
+!    print*,'itra3',mpi_itra1(chunksize-2:chunksize+1)
+!    endif
+   if (myid.eq.0) then
+!        call itime(now)
+!        ttime=now(1)*3600+now(2)*60+now(3)-ttime
+        call cpu_time(finish)  
+!      print*,'receiving time',ttime
+            if (option_verbose.eq.1) then
+       print*,'receiving time',finish-start 
+           endif
+    endif 
+    endif !finish transfering between nodes  
+
+! update the drydepo
+            if (DRYDEP.and.ldirect.gt.0) then
+  do ks=1,nspec
+  do kp=1,maxpointspec_act
+    do nage=1,nageclass
+
+      do jy=0,numygrid-1
+        do ix=0,numxgrid-1
+          do l=1,nclassunc
+       drygridunc(ix,jy,ks,kp,l,nage)=drygridunc(ix,jy,ks,kp,l,nage) &
+               +drygridunc2(ix,jy,ks,kp,l,nage)
+          end do
+        end do
+      end do
+    if (nested_output.eq.1) then
+      do jy=0,numygridn-1
+        do ix=0,numxgridn-1
+          do l=1,nclassunc
+       drygriduncn(ix,jy,ks,kp,l,nage)=drygriduncn(ix,jy,ks,kp,l,nage) &
+               +drygriduncn2(ix,jy,ks,kp,l,nage)
+          end do
+        end do
+      end do
+    endif
+    end do
+  end do
+  end do
+
+   endif
+
+!          if (DRYDEP.AND.(ldirect.eq.1)) then
+!!           call drydepokernel(nclass(jj),drydeposit,real(xtra1(jj)), &
+!            call drydepokernel(th_nclass,drydeposit,real(th_xtra1), &
+!!                real(ytra1(jj)),nage,kp)
+!                 real(th_ytra1),itage,nage,kp)
+!            if (nested_output.eq.1) call drydepokernel_nest( &
+!!                nclass(jj),drydeposit,real(xtra1(jj)),real(ytra1(jj)), &
+!              th_nclass,drydeposit,real(th_xtra1),real(th_ytra1), &
+!                 itage,nage,kp)
+!          endif
+
+
+  end do !loop over time 
+
+
+  ! Complete the calculation of initial conditions for particles not yet terminated
+  !*****************************************************************************
+    call MPI_BARRIER(MPI_COMM_WORLD,ierr)
+
+  do j=1,numpart
+    if (linit_cond.ge.1) call initial_cond_calc(jtime,j)
+  end do
+
+  if (ipout.eq.2) call partoutput(jtime)     ! dump particle positions
+
+  if (linit_cond.ge.1) call initial_cond_output(jtime)   ! dump initial cond. field
+
+  close(104)
+
+  ! De-allocate memory and end
+  !***************************
+
+  if (iflux.eq.1) then
+      deallocate(flux)
+  endif
+    if (ntasks.gt.1) then
+!  print*,'before dealloc',myid
+   deallocate(mpi_npoint,mpi_idt,mpi_itra1)
+!  print*,'after dealloc, part1',myid
+   deallocate(mpi_uap,mpi_ucp,mpi_uzp)
+!  print*,'after dealloc, part12',myid
+   deallocate(mpi_us,mpi_vs,mpi_ws,mpi_ztra1)
+!  print*,'after dealloc, part2',myid
+   deallocate(mpi_xtra1,mpi_ytra1)
+!  print*,'after dealloc, part3',myid
+   deallocate(mpi_cbt)
+!  print*,'after dealloc, part4',myid
+!  deallocate(mpi_xmass1,mpi_drydep1,mpi_nclass)
+   deallocate(mpi_xmass1,mpi_nclass)
+!  print*,'after dealloc',myid
+   deallocate(dummyi2)
+   deallocate(dummyr2)
+   deallocate(dummyi22)
+   deallocate(dummyr22)
+
+   endif
+  if (OHREA.eqv..TRUE.) then
+      deallocate(OH_field,OH_field_height)
+  endif
+  deallocate(gridunc)
+  deallocate(xpoint1,xpoint2,ypoint1,ypoint2,zpoint1,zpoint2,xmass)
+  deallocate(ireleasestart,ireleaseend,npart,kindz)
+!  deallocate(xmasssave)
+  if (myid.eq.0) then
+  if (nested_output.eq.1) then
+     deallocate(orooutn, arean, volumen)
+     if (ldirect.gt.0) then
+     deallocate(griduncn,drygriduncn,wetgriduncn,drygriduncn2)
+     endif
+  endif
+  if (ldirect.gt.0) then
+      if (allocated(drygridunc)) deallocate(drygridunc)
+      if (allocated(wetgridunc)) deallocate(wetgridunc)
+      if (allocated(drygridunc2)) deallocate(drygridunc2)
+      if (allocated(drygriduncn2)) deallocate(drygriduncn2)
+  endif
+  deallocate(outheight,outheighthalf)
+  deallocate(oroout, area, volume)
+  endif
+end subroutine timemanager_mpi
+
+
+
Index: /branches/jerome/src_flexwrf_v3.1/timemanager_serial.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/timemanager_serial.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/timemanager_serial.f90	(revision 16)
@@ -0,0 +1,769 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                *
+!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine,       *
+!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
+!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso,          *
+!* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann,   *
+!*                                                                     *
+!* This file is part of FLEXPART WRF                                   *
+!*                                                                     *
+!* 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(mts)
+
+!*******************************************************************************
+!                                                                              *
+! 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                                                              *
+!                                                                              *
+!     Dec 2005, J. Fast - Only call conccalc & concoutput when (iout.ge.1)     *
+!     Aug 2007, W. Wang - call KFeta convection scheme (lconvection=2or3)
+!                       Note, backward is unavailabe for lconvection=2
+!     Mar 2012, J. Brioude: modifications to handle openmp and mpi             *
+!*******************************************************************************
+!  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                                          *
+! jtime [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 interpolation *
+! xtra1(maxpart), ytra1(maxpart), ztra1(maxpart) =                             *
+!                    spatial positions of trajectories                         *
+!                                                                              *
+! Constants:                                                                   *
+! maxpart            maximum number of trajectories                            *
+!                                                                              *
+!*******************************************************************************
+
+!      include 'includepar'
+!      include 'includecom'
+  use unc_mod
+  use point_mod
+!  use xmass_mod
+  use flux_mod
+  use outg_mod
+  use oh_mod
+  use par_mod
+  use com_mod
+ use mt_stream
+
+!  use ran_mod
+!  use interpol_mod
+
+      implicit none
+
+
+  integer :: ix,jy,j,ks,kp,l,n,jtime,nstop,nstop1
+! integer :: ksp
+  integer :: loutnext,loutstart,loutend,jj,chunksize
+!,chunksize2
+  integer :: chunksize3,omp_get_num_threads
+  integer :: ldeltat,itage,nage,th_itra1,i
+  real :: outnum,weight,prob(maxspec),nrand,decfact
+!  real :: uap(maxpart),ucp(maxpart),uzp(maxpart)
+!  real :: us(maxpart),vs(maxpart),ws(maxpart)
+!  integer(kind=2) :: cbt(maxpart)
+!  real,allocatable, dimension (:) :: uap,ucp,uzp
+!  real,allocatable, dimension (:) :: us,vs,ws
+!  integer(kind=2),allocatable, dimension (:) :: cbt
+  real :: drydeposit(maxspec),gridtotalunc,wetgridtotalunc
+  real :: drygridtotalunc,xold,yold,zold,xmassfract
+!      integer j,k,l,n,jtime,nstop,nstop1
+!      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),cbt(maxpart)
+!     real drydeposit(maxspec),gridtotalunc,wetgridtotalunc
+!      real drygridtotalunc,xold,yold,zold
+!     real xm,xm1
+
+
+  integer :: th_npoint,th_idt,th_itramem,jdeb,jfin,stat,th_nclass
+  integer,save :: cpt(maxomp)=0
+! integer,save :: cpt(24)=0
+  real(kind=dp) :: th_xtra1,th_ytra1
+  real :: th_ztra1,th_uap,th_ucp,th_uzp
+  real :: th_us,th_vs,th_ws,ran3
+  integer(kind=2) :: th_cbt
+  integer :: from
+
+  real :: p1,p2,p3,p4,ddx,ddy,rddx,rddy,dtt,dt1,dt2
+  integer :: ixp,jyp,ngrid,indz,indzp,nbp,jj2,ii,offset
+  logical :: depoindicator(maxspec)
+  logical,save :: indzindicator(nzmax)
+  real :: ust,wst,ol,h,zeta,sigu,sigv,tlu,tlv,tlw
+  real :: sigw,dsigwdz,dsigw2dz,th_xmass1(maxspec)
+  real :: start, finish
+  real :: uprof(nzmax),vprof(nzmax),wprof(nzmax)
+  real :: usigprof(nzmax),vsigprof(nzmax),wsigprof(nzmax)
+  real :: rhoprof(nzmax),rhogradprof(nzmax)
+  real :: tkeprof(nzmax),pttprof(nzmax)
+  real :: u,v,w,usig,vsig,wsig,pvi
+  integer*4 :: now(3)
+  integer :: ttime,cpttra
+!  integer, dimension(MPI_STATUS_SIZE) :: status
+  integer :: myid,ntasks,ierr,islave,tag2,ompid,n_threads,tag3,i_omp
+  type (mt_state) :: mts (0: MAX_STREAM)
+!************************
+
+!JB
+!  call MPI_COMM_RANK ( MPI_COMM_WORLD, myid, ierr )
+!  call MPI_COMM_SIZE ( MPI_COMM_WORLD, ntasks, ierr )
+! myid gives the info on the node id
+      ntasks=1
+      myid=0
+      loutnext=loutstep/2
+      outnum=0.
+      loutstart=loutnext-loutaver/2
+      loutend=loutnext+loutaver/2
+
+!   if (myid.eq.0) then
+    allocate(uap(maxpart) ,stat=stat)
+    allocate(ucp(maxpart) ,stat=stat)
+    allocate(uzp(maxpart) ,stat=stat)
+    allocate(us(maxpart) ,stat=stat)
+    allocate(vs(maxpart) ,stat=stat)
+    allocate(ws(maxpart) ,stat=stat)
+    allocate(cbt(maxpart) ,stat=stat)
+!   endif
+
+!**********************************************************************
+! Loop over the whole modelling period in time steps of mintime seconds
+!**********************************************************************
+
+!     print*,'time',myid,ideltas,lsynctime
+      do jtime=0,ideltas,lsynctime
+
+
+!         print*,'jtime',jtime
+! Computation of wet deposition 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. jtime .ne. 0 .and. numpart .gt. 0) &
+          call wetdepo(jtime,lsynctime,loutnext)
+
+    if (OHREA .and. jtime .ne. 0 .and. numpart .gt. 0) &
+         call ohreaction(jtime,lsynctime,loutnext)
+
+! compute convection for backward runs
+!*************************************
+
+!          if ((ldirect.eq.-1).and.(lconvection.eq.1).and.(jtime.lt.0))
+!    &    call convmix(jtime)
+
+           if ((ldirect.eq.-1).and.(jtime.lt.0)) then 
+             if (lconvection .eq. 1) call convmix(jtime)
+             if (lconvection .eq. 2 .or. lconvection .eq. 3) &
+                call convmix_kfeta(jtime)
+           endif
+
+! Get necessary wind fields if not available
+!*******************************************
+
+!        call itime(now)
+!        ttime=now(1)*3600+now(2)*60+now(3)
+        call cpu_time(start)  
+        call getfields(jtime,nstop1)
+        if (nstop1.gt.1) stop 'NO METEO FIELDS AVAILABLE'
+!        call itime(now)
+!        ttime=now(1)*3600+now(2)*60+now(3)-ttime
+        call cpu_time(finish)  
+!      print*,'read wind time',ttime
+
+! Release particles
+!******************
+
+!JB
+     if (myid.eq.0) then ! I let only the master thread releasing the particles and calculate the output
+!        call itime(now)
+        call cpu_time(start)  
+        if (mdomainfill.ge.1) then
+          if (jtime.eq.0) then
+            call init_domainfill()
+          else
+            call boundcond_domainfill(jtime,loutend)
+          endif
+        else
+        if (numpoint_option.eq.0) then
+          call releaseparticles_irreg(jtime)
+         elseif (numpoint_option.eq.1) then
+!      print*,'avant release'
+          call releaseparticles_reg(jtime) 
+          endif
+        endif
+!           do i=1,numpart
+!         print*,'ipart 2',myid,i,ztra1(i)
+!            enddo
+!        print*,'test rel',npoint(1),npoint(2),npoint(3)
+
+!         print*,'test rel1',npoint(5139),npoint(6002),npoint(100003)
+! 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)) &
+!           call convmix(jtime)
+
+          if (ldirect.eq.1) then 
+           if (lconvection.eq.1)call convmix(jtime)
+           if (lconvection.eq.2 .or. lconvection .eq. 3) &
+             call convmix_kfeta(jtime)
+          endif
+
+! If middle of averaging period of output fields is reached, accumulated
+! deposited mass radioactively decays 
+!***********************************************************************
+
+    if (DEP.and.(jtime.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 (mod(jtime,loutsample).eq.0) then 
+!          xm=0.
+!          xm1=0.
+!          do 247 j=1,numpart
+!47          if (itra1(j).eq.jtime) xm1=xm1+xmass1(j,1)
+!          xm=xm1
+!          do 248 nage=1,nageclass
+!            do 248 ix=0,numxgrid-1
+!              do 248 jy=0,numygrid-1
+!                do 248 l=1,nclassunc
+!48        xm=xm+wetgridunc(ix,jy,1,l,nage)+drygridunc(ix,jy,1,l,nage)
+!          write(*,'(i6,4f10.3)') jtime,xm,xm1
+!       endif
+!!! CHANGE
+
+          
+! Check whether concentrations are to be calculated
+!**************************************************
+
+        if ((ldirect*jtime.ge.ldirect*loutstart).and. &
+        (ldirect*jtime.le.ldirect*loutend)) then ! add to grid
+          if (mod(jtime-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 ((jtime.eq.loutstart).or.(jtime.eq.loutend)) then
+              weight=0.5
+            else
+              weight=1.0
+            endif
+            outnum=outnum+weight
+            if(iout.ge.1) then 
+             if (outgrid_option.eq.0) then 
+             call conccalc_irreg(jtime,weight)
+             elseif (outgrid_option.eq.1) then
+             call conccalc_reg(jtime,weight)
+             endif
+            endif
+          endif
+
+
+!         if ((mquasilag.eq.1).and.(jtime.eq.(loutstart+loutend)/2)) &
+!         call partoutput_short(jtime)    ! dump particle positions in extremely compressed format
+
+
+! Output and reinitialization of grid
+! If necessary, first sample of new grid is also taken
+!*****************************************************
+
+          if ((jtime.eq.loutend).and.(outnum.gt.0.)) then
+!            print*,'iout',iout,ipout,outgrid_option
+            if ((iout.le.3.).or.(iout.eq.5)) then 
+             if(iout.ge.1) then
+             if (outgrid_option.eq.0) then
+             call concoutput_irreg(jtime,outnum,gridtotalunc, &
+              wetgridtotalunc,drygridtotalunc)
+       if (nested_output.eq.1) call concoutput_nest_irreg(jtime,outnum)
+             elseif (outgrid_option.eq.1) then
+             call concoutput_reg(jtime,outnum,gridtotalunc, &
+              wetgridtotalunc,drygridtotalunc)
+       if (nested_output.eq.1) call concoutput_nest_reg(jtime,outnum)
+             endif
+            endif
+
+!             if (nested_output.eq.1.and.iout.ge.1)
+!    +           call concoutput_nest(jtime,outnum)
+              outnum=0.
+            endif
+            if ((iout.eq.4).or.(iout.eq.5)) call plumetraj(jtime)
+            if (iflux.eq.1) call fluxoutput(jtime)
+            write(*,45) jtime,numpart,gridtotalunc,wetgridtotalunc, &
+            drygridtotalunc
+45          format(i9,' SECONDS SIMULATED: ',i9, &
+            ' PARTICLES:    Uncertainty: ',3f7.3)
+            if (ipout.ge.1) call partoutput(jtime)    ! dump particle positions
+            loutnext=loutnext+loutstep
+            loutstart=loutnext-loutaver/2
+            loutend=loutnext+loutaver/2
+            if (jtime.eq.loutstart) then
+              weight=0.5
+              outnum=outnum+weight
+              if(iout.ge.1) then
+               if (outgrid_option.eq.0) then
+               call conccalc_irreg(jtime,weight)
+               elseif (outgrid_option.eq.1) then
+               call conccalc_reg(jtime,weight)
+               endif
+             endif
+            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*jtime.ge.ldirect*itsplit) then
+          n=numpart
+          do j=1,numpart
+            if (ldirect*jtime.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
+        
+
+
+
+! Loop over all particles
+!************************
+
+
+!     chunksize=int(numpart/ntasks)+1  !if sent homogeneously
+!        call itime(now)
+!        ttime=now(1)*3600+now(2)*60+now(3)-ttime
+        call cpu_time(finish)  
+
+!      print*,'processing time',ttime
+   endif !over myid
+!JB
+! at this stage, I assume that each node has the same shared memory because they run getfields.
+! now we need to split the trajectories into pieces for each node
+!   if (myid.eq.0) then
+
+        if (jtime.eq.ideltas) exit    
+
+! Compute interval since radioactive decay of deposited mass was computed
+!************************************************************************
+
+        if (jtime.lt.loutnext) then
+          ldeltat=jtime-(loutnext-loutstep)
+        else                                  ! first half of next interval
+          ldeltat=jtime-loutnext
+        endif
+
+
+!  if (myid.eq.0) then
+!       call itime(now)
+!        ttime=now(1)*3600+now(2)*60+now(3)
+!   do ii=1,ntasks-1
+!    call MPI_SEND(chunksize,1, MPI_INTEGER, ii,3001, MPI_COMM_WORLD, ierr)
+!    call MPI_SEND(numpart,1, MPI_INTEGER, ii,3002, MPI_COMM_WORLD, ierr)
+!   enddo 
+!   else
+!    call MPI_RECV(chunksize,1, MPI_INTEGER, 0,3001, MPI_COMM_WORLD,status, ierr)
+!    call MPI_RECV(numpart,1, MPI_INTEGER, 0,3002, MPI_COMM_WORLD,status, ierr)
+!   endif
+!  print*,'numpart',numpart
+
+!        call itime(now)
+!        ttime=now(1)*3600+now(2)*60+now(3)
+
+! initialize the temporary drydeposition grid
+
+            if (DRYDEP.and.ldirect.gt.0) then
+  do ks=1,nspec
+  do kp=1,maxpointspec_act
+    do nage=1,nageclass
+      do jy=0,numygrid-1
+        do ix=0,numxgrid-1
+          do l=1,nclassunc
+            drygridunc2(ix,jy,ks,kp,l,nage)=0.
+          end do
+        end do
+      end do
+    if (nested_output.eq.1) then
+      do jy=0,numygridn-1
+        do ix=0,numxgridn-1
+          do l=1,nclassunc
+            drygriduncn2(ix,jy,ks,kp,l,nage)=0.
+          end do
+        end do
+      end do
+    endif
+    end do
+  end do
+  end do
+   endif
+
+
+        call cpu_time(start)  
+!       chunksize3=int(chunksize2/omp_get_num_threads())+1
+!       chunksize3=int(real(chunksize2)/real(omp_get_num_threads())/20.)+1 !more efficient
+
+!       ompid=omp_get_num_threads()
+        ompid=0
+
+        cpttra=0
+!        print*,'chunksi',chunksize2,myid
+        if (numpart.gt.0 ) then
+!         print*,'test rel2',npoint(5139),npoint(6002),npoint(100003)
+!        do jj=1,numpart
+!        do jj=numpart,1,-1
+!        print*,jj
+        do jj=1,numpart
+
+! If integration step is due, do it
+!**********************************
+          if (itra1(jj).eq.jtime) then
+           cpttra=cpttra+1
+        if (ioutputforeachrelease.eq.1) then
+            kp=npoint(jj)
+        else
+            kp=1
+        endif
+
+! Determine age class of the particle
+            itage=abs(itra1(jj)-itramem(jj))
+            do nage=1,nageclass
+              if (itage.lt.lage(nage)) exit
+         enddo
+
+             nbp=1
+            if ((itramem(jj).eq.jtime).or.(jtime.eq.0)) &
+           call initialize(jtime,idt(jj),uap(jj),ucp(jj),uzp(jj), &
+        us(jj),vs(jj),ws(jj),xtra1(jj),ytra1(jj),ztra1(jj),cbt(jj), &
+!            call initialize(jtime,th_idt,th_uap,th_ucp,th_uzp, &
+!            th_us,th_vs,th_ws,th_xtra1,th_ytra1,th_ztra1,th_cbt, &
+      ngrid,depoindicator,indzindicator,cpt(nbp),ompid,myid,1,mts )
+
+!     print*,'after',th_xtra1,th_ytra1,th_ztra1
+! Memorize particle positions
+!****************************
+
+            xold=xtra1(jj)
+            yold=ytra1(jj)
+            zold=ztra1(jj)
+!            xold=th_xtra1
+!            yold=th_ytra1
+!            zold=th_ztra1
+! Integrate Lagevin equation for lsynctime seconds
+!*************************************************
+!              write(*,*)'numpart,jtime, particle #=',numpart,jtime,j
+
+        call advance(jtime,npoint(jj),idt(jj),uap(jj),ucp(jj),uzp(jj),us(jj), &
+         vs(jj),ws(jj),nstop,xtra1(jj),ytra1(jj),ztra1(jj),prob,cbt(jj), &
+!        call advance(jtime,th_npoint,th_idt,th_uap,th_ucp,th_uzp, &
+!            th_us,th_vs,th_ws,nstop,th_xtra1,&
+!            th_ytra1,th_ztra1,prob,th_cbt, &
+      ngrid,depoindicator,indzindicator,cpt(nbp),ompid,myid,1,mts )
+!       if (jj.eq.103) print*,'aft',th_xtra1,th_ytra1,th_ztra1
+! Calculate the gross fluxes across layer interfaces
+!***************************************************
+
+
+            if (iflux.eq.1) call calcfluxes(nage,jj,xold,yold,zold)
+
+!      if (jj.lt.5) print*,'coord after',myid,th_itra1,th_xmass1(1),DRYDEPSPEC(ks)
+
+! 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(jtime,jj)
+              itra1(jj)=-999999999
+!              th_itra1=-999999999
+            else
+              itra1(jj)=jtime+lsynctime
+!              th_itra1=jtime+lsynctime
+
+
+!      if (jj.lt.5) print*,'coord after2',myid,th_itra1,th_xmass1(1),DRYDEPSPEC(ks)
+! Dry deposition and radioactive decay for each species
+!******************************************************
+          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(jj,ks)*prob(ks)*decfact
+!                  drydeposit(ks)=th_xmass1(ks)*prob(ks)*decfact
+                  xmass1(jj,ks)=xmass1(jj,ks)*(1.-prob(ks))*decfact
+!                  th_xmass1(ks)=th_xmass1(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(jj,ks)=xmass1(jj,ks)*decfact
+!                  th_xmass1(ks)=th_xmass1(ks)*decfact
+                endif
+!      if (jj.lt.5) print*,'coord after3',myid,th_itra1,th_xmass1(1),DRYDEPSPEC(ks),xmass(th_npoint,1)
+
+            if (mdomainfill.eq.0) then
+              if (xmass(npoint(jj),ks).gt.0.) &
+                   xmassfract=max(xmassfract,real(npart(npoint(jj)))* &
+!                  xmassfract=max(xmassfract,real(npart(th_npoint))* &
+                    xmass1(jj,ks)/xmass(npoint(jj),ks))
+!                   th_xmass1(ks)/xmass(th_npoint,ks))
+            else
+              xmassfract=1.
+            endif
+
+            end do
+
+          if (xmassfract.lt.0.000001) then   ! terminate all particles carrying less mass
+            itra1(jj)=-999999999
+!            th_itra1=-999999999
+          endif
+
+  !        Sabine Eckhardt, June 2008
+  !        don't create depofield for backward runs
+          if (DRYDEP.AND.(ldirect.eq.1)) then
+           call drydepokernel(nclass(jj),drydeposit,real(xtra1(jj)), &
+!            call drydepokernel(th_nclass,drydeposit,real(th_xtra1), &
+                 real(ytra1(jj)),itage,nage,kp)
+!                real(th_ytra1),itage,nage,kp)
+            if (nested_output.eq.1) call drydepokernel_nest( &
+              nclass(jj),drydeposit,real(xtra1(jj)),real(ytra1(jj)), &
+!              th_nclass,drydeposit,real(th_xtra1),real(th_ytra1), &
+                 itage,nage,kp)
+          endif
+
+  ! Terminate trajectories that are older than maximum allowed age
+  !***************************************************************
+
+          if (abs(itra1(jj)-itramem(jj)).ge.lage(nageclass)) then
+!          if (abs(th_itra1-th_itramem).ge.lage(nageclass)) then
+            if (linit_cond.ge.1) &
+                  call initial_cond_calc(jtime+lsynctime,jj)
+            itra1(jj)=-999999999
+!            th_itra1=-999999999
+          endif
+      endif
+!!     print*,xtra1(j),th_xtra1,OMP_GET_THREAD_NUM()
+
+      endif
+
+    end do !loop over particles
+
+    endif
+
+
+
+!        call itime(now)
+!        ttime=now(1)*3600+now(2)*60+now(3)-ttime
+        call cpu_time(finish)  
+!      print*,'time',ttime,cpttra,myid,OMP_GET_THREAD_NUM()
+             if (option_verbose.eq.1) then
+       print*,'time',finish-start,cpttra,myid,ompid 
+           endif
+
+! update the drydepo
+            if (DRYDEP.and.ldirect.gt.0) then
+  do ks=1,nspec
+  do kp=1,maxpointspec_act
+    do nage=1,nageclass
+
+      do jy=0,numygrid-1
+        do ix=0,numxgrid-1
+          do l=1,nclassunc
+       drygridunc(ix,jy,ks,kp,l,nage)=drygridunc(ix,jy,ks,kp,l,nage) &
+               +drygridunc2(ix,jy,ks,kp,l,nage)
+          end do
+        end do
+      end do
+    if (nested_output.eq.1) then
+      do jy=0,numygridn-1
+        do ix=0,numxgridn-1
+          do l=1,nclassunc
+       drygriduncn(ix,jy,ks,kp,l,nage)=drygriduncn(ix,jy,ks,kp,l,nage) &
+               +drygriduncn2(ix,jy,ks,kp,l,nage)
+          end do
+        end do
+      end do
+    endif
+    end do
+  end do
+  end do
+
+   endif
+
+  end do !loop over time 
+
+
+  ! Complete the calculation of initial conditions for particles not yet terminated
+  !*****************************************************************************
+
+  do j=1,numpart
+    if (linit_cond.ge.1) call initial_cond_calc(jtime,j)
+  end do
+
+  if (ipout.eq.2) call partoutput(jtime)     ! dump particle positions
+
+  if (linit_cond.ge.1) call initial_cond_output(jtime)   ! 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
+  deallocate(gridunc)
+  deallocate(xpoint1,xpoint2,ypoint1,ypoint2,zpoint1,zpoint2,xmass)
+  deallocate(ireleasestart,ireleaseend,npart,kindz)
+!  deallocate(xmasssave)
+  if (myid.eq.0) then
+  if (nested_output.eq.1) then
+     deallocate(orooutn, arean, volumen)
+     if (ldirect.gt.0) then
+     deallocate(griduncn,drygriduncn,wetgriduncn,drygriduncn2)
+     endif
+  endif
+  if (ldirect.gt.0) then
+      if (allocated(drygridunc)) deallocate(drygridunc)
+      if (allocated(wetgridunc)) deallocate(wetgridunc)
+      if (allocated(drygridunc2)) deallocate(drygridunc2)
+      if (allocated(drygriduncn2)) deallocate(drygriduncn2)
+  endif
+  deallocate(outheight,outheighthalf)
+  deallocate(oroout, area, volume)
+  endif
+end subroutine timemanager
+
+
+
Index: /branches/jerome/src_flexwrf_v3.1/tke_partition_hanna.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/tke_partition_hanna.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/tke_partition_hanna.f90	(revision 16)
@@ -0,0 +1,192 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                *
+!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine,       *
+!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
+!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso,          *
+!* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann,   *
+!*                                                                     *
+!* This file is part of FLEXPART WRF                                   *
+!*                                                                     *
+!* 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 tke_partition_hanna(z, &
+   ust,wst,ol,h,zeta,sigu,sigv,tlu,tlv,tlw, &
+   sigw,dsigwdz,dsigw2dz,uprof,vprof,tkeprof,pttprof,indz,indzp)
+!                      i
+!*******************************************************************************
+!                                                                              *
+!     Computation of \sigma_u,v,w,dsigwdz, and dsigw2dz based on TKE from WRF  *
+!                                                                              *
+!     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                                  *
+!                                                                              *
+!*******************************************************************************
+! 12 JUNE 2007  compute sigu,sigv,sigw,dsigwdz, and dsigw2dz from TKE          *
+! fu2               fraction for u2
+! fv2               fraction for v2
+! fw2               fraction for w2
+!
+! 25 JUNE 2007 merged from hanna_tke and tke_partition.f
+
+!      include 'includepar'
+!      include 'includecom'
+!      include 'includehanna'
+!      include 'includeinterpol'
+  use par_mod
+  use com_mod
+!  use hanna_mod
+!  use interpol_mod
+   implicit none 
+      real :: corr,z,zzz,hanna_sigu,hanna_sigv,hanna_sigw,dz,dz1,dz2
+      real :: fu2(2),fv2(2),fw2(2)
+      real :: siguprof(2),sigvprof(2),sigwprof(2)
+      integer :: k,indz,indzp
+     real :: uprof(nzmax),vprof(nzmax),tkeprof(nzmax),pttprof(nzmax)
+    real :: ust,wst,ol,h,zeta,sigu,sigv,tlu,tlv,tlw
+    real :: sigw,dsigwdz,dsigw2dz
+
+       do k=1,2 
+         fu2(k)=0.333
+         fv2(k)=0.333
+         fw2(k)=0.333        
+         siguprof(k)=0.0
+         sigvprof(k)=0.0
+         sigwprof(k)=0.0
+       enddo
+
+! determine fraction
+       do k=1,2                                   ! k fraction      
+!**********************
+! 1. Neutral conditions
+!**********************
+        if (k .eq. 1) zzz=height(indz)
+        if (k .eq. 2) zzz=height(indzp)
+      if (h/abs(ol).lt.1.) then
+        ust=max(1.e-4,ust)
+        corr=height(indz+k-1)/ust
+        hanna_sigu=1.e-2+2.0*ust*exp(-3.e-4*corr)
+        hanna_sigw=1.e-2+1.3*ust*exp(-2.e-4*corr)
+        hanna_sigv=hanna_sigw
+
+!***********************
+! 2. Unstable conditions
+!***********************
+
+      else if (ol.lt.0.) then
+
+
+! Determine sigmas
+!*****************
+
+        hanna_sigu=1.e-2+ust*(12-0.5*h/ol)**0.33333
+        hanna_sigv=hanna_sigu
+        hanna_sigw=sqrt(1.2*wst**2*(1.-.9*zeta)*height(indz+k-1)/h &
+       **0.66666+(1.8-1.4*height(k)/h)*ust**2)+1.e-2
+
+!*********************
+! 3. Stable conditions
+!*********************
+      else
+        hanna_sigu=1.e-2+2.*ust*(1.-height(indz+k-1)/h)
+        hanna_sigv=1.e-2+1.3*ust*(1.-height(indz+k-1)/h)
+        hanna_sigw=hanna_sigv
+      endif
+        fu2(k)=hanna_sigu**2/(hanna_sigu**2+hanna_sigv**2+hanna_sigw**2)
+        fv2(k)=hanna_sigv**2/(hanna_sigu**2+hanna_sigv**2+hanna_sigw**2)
+        fw2(k)=hanna_sigw**2/(hanna_sigu**2+hanna_sigv**2+hanna_sigw**2)
+      enddo                                          !k fraction
+
+!- compute sigu,v,w
+      do k=1,2             ! siguprof
+        siguprof(k)=max(sqrt(2.0*tkeprof(indz+k-1)*fu2(k)),1.e-2)
+        sigvprof(k)=max(sqrt(2.0*tkeprof(indz+k-1)*fv2(k)),1.e-2)
+        sigwprof(k)=max(sqrt(2.0*tkeprof(indz+k-1)*fw2(k)),1.e-2)
+!C         write(*,*)'z=',height(indz+k-1),'tke=', tkeprof(indz+k-1)
+      enddo                 ! siguprof
+!         write(*,*)'tkeprof=',(tkeprof(k),k=1,nz)
+!- interpolate sigu,sigv, sigw
+          dz=1./(height(indzp)-height(indz))
+          dz1=(z - height(indz))*dz
+          dz2=(height(indzp)-z)*dz 
+           
+          sigu=dz1*siguprof(2)+dz2*siguprof(1)
+          sigv=dz1*sigvprof(2)+dz2*sigvprof(1)
+          sigw=dz1*sigwprof(2)+dz2*sigwprof(1)
+          
+          dsigwdz=max(1.e-10,(sigwprof(2)-sigwprof(1))*dz )          
+          dsigw2dz=max(1.e-10,(sigwprof(2)**2-sigwprof(1)**2)*dz )
+
+!-- compute length scales based on hanna(1982)
+!*************************
+! 1. Neutral conditions
+!**********************
+ 
+      if (h/abs(ol).lt.1.) then
+        tlu=0.5*z/sigw/(1.+1.5e-3*corr)
+        tlv=tlu
+        tlw=tlu
+ 
+!***********************
+! 2. Unstable conditions
+!***********************
+ 
+      else if (ol.lt.0.) then
+ 
+! 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
+        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 tke_partition_hanna
Index: /branches/jerome/src_flexwrf_v3.1/tke_partition_my.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/tke_partition_my.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/tke_partition_my.f90	(revision 16)
@@ -0,0 +1,239 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                *
+!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine,       *
+!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
+!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso,          *
+!* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann,   *
+!*                                                                     *
+!* This file is part of FLEXPART WRF                                   *
+!*                                                                     *
+!* 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 tke_partition_my(z, &
+   ust,wst,ol,h,zeta,sigu,sigv,tlu,tlv,tlw, &
+   sigw,dsigwdz,dsigw2dz,uprof,vprof,tkeprof,pttprof,indz,indzp)
+
+!                      i
+!*******************************************************************************
+!                                                                              *
+!     Computation of \sigma_u,v,w,dsigwdz, and dsigw2dz based on TKE from WRF  *
+!                                                                              *
+!     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                                  *
+!                                                                              *
+!*******************************************************************************
+! 12 JUNE 2007  compute sigu,sigv,sigw,dsigwdz, and dsigw2dz from TKE          *
+! fu2               fraction for u2
+! fv2               fraction for v2
+! fw2               fraction for w2
+!
+! 25 JUNE 2007 merged from hanna_tke and tke_partition.f
+! 11 Sep 2007 implement different formulations for growing and decaying turbulences
+ 
+!      include 'includepar'
+!      include 'includecom'
+!      include 'includehanna'
+!      include 'includeinterpol'
+  use par_mod
+  use com_mod
+! use hanna_mod
+!  use interpol_mod
+
+      implicit none
+      real :: z,zzz,zzz1,dz,dz1,dz2,tke_z,dpttdz
+      real :: fu2,fv2,fw2,ftotal,ygu,ygv,ygm,ygh,yl,ylmax,ysm,ysh
+      real :: siguprof(2),sigvprof(2),sigwprof(2)
+      real :: ya1
+      real :: ya2
+      real :: yb1
+      real :: yb2
+      real :: yc1
+      real :: yse
+      real :: yap
+      real :: e1,e2,e3,e4,e5,rf,rfc,rf1,rf2,ch,cm
+      real :: er,smr,shr,dudz,dvdz,tke_mid
+      integer :: k,indz,indzp
+     real :: uprof(nzmax),vprof(nzmax),tkeprof(nzmax),pttprof(nzmax)
+    real :: ust,wst,ol,h,zeta,sigu,sigv,tlu,tlv,tlw
+    real :: sigw,dsigwdz,dsigw2dz
+
+!      data ya1,ya2,yb1,yb2,yc1,yse,yap/
+!     +   0.92,0.74,16.6,10.1,0.08,0.20,0.17/
+       ya1=0.92
+       ya2=0.74
+       yb1=16.6
+       yb2=10.1
+       yc1=0.08
+       yse=0.20
+       yap=0.17 
+
+!- interpolate tke
+          dz=1./(height(indzp)-height(indz))
+          dz1=(z - height(indz))*dz
+          dz2=(height(indzp)-z)*dz
+ 
+          tke_z=max(0.01,dz1*tkeprof(indzp)+dz2*tkeprof(indz))
+
+!- compute turbulent length scale
+!  yl -- turbulence length scale
+!  ylmax -- max yl
+          yl=0.01
+          ylmax=0.01
+          do k=1,nz-1
+            zzz=0.5*(height(k)+height(k+1))
+            zzz1=height(k+1)-height(k)
+            yl=yl+zzz*sqrt(0.5*(tkeprof(k)+tkeprof(k+1)))*zzz1
+            ylmax=ylmax+zzz1*sqrt(0.5*(tkeprof(k)+tkeprof(k+1)))
+          enddo
+            ylmax=0.1*yl/ylmax
+            yl=0.4*(z+0.1)/(1.0+0.4*(z+0.1)/ylmax)
+            if (pttprof(indzp) .gt. pttprof(indz)) then
+
+              dpttdz = (pttprof(indzp)-pttprof(indz))*dz
+
+              yl=min(yl,0.75*sqrt(2.0*tke_z/(9.8/300.0)/dpttdz))
+!            endif
+!- compute nondimensional vertical gradients
+          dudz=(uprof(indzp)-uprof(indz))*dz
+          dvdz=(vprof(indzp)-vprof(indz))*dz
+         ygu=yl/sqrt(2.0*tke_z)*dudz
+         ygv=yl/sqrt(2.0*tke_z)*dvdz
+         ygm=ygu*ygu+ygv*ygv+0.001       ! in case of zero
+         ygh=-yl*yl/2.0/tke_z*dpttdz*9.8/300.0
+
+!--  compute SM,SH
+!-   sm,sh nondimensional eddy diffusivities
+
+         ysm=1.0-3.0*ya2*(7.0*ya1+yb2)*ygh+ &
+              27.0*ya1*ya2*ya2*(4*ya1+yb2)*ygh*ygh+ &
+              6.0*ya1*ya1*(1.0-3.0*ya2*(yb2-3.0*ya2)*ygh)*ygm
+         ysm=ya1*(1-3*yc1-3*ya2*(yb2*(1-3*yc1)-12*ya1*yc1-3*ya2) &
+                 *ygh)/ysm
+
+         ysh=ya2*(1-6*ya1*ysm*ygm)/(1-3*ya2*ygh*(4*ya1+yb2))   
+
+
+! -- compute the equlibrium TKE, er 
+        e1=yb1-6.0*ya1
+        e2=12*ya1+yb1+3.0*yb2
+        e3=yb1*(1.0-3.0*yc1)-6.0*ya1
+        e4=yb1*(1.0-3.0*yc1)+12*ya1+9.0*ya2
+        e5=yb1+3.0*ya1+3.0*yb2
+        ch=ya2*e2/yb1
+        cm=ya1*e4/ya2/e5
+        rf1=e3/e4
+        rf2=e1/e5
+        rfc=e1/e2
+        rf=-(ysh/ysm)*( ygh/ygm )
+!          write(*,*)'ysh,ysm',ysh,ysm
+!          write(*,*)'ygh,ygm,dpttdz, ptt',ygh,ygm,dpttdz,pttprof(indzp)
+!          if (rf .le. 0) write(*,*)'aaaaaaaaaaaaaaa'        
+        shr = 0.0
+        if (rf .ge. rfc) then 
+            shr=ch*1.0e-4            ! Ri > critical value, then =
+        elseif ((1.0-rf) .ne. 0.0) then
+            shr=ch*(rfc-rf)/(1.0-rf)
+        endif
+
+        smr = 0.0
+        if (rf .ge. rf1) then 
+           smr=cm*shr*1.0e-4
+        elseif((rf2-rf) .ne. 0.0 .and. rf .lt. rf2) then 
+           smr=cm*(rf1-rf)/(rf2-rf)*shr
+        endif
+        
+        er=0.5*yb1*yl*yl*(smr*dudz*dudz*dvdz*dvdz- &
+                          shr*dpttdz*9.8/300.0)
+        er=max(er,0.01)
+        if (tke_z .ge. er ) then                    ! decaying turbuelnce  
+          tke_mid=tke_z
+        else
+          tke_mid=er
+          ysm=sqrt(tke_z/er)*smr
+          ysh=sqrt(tke_z/er)*shr
+        endif 
+ 
+!- fractions of u2,v2,w2
+!        print*,'in tke',tke_mid,ya1,ysm,ygm,ysh,ygh,ygu
+         fu2=0.333-2*ya1*(ysm*ygm+ysh*ygh)+6*ya1*ysm*ygu*ygu
+         fv2=0.333-2*ya1*(ysm*ygm+ysh*ygh)+6*ya1*ysm*ygv*ygv
+         fw2=0.333-2*ya1*(ysm*ygm+ysh*ygh)+6*ya1*ysh*ygh
+!        fw2=0.333-2*ya1*(ysm*ygm+ysh*ygh)+6*ya1*ysm*ygh*ygh
+!        fw2=fw2*0.5
+         if(fu2*fv2*fw2 .le. 0.0) then 
+           fu2=0.333
+           fv2=0.333
+           fw2=0.333
+         endif
+
+        else ! test on pttprof
+
+           fu2=0.333
+           fv2=0.333
+           fw2=0.333
+          tke_mid=tke_z
+        endif
+          !ftotal=(fu2+fv2+fw2)
+          !fu2=fu2/ftotal
+          !fv2=fv2/ftotal
+          !fw2=fw2/ftotal
+
+! JB: make the partitionning equal
+!          fu2=0.333
+!          fv2=0.333
+!          fw2=0.333
+!
+         sigu=sqrt(2.0*tke_mid*fu2)
+         sigv=sqrt(2.0*tke_mid*fv2)
+         sigw=sqrt(2.0*tke_mid*fw2)
+
+         tlu=2.0*yl/sigu
+         tlv=2.0*yl/sigv
+         tlw=2.0*yl/sigw
+
+         tlu=max(10.,tlu)
+         tlv=max(10.,tlv)
+         tlw=max(30.,tlw)
+
+!- dsigw/dz,dsigw2/dz ; assuming fraction is not changed
+
+         dsigwdz=(sqrt(2.0*tkeprof(indzp)*fw2)- &
+                  sqrt(2.0*tkeprof(indz)*fw2))*dz
+         dsigwdz=max(1.0e-10,dsigwdz)
+
+         dsigw2dz=(2.0*tkeprof(indzp)*fw2-2.0*tkeprof(indz)*fw2)*dz
+         dsigw2dz=max(1.0e-10,dsigw2dz)
+
+!         write(*,*)'tke=',tke_z, 'er=',er
+!         write(*,*)'rfc,rf1,rf2,rf=',rfc,rf1,rf2,rf
+!          write(*,*)'smr=',smr,'ysm=',ysm
+!         write(*,*)'shr=',shr,'ysh=',ysh
+!         write(*,*)'fu2,fv2,fw2=',fu2,fv2,fw2
+!         write(*,*)'ftotal=',ftotal
+!         if (fu2*fv2*fw2 .le. 0) stop
+end subroutine tke_partition_my
Index: /branches/jerome/src_flexwrf_v3.1/unc_mod.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/unc_mod.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/unc_mod.f90	(revision 16)
@@ -0,0 +1,37 @@
+!**********************************************************************
+! 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 (:,:,:,:,:,:) :: drygridunc2
+  real,allocatable, dimension (:,:,:,:,:,:) :: drygriduncn2
+  real,allocatable, dimension (:,:,:,:,:,:) :: wetgridunc
+  real,allocatable, dimension (:,:,:,:,:,:) :: wetgriduncn
+
+  real,allocatable, dimension (:,:,:,:,:) :: init_cond
+
+end module unc_mod
Index: /branches/jerome/src_flexwrf_v3.1/verttransform.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/verttransform.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/verttransform.f90	(revision 16)
@@ -0,0 +1,874 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                *
+!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine,       *
+!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
+!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso,          *
+!* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann,   *
+!*                                                                     *
+!* This file is part of FLEXPART WRF                                   *
+!*                                                                     *
+!* 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,divh)
+!                              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.             *
+!                                                                              *
+!     Note:  This is the FLEXPART_WRF version of subroutine assignland.        *
+!            The computational grid is the WRF x-y grid rather than lat-lon.   *
+!                                                                              *
+!     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          *
+!                                                                              *
+!     Oct-Nov 2005 - R. Easter - conversion to wrf                             *
+!     17 Nov 2005 - R. Easter - terrain correction applied to ww.  There are   *
+!            now 3 options, controlled by "method_w_terrain_correction"        *
+!                                                                              *
+!     11 June 2007,  conversion of tkeh to tke
+!     25 June 2007   conversion of ptth to ptt
+!     Jan 2012, J Brioude:  modified to handle different wind options and openmp 
+!*******************************************************************************
+!                                                                              *
+! 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]                        *
+!                                                                              *
+!*******************************************************************************
+
+  use par_mod
+  use com_mod
+!      include 'includepar'
+!      include 'includecom'
+
+  implicit none
+
+      integer :: ix,jy,kz,iz,n,kmin,kl,klp,ix1,jy1,ixp,jyp,ixm,jym
+! CDA 
+      integer :: icloudtop
+
+      integer :: method_z_compute,aa
+      real :: uvzlev(nuvzmax),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
+      real :: uuaux,vvaux,uupolaux,vvpolaux,ddpol,ffpol,wdummy
+      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)
+   real(kind=4) :: divh(0:nxmax-1,0:nymax-1,nuvzmax)
+
+!     real :: uuh(0:nxmax-1,0:nymax-1,nuvzmax)
+!     real :: divh(0:nxmax-1,0:nymax-1,nuvzmax)
+      real :: div(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 :: wwh_svaa(nwzmax), wtc_stat(4,nzmax),u,v
+      real,parameter :: const=r_air/ga
+! CDA cloud commented
+!      integer :: rain_cloud_above,kz_inv
+
+      integer :: kz_inv
+      real :: f_qvsat,pressure
+! CDA some new declarations and mods
+!      real :: rh,lsp,convp
+      real :: rh,lsp,convp,prec,rhmin
+      real,parameter :: precmin = 0.002
+
+
+
+      logical :: init = .true.
+! CDA
+      logical :: lconvectprec = .true.
+
+
+
+! set method_w_terrain_correction  & method_z_compute
+      method_w_terrain_correction = 20
+      method_z_compute = 10
+       aa=0
+      do iz = 1, nz
+      do ix = 1, 4
+          wtc_stat(ix,iz) = 0.0
+      end do
+      end do
+
+
+!*************************************************************************
+! 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, and of the interfaces, where w is given. So,   *
+! the vertical resolution in the z system is doubled. As reference point,*
+! the lower left corner of the grid is used.                             *
+! Unlike in the eta system, no difference between heights for u,v and    *
+! heights for w exists.                                                  *
+!*************************************************************************
+
+      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
+!
+! FLEXPART_WRF - use grid point with highest surface pressure
+!**************************************************************************************
+
+        pint = -1.0
+        ixm = -999888777
+        jym = -999888777
+        do jy=0,nymin1
+          do ix=0,nxmin1
+!           if (ps(ix,jy,1,n).gt.100000.) then
+            if (ps(ix,jy,1,n).gt.pint) then
+              pint = ps(ix,jy,1,n)
+              ixm=ix
+              jym=jy
+!             goto 3
+            endif
+         enddo
+         enddo
+3       continue
+!       write(*,'(/a,2i4,1pe11.2)') 
+!    &          'verttransform -- ixm,jym,ps() =', ixm, jym, pint
+
+
+        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
+! use pressure from wrf met file
+!         pint=akz(kz)+bkz(kz)*ps(ixm,jym,1,n)
+          pint=pph(ixm,jym,kz,n)
+          tv=tth(ixm,jym,kz,n)*(1.+0.608*qvh(ixm,jym,kz,n))
+
+
+! 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.
+! Note that two more changes are necessary in this subroutine below.
+! One change is also necessary in gridcheck.f, and another one in verttransform_nests.
+!*************************************************************************************
+
+          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
+
+! 
+! *** NOTE -- the doubled vertical resolution has not been tested in FLEXPART_WRF
+! 
+! Switch on following lines to use doubled vertical resolution
+!*************************************************************
+!         if (abs(tv-tvold).gt.0.2) then
+!           height((kz-1)*2)=
+!    +      height(max((kz-2)*2,1))+const*log(pold/pint)*
+!    +      (tv-tvold)/log(tv/tvold)
+!         else
+!           height((kz-1)*2)=height(max((kz-2)*2,1))+
+!    +      const*log(pold/pint)*tv
+!         endif
+! End doubled vertical resolution
+ 
+! FLEXPART_WRF - get height from zzh
+          if (method_z_compute .eq. 10) then
+             if ((add_sfc_level .eq. 1) .and. (kz .eq. 2)) then
+                height(kz) = 0.5*(zzh(ixm,jym,   3,n)+zzh(ixm,jym, 1,n)) &
+                           - zzh(ixm,jym,1,n)
+             else
+                height(kz) = 0.5*(zzh(ixm,jym,kz+1,n)+zzh(ixm,jym,kz,n)) &
+                           - zzh(ixm,jym,1,n)
+             end if
+          end if
+
+          tvold=tv
+          pold=pint
+         enddo
+           do kz=1,nz-1
+         heightmid(kz)=0.5*(height(kz)+height(kz+1))
+          enddo
+! 
+! *** NOTE -- the doubled vertical resolution has not been tested in FLEXPART_WRF
+! 
+! Switch on following lines to use doubled vertical resolution
+!*************************************************************
+!       do 7 kz=3,nz-1,2
+!         height(kz)=0.5*(height(kz-1)+height(kz+1))
+!       height(nz)=height(nz-1)+height(nz-1)-height(nz-2)
+! End doubled vertical resolution
+
+
+! 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
+!*************************
+
+!!!$OMP PARALLEL DEFAULT(SHARED) &
+!!!$OMP PRIVATE(ix,jy,ixm,jym,tvold,pold,pint,tv,rhoh,uvzlev,wzlev, &
+!!!$OMP uvwzlev,pinmconv,kz,iz,kmin,dz1,dz2,dz,ix1,jy1,ixp,jyp, &
+!!!$OMP dzdy,dzdx,aa,u,v,wwh_svaa )
+!!!$OMP DO
+      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)
+          uvzlev(1)=0.
+          wzlev(1)=0.
+          rhoh(1)=pold/(r_air*tvold)
+
+
+! Compute heights of eta levels
+!******************************
+
+          do kz=2,nuvz
+! use pressure from wrf met file
+!           pint=akz(kz)+bkz(kz)*ps(ix,jy,1,n)
+            pint=pph(ix,jy,kz,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
+              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
+          pold=pint
+      end do
+
+
+          do kz=2,nwz-1
+          wzlev(kz)=(uvzlev(kz+1)+uvzlev(kz))/2.
+      end do
+
+          wzlev(nwz)=wzlev(nwz-1)+ &
+          uvzlev(nuvz)-uvzlev(nuvz-1)
+
+! FLEXPART_WRF - get uvzlev & wzlev from zzh
+          if (method_z_compute .eq. 10) then
+            do kz = 2, nuvz
+              if ((add_sfc_level .eq. 1) .and. (kz .eq. 2)) then
+                uvzlev(kz) = 0.5*(zzh(ix,jy,   3,n) + zzh(ix,jy, 1,n)) &
+                           - zzh(ix,jy,1,n)
+              else
+                uvzlev(kz) = 0.5*(zzh(ix,jy,kz+1,n) + zzh(ix,jy,kz,n)) &
+                           - zzh(ix,jy,1,n)
+              end if
+            end do
+            do kz = 2, nwz
+              wzlev(kz) = zzh(ix,jy,kz+add_sfc_level,n)  &
+                        - zzh(ix,jy,1,n)
+            end do
+          end if
+
+          uvwzlev(ix,jy,1)=0.0
+          do kz=2,nuvz
+          uvwzlev(ix,jy,kz)=uvzlev(kz)
+      end do
+
+!     if ((ix .eq. ixm) .and. (jy .eq. jym)) then
+!        write(*,'(/a)') 
+!    &     'kz, height, uvzlev, wzlev, zzh-zzh(1) at ixm,jym  (in km)'
+!        write(*,'(i3,4f8.3)') (kz, height(kz)*1.0e-3, 
+!    &     uvzlev(kz)*1.0e-3, wzlev(kz)*1.0e-3,
+!    &     (zzh(ix,jy,kz,n)-zzh(ix,jy,1,n))*1.0e-3, kz=nz,1,-1)
+!        ixm = -9
+!     end if
+
+! Switch on following lines to use doubled vertical resolution
+! Switch off the three lines above.
+!*************************************************************
+!22          uvwzlev(ix,jy,(kz-1)*2)=uvzlev(kz)
+!          do 23 kz=2,nwz
+!23          uvwzlev(ix,jy,(kz-1)*2+1)=wzlev(kz)
+! End doubled vertical resolution
+
+! pinmconv=(h2-h1)/(p2-p1)
+!
+! in flexpart_ecmwf, pinmconv is used to convert etadot to w
+! in FLEXPART_WRF, vertical velocity is already m/s, so pinmconv=1.0
+
+          if (wind_option.le.0) then
+          pinmconv(1)=1.0
+          do kz=2,nz-1
+             pinmconv(kz)=1.0
+          enddo
+          pinmconv(nz)=1.0
+          elseif (wind_option.ge.1) then
+
+!         pinmconv(1)=(uvzlev(1+add_sfc_level)-0.) & 
+!         /(eta_u_wrf(1)-1.)
+          pinmconv(1)=(wzlev(2)-0.) &
+          /(eta_w_wrf(2)-1.)
+          do kz=2,nz-1
+
+!          pinmconv(kz)=(uvzlev(kz+add_sfc_level)-uvzlev(kz-1+add_sfc_level)) & 
+!          /(eta_u_wrf(kz)-eta_u_wrf(kz-1))
+!          /(pph(ix,jy,kz+add_sfc_level,n)-pph(ix,jy,kz-1+add_sfc_level,n)) &
+!          *(pph(ix,jy,1,n)-pph(ix,jy,nz,n))
+!          *(ps(ix,jy,1,n)-p_top_wrf)
+
+          pinmconv(kz)=(wzlev(kz+1)-wzlev(kz-1)) &
+          /(eta_w_wrf(kz+1)-eta_w_wrf(kz-1))
+           enddo   
+
+          pinmconv(nwz)=pinmconv(nwz-1) ! 
+          endif
+! 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)
+          div(ix,jy,1)=divh(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)
+          tke(ix,jy,1,n)=tkeh(ix,jy,1,n)
+          tke(ix,jy,nz,n)=tkeh(ix,jy,nuvz,n)
+          ptt(ix,jy,1,n)=ptth(ix,jy,1,n)
+          ptt(ix,jy,nz,n)=ptth(ix,jy,nuvz,n)
+
+
+           kmin=2
+          do iz=2,nz-1
+            do kz=kmin,nuvz
+              if(heightmid(iz).gt.uvzlev(nuvz)) then
+               div(ix,jy,iz)=div(ix,jy,nz)
+                goto 230
+              endif
+              if ((heightmid(iz).gt.uvzlev(kz-1)).and. &
+                  (heightmid(iz).le.uvzlev(kz))) then
+               dz1=heightmid(iz)-uvzlev(kz-1)
+               dz2=uvzlev(kz)-heightmid(iz)
+               dz=dz1+dz2
+          div(ix,jy,iz)=(divh(ix,jy,kz-1)*dz2+divh(ix,jy,kz)*dz1)/dz
+               kmin=kz
+           goto 230
+          endif
+        end do
+230      continue
+      end do
+
+           kmin=2
+          do iz=2,nz-1
+            do kz=kmin,nuvz
+              if(height(iz).gt.uvzlev(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)
+                tke(ix,jy,iz,n)=tke(ix,jy,nz,n)
+                ptt(ix,jy,iz,n)=ptt(ix,jy,nz,n)
+
+                goto 30
+              endif
+              if ((height(iz).gt.uvzlev(kz-1)).and. &
+                  (height(iz).le.uvzlev(kz))) then
+               dz1=height(iz)-uvzlev(kz-1)
+               dz2=uvzlev(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
+               tke(ix,jy,iz,n)=(tkeh(ix,jy,kz-1,n)*dz2 &
+                    +tkeh(ix,jy,kz,n)*dz1)/dz
+               ptt(ix,jy,iz,n)=(ptth(ix,jy,kz-1,n)*dz2 &
+                    +ptth(ix,jy,kz,n)*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)*dz2*pinmconv(kz-1)
+!!    +  +wwh(ix,jy,kz)*dz1*pinmconv(kz))/dz
+!               kmin=kz
+!               goto 40
+!              endif
+!        end do
+!40      continue
+!      end do
+
+          if (method_w_terrain_correction .eq. 20) then
+! apply w correction assuming that the WRF w is "absolute w";
+! apply it here to wwh; set wwh=0 at iz=1
+!            do iz = 1, nz
+!               wtc_stat(1,iz) = wtc_stat(1,iz) + ww(ix,jy,iz,n)
+!               wtc_stat(2,iz) = wtc_stat(2,iz) + abs(ww(ix,jy,iz,n))
+!            end do
+
+!             if ((ix.eq.0) .and. (jy.eq.0)) write(*,*) 
+!     &            'verttransform doing method_w_terrain_correction =', 
+!     &            method_w_terrain_correction
+             ix1 = max( ix-1, 0 )
+             jy1 = max( jy-1, 0 )
+             ixp = min( ix+1, nx-1 )
+             jyp = min( jy+1, ny-1 )
+          if (wind_option.eq.0) then
+            dzdx=(oro(ixp,jy) - oro(ix1,jy))/(dx*(ixp-ix1)*m_x(ix,jy,1))
+            dzdy=(oro(ix,jyp) - oro(ix,jy1))/(dy*(jyp-jy1)*m_y(ix,jy,1))
+             do kz = 1, nwz-1
+                wwh_svaa(kz) = wwh(ix,jy,kz)
+                wwh(ix,jy,kz) = wwh(ix,jy,kz)*pinmconv(kz) &
+!               wwh(ix,jy,kz) = 
+              - (uuh(ix,jy,kz)*dzdx + vvh(ix,jy,kz)*dzdy)   !this is correct. term of variation of geopot not necessary
+
+                if (kz .eq. 1) wwh(ix,jy,kz) = 0.0
+              aa=aa+1
+             end do
+          elseif (wind_option.ge.1) then
+             do kz = 2, nwz-1
+                wwh_svaa(kz) = wwh(ix,jy,kz)
+!             dzdx=(zzh(ixp,jy,kz,n) - zzh(ix1,jy,kz,n))
+!     +  /(dx*(ixp-ix1))
+!             dzdy=(zzh(ix,jyp,kz,n) - zzh(ix,jy1,kz,n))
+!     +  /(dy*(jyp-jy1))
+!             dzdx=(zzh(ixp,jy,kz,n) - zzh(ix1,jy,kz,n)-zzh(ixp,jy,1,n) &
+!        +zzh(ix1,jy,1,n)) &
+!        /(dx*(ixp-ix1)*m_x(ix,jy,1))
+!             dzdy=(zzh(ix,jyp,kz,n) - zzh(ix,jy1,kz,n)-zzh(ix,jyp,1,n) &
+!        +zzh(ix,jy1,1,n)) &
+!        /(dy*(jyp-jy1)*m_y(ix,jy,1))
+
+        dzdx=(zzh(ixp,jy,kz+add_sfc_level,n) - zzh(ix1,jy,kz+add_sfc_level,n) & 
+             -zzh(ixp,jy,1,n)+zzh(ix1,jy,1,n))/(dx*(ixp-ix1)*m_x(ix,jy,1))
+        dzdy=(zzh(ix,jyp,kz+add_sfc_level,n) - zzh(ix,jy1,kz+add_sfc_level,n)  &
+             -zzh(ix,jyp,1,n)+zzh(ix,jy1,1,n))/(dy*(jyp-jy1)*m_y(ix,jy,1))
+           u=0.5*(uuh(ix,jy,kz+add_sfc_level)+uuh(ix,jy,kz-1+add_sfc_level))
+           v=0.5*(vvh(ix,jy,kz+add_sfc_level)+vvh(ix,jy,kz-1+add_sfc_level))
+                wwh(ix,jy,kz) = wwh(ix,jy,kz)*pinmconv(kz)  &
+            + (u*dzdx + v*dzdy) ! variation of geopot on sigma is necessary
+
+!                wwh(ix,jy,kz) = wwh(ix,jy,kz)*pinmconv(kz) &
+!           + (uuh(ix,jy,kz)*dzdx + vvh(ix,jy,kz)*dzdy) ! variation of geopot on sigma is necessary
+!            if (kz .eq. 1) wwh(ix,jy,kz) = 0.0
+             if (kz .eq. 1) wwh(ix,jy,kz) = wwh(ix,jy,kz)*pinmconv(kz)
+!             aa=aa+1
+             end do
+         endif
+         if (wind_option.eq.-1) then
+!        ww(ix,jy,1,n)=wwh(ix,jy,1)
+         ww(ix,jy,1,n)=0.
+         do iz=2,nz
+         ww(ix,jy,iz,n)=ww(ix,jy,iz-1,n)-(height(iz)-height(iz-1))* &
+        div(ix,jy,iz-1)
+         enddo
+         else
+
+             ww(ix,jy,1,n)=wwh(ix,jy,1)
+             ww(ix,jy,nz,n)=wwh(ix,jy,nwz)
+             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)*dz2 &
+        +wwh(ix,jy,kz)*dz1) &
+                    /dz
+                  kmin=kz
+           goto 4000
+          endif
+        end do
+4000      continue
+      end do
+           endif
+
+!             do kz = 1, nwz
+!                wwh(ix,jy,kz) = wwh_svaa(kz)
+!             end do
+
+!            do iz = 1, nz
+!               wtc_stat(3,iz) = wtc_stat(3,iz) + ww(ix,jy,iz,n)
+!               wtc_stat(4,iz) = wtc_stat(4,iz) + abs(ww(ix,jy,iz,n))
+!            end do
+          end if
+
+! 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
+!!!$OMP END DO
+!!!$OMP END PARALLEL
+
+!****************************************************************
+! Compute slope of eta levels in windward direction and resulting
+! vertical wind correction
+!
+! The ECMWF model uses a hybrid-pressure vertical coordinate, "eta"
+!    The "eta" coordinate transitions from terrain-following near
+!    the surface to constant pressure in the stratosphere.
+!    The vertical velocities in the ECMWF grib files are "eta_dot"
+! FLEXPART uses a "height above ground" vertical coordinate
+!    which we will call "hag".
+!    The vertical velocity is uses (in ww array) is "hag_dot".
+! Converting from eta_dot to hag_dot involves
+!    >> multiplying by pinmconv = [d(hag)/d(eta)]
+!    >> adding a term that accounts for the fact that
+!       "eta" varies on constant "hag" surfaces.
+!       This term is [u*d(hag)/dx + v*d(hag)/dy], with the
+!       partial derivatives taken with "eta" being constant
+!
+! The WRF model uses a similar (to ECMWF) vertical coordinate.
+!    HOWEVER, the vertical velocities in the WRF output files
+!    are the "true/absolute w" in m/s.  (Is this true?)
+! Converting from "absolute w" to hag_dot involves
+!    adding a term that accounts for the fact that
+!    "absolute z" varies on constant "hag" surfaces.
+!    This term is [- u*d(oro)/dx - v*d(oro)/dy]
+!
+! The FLEXPART code did not apply the terrain corrections
+!    at jy=0 & ny-1; ix=0 & nx-1; iz=1 & nz.
+! FLEXPART_WRF applies the correction at all grid points
+!****************************************************************
+
+
+! If north pole is in the domain, calculate wind velocities in polar
+! stereographic coordinates
+!*******************************************************************
+ 
+      if (nglobal) then
+        write(*,*)
+        write(*,*) '*** stopping in verttransform ***'
+        write(*,*) '    the nglobal code section should not be active'
+        write(*,*)
+        stop
+!        do 74 jy=int(switchnorthg)-2,nymin1
+!          ylat=ylat0+real(jy)*dy
+!          do 74 ix=0,nxmin1
+!            xlon=xlon0+real(ix)*dx
+!            do 74 iz=1,nz
+!74            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))
+!
+!
+!        do 76 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
+!          else
+!            ddpol=pi+atan(uu(nx/2-1,nymin1,iz,n)/
+!     &                    vv(nx/2-1,nymin1,iz,n))-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 76 ix=0,nxmin1
+!            uupol(ix,jy,iz,n)=uupolaux
+!            vvpol(ix,jy,iz,n)=vvpolaux
+!76      continue
+! 
+! 
+!* Fix: Set W at pole to the zonally averaged W of the next equator-
+!* ward parallel of latitude
+! 
+!      do 85 iz=1,nz
+!          wdummy=0.
+!          jy=ny-2
+!          do 80 ix=0,nxmin1
+!80          wdummy=wdummy+ww(ix,jy,iz,n)
+!          wdummy=wdummy/real(nx)
+!          jy=nymin1
+!          do 85 ix=0,nxmin1
+!85          ww(ix,jy,iz,n)=wdummy
+ 
+      endif 
+
+ 
+! If south pole is in the domain, calculate wind velocities in polar
+! stereographic coordinates
+!*******************************************************************
+ 
+      if (sglobal) then
+        write(*,*)
+        write(*,*) '*** stopping in verttransform ***'
+        write(*,*) '    the sglobal code section should not be active'
+        write(*,*)
+        stop
+!        do 77 jy=0,int(switchsouthg)+3
+!          ylat=ylat0+real(jy)*dy
+!          do 77 ix=0,nxmin1
+!            xlon=xlon0+real(ix)*dx
+!            do 77 iz=1,nz
+!77            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))
+!      
+!        do 79 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
+!          else
+!            ddpol=pi+atan(uu(nx/2-1,0,iz,n)/
+!     &                    vv(nx/2-1,0,iz,n))+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 79 ix=0,nxmin1
+!            uupol(ix,jy,iz,n)=uupolaux
+!79          vvpol(ix,jy,iz,n)=vvpolaux
+! 
+! 
+!* Fix: Set W at pole to the zonally averaged W of the next equator-
+!* ward parallel of latitude
+! 
+!        do 95 iz=1,nz
+!          wdummy=0.
+!          jy=1
+!          do 90 ix=0,nxmin1
+!90          wdummy=wdummy+ww(ix,jy,iz,n)
+!          wdummy=wdummy/real(nx)
+!          jy=0
+!          do 95 ix=0,nxmin1
+!95          ww(ix,jy,iz,n)=wdummy
+      endif
+
+  !write (*,*) 'initializing clouds, n:',n,nymin1,nxmin1,nz^M
+  !   create a cloud and rainout/washout field, clouds occur where rh>80%^M
+  !   total cloudheight is stored at level 0^M
+    do 100 jy=0,nymin1
+      do 100 ix=0,nxmin1
+!        rain_cloud_above=0
+        lsp=lsprec(ix,jy,1,n)  
+        convp=convprec(ix,jy,1,n)
+!        cloudsh(ix,jy,n)=0
+
+          prec=lsp+convp
+          if (lsp.gt.convp) then !  prectype='lsp'
+            lconvectprec = .false.
+          else ! prectype='cp '
+            lconvectprec = .true.
+          endif
+          rhmin = 0.90 ! standard condition for presence of clouds
+
+!CPS       note that original by Sabine Eckhart was 80%
+!CPS       however, for T<-20 C we consider saturation over ice
+!CPS       so I think 90% should be enough
+
+
+          icloudbot(ix,jy,n)=icmv
+          icloudtop=icmv ! this is just a local variable
+98        do kz=1,nz
+            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))
+!cps            if (prec.gt.0.01) print*,'relhum',prec,kz,rh,height(kz)
+            if (rh .gt. rhmin) then
+              if (icloudbot(ix,jy,n) .eq. icmv) then
+                icloudbot(ix,jy,n)=nint(height(kz))
+              endif
+              icloudtop=nint(height(kz)) ! use int to save memory
+            endif
+          enddo
+
+
+!CPS try to get a cloud thicker than 50 m
+!CPS if there is at least .01 mm/h  - changed to 0.002 and put into
+!CPS parameter precpmin
+          if ((icloudbot(ix,jy,n) .eq. icmv .or. &
+               icloudtop-icloudbot(ix,jy,n) .lt. 50) .and. &
+               prec .gt. precmin) then
+            rhmin = rhmin - 0.05
+            if (rhmin .ge. 0.30) goto 98 ! give up for <= 25% rel.hum.
+          endif
+!CPS implement a rough fix for badly represented convection
+!CPS is based on looking at a limited set of comparison data
+          if (lconvectprec .and. icloudtop .lt. 6000 .and. &
+              prec .gt. precmin) then
+            if (convp .lt. 0.1) then
+              icloudbot(ix,jy,n) = 500
+              icloudtop =         8000
+            else
+              icloudbot(ix,jy,n) = 0
+              icloudtop =      10000
+            endif
+          endif
+          if (icloudtop .ne. icmv) then
+            icloudthck(ix,jy,n) = icloudtop-icloudbot(ix,jy,n)
+          else
+            icloudthck(ix,jy,n) = icmv
+          endif
+!CPS  get rid of too thin clouds
+          if (icloudthck(ix,jy,n) .lt. 50) then
+            icloudbot(ix,jy,n)=icmv
+            icloudthck(ix,jy,n)=icmv
+          endif
+
+100   continue
+
+
+
+
+
+
+!       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/jerome/src_flexwrf_v3.1/verttransform_nests.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/verttransform_nests.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/verttransform_nests.f90	(revision 16)
@@ -0,0 +1,511 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                *
+!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine,       *
+!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
+!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso,          *
+!* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann,   *
+!*                                                                     *
+!* This file is part of FLEXPART WRF                                   *
+!*                                                                     *
+!* 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,divhn)
+!                                    i   i    i    i   i
+!*******************************************************************************
+!                                                                              *
+! Note:  This is the FLEXPART_WRF version of subroutine verttransform_nests.   *
+!     The computational grid is the WRF x-y grid rather than lat-lon.          *
+!                                                                              *
+!     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        *
+!                                                                              *
+!     16 Nov 2005, R. Easter - changes for FLEXPART_WRF                        *
+!     17 Nov 2005 - R. Easter - terrain correction applied to ww.  There are   *
+!            now 3 options, controlled by "method_w_terrain_correction"        *
+!                                                                              *
+!     11 June 2007  --  convert TKEhn to tken
+!     25 June 2007  --  convert ptthn to pttn
+!     Jan 2012, J Brioude:  modified to handle different wind options and openmp 
+!*******************************************************************************
+!                                                                              *
+! 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
+
+!      include 'includepar'
+!      include 'includecom'
+    implicit none
+     integer :: ix,jy,kz,iz,n,l,kmin,kl,klp,ix1,jy1,ixp,jyp,ixm,jym
+     integer :: icloudtop
+     real :: rh,lsp,convp,prec,rhmin
+     integer :: method_z_compute,aa,dimx,dimy
+     real :: uvzlev(nuvzmax),wzlev(nwzmax),rhoh(nuvzmax),pinmconv(nzmax)
+     real :: uvwzlev(0:nxmaxn-1,0:nymaxn-1,nzmax)
+     real :: ew,pint,tv,tvold,pold,const,dz1,dz2,dz,ui,vi
+     real :: dzdx,dzdy
+     real :: dzdx1,dzdx2,dzdy1,dzdy2
+     real :: pvhn(0:nxmaxn-1,0:nymaxn-1,nuvzmax,maxnests)
+     real :: divn(0:nxmaxn-1,0:nymaxn-1,nuvzmax,maxnests)
+     real(kind=4) :: uuhn(0:nxmaxn-1,0:nymaxn-1,nuvzmax,maxnests)
+     real(kind=4) :: vvhn(0:nxmaxn-1,0:nymaxn-1,nuvzmax,maxnests)
+     real(kind=4) :: wwhn(0:nxmaxn-1,0:nymaxn-1,nwzmax,maxnests)
+     real(kind=4) :: divhn(0:nxmaxn-1,0:nymaxn-1,nuvzmax,maxnests)
+     real :: wwhn_svaa(nwzmax),u,v
+     parameter(const=r_air/ga)
+!      integer :: rain_cloud_above,kz_inv
+
+      real :: f_qvsat,pressure
+!      real :: rh,lsp,convp
+      real,parameter :: precmin = 0.002
+
+! CDA
+      logical :: lconvectprec = .true.
+
+
+! set method_z_compute
+      method_z_compute = 10
+
+
+! Loop over all nests
+!********************
+
+      do l=1,numbnests
+        dimy=nyn(l)-1
+        dimx=nxn(l)-1
+!      print*,'start omp '
+! Loop over the whole grid
+!*************************
+!!!$OMP PARALLEL DEFAULT(SHARED) &
+!!!$OMP PRIVATE(ix,jy,ixm,jym,tvold,pold,pint,tv,rhoh,uvzlev,wzlev, &
+!!!$OMP uvwzlev,pinmconv,kz,iz,kmin,dz1,dz2,dz,ix1,jy1,ixp,jyp, &
+!!!$OMP dzdy,dzdx,aa,u,v )
+!$OMP DO
+      do jy=0,dimy
+        do ix=0,dimx
+
+           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)
+          uvzlev(1)=0.
+          wzlev(1)=0.
+          rhoh(1)=pold/(r_air*tvold)
+
+
+! Compute heights of eta levels
+!******************************
+
+          do kz=2,nuvz
+! FLEXPART_WRF - pphn hold pressure
+!           pint=akz(kz)+bkz(kz)*psn(ix,jy,1,n,l)
+            pint=pphn(ix,jy,kz,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
+              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
+            pold=pint
+      end do
+
+
+!      print*,'etap 1',ix,jy
+
+          do kz=2,nwz-1
+            wzlev(kz)=(uvzlev(kz+1)+uvzlev(kz))/2.
+      end do
+          wzlev(nwz)=wzlev(nwz-1)+ &
+          uvzlev(nuvz)-uvzlev(nuvz-1)
+
+! FLEXPART_WRF - get uvzlev & wzlev from zzh
+          if (method_z_compute .eq. 10) then
+            do kz = 2, nuvz
+              if ((add_sfc_level .eq. 1) .and. (kz .eq. 2)) then
+                uvzlev(kz) = 0.5*(zzhn(ix,jy,3,n,l) +  &
+                                  zzhn(ix,jy,1,n,l)) &
+                           - zzhn(ix,jy,1,n,l)
+              else
+                uvzlev(kz) = 0.5*(zzhn(ix,jy,kz+1,n,l) + &
+                                  zzhn(ix,jy,kz  ,n,l)) &
+                           - zzhn(ix,jy,1,n,l)
+              end if
+            end do
+            do kz = 2, nwz
+              wzlev(kz) = zzhn(ix,jy,kz+add_sfc_level,n,l)  &
+                        - zzhn(ix,jy,1,n,l)
+            end do
+          end if
+
+!      print*,'etap 2',ix,jy
+! 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.  
+! Note that one change is also necessary in gridcheck.f,
+! and three changes in verttransform.f
+!
+! *** NOTE -- the doubled vertical resolution has not been tested in FLEXPART_WRF
+!*******************************************************************************
+          uvwzlev(ix,jy,1)=0.0
+          do kz=2,nuvz
+          uvwzlev(ix,jy,kz)=uvzlev(kz)
+         enddo
+! Switch on following lines to use doubled vertical resolution
+! Switch off the three lines above.
+!
+! *** NOTE -- the doubled vertical resolution has not been tested in FLEXPART_WRF
+!*************************************************************
+!22          uvwzlev(ix,jy,(kz-1)*2)=uvzlev(kz)
+!          do 23 kz=2,nwz
+!23          uvwzlev(ix,jy,(kz-1)*2+1)=wzlev(kz)
+! End doubled vertical resolution
+
+! pinmconv=(h2-h1)/(p2-p1)
+!
+! in flexpart_ecmwf, pinmconv is used to convert etadot to w
+! in FLEXPART_WRF, vertical velocity is already m/s, so pinmconv=1.0
+!
+!         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)))
+          if (wind_option.eq.0) then
+          pinmconv(1)=1.0
+          do kz=2,nz-1
+             pinmconv(kz)=1.0
+          enddo
+          pinmconv(nz)=1.0
+          elseif (wind_option.eq.1) then
+!          pinmconv(1)=(uvzlev(2)-uvzlev(1)) &
+!          /(eta_u_wrf(1)-1.)
+          pinmconv(1)=(wzlev(2)-0.) &
+          /(eta_w_wrf(2)-1.)
+          do kz=2,nz-1
+!          pinmconv(kz)=(uvzlev(kz)-uvzlev(kz-1)) &
+!          /(eta_u_wrf(kz)-eta_u_wrf(kz-1))
+          pinmconv(kz)=(wzlev(kz+1)-wzlev(kz-1)) &
+          /(eta_w_wrf(kz+1)-eta_w_wrf(kz-1))
+           enddo
+          pinmconv(nwz)=pinmconv(nwz-1)
+          endif
+
+
+!      print*,'etap 3',ix,jy
+
+! 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)
+          divn(ix,jy,1,l)=divhn(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)
+          tken(ix,jy,1,n,l)=tkehn(ix,jy,1,n,l)
+          tken(ix,jy,nz,n,l)=tkehn(ix,jy,nuvz,n,l)
+          pttn(ix,jy,1,n,l)=ptthn(ix,jy,1,n,l)
+          pttn(ix,jy,nz,n,l)=ptthn(ix,jy,nuvz,n,l)
+
+
+!      print*,'etap 3.5',ix,jy
+           kmin=2
+          do iz=2,nz-1
+            do kz=kmin,nuvz
+              if(heightmid(iz).gt.uvzlev(nuvz)) then
+               divn(ix,jy,iz,l)=divn(ix,jy,nz,l)
+                goto 230
+              endif
+!!      print*,'etap 3.7',kz,iz,heightmid(iz),uvzlev(kz-1),uvzlev(kz)
+              if ((heightmid(iz).gt.uvzlev(kz-1)).and. &
+                  (heightmid(iz).le.uvzlev(kz))) then
+               dz1=heightmid(iz)-uvzlev(kz-1)
+               dz2=uvzlev(kz)-heightmid(iz)
+               dz=dz1+dz2
+          divn(ix,jy,iz,l)=(divhn(ix,jy,kz-1,l)*dz2+divhn(ix,jy,kz,l)*dz1)/dz
+               kmin=kz
+           goto 230
+          endif
+        end do
+230      continue
+      end do
+
+!      print*,'etap 4',ix,jy
+
+          kmin=2
+          do iz=2,nz-1
+            do kz=kmin,nuvz
+              if(height(iz).gt.uvzlev(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)
+                tken(ix,jy,iz,n,l)=tken(ix,jy,nz,n,l)
+                pttn(ix,jy,iz,n,l)=pttn(ix,jy,nz,n,l)
+                goto 30
+              endif
+              if ((height(iz).gt.uvzlev(kz-1)).and. &
+                  (height(iz).le.uvzlev(kz))) then
+               dz1=height(iz)-uvzlev(kz-1)
+               dz2=uvzlev(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
+               tken(ix,jy,iz,n,l)=(tkehn(ix,jy,kz-1,n,l)*dz2+ &
+               tkehn(ix,jy,kz,n,l)*dz1)/dz
+               pttn(ix,jy,iz,n,l)=(ptthn(ix,jy,kz-1,n,l)*dz2+ &
+               ptthn(ix,jy,kz,n,l)*dz1)/dz
+
+
+               kmin=kz
+           goto 30
+          endif
+        end do
+30      continue
+      end do
+
+!      print*,'continue to ww in nests'
+! Levels, where w is given
+!*************************
+
+          if (method_w_terrain_correction .eq. 20) then
+! apply w correction assuming that the WRF w is "absolute w";
+! apply it here to wwh; set wwh=0 at iz=1
+             ix1 = max( ix-1, 0 )
+             jy1 = max( jy-1, 0 )
+             ixp = min( ix+1, nxn(l)-1 )
+             jyp = min( jy+1, nyn(l)-1 )
+          if (wind_option.eq.0) then
+         dzdx=(oron(ixp,jy,l)-oron(ix1,jy,l))/(dxn(l)*(ixp-ix1)*m_xn(ix,jy,1,l))
+         dzdy=(oron(ix,jyp,l)-oron(ix,jy1,l))/(dyn(l)*(jyp-jy1)*m_yn(ix,jy,1,l))
+
+             do kz = 1, nwz-1
+!               wwhn_svaa(kz) = wwhn(ix,jy,kz,l)
+                wwhn(ix,jy,kz,l) = wwhn(ix,jy,kz,l) &
+                     - (uuhn(ix,jy,kz,l)*dzdx + vvhn(ix,jy,kz,l)*dzdy)  
+!               if (kz .eq. 1) wwhn(ix,jy,kz,l) = 0.0
+             end do
+          elseif (wind_option.ge.1) then
+             do kz = 2, nwz-1
+!               wwhn_svaa(kz) = wwhn(ix,jy,kz,l)
+             dzdx=(zzhn(ixp,jy,kz+add_sfc_level,n,l) - zzhn(ix1,jy,kz+add_sfc_level,n,l) &
+        -zzhn(ixp,jy,1,n,l) &
+        +zzhn(ix1,jy,1,n,l)) &
+        /(dxn(l)*(ixp-ix1)*m_xn(ix,jy,1,l))
+             dzdy=(zzhn(ix,jyp,kz+add_sfc_level,n,l) - zzhn(ix,jy1,kz+add_sfc_level,n,l) &
+        -zzhn(ix,jyp,1,n,l) &
+        +zzhn(ix,jy1,1,n,l)) &
+        /(dyn(l)*(jyp-jy1)*m_yn(ix,jy,1,l))
+
+        dzdx=(zzhn(ixp,jy,kz+add_sfc_level,n,l) - zzhn(ix1,jy,kz+add_sfc_level,n,l) &
+             -zzhn(ixp,jy,1,n,l)+zzhn(ix1,jy,1,n,l))/(dxn(l)*(ixp-ix1)*m_xn(ix,jy,1,l))
+        dzdy=(zzhn(ix,jyp,kz+add_sfc_level,n,l) - zzhn(ix,jy1,kz+add_sfc_level,n,l)  &
+             -zzhn(ix,jyp,1,n,l)+zzhn(ix,jy1,1,n,l))/(dyn(l)*(jyp-jy1)*m_yn(ix,jy,1,l))
+           u=0.5*(uuhn(ix,jy,kz+add_sfc_level,l)+uuhn(ix,jy,kz-1+add_sfc_level,l))
+           v=0.5*(vvhn(ix,jy,kz+add_sfc_level,l)+vvhn(ix,jy,kz-1+add_sfc_level,l))
+
+                wwhn(ix,jy,kz,l) = wwhn(ix,jy,kz,l)*pinmconv(kz) &
+!            + (uuhn(ix,jy,kz,l)*dzdx + vvhn(ix,jy,kz,l)*dzdy) ! variation of geopot on sigma is necessary
+            + (u*dzdx + v*dzdy) ! variation of geopot on sigma is necessary
+             if (kz .eq. 1) wwhn(ix,jy,kz,l) = wwhn(ix,jy,kz,l)*pinmconv(kz)
+
+!             if (kz .eq. 1) wwhn(ix,jy,kz,l) = 0.0
+              end do
+         endif
+         if (wind_option.eq.-1) then
+!!        ww(ix,jy,1,n)=wwh(ix,jy,1)
+         wwn(ix,jy,1,n,l)=0.
+         do iz=2,nz
+         wwn(ix,jy,iz,n,l)=wwn(ix,jy,iz-1,n,l)-(height(iz)-height(iz-1))* &
+        divn(ix,jy,iz-1,l)
+         enddo
+         else
+!       print*,'converting ww in nest'
+          wwn(ix,jy,1,n,l)=wwhn(ix,jy,1,l)
+          wwn(ix,jy,nz,n,l)=wwhn(ix,jy,nwz,l)
+          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)*dz2+ &
+         wwhn(ix,jy,kz,l)*dz1)/dz
+               kmin=kz
+           goto 40
+          endif
+        end do
+40      continue
+      end do
+         endif 
+
+!          if (method_w_terrain_correction .eq. 20) then
+!             do kz = 1, nwz
+!                wwhn(ix,jy,kz,l) = wwhn_svaa(kz)
+!             end do
+!          end if
+          end if
+
+! 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
+!!!$OMP END DO
+!!!$OMP END PARALLEL
+
+!         print*,'end of ww, now clouds, nests'
+!****************************************************************
+! Compute slope of eta levels in windward direction and resulting
+! vertical wind correction
+!
+! See notes in verttransform.f about the w correction done here.
+!****************************************************************
+  !write (*,*) 'initializing clouds, n:',n,nymin1,nxmin1,nz^M
+  !   create a cloud and rainout/washout field, clouds occur where rh>80%^M
+  !   total cloudheight is stored at level 0^M
+
+     do 100 jy=0,nyn(l)-1
+       do 100 ix=0,nxn(l)-1
+!        rain_cloud_above=0
+         lsp=lsprecn(ix,jy,1,n,l)
+         convp=convprecn(ix,jy,1,n,l)
+
+!        cloudsh(ix,jy,n)=0
+
+          prec=lsp+convp
+          if (lsp.gt.convp) then !  prectype='lsp'
+            lconvectprec = .false.
+          else ! prectype='cp '
+            lconvectprec = .true.
+          endif
+          rhmin = 0.90 ! standard condition for presence of clouds
+
+!CPS       note that original by Sabine Eckhart was 80%
+!CPS       however, for T<-20 C we consider saturation over ice
+!CPS       so I think 90% should be enough
+
+          icloudbotn(ix,jy,n,l)=icmv
+          icloudtop=icmv ! this is just a local variable
+98        do kz=1,nz
+            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))
+!cps            if (prec.gt.0.01) print*,'relhum',prec,kz,rh,height(kz)
+            if (rh .gt. rhmin) then
+              if (icloudbotn(ix,jy,n,l) .eq. icmv) then
+                icloudbotn(ix,jy,n,l)=nint(height(kz))
+              endif
+              icloudtop=nint(height(kz)) ! use int to save memory
+            endif
+          enddo
+
+!CPS try to get a cloud thicker than 50 m
+!CPS if there is at least .01 mm/h  - changed to 0.002 and put into
+!CPS parameter precpmin
+          if ((icloudbotn(ix,jy,n,l) .eq. icmv .or. &
+               icloudtop-icloudbotn(ix,jy,n,l) .lt. 50) .and. &
+               prec .gt. precmin) then
+            rhmin = rhmin - 0.05
+            if (rhmin .ge. 0.30) goto 98 ! give up for <= 25% rel.hum.
+          endif
+!CPS implement a rough fix for badly represented convection
+!CPS is based on looking at a limited set of comparison data
+          if (lconvectprec .and. icloudtop .lt. 6000 .and. &
+              prec .gt. precmin) then
+            if (convp .lt. 0.1) then
+              icloudbotn(ix,jy,n,l) = 500
+              icloudtop =         8000
+            else
+              icloudbotn(ix,jy,n,l) = 0
+              icloudtop =      10000
+            endif
+          endif
+          if (icloudtop .ne. icmv) then
+            icloudthckn(ix,jy,n,l) = icloudtop-icloudbotn(ix,jy,n,l)
+          else
+            icloudthckn(ix,jy,n,l) = icmv
+          endif
+!CPS  get rid of too thin clouds
+          if (icloudthckn(ix,jy,n,l) .lt. 50) then
+            icloudbotn(ix,jy,n,l)=icmv
+            icloudthckn(ix,jy,n,l)=icmv
+          endif
+
+100   continue
+      enddo ! nests    
+
+      return
+      end
Index: /branches/jerome/src_flexwrf_v3.1/wetdepo.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/wetdepo.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/wetdepo.f90	(revision 16)
@@ -0,0 +1,406 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                *
+!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine,       *
+!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
+!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso,          *
+!* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann,   *
+!*                                                                     *
+!* This file is part of FLEXPART WRF            
+!                                                                     *
+! 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!                           *
+  !                                                                            *
+  !* D Arnold 2012 01 25 implement patch developed by P.Seibert to avoid       *
+  !* problems with cloud fraction                                              *
+  !* set cloud cover to 1  when there is precip & use diagnosed clouds in      *
+  !* vertransform* for in-cloud below-cloud scavenging                         *
+  !* Set fraction to max val from grid cells larger than 5 km.                 *
+  !* Missing: new fractions of grid cell affected by rain , coming from        *
+  !* modelling studies with 150 km grid-sizes!                                 *
+  !* precip interpolation is under check by developers                         *
+  !* modifications identified by "CDA"                                         *
+!*
+!* Petra Seibert, 2011/2012: Fixing some deficiencies in this modification
+  !********************************************************************************
+  !*****************************************************************************
+  !                                                                            *
+  ! 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
+! use ieee_arithmetic
+  implicit none
+
+  integer :: jpart,itime,ltsample,loutnext,ldeltat,i,j,ix,jy
+!  integer :: ngrid,itage,nage,hz,il,interp_time, n, clouds_v
+  integer :: ngrid,itage,nage,kz,il,interp_time, n
+!  integer :: ks, kp
+  integer :: ks, kp, icbot,ictop, indcloud
+
+  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 :: xtn,ytn,lsp,convp,cc,fraction,prec,wetscav,precsub,f
+  real :: wetscavold
+!  real :: wetdeposit(maxspec),restmass
+  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 (jpart.eq.103) print*,real(xtra1(jpart)),real(ytra1(jpart)),jpart
+
+! CDA part of the bug fix from P. Seiber includes modification of
+! CDA interpol_rain routines.
+!    if (ieee_is_nan(xtra1(jpart))) then
+      if (xtra1(jpart).ne.xtra1(jpart)) then
+     print*,jpart,xtra1(jpart),ytra1(jpart),itra1(jpart)
+       endif
+    if (ngrid.eq.0) then
+!CDA old code:
+!      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)
+!CDA new code:
+        
+          call interpol_rain(lsprec,convprec,tcc, &
+           icloudbot,icloudthck,nxmax,nymax,1,nx,ny, &
+!          memind,sngl(xtra1(jpart)),sngl(ytra1(jpart)),1,memtime(1), &
+           memind,real(xtra1(jpart)),real(ytra1(jpart)),1,memtime(1), &
+           memtime(2),interp_time,lsp,convp,cc,icbot,ictop,icmv)
+
+    else
+! CDA old code:
+!      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)
+! CDA new code:
+      call interpol_rain_nests(lsprecn,convprecn,tccn, &
+           icloudbotn,icloudthckn,nxmaxn,nymaxn,1,&
+             maxnests,ngrid,nxn,nyn, memind,xtn,ytn, &
+           1,memtime(1), &
+           memtime(2),interp_time,lsp,convp,cc,icbot,ictop,icmv)
+
+    endif
+
+!    if ((lsp.lt.0.01).and.(convp.lt.0.01)) goto 20
+
+!CPS 2012: subtract a small value, eg 0.01 mm/h, to remove spurious precip
+        prec = lsp+convp
+        precsub = 0.01
+        if (prec .lt. precsub) then
+          goto 20
+        else
+          f = (prec-precsub)/prec
+          lsp = f*lsp
+          convp = f*convp
+        endif
+
+
+  ! get the level were the actual particle is in
+      do il=2,nz
+        if (height(il).gt.ztra1(jpart)) then
+          kz=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
+! CDA  PS part of fix
+
+        if (ztra1(jpart) .le. float(ictop)) then
+          if (ztra1(jpart) .gt. float(icbot)) then
+            indcloud = 2 ! in-cloud
+          else
+            indcloud = 1 ! below-cloud
+          endif
+        elseif (ictop .eq. icmv) then
+          indcloud = 0 ! no cloud found, use old scheme
+        else
+          goto 20 ! above cloud
+        endif
+
+!  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
+
+  !CDA
+     !  if (dx.le.5000.) then
+     !    j=5 
+     !    i=5 
+     !  endif
+   ! for the moment i set all to 5
+       i=5
+       j=5
+  !CDA
+  !CDA cc (coming from CLDFRA works as a mask for the precipitation
+  ! in vertransform* we diagnose the clouds. We consider not that
+  ! when there is precip, there is cloud as diagnosed in vertransform
+  ! this is the same approx used in other models HYSPLIT, for insance
+  ! set cc to 1
+    cc=1. 
+
+    fraction=max(0.05,cc*(lsp*lfr(i)+convp*cfr(j))/(lsp+convp))
+
+  ! 2) Computation of precipitation rate in sub-grid cell
+  !******************************************************
+
+    prec=(lsp+convp)/fraction
+
+  ! 3) Computation of scavenging coefficients for all species
+  !    Computation of wet deposition
+  !**********************************************************
+
+    do 10 ks=1,nspec                                  ! loop over species
+      wetdeposit(ks)=0.
+
+          if (weta(ks).gt.0.) then
+            if (indcloud .eq. 1) then ! BELOW CLOUD SCAVENGING
+!C               for aerosols and not highliy soluble substances weta=5E-6
+              wetscav=weta(ks)*prec**wetb(ks)                ! scavenging coeff
+!c             write(*,*) 'bel. wetscav: ',wetscav
+            elseif (indcloud .eq. 2) then !  IN CLOUD SCAVENGING
+              if (ngrid.gt.0) then
+                 act_temp=ttn(ix,jy,kz,n,ngrid)
+              else
+                 act_temp=tt(ix,jy,kz,n)
+              endif
+              cl=2E-7*prec**0.36
+              if (dquer(ks).gt.0) then ! is particle
+                S_i=0.9/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/(ictop-icbot) ! 3.6e6 converts mm/h to m/s
+              wetscavold = 2.e-5*prec**0.8 ! 1.e-4*prec**0.62
+              wetscav = min(0.1*wetscav,wetscavold) ! 0.1 is ASt current setting
+!PS tihb new scheme
+!PS tihc for no cloud, 1.e-5*prec**0.8 ! 1.e-4*prec**0.62
+!PS tihd limit to wetscavold= 1.e-4*prec**0.8
+!PS tihe mulitiply wetscav with .1
+!PS tihf set the wetscavold to 1.e-5prec**0.8
+!PS tihg set the wetscav & wetscavold to 2.e-5*prec**0.8 + weta=2.e-6 (instead of 1.e-6)
+
+            else ! PS: no cloud diagnosed, old scheme,
+!CPS          using with fixed a,b for simplicity, one may wish to change!!
+!             wetscav = 1.e-4*prec**0.62
+              wetscav = 2.e-5*prec**0.8 
+            endif
+
+            wetdeposit(ks)=xmass1(jpart,ks)*  &
+              (1.-exp(-wetscav*abs(ltsample)))*fraction  ! wet deposition
+! CDA test
+!        if (wetdeposit(ks).gt.0) then
+!           write(*,*) 'wetdepo: ',wetdeposit(ks),ks
+!        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
+!cccccccccccccccc depostatistic
+!c            wetdepo_sum(ks,kp)=wetdepo_sum(ks,kp)+wetdeposit(ks)
+!cccccccccccccccc depostatistic
+            else
+              xmass1(jpart,ks)=0.
+            endif
+!C Correct deposited mass to the last time step when radioactive decay of
+!C gridded deposited mass was calculated
+            if (decay(ks).gt.0.) then
+              wetdeposit(ks)=wetdeposit(ks)*exp(abs(ldeltat)*decay(ks))
+            endif
+          else  ! weta(k)<0
+             wetdeposit(ks)=0.
+          endif
+10      continue
+
+
+
+  ! Sabine Eckhard, 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
+!   print*,'kp',kp,jpart,npoint(jpart)
+  ! CDA added itage for the kernel not to be applied during the first hours
+    call wetdepokernel(nclass(jpart),wetdeposit,real(xtra1(jpart)), &
+         real(ytra1(jpart)),itage,nage,kp)
+    if (nested_output.eq.1) call wetdepokernel_nest(nclass(jpart), &
+         wetdeposit,real(xtra1(jpart)),real(ytra1(jpart)),itage, &
+         nage,kp)
+    endif
+
+20  continue
+  end do
+
+end subroutine wetdepo
Index: /branches/jerome/src_flexwrf_v3.1/wetdepokernel.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/wetdepokernel.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/wetdepokernel.f90	(revision 16)
@@ -0,0 +1,147 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                *
+!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine,       *
+!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
+!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso,          *
+!* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann,   *
+!*                                                                     *
+!* This file is part of FLEXPART WRF                                   *
+!*                                  
+! 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,itage,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                                                       *
+  !
+  !     D. Arnold: modification to skip the kernel the first 3 hours.
+  !     then, modification to a regular lat-lon.
+  !*****************************************************************************
+  !                                                                            *
+  ! 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
+! CDA new declarations
+   real :: rhoprof(2),rhoi,xlon,ylat,xl2,yl2
+   integer :: itage
+!JB
+  if (outgrid_option.eq.0) then
+! CDA
+  xl=(x*dx+xoutshift)/dxout
+  yl=(y*dy+youtshift)/dyout
+  elseif (outgrid_option.eq.1) then
+! CDA new code:
+  xl2=x*dx+xmet0
+  yl2=y*dy+ymet0
+  call xymeter_to_ll_wrf(xl2,yl2,xlon,ylat)
+  xl=(xlon-outlon0)/dxoutl
+  yl=(ylat-outlat0)/dyoutl
+  endif
+
+  ix=int(xl)
+  jy=int(yl)
+!JB I don't know what this thing is suppose to do, but I put it here in case it is necessary
+! see for instance conccalc_reg.f90
+!      ix=int(xl)
+!      if (xl.lt.0.) ix=ix-1
+!      jy=int(yl)
+!      if (yl.lt.0.) jy=jy-1
+!
+
+! CDA skip kernelfor some hours to prevent smoothing close to source
+   if (itage.lt.7200) then ! no kernel, direct attribution to grid cell
+    do ks=1,nspec
+      if ((ix.ge.0).and.(jy.ge.0).and.(ix.le.numxgrid-1).and. &
+                                   (jy.le.numygrid-1)) &
+                    wetgridunc(ix,jy,ks,kp,nunc,nage)= &
+              wetgridunc(ix,jy,ks,kp,nunc,nage)+deposit(ks)
+    enddo   
+   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
+  !**********************************************
+
+  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
+
+  endif ! Kernel
+end subroutine wetdepokernel
Index: /branches/jerome/src_flexwrf_v3.1/wetdepokernel_nest.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/wetdepokernel_nest.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/wetdepokernel_nest.f90	(revision 16)
@@ -0,0 +1,150 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                *
+!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine,       *
+!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
+!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso,          *
+!* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann,   *
+!*                                                                     *
+!* This file is part of FLEXPART WRF         
+!                                                                     *
+! 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,itage,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.                      *
+  !                                                                            *
+  !     Dec 2012: modifications following wetdepokernel.f90                   *
+  !*****************************************************************************
+  !                                                                            *
+  ! 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
+! CDA new declarations
+   real :: rhoprof(2),rhoi,xlon,ylat,xl2,yl2
+   integer :: itage
+! CDA
+
+
+!JB
+  if (outgrid_option.eq.0) then
+! CDA
+  xl=(x*dx+xoutshiftn)/dxoutn
+  yl=(y*dy+youtshiftn)/dyoutn
+  elseif (outgrid_option.eq.1) then
+! CDA new code:
+  xl2=x*dx+xmet0
+  yl2=y*dy+ymet0
+  call xymeter_to_ll_wrf(xl2,yl2,xlon,ylat)
+  xl=(xlon-outlon0n)/dxoutln
+  yl=(ylat-outlat0n)/dyoutln
+  endif
+
+  ix=int(xl)
+  jy=int(yl)
+
+! CDA skip kernelfor some hours to prevent smoothing close to source
+      if (itage.lt.7200) then ! no kernel, direct attribution to grid cell
+        do ks=1,nspec
+          if ((abs(deposit(ks)).gt.0).and.DRYDEPSPEC(ks)) then
+!        print*,ix,jy,ks,kp,nunc,nage
+            if ((ix.ge.0).and.(jy.ge.0).and.(ix.le.numxgridn-1).and. &
+                                      (jy.le.numygridn-1)) &
+        wetgriduncn(ix,jy,ks,kp,nunc,nage)= &
+          wetgriduncn(ix,jy,ks,kp,nunc,nage)+deposit(ks)
+          endif
+        enddo
+ 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
+  !**********************************************
+
+  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
+  endif !kernel
+
+end subroutine wetdepokernel_nest
Index: /branches/jerome/src_flexwrf_v3.1/windalign.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/windalign.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/windalign.f90	(revision 16)
@@ -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/jerome/src_flexwrf_v3.1/wrf_map_utils_mod.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/wrf_map_utils_mod.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/wrf_map_utils_mod.f90	(revision 16)
@@ -0,0 +1,77 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                *
+!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine,       *
+!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
+!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso,          *
+!* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann,   *
+!*                                                                     *
+!* This file is part of FLEXPART WRF                                   *
+!*                                                                     *
+!* 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/>.   *
+!***********************************************************************
+! file include_map_utils - created 22-nov-2005
+!
+!   this file contains the "module data" from 
+!	file .../wrfsi2.1/src/mod/module_map_utils.F
+!-----------------------------------------------------------------------
+
+module wrf_map_utils_mod
+      implicit none
+
+      logical :: proj_init, proj_cyclic
+
+      integer :: proj_code, proj_nx, proj_ny
+      integer :: proj_latlon, proj_merc, proj_lc, proj_ps, proj_rotlat
+      real :: proj_lat1, proj_lon1, proj_dx, &
+           proj_dlat, proj_dlon, proj_clat, proj_clon, &
+           proj_stdlon, proj_truelat1, proj_truelat2, &
+           proj_hemi, proj_cone, proj_polei, proj_polej, &
+           proj_rsw, proj_rebydx
+      real :: pi, deg_per_rad, rad_per_deg, earth_radius_m
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! ! define data structures to define various projections
+!
+! type proj_info
+!
+!   logical        proj_init     ! flag to indicate if this struct is 
+!                                ! ready for use
+!   logical        proj_cyclic   ! flag indicating if this grid
+!                                ! is cyclic in the longitudinal
+!                                ! direction...happens with
+!                                ! global lat/lon grids like gfs/avn
+!   integer        proj_code     ! integer code for projection type
+!   integer        proj_nx
+!   integer        proj_ny
+!   real           proj_lat1    ! sw latitude (1,1) in degrees (-90->90n)
+!   real           proj_lon1    ! sw longitude (1,1) in degrees (-180->180e)
+!   real           proj_dx       ! grid spacing in meters at truelats, used
+!                                ! only for ps, lc, and merc projections
+!   real           proj_dlat     ! lat increment for lat/lon grids
+!   real           proj_dlon     ! lon increment for lat/lon grids
+!   real           proj_clat     ! center latitude of grid
+!   real           proj_clon     ! center longitude of grid
+!   real           proj_stdlon   ! longitude parallel to y-axis (-180->180e)
+!   real           proj_truelat1 ! first true latitude (all projections)
+!   real           proj_truelat2 ! second true lat (lc only)
+!   real           proj_hemi     ! 1 for nh, -1 for sh
+!   real           proj_cone     ! cone factor for lc projections
+!   real           proj_polei    ! computed i-location of pole point
+!   real           proj_polej    ! computed j-location of pole point
+!   real           proj_rsw      ! computed radius to sw corner
+!   real           proj_rebydx   ! earth radius divided by dx
+!
+! end type proj_info
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+end module wrf_map_utils_mod
Index: /branches/jerome/src_flexwrf_v3.1/write_ncconc.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/write_ncconc.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/write_ncconc.f90	(revision 16)
@@ -0,0 +1,321 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                *
+!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine,       *
+!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
+!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso,          *
+!* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann,   *
+!* Adam Dingwell                                                      *
+!*                                                                    *
+!* This file is part of FLEXPART WRF                                  *
+!                                                                     *
+! 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 write_ncconc(itime,outnum,ks,kp,nage,tot_mu_scalar,nesting_level)
+  
+  !*****************************************************************************
+  !                                                                            *
+  !  This routine writes concentration, mixing ratio and deposition fields     *
+  !  to a netcdf file defined by flex_ncheader.                                *
+  !                                                                            *
+  !  flex_ncheader is called from within write_ncconc when it's time for a new *
+  !  output file.                                                              *
+  !                                                                            *
+  !  write_ncconc should be called by concoutput_irreg and concoutput_reg      *
+  !  it is separate from the binary and ascii output routines to avoid mixing  *
+  !  of sparse and full grid approaches.  Netcdf will output the full grid.    *
+  !                                                                            *
+  !      Author: A. Dingwell                                                   *
+  !                                                                            *
+  !      29 May 2013                                                           *
+  !                                                                            *
+  ! Modifications:                                                             *
+  ! June 5 2013: J. Brioude: compression using deflate level, optimization of  *
+  !  the writing procedure. bug fixes for backtrajectory mode                  *
+  !*****************************************************************************
+  
+  use point_mod
+  use outg_mod
+  use par_mod
+  use com_mod
+
+  implicit none
+
+  include 'netcdf.inc'
+
+  real    :: outnum         ! Number of samples for each concentration calculation
+  integer :: itime          ! Current simulation time [s]
+  integer :: ks,kp,nage     ! species, maxpointspec_act and nageclass indices resp.
+  real    :: tot_mu_scalar  ! total mass per source and species (backward)
+                            ! or unity (forward).  Should probably be sent as
+                            ! tot_mu(ks,kp) from concoutput*.f90
+  integer :: nesting_level  ! 0 for main (mother) grid, 1 for nest (child)
+
+  real(kind=dp) :: jul          ! Julian date
+  integer   :: jjjjmmdd,ihmmss  ! date & time as integer
+  character :: adate*8,atime*6  ! date and time strings, used for filename
+
+  integer :: ncid           ! Pointer to netcdf file, depends on nesting level
+  integer :: grid_nx,grid_ny! outgrid dimensions, depend on the nesting level
+  integer :: ncret          ! Netcdf:  return code
+  integer :: ix,jy,kz       ! iterators
+  character :: datestr*15   ! For the Times variable
+  integer :: deflate_level=5 ! compression level
+    
+  if (option_verbose.ge.1) then
+    write(*,*)'write_ncconc: writing netcdf output for: domain,kp,nage =',&
+      nesting_level+1,kp,nage
+  endif
+
+  ! Determine which nest/outfile we are writing to
+  !***********************************************
+  if (nesting_level.eq.0) then
+    ncid    = ncout
+    grid_nx = numxgrid
+    grid_ny = numygrid
+  elseif (nesting_level.eq.1) then
+    ncid    = ncoutn
+    grid_nx = numxgridn
+    grid_ny = numygridn
+  else
+    write(*,*) '***write_ncconc error: nesting level  must be 0 or 1'
+    ! Note for future development: If additional output nests are to be
+    ! supported for netcdf output, modification must be made here as well as in
+    ! the respective nesting_level if-block in write_ncheader
+  endif
+  ! Update/Initialize record index
+  !*******************************
+   if ((ks.eq.1).and.(kp.eq.1).and.(nage.eq.1)) then
+!   print*,'ncirec',ncirec,ncnumrec
+  if (nesting_level.eq.0) then  ! Only update for first domain
+    if (itime.eq.loutstep) then  ! first output
+      ncirec = 1  ! initialize record index
+    elseif (ncirec.eq.ncnumrec) then  ! new file
+!      print*,'file is closing'
+      ncirec = 1  ! reset record index
+      ncret=nf_close(ncid)      ! close the old file
+      call check_ncerror(ncret)
+!      print*,'file is closed'
+    else
+      ncirec=ncirec+1 ! move on to next record
+    endif
+  endif
+!   print*,'ncirec',ncirec,ncnumrec
+  endif
+
+  ! Check if it's time to create a new netcdf file
+  !***********************************************
+  if (ncirec.eq.1) then         ! First output in current file?
+!   write(*,*) 'itime=',itime
+   if ((ks.eq.1).and.(kp.eq.1).and.(nage.eq.1)) then
+!    if (itime.ne.loutstep) then ! Not the first output file?
+!      ncret=nf_close(ncid)      ! close the old file
+!      call check_ncerror(ncret)
+!     print*,'file is closed'
+!    endif
+!   call write_ncheader(itime,nesting_level)  ! Create new file
+    if (option_verbose.ge.1) &
+      write(*,*)'write_ncconc: calling write_ncinfo'
+    call write_ncinfo(itime,nesting_level)  ! Create new file
+    ! Reassign file handle to the newly created file:
+     endif
+    if (nesting_level.eq.0) ncid=ncout
+    if (nesting_level.eq.1) ncid=ncoutn
+  endif
+
+  if (option_verbose.ge.10) &
+    write(*,*) 'ncid,nccovid=',ncid,nccovid
+
+
+  ! Create output for the current record index
+  !*******************************************
+  jul=bdate+real(itime,kind=dp)/86400._dp
+  call caldate(jul,jjjjmmdd,ihmmss)
+  write(adate,'(i8.8)') jjjjmmdd
+  write(atime,'(i6.6)') ihmmss
+  
+   if ((ks.eq.1).and.(kp.eq.1).and.(nage.eq.1)) then
+
+  if (option_verbose.ge.10) write(*,*)'write_ncconc: record index',ncirec
+  write(datestr,'(I8.8,A1,I6.6)') jjjjmmdd,'_',ihmmss
+  ncret = nf_put_vara_text(ncid,ncrecvid,(/1,ncirec/),(/15,1/),datestr)
+  call check_ncerror(ncret)
+   endif
+
+  if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then ! concentration
+    if (option_verbose.ge.1)  &
+      write(*,*)'write_ncconc: concentration output',kp,nage,ncirec,nccovid,ncid
+
+
+    do kz=1,numzgrid
+    do jy=0,grid_ny-1
+    do ix=0,grid_nx-1
+      grid2(ix,jy,kz,kp)= grid(ix,jy,kz)*factor3d(ix,jy,kz)/tot_mu_scalar
+    enddo ! ix=1,grid_nx-1
+    enddo ! jy=1,grid_ny-1
+    enddo ! kz=1,numzgrid
+
+    if (kp.eq.maxpointspec_act) then
+    if (ldirect.eq.-1) then 
+      ncret = nf_put_vara_real(ncid,nccovid, &
+        (/1,1,1,1,nage,ncirec/),(/grid_nx,grid_ny,numzgrid,kp,1,1/), &
+        grid2(0:grid_nx-1,0:grid_ny-1,1:numzgrid,1:kp))
+      call check_ncerror(ncret)
+    else
+    if (kp.gt.1) then
+      ncret = nf_put_vara_real(ncid,nccovid, &
+        (/1,1,1,1,ks,nage,ncirec/),(/grid_nx,grid_ny,numzgrid,kp,1,1,1/), &
+        grid2(0:grid_nx-1,0:grid_ny-1,1:numzgrid,1:kp)) 
+    else
+      ncret = nf_put_vara_real(ncid,nccovid, &
+        (/1,1,1,ks,nage,ncirec/),(/grid_nx,grid_ny,numzgrid,1,1,1/), &
+        grid2(0:grid_nx-1,0:grid_ny-1,1:numzgrid,1)) 
+    endif
+      call check_ncerror(ncret)
+    endif
+  endif
+!    do kz=1,numzgrid
+!    do jy=0,grid_ny-1
+!    do ix=0,grid_nx-1
+!      ncret = nf_put_vara_real(ncid,nccovid, &
+!        (/ix+1,jy+1,kz,kp,nage,ncirec/),(/1,1,1,1,1,1/), &
+!        grid(ix,jy,kz)*factor3d(ix,jy,kz)/tot_mu_scalar)
+!      call check_ncerror(ncret)
+!    enddo ! ix=1,grid_nx-1
+!    enddo ! jy=1,grid_ny-1
+!    enddo ! kz=1,numzgrid
+  endif ! concentraion
+
+  if ((iout.eq.2).or.(iout.eq.3)) then  ! mixing ratio
+    if (option_verbose.ge.1)write(*,*)'write_ncconc: mixing ratio output'
+    do kz=1,numzgrid
+    do jy=0,grid_ny-1
+    do ix=0,grid_nx-1
+      grid3(ix,jy,kz,kp)= 1.e12*grid(ix,jy,kz)/volume(ix,jy,kz)/outnum*  &
+        weightair/weightmolar(ks)/densityoutgrid(ix,jy,kz)
+    enddo ! ix=1,grid_nx-1
+    enddo ! jy=1,grid_ny-1
+    enddo ! kz=1,numzgrid
+    if (kp.eq.maxpointspec_act) then
+    if (ldirect.eq.-1) then
+      ncret = nf_put_vara_real(ncid,ncravid, &
+        (/1,1,1,1,nage,ncirec/),(/grid_nx,grid_ny,numzgrid,kp,1,1/), &
+        grid3(0:grid_nx-1,0:grid_ny-1,1:numzgrid,1:kp))
+      call check_ncerror(ncret)
+  else
+    if (kp.gt.1) then
+      ncret = nf_put_vara_real(ncid,ncravid, &
+        (/1,1,1,1,ks,nage,ncirec/),(/grid_nx,grid_ny,numzgrid,kp,1,1,1/), &
+        grid3(0:grid_nx-1,0:grid_ny-1,1:numzgrid,1:kp))
+    else
+      ncret = nf_put_vara_real(ncid,ncravid, &
+        (/1,1,1,ks,nage,ncirec/),(/grid_nx,grid_ny,numzgrid,1,1,1/), &
+        grid3(0:grid_nx-1,0:grid_ny-1,1:numzgrid,1))
+    endif
+      call check_ncerror(ncret)
+  endif
+    endif
+
+!    do kz=1,numzgrid
+!    do jy=0,grid_ny-1
+!    do ix=0,grid_nx-1
+!      ncret = nf_put_vara_real(ncid,ncravid, &
+!        (/ix+1,jy+1,kz,kp,nage,ncirec/),(/1,1,1,1,1,1/), &
+!        1.e12*grid(ix,jy,kz)/volume(ix,jy,kz)/outnum*  &
+!        weightair/weightmolar(ks)/densityoutgrid(ix,jy,kz))
+!      call check_ncerror(ncret)
+!    enddo ! ix=1,grid_nx-1
+!    enddo ! jy=1,numygrid-1
+!    enddo ! kz=1,numzgrid
+  endif ! mixing ratio
+
+  if ((ldirect.eq.1).and.(WETDEP)) then ! WETDEP
+    if (option_verbose.ge.1)write(*,*)'write_ncconc: wet deposition output'
+    do jy=0,grid_ny-1
+    do ix=0,grid_nx-1
+    if (nesting_level.eq.0)  wetgrid2(ix,jy,kp)=1.e12*wetgrid(ix,jy)/area(ix,jy)
+    if (nesting_level.eq.1)  wetgrid2(ix,jy,kp)=1.e12*wetgrid(ix,jy)/arean(ix,jy)
+    enddo ! ix=1,grid_nx-1
+    enddo ! jy=1,grid_ny-1
+    if (kp.eq.maxpointspec_act) then
+  if (ldirect.eq.-1) then
+      ncret = nf_put_vara_real(ncid,ncwdvid, &
+        (/1,1,1,nage,ncirec/),(/grid_nx,grid_ny,kp,1,1/), &
+        wetgrid2(0:grid_nx-1,0:grid_ny-1,1:kp))
+      call check_ncerror(ncret)
+  else
+    if (kp.gt.1) then
+      ncret = nf_put_vara_real(ncid,ncwdvid, &
+        (/1,1,1,ks,nage,ncirec/),(/grid_nx,grid_ny,kp,1,1,1/), &
+        wetgrid2(0:grid_nx-1,0:grid_ny-1,1:kp))
+    else
+      ncret = nf_put_vara_real(ncid,ncwdvid, &
+        (/1,1,ks,nage,ncirec/),(/grid_nx,grid_ny,1,1,1/), &
+        wetgrid2(0:grid_nx-1,0:grid_ny-1,1))
+    endif
+      call check_ncerror(ncret)
+    endif
+  endif
+!    do jy=0,grid_ny-1
+!    do ix=0,grid_nx-1
+!      ncret = nf_put_vara_real(ncid,ncwdvid, &
+!        (/ix+1,jy+1,kp,nage,ncirec/),(/1,1,1,1,1/), &
+!        1.e12*wetgrid(ix,jy)/area(ix,jy))
+!      call check_ncerror(ncret)
+!    enddo ! ix=1,grid_nx-1
+!    enddo ! jy=1,numygrid-1
+  endif ! WETDEP
+
+  if ((ldirect.eq.1).and.(DRYDEP)) then ! DRYDEP
+    if (option_verbose.ge.1)write(*,*)'write_ncconc: dry deposition output'
+    do jy=0,grid_ny-1
+    do ix=0,grid_nx-1
+    if (nesting_level.eq.0)  drygrid2(ix,jy,kp)=1.e12*drygrid(ix,jy)/area(ix,jy)
+    if (nesting_level.eq.1)  drygrid2(ix,jy,kp)=1.e12*drygrid(ix,jy)/arean(ix,jy)
+    enddo ! ix=1,grid_nx-1
+    enddo ! jy=1,grid_ny-1
+    if (kp.eq.maxpointspec_act) then
+  if (ldirect.eq.-1) then
+      ncret = nf_put_vara_real(ncid,ncddvid, &
+        (/1,1,1,nage,ncirec/),(/grid_nx,grid_ny,kp,1,1/), &
+        drygrid2(0:grid_nx-1,0:grid_ny-1,1:kp))
+      call check_ncerror(ncret)
+  else
+    if (kp.gt.1) then
+      ncret = nf_put_vara_real(ncid,ncddvid, &
+        (/1,1,1,ks,nage,ncirec/),(/grid_nx,grid_ny,kp,1,1,1/), &
+        drygrid2(0:grid_nx-1,0:grid_ny-1,1:kp))
+    else
+      ncret = nf_put_vara_real(ncid,ncddvid, &
+        (/1,1,ks,nage,ncirec/),(/grid_nx,grid_ny,1,1,1/), &
+        drygrid2(0:grid_nx-1,0:grid_ny-1,1))
+    endif
+      call check_ncerror(ncret)
+    endif
+  endif
+
+!    do jy=0,grid_ny-1
+!    do ix=0,grid_nx-1
+!      ncret = nf_put_vara_real(ncid,ncddvid, &
+!        (/ix+1,jy+1,kp,nage,ncirec/),(/1,1,1,1,1/), &
+!        1.e12*drygrid(ix,jy)/area(ix,jy))
+!      call check_ncerror(ncret)
+!    enddo ! ix=1,grid_nx-1
+!    enddo ! jy=1,numygrid-1
+  endif ! DRYDEP
+
+   ncret=nf_sync(ncid)
+   call check_ncerror(ncret)
+
+end subroutine write_ncconc
Index: /branches/jerome/src_flexwrf_v3.1/write_ncheader.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/write_ncheader.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/write_ncheader.f90	(revision 16)
@@ -0,0 +1,767 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                *
+!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine,       *
+!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
+!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso,          *
+!* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann,   *
+!* Adam Dingwell                                                      *
+!*                                                                    *
+!* This file is part of FLEXPART WRF                                  *
+!                                                                     *
+! 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 write_ncheader(itime,nesting_level)
+  
+  !*****************************************************************************
+  !                                                                            *
+  !  This routine perdefines a netcdf ouput file with information on flexpart  *
+  !  settings, releases and topography.                                        *
+  !                                                                            *
+  !      Author: A. Dingwell                                                   *
+  !                                                                            *
+  !      27 May 2013                                                           *
+  !                                                                            *
+  !  Modifications                                                             *
+  !  June 5 2013: J. Brioude: generate a header*nc                             * 
+  !*****************************************************************************
+
+  use point_mod
+  use outg_mod
+  use com_mod
+
+  implicit none
+
+  include 'netcdf.inc'
+
+  integer :: itime,stat     ! seconds since simulation start
+  integer :: nesting_level  ! 0 for main grid (mother) 1 for nest (child)
+                            ! this is written to be easy to expand is additional 
+                            ! are desired in the future
+
+  real(kind=dp) :: jul          ! Julian date
+  integer   :: jjjjmmdd,ihmmss  ! date & time as integer
+  character :: adate*8,atime*6  ! date and time strings, used for filename
+
+  ! Grid related variables
+  real    :: xp1,yp1,xp2,yp2  ! temporary coordinates
+  real    :: xsw,xne,ysw,yne,tmpx,tmpy,tmplon,tmplat,xl2,yl2
+  integer :: ncgrid_nx,ncgrid_ny        ! nx,ny of current grid
+  integer :: ncgrid_dx,ncgrid_dy        ! dx,dy of current grid in m or latlon
+  real    :: ncgrid_swlon,ncgrid_swlat  ! SW corner of current grid in latlon
+  real    :: ncgrid_nelon,ncgrid_nelat  ! NE corner of current grid in latlon
+  real    :: ncgrid_xm0,ncgrid_ym0      ! lower-left grid coord in metres
+  real    :: ncgrid_lon0,ncgrid_lat0    ! lower-left grid coord in latlon
+
+  ! Grid related 2D-variables (reassigning these here is a bit inefficient but
+  ! it lets us keep a consistent structure of the code, besides it's only once
+  ! per output
+  real,allocatable,dimension (:,:)  :: ncgrid_oro,ncgrid_area ! of current grid
+
+  ! Iterators
+  integer i,j,ix,jy
+
+  ! NETCDF file related variables
+  integer nclvlid,nclonid,nclatid,ncrecid,ncspcid,ncageid !outgrid dimension ids
+  integer ncrelid,ncrseid                                 ! release points dimension ids
+  integer ncrnvid,ncrmvid,ncspvid             ! release points: number,mass,species ids
+  integer ncrtvid,ncrxvid,ncryvid,ncrzvid     ! release points: t,x,y,z min/max limits
+  integer nctovid,ncarvid                     ! Topography and grid area variable-ids
+  integer ncstr1id,ncstr2id,ncstr3id          ! decrtiption string length dimid
+  integer nclvlvid,nclonvid,nclatvid,ncspcvid,ncagevid  ! outgrid dimension variables
+  integer nclonvid2,nclatvid2
+  integer ncdimsid3(6),ncdimsid2(5) ! arrays of dimension ids for outgrid 3D & 2D
+
+  ! NETCDF filename & attribute related variables
+  character descr*11,units*5,ncname*29,coord*11,coordxy*10
+  integer coordxylen
+  character unit2d*10   ! unit for deposition fields
+  integer   unit2dlen   ! length of character string
+
+  ! NETCDF misc variables
+  integer ncid    ! local container for netcdf file-id (either ncout or ncoutn)
+  integer ncret   ! Return-value of calls to nf_* utils
+  integer :: deflate_level=1 ! compression level
+  integer :: shuffle=1 ! shuffle
+! integer :: chunks(2) ! shuffle
+  ! Attribute notation:
+  descr = 'description'
+  units = 'units'
+  coord = 'coordinates'
+  coordxy = 'XLONG XLAT'
+  coordxylen = 10
+
+  ! 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 header output file
+  !************************
+! write(ncname,'(A8,I2.2,A1,I8.8,A1,I6.6,A3)') &
+!   'flxout_d',nesting_level+1,'_',jjjjmmdd,'_',ihmmss,'.nc' ! filename
+  write(ncname,'(A8,I2.2,A3)') &
+    'header_d',nesting_level+1,'.nc' ! filename
+
+
+!  call nf_set_log_level(3)
+  if (option_verbose.ge.1) write(*,*) &
+    'write_ncheader: creating file: ',path(1)(1:length(1))//ncname
+! call nf_set_chunk_cache(32000000)
+! ncret = nf_create(path(1)(1:length(1))//ncname, nf_clobber,ncid)
+  ncret = nf_create(path(1)(1:length(1))//ncname, NF_NETCDF4,ncid)
+  call check_ncerror(ncret)
+
+  ! Determine which nest/outfile we just created so we can set up the grid
+  !***********************************************************************
+  if (nesting_level.eq.0) then  ! current grid is main grid
+    ncout   = ncid  ! copy current file handle to ncout
+    ncgrid_nx = numxgrid
+    ncgrid_ny = numygrid
+    ncgrid_nelon = outgrid_nelon
+    ncgrid_nelat = outgrid_nelat
+    ncgrid_swlon = outgrid_swlon
+    ncgrid_swlat = outgrid_swlat
+    allocate(ncgrid_oro(ncgrid_nx,ncgrid_ny),stat=stat)
+    allocate(ncgrid_area(ncgrid_nx,ncgrid_ny),stat=stat)
+    ncgrid_oro   = oroout(0:ncgrid_nx-1,0:ncgrid_ny-1)
+    ncgrid_area  = area(0:ncgrid_nx-1,0:ncgrid_ny-1)
+    if (outgrid_option.eq.1) then ! input was in latlon
+      ncgrid_dx = dxoutl
+      ncgrid_dy = dyoutl
+      ncgrid_lon0 = outlon0
+      ncgrid_lat0 = outlat0
+    else  ! input was in metres
+      ncgrid_dx = dxout
+      ncgrid_dy = dyout
+      ncgrid_xm0  = out_xm0
+      ncgrid_ym0  = out_ym0
+    endif
+  elseif (nesting_level.eq.1) then  ! current grid is nested
+    ncoutn  = ncid  ! copy current file handle to ncoutn
+    ncgrid_nx = numxgridn
+    ncgrid_ny = numygridn
+    ncgrid_nelon = outgridn_nelon
+    ncgrid_nelat = outgridn_nelat
+    ncgrid_swlon = outgridn_swlon
+    ncgrid_swlat = outgridn_swlat
+    allocate(ncgrid_oro(ncgrid_nx,ncgrid_ny),stat=stat)
+    allocate(ncgrid_area(ncgrid_nx,ncgrid_ny),stat=stat)
+    ncgrid_oro   = orooutn(0:ncgrid_nx-1,0:ncgrid_ny-1)
+    ncgrid_area  = arean(0:ncgrid_nx-1,0:ncgrid_ny-1)
+    if (outgrid_option.eq.1) then ! input was in latlon
+      ncgrid_dx = dxoutln
+      ncgrid_dy = dyoutln
+      ncgrid_lon0 = outlon0n
+      ncgrid_lat0 = outlat0n
+    else  ! input was in metres
+      ncgrid_dx = dxoutn
+      ncgrid_dy = dyoutn
+      ncgrid_xm0  = out_xm0n
+      ncgrid_ym0  = out_ym0n
+    endif
+  endif
+
+  if (option_verbose.ge.10) &
+    write(*,*) 'write_ncheader: ncout,ncoutn=',ncout,ncoutn
+
+  ! Write the header information
+  !*****************************
+
+  !ncret = nf_put_att_text(ncout,nf_global,'TITLE',20,version)
+  !call check_ncerror(ncret)
+  if (ldirect.eq.1) then  ! Forward simulation
+    if (option_verbose.ge.10) write(*,10) 'forward simulation attributes'
+    ncret = nf_put_att_int(ncid,nf_global,'SIMULATION_START_DATE',nf_int,1,ibdate)
+    call check_ncerror(ncret)
+    ncret = nf_put_att_int(ncid,nf_global,'SIMULATION_START_TIME',nf_int,1,ibtime)
+    call check_ncerror(ncret)
+
+    ncret = nf_put_att_int(ncid,nf_global,'SIMULATION_END_DATE',nf_int,1,iedate)
+    call check_ncerror(ncret)
+    ncret = nf_put_att_int(ncid,nf_global,'SIMULATION_END_TIME',nf_int,1,ietime)
+    call check_ncerror(ncret)
+  else                  ! Backward simulation
+    if (option_verbose.ge.10) write(*,10) 'backward simulation attributes'
+    ncret = nf_put_att_int(ncid,nf_global,'SIMULATION_START_DATE',nf_int,1,iedate)
+    call check_ncerror(ncret)
+    ncret = nf_put_att_int(ncid,nf_global,'SIMULATION_START_TIME',nf_int,1,ietime)
+    call check_ncerror(ncret)
+
+    ncret = nf_put_att_int(ncid,nf_global,'SIMULATION_END_DATE',nf_int,1,ibdate)
+    call check_ncerror(ncret)
+    ncret = nf_put_att_int(ncid,nf_global,'SIMULATION_END_TIME',nf_int,1,ibtime)
+    call check_ncerror(ncret)
+  endif
+
+  if (option_verbose.ge.10) write(*,10) 'map projection attributes'
+  if (outgrid_option .eq. 1) then
+    ncret = &
+      nf_put_att_text(ncid,nf_global,'OUTPUT_PROJECTION',20,'Regular Latit/Longit')
+    call check_ncerror(ncret)
+  else
+    if (map_proj_id.eq.1) then
+      ncret = &
+        nf_put_att_text(ncid,nf_global,'OUTPUT_PROJECTION',17,'Lambert conformal')
+      call check_ncerror(ncret)
+    elseif (map_proj_id.eq.2) then
+      ncret = &
+        nf_put_att_text(ncid,nf_global,'OUTPUT_PROJECTION',13,'stereographic')
+      call check_ncerror(ncret)
+    elseif (map_proj_id.eq.3) then
+      ncret = &
+        nf_put_att_text(ncid,nf_global,'OUTPUT_PROJECTION',8,'mercator')
+      call check_ncerror(ncret)
+    elseif (map_proj_id.eq.4) then
+      ncret = &
+        nf_put_att_text(ncid,nf_global,'OUTPUT_PROJECTION',6,'global')
+      call check_ncerror(ncret)
+    endif
+  endif
+
+  ! Write info common model settings
+  !*********************************
+  if (option_verbose.ge.10) write(*,10) 'common model attributes'
+
+  if (option_verbose.ge.10) write(*,10) 'OUTPUT_INTERVAL'
+  ncret = nf_put_att_int(ncid,nf_global,'OUTPUT_INTERVAL',nf_int,1,loutstep)
+  call check_ncerror(ncret)
+
+  if (option_verbose.ge.10) write(*,10) 'AVERAGING_TIME'
+  ncret = nf_put_att_int(ncid,nf_global,'AVERAGING_TIME',nf_int,1,loutaver)
+  call check_ncerror(ncret)
+
+  if (option_verbose.ge.10) write(*,10) 'AVERAGE_SAMPLING'
+  ncret = nf_put_att_int(ncid,nf_global,'AVERAGE_SAMPLING',nf_int,1,loutsample)
+  call check_ncerror(ncret)
+
+  ncret = nf_put_att_int(ncid,nf_global,'NSPEC',nf_int,1,nspec)
+  call check_ncerror(ncret)
+  ncret = nf_put_att_int(ncid,nf_global,'NUMRECEPTOR',nf_int,1,numreceptor)
+  call check_ncerror(ncret)
+  ncret = nf_put_att_int(ncid,nf_global,'NAGECLASS',nf_int,1,nageclass)
+  call check_ncerror(ncret)
+
+  ncret = nf_put_att_int(ncid,nf_global,'NUMRELEASES',nf_int,1,numpoint)
+  call check_ncerror(ncret)
+
+  ncret = nf_put_att_int(ncid,nf_global,'DISPERSION_METHOD',nf_int,1,method)
+  call check_ncerror(ncret)
+
+  ncret = nf_put_att_int(ncid,nf_global,'SUBGRID_TOPOGRAPHY',nf_int,1,lsubgrid)
+  call check_ncerror(ncret)
+
+  ncret = nf_put_att_int(ncid,nf_global,'CONVECTION_PARAM',nf_int,1,lconvection)
+  call check_ncerror(ncret)
+
+  ncret = nf_put_att_int(ncid,nf_global,'SUBGRID_TOPOGRAPHY',nf_int,1,lsubgrid)
+  call check_ncerror(ncret)
+
+  ! Write information on output grid setup
+  !***************************************
+  if (option_verbose.ge.10) write(*,10) 'WEST-EAST_GRID_DIMENSION'
+  ncret = nf_put_att_int(ncid,nf_global,'WEST-EAST_GRID_DIMENSION', &
+    nf_int,1,ncgrid_nx)
+  call check_ncerror(ncret)
+
+  if (option_verbose.ge.10) write(*,10) 'SOUTH-NORTH_GRID_DIMENSION'
+  ncret = nf_put_att_int(ncid,nf_global,'SOUTH-NORTH_GRID_DIMENSION', &
+    nf_int,1,ncgrid_ny)
+  call check_ncerror(ncret)
+  
+  if (option_verbose.ge.10) write(*,10) 'BOTTOM-TOP_GRID_DIMENSION'
+  ncret = nf_put_att_int(ncid,nf_global,'BOTTOM-TOP_GRID_DIMENSION', &
+    nf_int,1,numzgrid)
+
+  if (option_verbose.ge.10) write(*,10) 'DX and DY'
+  ncret = nf_put_att_int(ncid,nf_global,'DX',nf_int,1,ncgrid_dx)
+  call check_ncerror(ncret)
+
+  ncret = nf_put_att_int(ncid,nf_global,'DY',nf_int,1,ncgrid_dy)
+  call check_ncerror(ncret)
+
+  ! Set up netcdf dimensions
+  !*************************
+  if (option_verbose.ge.10) write(*,10) 'main grid dimensions'
+
+  ncret = nf_def_dim(ncid,'Time',nf_unlimited,ncrecid)
+  call check_ncerror(ncret)
+
+  ncret = nf_def_dim(ncid,'DateStrLen',15,ncstr3id) !TODO: WRF format
+  call check_ncerror(ncret)
+
+  ncret = nf_def_dim(ncid,'west_east',ncgrid_nx,nclonid)
+  call check_ncerror(ncret)
+
+  ncret = nf_def_dim(ncid,'south_north',ncgrid_ny,nclatid)
+  call check_ncerror(ncret)
+
+  ncret = nf_def_dim(ncid,'bottom_top',numzgrid,nclvlid)
+  call check_ncerror(ncret)
+
+  ncret = nf_def_dim(ncid,'species',nspec,ncspcid)
+  call check_ncerror(ncret)
+
+  ncret = nf_def_dim(ncid,'SpeciesStrLen',10,ncstr1id)
+  call check_ncerror(ncret)
+
+  ncret = nf_def_dim(ncid,'ageclass',nageclass,ncageid)
+  call check_ncerror(ncret)
+
+  if (option_verbose.ge.10) write(*,10) 'release point dimensions'
+  ncret = nf_def_dim(ncid,'releases',numpoint,ncrelid)
+  call check_ncerror(ncret)
+  
+  ncret = nf_def_dim(ncid,'ReleaseStrLen',45,ncstr2id)
+  call check_ncerror(ncret)
+
+  ncret = nf_def_dim(ncid,'ReleaseStartEnd',2,ncrseid)
+  call check_ncerror(ncret)
+
+  ! Select which dimensions to use for main output grids
+  ncdimsid3(1) = nclonid ! X
+  ncdimsid3(2) = nclatid ! Y
+  ncdimsid3(3) = nclvlid ! Z
+  if (ldirect.eq.1) ncdimsid3(4) = ncspcid ! species
+  if (ldirect.eq.-1) ncdimsid3(4) = ncrelid ! points
+  ncdimsid3(5) = ncageid ! ageclass
+  ncdimsid3(6) = ncrecid ! t
+
+  ncdimsid2(1) = nclonid ! X
+  ncdimsid2(2) = nclatid ! Y
+  if (ldirect.eq.1) ncdimsid2(3) = ncspcid ! species
+  if (ldirect.eq.-1) ncdimsid2(3) = ncrelid ! points
+  ncdimsid2(4) = ncageid ! ageclass
+  ncdimsid2(5) = ncrecid ! t
+
+  ! Set up dimension variables
+  !***************************
+
+  ! XLONG
+  if (option_verbose.ge.10) write(*,10) 'XLONG dimension variable'
+  ncret = nf_def_var(ncid,'XLONG',nf_real,2,ncdimsid2(1:2),nclonvid)
+
+!     Turn on deflate compression, fletcher32 checksum.
+  ncret = NF_DEF_VAR_deflate(ncid,nclonvid, shuffle, 1, deflate_level)
+!           if (ncret .ne. nf_noerr) call handle_err(retval)
+!          ncret = NF_DEF_VAR_FLETCHER32(ncid, nclonvid, NF_FLETCHER32)
+!           if (ncret .ne. nf_noerr) call handle_err(retval)
+
+!  ncret = nf_def_var_deflate(ncid,'XLONG',nf_real,2,ncdimsid2(1:2),nclonvid,deflate_level=deflate_level)
+  call check_ncerror(ncret)
+  ncret = nf_put_att_text(ncid,nclonvid,descr,42,'Longitude of center grid, west is negative')
+  call check_ncerror(ncret)
+  ncret = nf_put_att_text(ncid,nclonvid,units,11,'degree_east')
+  call check_ncerror(ncret)
+  
+  ncret = nf_def_var(ncid,'XLONG_CORNER',nf_real,2,ncdimsid2(1:2),nclonvid2)
+  ncret = NF_DEF_VAR_deflate(ncid,nclonvid2, shuffle, 1, deflate_level)
+  call check_ncerror(ncret)
+  ncret = nf_put_att_text(ncid,nclonvid2,descr,57,'Longitude of lower left corner of grids, west is negative')
+  call check_ncerror(ncret)
+  ncret = nf_put_att_text(ncid,nclonvid2,units,11,'degree_east')
+  call check_ncerror(ncret)
+
+  ! XLAT
+  if (option_verbose.ge.10) write(*,10) 'XLAT dimension variable'
+  ncret = nf_def_var(ncid,'XLAT',nf_real,2,ncdimsid2(1:2),nclatvid)
+! ncret = nf_def_var_deflate(ncid,'XLAT',nf_real,2,ncdimsid2(1:2),nclatvid,deflate_level=deflate_level)
+  ncret = NF_DEF_VAR_deflate(ncid,nclatvid, shuffle, 1, deflate_level)
+  call check_ncerror(ncret)
+  ncret = nf_put_att_text(ncid,nclatvid,descr,42,'Latitude of center grid, south is negative')
+  call check_ncerror(ncret)
+  ncret = nf_put_att_text(ncid,nclatvid,units,12,'degree_north')
+  call check_ncerror(ncret)
+  
+  ncret = nf_def_var(ncid,'XLAT_CORNER',nf_real,2,ncdimsid2(1:2),nclatvid2)
+  ncret = NF_DEF_VAR_deflate(ncid,nclatvid2, shuffle, 1, deflate_level)
+  call check_ncerror(ncret)
+  ncret = nf_put_att_text(ncid,nclatvid2,descr,57,'Latitude of lower left corner of grids, south is negative')
+  call check_ncerror(ncret)
+  ncret = nf_put_att_text(ncid,nclatvid2,units,12,'degree_north')
+  call check_ncerror(ncret)
+
+  ! ZTOP
+  if (option_verbose.ge.10) write(*,10) 'ZTOP dimension variable'
+  ncret = nf_def_var(ncid,'ZTOP',nf_real,1,ncdimsid3(3),nclvlvid)
+  ncret = NF_DEF_VAR_deflate(ncid,nclvlvid, shuffle, 1, deflate_level)
+  call check_ncerror(ncret)
+  ncret = nf_put_att_text(ncid,nclvlvid,descr,32, &
+    'UPPER BOUNDARY OF MODEL LAYER')
+  call check_ncerror(ncret)
+  ncret = nf_put_att_text(ncid,nclvlvid,units,1,'m')
+  call check_ncerror(ncret)
+
+  ! SPECIES
+  if (option_verbose.ge.10) write(*,10) 'SPECIES dimension variable'
+  ncret = nf_def_var(ncid,'SPECIES',nf_char,2,(/ncstr1id,ncspcid/),ncspcvid)
+  ncret = NF_DEF_VAR_deflate(ncid,ncspcvid, shuffle, 1, deflate_level)
+  call check_ncerror(ncret)
+  ncret = nf_put_att_text(ncid,ncspcvid,descr,15,'NAME OF SPECIES')
+  call check_ncerror(ncret)
+
+  ! AGECLASSES
+  if (option_verbose.ge.10) write(*,10) 'AGECLASSES dimension variable'
+  ncret = nf_def_var(ncid,'AGECLASS',nf_int,1,ncageid,ncagevid)
+  ncret = NF_DEF_VAR_deflate(ncid,ncagevid, shuffle, 1, deflate_level)
+  call check_ncerror(ncret)
+  ncret = nf_put_att_text(ncid,ncagevid,descr,27,'MAX AGE OF SPECIES IN CLASS')
+  call check_ncerror(ncret)
+  ncret = nf_put_att_text(ncid,ncagevid,units,1,'s')
+  call check_ncerror(ncret)
+
+  ! TIMES
+  if (option_verbose.ge.10) write(*,10) 'TIMES dimension variable'
+  ncret = nf_def_var(ncid,'Times',nf_char,2,(/ncstr3id,ncrecid/),ncrecvid)
+  ncret = NF_DEF_VAR_deflate(ncid,ncrecvid, shuffle, 1, deflate_level)
+  call check_ncerror(ncret)
+  ncret = nf_put_att_text(ncid,ncrecvid,descr,42, &
+    'TIME OF OUTPUT (END OF AVERAGING INTERVAL)')
+
+  ! Release related variables
+  if (option_verbose.ge.10) write(*,10) 'ReleaseName variable'
+  ncret = nf_def_var(ncid,'ReleaseName',nf_char,2,(/ncstr2id,ncrelid/),ncrnvid)
+  ncret = NF_DEF_VAR_deflate(ncid,ncrnvid, shuffle, 1, deflate_level)
+  call check_ncerror(ncret)
+  ncret = nf_put_att_text(ncid,ncrnvid,descr,25,'RELEASE IDENTIFIER/COMMENT')
+  call check_ncerror(ncret)
+  ncret = nf_put_att_text(ncid,ncrnvid,units,1,'-')
+  call check_ncerror(ncret)
+
+  if (option_verbose.ge.10) write(*,10) 'ReleaseTstart_end variable'
+  ncret = nf_def_var(ncid,'ReleaseTstart_end', &
+    nf_int,2,(/ncrseid,ncrelid/),ncrtvid)
+  ncret = NF_DEF_VAR_deflate(ncid,ncrtvid, shuffle, 1, deflate_level)
+  call check_ncerror(ncret)
+  ncret = nf_put_att_text(ncid,ncrtvid,descr,32, &
+    'BEGINNING/ENDING TIME OF RELEASE (SECONDS SINCE RUN START)')
+  call check_ncerror(ncret)
+  ncret = nf_put_att_text(ncid,ncrtvid,units,1,'s')
+  call check_ncerror(ncret)
+
+  if (option_verbose.ge.10) write(*,10) 'ReleaseXstart_end variable'
+  ncret = nf_def_var(ncid,'ReleaseXstart_end',  &
+    nf_float,2,(/ncrseid,ncrelid/),ncrxvid)
+  ncret = NF_DEF_VAR_deflate(ncid,ncrxvid, shuffle, 1, deflate_level)
+  call check_ncerror(ncret)
+  ncret = nf_put_att_text(ncid,ncrxvid,descr,32, &
+    'WEST/EAST BOUNDARIES OF SOURCE')
+  call check_ncerror(ncret)
+  ncret = nf_put_att_text(ncid,ncrxvid,units,12,'degree_north')
+  call check_ncerror(ncret)
+
+  if (option_verbose.ge.10) write(*,10) 'ReleaseYstart_end variable'
+  ncret = nf_def_var(ncid,'ReleaseYstart_end',  &
+    nf_float,2,(/ncrseid,ncrelid/),ncryvid)
+  ncret = NF_DEF_VAR_deflate(ncid,ncryvid, shuffle, 1, deflate_level)
+  call check_ncerror(ncret)
+  ncret = nf_put_att_text(ncid,ncryvid,descr,32, &
+    'SOUTH/NORTH BOUNDARIES OF SOURCE')
+  call check_ncerror(ncret)
+  ncret = nf_put_att_text(ncid,ncryvid,units,12,'degree_north')
+  call check_ncerror(ncret)
+
+  if (option_verbose.ge.10) write(*,10) 'ReleaseZstart_end variable'
+  ncret = nf_def_var(ncid,'ReleaseZstart_end',  &
+    nf_float,2,(/ncrseid,ncrelid/),ncrzvid)
+  ncret = NF_DEF_VAR_deflate(ncid,ncrzvid, shuffle, 1, deflate_level)
+  call check_ncerror(ncret)
+  ncret = nf_put_att_text(ncid,ncrzvid,descr,31, &
+    'BOTTOM/TOP BOUNDARIES OF SOURCE')
+  call check_ncerror(ncret)
+  ncret = nf_put_att_text(ncid,ncrzvid,units,1,'m')
+  call check_ncerror(ncret)
+
+  if (option_verbose.ge.10) write(*,10) 'ReleaseNP variable'
+  ncret = nf_def_var(ncid,'ReleaseNP',nf_int,1,ncrelid,ncspvid)
+  ncret = NF_DEF_VAR_deflate(ncid,ncspvid, shuffle, 1, deflate_level)
+  call check_ncerror(ncret)
+  ncret = nf_put_att_text(ncid,ncspvid,descr,34, &
+    'TOTAL NUMBER OF PARTICLES RELEASED')
+  ncret = nf_put_att_text(ncid,ncspvid,units,1,'-')
+  call check_ncerror(ncret)
+
+  if (option_verbose.ge.10) write(*,10) 'ReleaseXMass variable'
+  ncret = nf_def_var(ncid,'ReleaseXMass',nf_real,2,(/ncspcid,ncrelid/),ncrmvid)
+  ncret = NF_DEF_VAR_deflate(ncid,ncrmvid, shuffle, 1, deflate_level)
+  call check_ncerror(ncret)
+  ncret = nf_put_att_text(ncid,ncrmvid,descr,18,'TOTAL MASS RELEASED')
+  call check_ncerror(ncret)
+  ncret = nf_put_att_text(ncid,ncrmvid,units,2,'kg')
+  call check_ncerror(ncret)
+
+  ! Since we need to exit define mode before we can insert
+  ! variable data, we will include the last file attributes and
+  ! define the last variables here.
+
+  ! DIRECTION INDEPENDENT OUTPUT VARIABLES
+  if (option_verbose.ge.10) write(*,10) 'TOPOGRAPHY variable'
+  ncret = nf_def_var(ncid,'TOPOGRAPHY',NF_real,2,ncdimsid2(1:2),nctovid)
+! ncret = nf_def_var_deflate(ncid,'TOPOGRAPHY',NF_real,2,ncdimsid2(1:2),nctovid,deflate_level=deflate_level)
+  ncret = NF_DEF_VAR_deflate(ncid,nctovid, shuffle, 1, deflate_level)
+  call check_ncerror(ncret)
+  ncret = nf_put_att_text(ncid,nctovid,descr,33,  &
+    'TERRAIN ELEVATION ABOVE SEA LEVEL')
+  call check_ncerror(ncret)
+  ncret = nf_put_att_text(ncid,nctovid,units,1,'m')
+  call check_ncerror(ncret)
+  ncret = nf_put_att_text(ncid,nctovid,coord,coordxylen,coordxy)
+  call check_ncerror(ncret)
+
+  if (option_verbose.ge.10) write(*,10) 'GRIDAREA variable'
+  ncret = nf_def_var(ncid,'GRIDAREA',NF_real,2,ncdimsid2(1:2),ncarvid)
+! ncret = nf_def_var_deflate(ncid,'GRIDAREA',NF_real,2,ncdimsid2(1:2),ncarvid,deflate_level=deflate_level)
+  ncret = NF_DEF_VAR_deflate(ncid,ncarvid, shuffle, 1, deflate_level)
+  call check_ncerror(ncret)
+  ncret = nf_put_att_text(ncid,ncarvid,descr,30, &
+    'SURFACE AREA OF EACH GRID CELL')
+  call check_ncerror(ncret)
+  ncret = nf_put_att_text(ncid,ncarvid,units,2,'m2')
+  call check_ncerror(ncret)
+  ncret = nf_put_att_text(ncid,ncarvid,coord,coordxylen,coordxy)
+  call check_ncerror(ncret)
+
+  ! MAIN OUTPUT VARIABLES
+!  if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then ! CONCENTRATION
+!    if (option_verbose.ge.10) write(*,10) 'CONC variable'
+!    ncret = nf_def_var(ncid,'CONC',NF_REAL,6,ncdimsid3,nccovid)
+!!   chunks(1) = ncgrid_nx
+!!   chunks(2) = ncgrid_ny
+!!!   ncret = NF_DEF_VAR_CHUNKING(ncid, nccovid, NF_CHUNKED, chunks)
+!!   if (ncret .ne. nf_noerr) call check_ncerror(ncret)
+!    ncret = NF_DEF_VAR_deflate(ncid,nccovid, shuffle, 1, deflate_level)
+!
+!    call check_ncerror(ncret)
+!    ncret = nf_put_att_text(ncid,nccovid,descr,33, &
+!      'CONCENTRATION OF AIRBORNE SPECIES')
+!    call check_ncerror(ncret)
+!    ncret = nf_put_att_text(ncid,nccovid,coord,coordxylen,coordxy)
+!    call check_ncerror(ncret)
+!  endif
+
+!  if ((iout.eq.2).or.(iout.eq.3)) then  ! MIXING RATIO
+!    if (option_verbose.ge.10) write(*,10) 'MIXINGRATIO variable'
+!    ncret = nf_def_var(ncid,'MIXINGRATIO',NF_REAL,6,ncdimsid3,ncravid)
+!  ncret = NF_DEF_VAR_deflate(ncid,ncravid, shuffle, 1, deflate_level)
+!    call check_ncerror(ncret)
+!    ncret = nf_put_att_text(ncid,ncravid,descr,37, &
+!      'MASS MIXING RATIO OF AIRBORNE SPECIES')
+!    call check_ncerror(ncret)
+!    ncret = nf_put_att_text(ncid,ncravid,coord,coordxylen,coordxy)
+!    call check_ncerror(ncret)
+!  endif
+!
+!  if (ldirect.eq.1) then  ! Forward run
+!    unit2d = 'pg m-2'
+!    unit2dlen = 6
+!
+!    if (option_verbose.ge.10) write(*,10) 'DRYDEP variable'
+!    write(*,*) ncdimsid2
+!    ncret = nf_def_var(ncid,'DRYDEP',NF_REAL,5,ncdimsid2,ncddvid)
+!  ncret = NF_DEF_VAR_deflate(ncid,ncddvid, shuffle, 1, deflate_level)
+!    call check_ncerror(ncret)
+!    ncret = nf_put_att_text(ncid,ncddvid,descr,32, &
+!      'ACCUMULATED TOTAL DRY DEPOSITION')
+!    call check_ncerror(ncret)
+!    ncret = nf_put_att_text(ncid,ncddvid,units,unit2dlen,unit2d)
+!    call check_ncerror(ncret)
+!    ncret = nf_put_att_text(ncid,ncddvid,coord,coordxylen,coordxy)
+!    call check_ncerror(ncret)
+!
+!    if (option_verbose.ge.10) write(*,10) 'WETDEP variable'
+!    ncret = nf_def_var(ncid,'WETDEP',NF_REAL,5,ncdimsid2,ncwdvid)
+!  ncret = NF_DEF_VAR_deflate(ncid,ncwdvid, shuffle, 1, deflate_level)
+!    call check_ncerror(ncret)
+!    ncret = nf_put_att_text(ncid,ncwdvid,descr,32, &
+!      'ACCUMULATED TOTAL WET DEPOSITION')
+!    call check_ncerror(ncret)
+!    ncret = nf_put_att_text(ncid,ncwdvid,units,unit2dlen,unit2d)
+!    call check_ncerror(ncret)
+!    ncret = nf_put_att_text(ncid,ncwdvid,coord,coordxylen,coordxy)
+!    call check_ncerror(ncret)
+!
+!    ! Add unit attr to mixing ratio and concentration fields
+!    ncret = nf_put_att_text(ncid,nccovid,units,6,'ng m-3') !CONC
+!    call check_ncerror(ncret)
+!    ncret = nf_put_att_text(ncid,ncravid,units,3,'ppt')  !MIX
+!    call check_ncerror(ncret)
+!  else                    ! Backward run
+!    if (ind_rel.eq.1) then ! release in mass
+!      write(*,*) 'A'
+!      !Concentration field should be in 's' (?)
+!      ncret = nf_put_att_text(ncid,nccovid,units,1,'s') !CONC
+!      !call check_ncerror(ncret)
+!      !Mixing ratio field should be in 's kg m-3' (?)
+!      !ncret = nf_put_att_text(ncid,ncravid,units,8,'s kg m-3') !RATIO
+!      !call check_ncerror(ncret)
+!    else  ! release in mass mix
+!      !Concentration should be in 's m3 kg-1' (?)
+!      write(*,*) 'B'
+!      ncret = nf_put_att_text(ncid,nccovid,units,9,'s m3 kg-1') !CONC
+!      !call check_ncerror(ncret)
+!      !Mixing ratio should be in 's' (?)
+!      ncret = nf_put_att_text(ncid,ncravid,units,1,'s') !RATIO
+!      !call check_ncerror(ncret)
+!    endif
+!  endif ! Backward/Forward run
+
+  ! EXIT DEFINE MODE, ENTER DATA MODE
+  ncret = nf_enddef(ncid)
+  call check_ncerror(ncret)
+
+  ! DIMENSION VARIABLES
+  if (option_verbose.ge.10) write(*,10) 'ZTOP data'
+  ncret = nf_put_var_real(ncid,nclvlvid,outheight)
+  call check_ncerror(ncret)
+
+  ! X,Y - Lon,Lat
+  if (option_verbose.ge.10) write(*,10) 'XLAT,XLONG data'
+
+  if (outgrid_option.eq.0) then ! irregular
+    do jy=1,ncgrid_ny
+    do ix=1,ncgrid_nx
+      tmpx=ncgrid_xm0+(float(ix)-0.5)*ncgrid_dx
+      tmpy=ncgrid_ym0+(float(jy)-0.5)*ncgrid_dy
+      call xymeter_to_ll_wrf(tmpx,tmpy,tmplon,tmplat)
+      ncret = nf_put_vara_real(ncid,nclonvid,(/ix,jy/),(/1,1/),tmplon)
+      call check_ncerror(ncret)
+      ncret = nf_put_vara_real(ncid,nclatvid,(/ix,jy/),(/1,1/),tmplat)
+      call check_ncerror(ncret)
+      tmpx=ncgrid_xm0+(float(ix)-1.)*ncgrid_dx
+      tmpy=ncgrid_ym0+(float(jy)-1.)*ncgrid_dy
+      call xymeter_to_ll_wrf(tmpx,tmpy,tmplon,tmplat)
+      ncret = nf_put_vara_real(ncid,nclonvid2,(/ix,jy/),(/1,1/),tmplon)
+      call check_ncerror(ncret)
+      ncret = nf_put_vara_real(ncid,nclatvid2,(/ix,jy/),(/1,1/),tmplat)
+      call check_ncerror(ncret)
+    enddo
+    enddo
+  else
+    do jy=1,ncgrid_ny
+    do ix=1,ncgrid_nx
+      call ll_to_xymeter_wrf(ncgrid_swlon,ncgrid_swlat,xsw,ysw)
+      call ll_to_xymeter_wrf(ncgrid_nelon,ncgrid_nelat,xne,yne)
+      tmpx=xsw+(xne-xsw)*float(ix-1)/float(ncgrid_nx-1)
+      tmpy=ysw+(yne-ysw)*float(jy-1)/float(ncgrid_ny-1)
+      call xymeter_to_ll_wrf(tmpx,tmpy,tmplon,tmplat)
+      xl2=ncgrid_lon0+(float(ix)-0.5)*dxoutl !long
+      yl2=ncgrid_lat0+(float(jy)-0.5)*dyoutl !lat
+      ncret = nf_put_vara_real(ncid,nclonvid,(/ix,jy/),(/1,1/),xl2)
+      call check_ncerror(ncret)
+      ncret = nf_put_vara_real(ncid,nclatvid,(/ix,jy/),(/1,1/),yl2)
+      call check_ncerror(ncret)
+      xl2=ncgrid_lon0+(float(ix)-1.)*dxoutl !long
+      yl2=ncgrid_lat0+(float(jy)-1.)*dyoutl !lat
+      ncret = nf_put_vara_real(ncid,nclonvid2,(/ix,jy/),(/1,1/),xl2)
+      call check_ncerror(ncret)
+      ncret = nf_put_vara_real(ncid,nclatvid2,(/ix,jy/),(/1,1/),yl2)
+      call check_ncerror(ncret)
+    enddo
+    enddo
+  endif ! outgrid_option
+
+
+  ! Write information on release points: total number, then for each point:
+  ! start, end, coordinates, # of particles, name, mass
+  !************************************************************************
+  do i=1,numpoint
+    xp1=xpoint1(i)*dx+xlon0 ! This is probably wrong, but it seems to be 
+    yp1=ypoint1(i)*dy+ylat0 ! the same in writeheader*.f90, so I'll leave
+    xp2=xpoint2(i)*dx+xlon0 ! it for now... //AD
+    yp2=ypoint2(i)*dy+ylat0 !
+
+    if (option_verbose.ge.10) write(*,10) 'ReleaseTstart_end data'
+    ncret = nf_put_vara_int(ncid,ncrtvid,   & ! ReleaseTstart_end
+      (/1,i/),(/2,1/),(/ireleasestart(i),ireleaseend(i)/))
+    call check_ncerror(ncret)
+
+    if (option_verbose.ge.10) write(*,10) 'ReleaseXstart_end data'
+    ncret = nf_put_vara_real(ncid,ncrxvid,  & ! ReleaseXstart_end
+      (/1,i/),(/2,1/),(/xp1,xp2/))
+    call check_ncerror(ncret)
+
+    if (option_verbose.ge.10) write(*,10) 'ReleaseYstart_end data'
+    ncret = nf_put_vara_real(ncid,ncryvid,  & !ReleaseYstart_end
+      (/1,i/),(/2,1/),(/yp1,yp2/))
+    call check_ncerror(ncret)
+
+    if (option_verbose.ge.10) write(*,10) 'ReleaseZstart_end data'
+    ncret = nf_put_vara_real(ncid,ncrzvid,  & !ReleaseZstart_end
+      (/1,i/),(/2,1/),(/zpoint1(i),zpoint2(i)/))
+    call check_ncerror(ncret)
+
+    if (option_verbose.ge.10) write(*,10) 'ReleaseXMass data'
+    ncret = nf_put_vara_real(ncid,ncrmvid,  & !ReleaseXMass
+      (/1,i/),(/nspec,1/),xmass(i,1:nspec))
+    call check_ncerror(ncret)
+
+    if (option_verbose.ge.10) write(*,10) 'ReleaseNP data'
+    ncret = nf_put_vara_int(ncid,ncspvid,   & !ReleaseNP
+      i,1,npart(i))
+    call check_ncerror(ncret)
+
+    !Release Name/Comment
+    j=1 ! Find the length of each release point comment/name
+    do while( j.lt.45.and.compoint(i)(j+1:j+1).ne." ")
+      j=j+1
+    enddo
+    if (option_verbose.ge.10) write(*,10) 'ReleaseName data'
+    ncret = nf_put_vara_text(ncid,ncrnvid,(/1,i/),(/j,1/),compoint(i)(1:j))
+    call check_ncerror(ncret)
+  enddo
+
+  ! Write age class information
+  !****************************
+  if (option_verbose.ge.10) write(*,10) 'AGECLASSES data'
+  ncret = nf_put_var_int(ncid,ncagevid,lage(1:nageclass))
+  call check_ncerror(ncret)
+
+  ! Write topography to output file
+  !********************************
+  if (option_verbose.ge.10) write(*,10) 'TOPOGRAPHY data'
+! do ix=0,ncgrid_nx-1
+  do ix=1,ncgrid_nx
+    ncret = nf_put_vara_real(ncid,nctovid,  &
+!     (/ix+1,1/),(/1,ncgrid_ny/),ncgrid_oro(ix,0:ncgrid_ny-1))
+      (/ix,1/),(/1,ncgrid_ny/),ncgrid_oro(ix,1:ncgrid_ny))
+    call check_ncerror(ncret)
+  enddo
+
+  ! Write grid cell surface area
+  !*****************************
+  if (option_verbose.ge.10) write(*,10) 'GRIDAREA data'
+! do ix=0,ncgrid_nx-1
+  do ix=1,ncgrid_nx
+    ncret = nf_put_vara_real(ncid,ncarvid,  &
+!     (/ix+1,1/),(/1,ncgrid_ny/),ncgrid_area(ix,0:ncgrid_ny-1))
+      (/ix,1/),(/1,ncgrid_ny/),ncgrid_area(ix,1:ncgrid_ny))
+    call check_ncerror(ncret)
+  enddo
+
+  ! SAVE CREATED NETCDF TO FILE
+  !****************************
+  if (option_verbose.ge.1) write(*,*) 'write_ncheader: writing to disk'
+  ncret = nf_sync(ncid)
+  call check_ncerror(ncret)
+
+  return
+
+10 format('write_ncheader: Setting up ',A)
+
+    ncret=nf_close(ncid)
+    deallocate(ncgrid_oro,ncgrid_area)
+end subroutine write_ncheader
Index: /branches/jerome/src_flexwrf_v3.1/write_ncheader_v3.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/write_ncheader_v3.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/write_ncheader_v3.f90	(revision 16)
@@ -0,0 +1,768 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                *
+!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine,       *
+!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
+!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso,          *
+!* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann,   *
+!* Adam Dingwell                                                      *
+!*                                                                    *
+!* This file is part of FLEXPART WRF                                  *
+!                                                                     *
+! 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 write_ncheader(itime,nesting_level)
+  
+  !*****************************************************************************
+  !                                                                            *
+  !  This routine perdefines a netcdf ouput file with information on flexpart  *
+  !  settings, releases and topography.                                        *
+  !                                                                            *
+  !      Author: A. Dingwell                                                   *
+  !                                                                            *
+  !      27 May 2013                                                           *
+  !                                                                            *
+  !  Modifications                                                             *
+  !  June 5 2013: J. Brioude: generate a header*nc                             * 
+  !*****************************************************************************
+
+  use point_mod
+  use outg_mod
+  use com_mod
+
+  implicit none
+
+  include 'netcdf.inc'
+
+  integer :: itime,stat     ! seconds since simulation start
+  integer :: nesting_level  ! 0 for main grid (mother) 1 for nest (child)
+                            ! this is written to be easy to expand is additional 
+                            ! are desired in the future
+
+  real(kind=dp) :: jul          ! Julian date
+  integer   :: jjjjmmdd,ihmmss  ! date & time as integer
+  character :: adate*8,atime*6  ! date and time strings, used for filename
+
+  ! Grid related variables
+  real    :: xp1,yp1,xp2,yp2  ! temporary coordinates
+  real    :: xsw,xne,ysw,yne,tmpx,tmpy,tmplon,tmplat,xl2,yl2
+  integer :: ncgrid_nx,ncgrid_ny        ! nx,ny of current grid
+  integer :: ncgrid_dx,ncgrid_dy        ! dx,dy of current grid in m or latlon
+  real    :: ncgrid_swlon,ncgrid_swlat  ! SW corner of current grid in latlon
+  real    :: ncgrid_nelon,ncgrid_nelat  ! NE corner of current grid in latlon
+  real    :: ncgrid_xm0,ncgrid_ym0      ! lower-left grid coord in metres
+  real    :: ncgrid_lon0,ncgrid_lat0    ! lower-left grid coord in latlon
+
+  ! Grid related 2D-variables (reassigning these here is a bit inefficient but
+  ! it lets us keep a consistent structure of the code, besides it's only once
+  ! per output
+  real,allocatable,dimension (:,:)  :: ncgrid_oro,ncgrid_area ! of current grid
+
+  ! Iterators
+  integer i,j,ix,jy
+
+  ! NETCDF file related variables
+  integer nclvlid,nclonid,nclatid,ncrecid,ncspcid,ncageid !outgrid dimension ids
+  integer ncrelid,ncrseid                                 ! release points dimension ids
+  integer ncrnvid,ncrmvid,ncspvid             ! release points: number,mass,species ids
+  integer ncrtvid,ncrxvid,ncryvid,ncrzvid     ! release points: t,x,y,z min/max limits
+  integer nctovid,ncarvid                     ! Topography and grid area variable-ids
+  integer ncstr1id,ncstr2id,ncstr3id          ! decrtiption string length dimid
+  integer nclvlvid,nclonvid,nclatvid,ncspcvid,ncagevid  ! outgrid dimension variables
+  integer nclonvid2,nclatvid2
+  integer ncdimsid3(6),ncdimsid2(5) ! arrays of dimension ids for outgrid 3D & 2D
+
+  ! NETCDF filename & attribute related variables
+  character descr*11,units*5,ncname*29,coord*11,coordxy*10
+  integer coordxylen
+  character unit2d*10   ! unit for deposition fields
+  integer   unit2dlen   ! length of character string
+
+  ! NETCDF misc variables
+  integer ncid    ! local container for netcdf file-id (either ncout or ncoutn)
+  integer ncret   ! Return-value of calls to nf_* utils
+  integer :: deflate_level=1 ! compression level
+  integer :: shuffle=1 ! shuffle
+! integer :: chunks(2) ! shuffle
+  ! Attribute notation:
+  descr = 'description'
+  units = 'units'
+  coord = 'coordinates'
+  coordxy = 'XLONG XLAT'
+  coordxylen = 10
+
+  ! 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 header output file
+  !************************
+! write(ncname,'(A8,I2.2,A1,I8.8,A1,I6.6,A3)') &
+!   'flxout_d',nesting_level+1,'_',jjjjmmdd,'_',ihmmss,'.nc' ! filename
+  write(ncname,'(A8,I2.2,A3)') &
+    'header_d',nesting_level+1,'.nc' ! filename
+
+
+!  call nf_set_log_level(3)
+  if (option_verbose.ge.1) write(*,*) &
+    'write_ncheader: creating file: ',path(1)(1:length(1))//ncname
+! call nf_set_chunk_cache(32000000)
+  ncret = nf_create(path(1)(1:length(1))//ncname, nf_clobber,ncid)
+! ncret = nf_create(path(1)(1:length(1))//ncname, NF_NETCDF4,ncid)
+  call check_ncerror(ncret)
+
+  ! Determine which nest/outfile we just created so we can set up the grid
+  !***********************************************************************
+  if (nesting_level.eq.0) then  ! current grid is main grid
+    ncout   = ncid  ! copy current file handle to ncout
+    ncgrid_nx = numxgrid
+    ncgrid_ny = numygrid
+    ncgrid_nelon = outgrid_nelon
+    ncgrid_nelat = outgrid_nelat
+    ncgrid_swlon = outgrid_swlon
+    ncgrid_swlat = outgrid_swlat
+    allocate(ncgrid_oro(ncgrid_nx,ncgrid_ny),stat=stat)
+    allocate(ncgrid_area(ncgrid_nx,ncgrid_ny),stat=stat)
+    ncgrid_oro   = oroout(0:ncgrid_nx-1,0:ncgrid_ny-1)
+    ncgrid_area  = area(0:ncgrid_nx-1,0:ncgrid_ny-1)
+    if (outgrid_option.eq.1) then ! input was in latlon
+      ncgrid_dx = dxoutl
+      ncgrid_dy = dyoutl
+      ncgrid_lon0 = outlon0
+      ncgrid_lat0 = outlat0
+    else  ! input was in metres
+      ncgrid_dx = dxout
+      ncgrid_dy = dyout
+      ncgrid_xm0  = out_xm0
+      ncgrid_ym0  = out_ym0
+    endif
+  elseif (nesting_level.eq.1) then  ! current grid is nested
+    ncoutn  = ncid  ! copy current file handle to ncoutn
+    ncgrid_nx = numxgridn
+    ncgrid_ny = numygridn
+    ncgrid_nelon = outgridn_nelon
+    ncgrid_nelat = outgridn_nelat
+    ncgrid_swlon = outgridn_swlon
+    ncgrid_swlat = outgridn_swlat
+    allocate(ncgrid_oro(ncgrid_nx,ncgrid_ny),stat=stat)
+    allocate(ncgrid_area(ncgrid_nx,ncgrid_ny),stat=stat)
+    ncgrid_oro   = orooutn(0:ncgrid_nx-1,0:ncgrid_ny-1)
+    ncgrid_area  = arean(0:ncgrid_nx-1,0:ncgrid_ny-1)
+    if (outgrid_option.eq.1) then ! input was in latlon
+      ncgrid_dx = dxoutln
+      ncgrid_dy = dyoutln
+      ncgrid_lon0 = outlon0n
+      ncgrid_lat0 = outlat0n
+    else  ! input was in metres
+      ncgrid_dx = dxoutn
+      ncgrid_dy = dyoutn
+      ncgrid_xm0  = out_xm0n
+      ncgrid_ym0  = out_ym0n
+    endif
+  endif
+
+  if (option_verbose.ge.10) &
+    write(*,*) 'write_ncheader: ncout,ncoutn=',ncout,ncoutn
+
+  ! Write the header information
+  !*****************************
+
+  !ncret = nf_put_att_text(ncout,nf_global,'TITLE',20,version)
+  !call check_ncerror(ncret)
+  if (ldirect.eq.1) then  ! Forward simulation
+    if (option_verbose.ge.10) write(*,10) 'forward simulation attributes'
+    ncret = nf_put_att_int(ncid,nf_global,'SIMULATION_START_DATE',nf_int,1,ibdate)
+    call check_ncerror(ncret)
+    ncret = nf_put_att_int(ncid,nf_global,'SIMULATION_START_TIME',nf_int,1,ibtime)
+    call check_ncerror(ncret)
+
+    ncret = nf_put_att_int(ncid,nf_global,'SIMULATION_END_DATE',nf_int,1,iedate)
+    call check_ncerror(ncret)
+    ncret = nf_put_att_int(ncid,nf_global,'SIMULATION_END_TIME',nf_int,1,ietime)
+    call check_ncerror(ncret)
+  else                  ! Backward simulation
+    if (option_verbose.ge.10) write(*,10) 'backward simulation attributes'
+    ncret = nf_put_att_int(ncid,nf_global,'SIMULATION_START_DATE',nf_int,1,iedate)
+    call check_ncerror(ncret)
+    ncret = nf_put_att_int(ncid,nf_global,'SIMULATION_START_TIME',nf_int,1,ietime)
+    call check_ncerror(ncret)
+
+    ncret = nf_put_att_int(ncid,nf_global,'SIMULATION_END_DATE',nf_int,1,ibdate)
+    call check_ncerror(ncret)
+    ncret = nf_put_att_int(ncid,nf_global,'SIMULATION_END_TIME',nf_int,1,ibtime)
+    call check_ncerror(ncret)
+  endif
+
+  if (option_verbose.ge.10) write(*,10) 'map projection attributes'
+  if (outgrid_option .eq. 1) then
+    ncret = &
+      nf_put_att_text(ncid,nf_global,'OUTPUT_PROJECTION',20,'Regular Latit/Longit')
+    call check_ncerror(ncret)
+  else
+    if (map_proj_id.eq.1) then
+      ncret = &
+        nf_put_att_text(ncid,nf_global,'OUTPUT_PROJECTION',17,'Lambert conformal')
+      call check_ncerror(ncret)
+    elseif (map_proj_id.eq.2) then
+      ncret = &
+        nf_put_att_text(ncid,nf_global,'OUTPUT_PROJECTION',13,'stereographic')
+      call check_ncerror(ncret)
+    elseif (map_proj_id.eq.3) then
+      ncret = &
+        nf_put_att_text(ncid,nf_global,'OUTPUT_PROJECTION',8,'mercator')
+      call check_ncerror(ncret)
+    elseif (map_proj_id.eq.4) then
+      ncret = &
+        nf_put_att_text(ncid,nf_global,'OUTPUT_PROJECTION',6,'global')
+      call check_ncerror(ncret)
+    endif
+  endif
+
+  ! Write info common model settings
+  !*********************************
+  if (option_verbose.ge.10) write(*,10) 'common model attributes'
+
+  if (option_verbose.ge.10) write(*,10) 'OUTPUT_INTERVAL'
+  ncret = nf_put_att_int(ncid,nf_global,'OUTPUT_INTERVAL',nf_int,1,loutstep)
+  call check_ncerror(ncret)
+
+  if (option_verbose.ge.10) write(*,10) 'AVERAGING_TIME'
+  ncret = nf_put_att_int(ncid,nf_global,'AVERAGING_TIME',nf_int,1,loutaver)
+  call check_ncerror(ncret)
+
+  if (option_verbose.ge.10) write(*,10) 'AVERAGE_SAMPLING'
+  ncret = nf_put_att_int(ncid,nf_global,'AVERAGE_SAMPLING',nf_int,1,loutsample)
+  call check_ncerror(ncret)
+
+  ncret = nf_put_att_int(ncid,nf_global,'NSPEC',nf_int,1,nspec)
+  call check_ncerror(ncret)
+  ncret = nf_put_att_int(ncid,nf_global,'NUMRECEPTOR',nf_int,1,numreceptor)
+  call check_ncerror(ncret)
+  ncret = nf_put_att_int(ncid,nf_global,'NAGECLASS',nf_int,1,nageclass)
+  call check_ncerror(ncret)
+
+  ncret = nf_put_att_int(ncid,nf_global,'NUMRELEASES',nf_int,1,numpoint)
+  call check_ncerror(ncret)
+
+  ncret = nf_put_att_int(ncid,nf_global,'DISPERSION_METHOD',nf_int,1,method)
+  call check_ncerror(ncret)
+
+  ncret = nf_put_att_int(ncid,nf_global,'SUBGRID_TOPOGRAPHY',nf_int,1,lsubgrid)
+  call check_ncerror(ncret)
+
+  ncret = nf_put_att_int(ncid,nf_global,'CONVECTION_PARAM',nf_int,1,lconvection)
+  call check_ncerror(ncret)
+
+  ncret = nf_put_att_int(ncid,nf_global,'SUBGRID_TOPOGRAPHY',nf_int,1,lsubgrid)
+  call check_ncerror(ncret)
+
+  ! Write information on output grid setup
+  !***************************************
+  if (option_verbose.ge.10) write(*,10) 'WEST-EAST_GRID_DIMENSION'
+  ncret = nf_put_att_int(ncid,nf_global,'WEST-EAST_GRID_DIMENSION', &
+    nf_int,1,ncgrid_nx)
+  call check_ncerror(ncret)
+
+  if (option_verbose.ge.10) write(*,10) 'SOUTH-NORTH_GRID_DIMENSION'
+  ncret = nf_put_att_int(ncid,nf_global,'SOUTH-NORTH_GRID_DIMENSION', &
+    nf_int,1,ncgrid_ny)
+  call check_ncerror(ncret)
+  
+  if (option_verbose.ge.10) write(*,10) 'BOTTOM-TOP_GRID_DIMENSION'
+  ncret = nf_put_att_int(ncid,nf_global,'BOTTOM-TOP_GRID_DIMENSION', &
+    nf_int,1,numzgrid)
+
+  if (option_verbose.ge.10) write(*,10) 'DX and DY'
+  ncret = nf_put_att_int(ncid,nf_global,'DX',nf_int,1,ncgrid_dx)
+  call check_ncerror(ncret)
+
+  ncret = nf_put_att_int(ncid,nf_global,'DY',nf_int,1,ncgrid_dy)
+  call check_ncerror(ncret)
+
+  ! Set up netcdf dimensions
+  !*************************
+  if (option_verbose.ge.10) write(*,10) 'main grid dimensions'
+
+  ncret = nf_def_dim(ncid,'Time',nf_unlimited,ncrecid)
+  call check_ncerror(ncret)
+
+  ncret = nf_def_dim(ncid,'DateStrLen',15,ncstr3id) !TODO: WRF format
+  call check_ncerror(ncret)
+
+  ncret = nf_def_dim(ncid,'west_east',ncgrid_nx,nclonid)
+  call check_ncerror(ncret)
+
+  ncret = nf_def_dim(ncid,'south_north',ncgrid_ny,nclatid)
+  call check_ncerror(ncret)
+
+  ncret = nf_def_dim(ncid,'bottom_top',numzgrid,nclvlid)
+  call check_ncerror(ncret)
+
+  ncret = nf_def_dim(ncid,'species',nspec,ncspcid)
+  call check_ncerror(ncret)
+
+  ncret = nf_def_dim(ncid,'SpeciesStrLen',10,ncstr1id)
+  call check_ncerror(ncret)
+
+  ncret = nf_def_dim(ncid,'ageclass',nageclass,ncageid)
+  call check_ncerror(ncret)
+
+  if (option_verbose.ge.10) write(*,10) 'release point dimensions'
+  ncret = nf_def_dim(ncid,'releases',numpoint,ncrelid)
+  call check_ncerror(ncret)
+  
+  ncret = nf_def_dim(ncid,'ReleaseStrLen',45,ncstr2id)
+  call check_ncerror(ncret)
+
+  ncret = nf_def_dim(ncid,'ReleaseStartEnd',2,ncrseid)
+  call check_ncerror(ncret)
+
+  ! Select which dimensions to use for main output grids
+  ncdimsid3(1) = nclonid ! X
+  ncdimsid3(2) = nclatid ! Y
+  ncdimsid3(3) = nclvlid ! Z
+  if (ldirect.eq.1) ncdimsid3(4) = ncspcid ! species
+  if (ldirect.eq.-1) ncdimsid3(4) = ncrelid ! points
+  ncdimsid3(5) = ncageid ! ageclass
+  ncdimsid3(6) = ncrecid ! t
+
+  ncdimsid2(1) = nclonid ! X
+  ncdimsid2(2) = nclatid ! Y
+  if (ldirect.eq.1) ncdimsid2(3) = ncspcid ! species
+  if (ldirect.eq.-1) ncdimsid2(3) = ncrelid ! points
+  ncdimsid2(4) = ncageid ! ageclass
+  ncdimsid2(5) = ncrecid ! t
+
+  ! Set up dimension variables
+  !***************************
+
+  ! XLONG
+  if (option_verbose.ge.10) write(*,10) 'XLONG dimension variable'
+  ncret = nf_def_var(ncid,'XLONG',nf_real,2,ncdimsid2(1:2),nclonvid)
+
+!     Turn on deflate compression, fletcher32 checksum.
+!  ncret = NF_DEF_VAR_deflate(ncid,nclonvid, shuffle, 1, deflate_level)
+!           if (ncret .ne. nf_noerr) call handle_err(retval)
+!          ncret = NF_DEF_VAR_FLETCHER32(ncid, nclonvid, NF_FLETCHER32)
+!           if (ncret .ne. nf_noerr) call handle_err(retval)
+
+!  ncret = nf_def_var_deflate(ncid,'XLONG',nf_real,2,ncdimsid2(1:2),nclonvid,deflate_level=deflate_level)
+
+  call check_ncerror(ncret)
+  ncret = nf_put_att_text(ncid,nclonvid,descr,42,'Longitude of center grid, west is negative')
+  call check_ncerror(ncret)
+  ncret = nf_put_att_text(ncid,nclonvid,units,11,'degree_east')
+  call check_ncerror(ncret)
+
+  ncret = nf_def_var(ncid,'XLONG_CORNER',nf_real,2,ncdimsid2(1:2),nclonvid2)
+  call check_ncerror(ncret)
+  ncret = nf_put_att_text(ncid,nclonvid2,descr,57,'Longitude of lower left corner of grids, west is negative')
+  call check_ncerror(ncret)
+  ncret = nf_put_att_text(ncid,nclonvid2,units,11,'degree_east')
+  call check_ncerror(ncret)
+
+
+  ! XLAT
+  if (option_verbose.ge.10) write(*,10) 'XLAT dimension variable'
+  ncret = nf_def_var(ncid,'XLAT',nf_real,2,ncdimsid2(1:2),nclatvid)
+! ncret = nf_def_var_deflate(ncid,'XLAT',nf_real,2,ncdimsid2(1:2),nclatvid,deflate_level=deflate_level)
+!  ncret = NF_DEF_VAR_deflate(ncid,nclatvid, shuffle, 1, deflate_level)
+  call check_ncerror(ncret)
+  ncret = nf_put_att_text(ncid,nclatvid,descr,42,'Latitude of center grid, south is negative')
+  call check_ncerror(ncret)
+  ncret = nf_put_att_text(ncid,nclatvid,units,12,'degree_north')
+  call check_ncerror(ncret)
+
+  ncret = nf_def_var(ncid,'XLAT_CORNER',nf_real,2,ncdimsid2(1:2),nclatvid2)
+  call check_ncerror(ncret)
+  ncret = nf_put_att_text(ncid,nclatvid2,descr,57,'Latitude of lower left corner of grids, south is negative')
+  call check_ncerror(ncret)
+  ncret = nf_put_att_text(ncid,nclatvid2,units,12,'degree_north')
+  call check_ncerror(ncret)
+
+  ! ZTOP
+  if (option_verbose.ge.10) write(*,10) 'ZTOP dimension variable'
+  ncret = nf_def_var(ncid,'ZTOP',nf_real,1,ncdimsid3(3),nclvlvid)
+!  ncret = NF_DEF_VAR_deflate(ncid,nclvlvid, shuffle, 1, deflate_level)
+  call check_ncerror(ncret)
+  ncret = nf_put_att_text(ncid,nclvlvid,descr,32, &
+    'UPPER BOUNDARY OF MODEL LAYER')
+  call check_ncerror(ncret)
+  ncret = nf_put_att_text(ncid,nclvlvid,units,1,'m')
+  call check_ncerror(ncret)
+
+  ! SPECIES
+  if (option_verbose.ge.10) write(*,10) 'SPECIES dimension variable'
+  ncret = nf_def_var(ncid,'SPECIES',nf_char,2,(/ncstr1id,ncspcid/),ncspcvid)
+!  ncret = NF_DEF_VAR_deflate(ncid,ncspcvid, shuffle, 1, deflate_level)
+  call check_ncerror(ncret)
+  ncret = nf_put_att_text(ncid,ncspcvid,descr,15,'NAME OF SPECIES')
+  call check_ncerror(ncret)
+
+  ! AGECLASSES
+  if (option_verbose.ge.10) write(*,10) 'AGECLASSES dimension variable'
+  ncret = nf_def_var(ncid,'AGECLASS',nf_int,1,ncageid,ncagevid)
+!  ncret = NF_DEF_VAR_deflate(ncid,ncagevid, shuffle, 1, deflate_level)
+  call check_ncerror(ncret)
+  ncret = nf_put_att_text(ncid,ncagevid,descr,27,'MAX AGE OF SPECIES IN CLASS')
+  call check_ncerror(ncret)
+  ncret = nf_put_att_text(ncid,ncagevid,units,1,'s')
+  call check_ncerror(ncret)
+
+  ! TIMES
+  if (option_verbose.ge.10) write(*,10) 'TIMES dimension variable'
+  ncret = nf_def_var(ncid,'Times',nf_char,2,(/ncstr3id,ncrecid/),ncrecvid)
+!  ncret = NF_DEF_VAR_deflate(ncid,ncrecvid, shuffle, 1, deflate_level)
+  call check_ncerror(ncret)
+  ncret = nf_put_att_text(ncid,ncrecvid,descr,42, &
+    'TIME OF OUTPUT (END OF AVERAGING INTERVAL)')
+
+  ! Release related variables
+  if (option_verbose.ge.10) write(*,10) 'ReleaseName variable'
+  ncret = nf_def_var(ncid,'ReleaseName',nf_char,2,(/ncstr2id,ncrelid/),ncrnvid)
+!  ncret = NF_DEF_VAR_deflate(ncid,ncrnvid, shuffle, 1, deflate_level)
+  call check_ncerror(ncret)
+  ncret = nf_put_att_text(ncid,ncrnvid,descr,25,'RELEASE IDENTIFIER/COMMENT')
+  call check_ncerror(ncret)
+  ncret = nf_put_att_text(ncid,ncrnvid,units,1,'-')
+  call check_ncerror(ncret)
+
+  if (option_verbose.ge.10) write(*,10) 'ReleaseTstart_end variable'
+  ncret = nf_def_var(ncid,'ReleaseTstart_end', &
+    nf_int,2,(/ncrseid,ncrelid/),ncrtvid)
+!  ncret = NF_DEF_VAR_deflate(ncid,ncrtvid, shuffle, 1, deflate_level)
+  call check_ncerror(ncret)
+  ncret = nf_put_att_text(ncid,ncrtvid,descr,32, &
+    'BEGINNING/ENDING TIME OF RELEASE (SECONDS SINCE RUN START)')
+  call check_ncerror(ncret)
+  ncret = nf_put_att_text(ncid,ncrtvid,units,1,'s')
+  call check_ncerror(ncret)
+
+  if (option_verbose.ge.10) write(*,10) 'ReleaseXstart_end variable'
+  ncret = nf_def_var(ncid,'ReleaseXstart_end',  &
+    nf_float,2,(/ncrseid,ncrelid/),ncrxvid)
+!  ncret = NF_DEF_VAR_deflate(ncid,ncrxvid, shuffle, 1, deflate_level)
+  call check_ncerror(ncret)
+  ncret = nf_put_att_text(ncid,ncrxvid,descr,32, &
+    'WEST/EAST BOUNDARIES OF SOURCE')
+  call check_ncerror(ncret)
+  ncret = nf_put_att_text(ncid,ncrxvid,units,12,'degree_north')
+  call check_ncerror(ncret)
+
+  if (option_verbose.ge.10) write(*,10) 'ReleaseYstart_end variable'
+  ncret = nf_def_var(ncid,'ReleaseYstart_end',  &
+    nf_float,2,(/ncrseid,ncrelid/),ncryvid)
+!  ncret = NF_DEF_VAR_deflate(ncid,ncryvid, shuffle, 1, deflate_level)
+  call check_ncerror(ncret)
+  ncret = nf_put_att_text(ncid,ncryvid,descr,32, &
+    'SOUTH/NORTH BOUNDARIES OF SOURCE')
+  call check_ncerror(ncret)
+  ncret = nf_put_att_text(ncid,ncryvid,units,12,'degree_north')
+  call check_ncerror(ncret)
+
+  if (option_verbose.ge.10) write(*,10) 'ReleaseZstart_end variable'
+  ncret = nf_def_var(ncid,'ReleaseZstart_end',  &
+    nf_float,2,(/ncrseid,ncrelid/),ncrzvid)
+!  ncret = NF_DEF_VAR_deflate(ncid,ncrzvid, shuffle, 1, deflate_level)
+  call check_ncerror(ncret)
+  ncret = nf_put_att_text(ncid,ncrzvid,descr,31, &
+    'BOTTOM/TOP BOUNDARIES OF SOURCE')
+  call check_ncerror(ncret)
+  ncret = nf_put_att_text(ncid,ncrzvid,units,1,'m')
+  call check_ncerror(ncret)
+
+  if (option_verbose.ge.10) write(*,10) 'ReleaseNP variable'
+  ncret = nf_def_var(ncid,'ReleaseNP',nf_int,1,ncrelid,ncspvid)
+!  ncret = NF_DEF_VAR_deflate(ncid,ncspvid, shuffle, 1, deflate_level)
+  call check_ncerror(ncret)
+  ncret = nf_put_att_text(ncid,ncspvid,descr,34, &
+    'TOTAL NUMBER OF PARTICLES RELEASED')
+  ncret = nf_put_att_text(ncid,ncspvid,units,1,'-')
+  call check_ncerror(ncret)
+
+  if (option_verbose.ge.10) write(*,10) 'ReleaseXMass variable'
+  ncret = nf_def_var(ncid,'ReleaseXMass',nf_real,2,(/ncspcid,ncrelid/),ncrmvid)
+!  ncret = NF_DEF_VAR_deflate(ncid,ncrmvid, shuffle, 1, deflate_level)
+  call check_ncerror(ncret)
+  ncret = nf_put_att_text(ncid,ncrmvid,descr,18,'TOTAL MASS RELEASED')
+  call check_ncerror(ncret)
+  ncret = nf_put_att_text(ncid,ncrmvid,units,2,'kg')
+  call check_ncerror(ncret)
+
+  ! Since we need to exit define mode before we can insert
+  ! variable data, we will include the last file attributes and
+  ! define the last variables here.
+
+  ! DIRECTION INDEPENDENT OUTPUT VARIABLES
+  if (option_verbose.ge.10) write(*,10) 'TOPOGRAPHY variable'
+  ncret = nf_def_var(ncid,'TOPOGRAPHY',NF_real,2,ncdimsid2(1:2),nctovid)
+! ncret = nf_def_var_deflate(ncid,'TOPOGRAPHY',NF_real,2,ncdimsid2(1:2),nctovid,deflate_level=deflate_level)
+!  ncret = NF_DEF_VAR_deflate(ncid,nctovid, shuffle, 1, deflate_level)
+  call check_ncerror(ncret)
+  ncret = nf_put_att_text(ncid,nctovid,descr,33,  &
+    'TERRAIN ELEVATION ABOVE SEA LEVEL')
+  call check_ncerror(ncret)
+  ncret = nf_put_att_text(ncid,nctovid,units,1,'m')
+  call check_ncerror(ncret)
+  ncret = nf_put_att_text(ncid,nctovid,coord,coordxylen,coordxy)
+  call check_ncerror(ncret)
+
+  if (option_verbose.ge.10) write(*,10) 'GRIDAREA variable'
+  ncret = nf_def_var(ncid,'GRIDAREA',NF_real,2,ncdimsid2(1:2),ncarvid)
+! ncret = nf_def_var_deflate(ncid,'GRIDAREA',NF_real,2,ncdimsid2(1:2),ncarvid,deflate_level=deflate_level)
+!  ncret = NF_DEF_VAR_deflate(ncid,ncarvid, shuffle, 1, deflate_level)
+  call check_ncerror(ncret)
+  ncret = nf_put_att_text(ncid,ncarvid,descr,30, &
+    'SURFACE AREA OF EACH GRID CELL')
+  call check_ncerror(ncret)
+  ncret = nf_put_att_text(ncid,ncarvid,units,2,'m2')
+  call check_ncerror(ncret)
+  ncret = nf_put_att_text(ncid,ncarvid,coord,coordxylen,coordxy)
+  call check_ncerror(ncret)
+
+  ! MAIN OUTPUT VARIABLES
+!  if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then ! CONCENTRATION
+!    if (option_verbose.ge.10) write(*,10) 'CONC variable'
+!    ncret = nf_def_var(ncid,'CONC',NF_REAL,6,ncdimsid3,nccovid)
+!!   chunks(1) = ncgrid_nx
+!!   chunks(2) = ncgrid_ny
+!!!   ncret = NF_DEF_VAR_CHUNKING(ncid, nccovid, NF_CHUNKED, chunks)
+!!   if (ncret .ne. nf_noerr) call check_ncerror(ncret)
+!    ncret = NF_DEF_VAR_deflate(ncid,nccovid, shuffle, 1, deflate_level)
+!
+!    call check_ncerror(ncret)
+!    ncret = nf_put_att_text(ncid,nccovid,descr,33, &
+!      'CONCENTRATION OF AIRBORNE SPECIES')
+!    call check_ncerror(ncret)
+!    ncret = nf_put_att_text(ncid,nccovid,coord,coordxylen,coordxy)
+!    call check_ncerror(ncret)
+!  endif
+
+!  if ((iout.eq.2).or.(iout.eq.3)) then  ! MIXING RATIO
+!    if (option_verbose.ge.10) write(*,10) 'MIXINGRATIO variable'
+!    ncret = nf_def_var(ncid,'MIXINGRATIO',NF_REAL,6,ncdimsid3,ncravid)
+!  ncret = NF_DEF_VAR_deflate(ncid,ncravid, shuffle, 1, deflate_level)
+!    call check_ncerror(ncret)
+!    ncret = nf_put_att_text(ncid,ncravid,descr,37, &
+!      'MASS MIXING RATIO OF AIRBORNE SPECIES')
+!    call check_ncerror(ncret)
+!    ncret = nf_put_att_text(ncid,ncravid,coord,coordxylen,coordxy)
+!    call check_ncerror(ncret)
+!  endif
+!
+!  if (ldirect.eq.1) then  ! Forward run
+!    unit2d = 'pg m-2'
+!    unit2dlen = 6
+!
+!    if (option_verbose.ge.10) write(*,10) 'DRYDEP variable'
+!    write(*,*) ncdimsid2
+!    ncret = nf_def_var(ncid,'DRYDEP',NF_REAL,5,ncdimsid2,ncddvid)
+!  ncret = NF_DEF_VAR_deflate(ncid,ncddvid, shuffle, 1, deflate_level)
+!    call check_ncerror(ncret)
+!    ncret = nf_put_att_text(ncid,ncddvid,descr,32, &
+!      'ACCUMULATED TOTAL DRY DEPOSITION')
+!    call check_ncerror(ncret)
+!    ncret = nf_put_att_text(ncid,ncddvid,units,unit2dlen,unit2d)
+!    call check_ncerror(ncret)
+!    ncret = nf_put_att_text(ncid,ncddvid,coord,coordxylen,coordxy)
+!    call check_ncerror(ncret)
+!
+!    if (option_verbose.ge.10) write(*,10) 'WETDEP variable'
+!    ncret = nf_def_var(ncid,'WETDEP',NF_REAL,5,ncdimsid2,ncwdvid)
+!  ncret = NF_DEF_VAR_deflate(ncid,ncwdvid, shuffle, 1, deflate_level)
+!    call check_ncerror(ncret)
+!    ncret = nf_put_att_text(ncid,ncwdvid,descr,32, &
+!      'ACCUMULATED TOTAL WET DEPOSITION')
+!    call check_ncerror(ncret)
+!    ncret = nf_put_att_text(ncid,ncwdvid,units,unit2dlen,unit2d)
+!    call check_ncerror(ncret)
+!    ncret = nf_put_att_text(ncid,ncwdvid,coord,coordxylen,coordxy)
+!    call check_ncerror(ncret)
+!
+!    ! Add unit attr to mixing ratio and concentration fields
+!    ncret = nf_put_att_text(ncid,nccovid,units,6,'ng m-3') !CONC
+!    call check_ncerror(ncret)
+!    ncret = nf_put_att_text(ncid,ncravid,units,3,'ppt')  !MIX
+!    call check_ncerror(ncret)
+!  else                    ! Backward run
+!    if (ind_rel.eq.1) then ! release in mass
+!      write(*,*) 'A'
+!      !Concentration field should be in 's' (?)
+!      ncret = nf_put_att_text(ncid,nccovid,units,1,'s') !CONC
+!      !call check_ncerror(ncret)
+!      !Mixing ratio field should be in 's kg m-3' (?)
+!      !ncret = nf_put_att_text(ncid,ncravid,units,8,'s kg m-3') !RATIO
+!      !call check_ncerror(ncret)
+!    else  ! release in mass mix
+!      !Concentration should be in 's m3 kg-1' (?)
+!      write(*,*) 'B'
+!      ncret = nf_put_att_text(ncid,nccovid,units,9,'s m3 kg-1') !CONC
+!      !call check_ncerror(ncret)
+!      !Mixing ratio should be in 's' (?)
+!      ncret = nf_put_att_text(ncid,ncravid,units,1,'s') !RATIO
+!      !call check_ncerror(ncret)
+!    endif
+!  endif ! Backward/Forward run
+
+  ! EXIT DEFINE MODE, ENTER DATA MODE
+  ncret = nf_enddef(ncid)
+  call check_ncerror(ncret)
+
+  ! DIMENSION VARIABLES
+  if (option_verbose.ge.10) write(*,10) 'ZTOP data'
+  ncret = nf_put_var_real(ncid,nclvlvid,outheight)
+  call check_ncerror(ncret)
+
+  ! X,Y - Lon,Lat
+  if (option_verbose.ge.10) write(*,10) 'XLAT,XLONG data'
+
+  if (outgrid_option.eq.0) then ! irregular
+    do jy=1,ncgrid_ny
+    do ix=1,ncgrid_nx
+      tmpx=ncgrid_xm0+(float(ix)-0.5)*ncgrid_dx
+      tmpy=ncgrid_ym0+(float(jy)-0.5)*ncgrid_dy
+      call xymeter_to_ll_wrf(tmpx,tmpy,tmplon,tmplat)
+      ncret = nf_put_vara_real(ncid,nclonvid,(/ix,jy/),(/1,1/),tmplon)
+      call check_ncerror(ncret)
+      ncret = nf_put_vara_real(ncid,nclatvid,(/ix,jy/),(/1,1/),tmplat)
+      call check_ncerror(ncret)
+      tmpx=ncgrid_xm0+(float(ix)-1.)*ncgrid_dx
+      tmpy=ncgrid_ym0+(float(jy)-1.)*ncgrid_dy
+      call xymeter_to_ll_wrf(tmpx,tmpy,tmplon,tmplat)
+      ncret = nf_put_vara_real(ncid,nclonvid2,(/ix,jy/),(/1,1/),tmplon)
+      call check_ncerror(ncret)
+      ncret = nf_put_vara_real(ncid,nclatvid2,(/ix,jy/),(/1,1/),tmplat)
+      call check_ncerror(ncret)
+    enddo
+    enddo
+  else
+    do jy=1,ncgrid_ny
+    do ix=1,ncgrid_nx
+      call ll_to_xymeter_wrf(ncgrid_swlon,ncgrid_swlat,xsw,ysw)
+      call ll_to_xymeter_wrf(ncgrid_nelon,ncgrid_nelat,xne,yne)
+      tmpx=xsw+(xne-xsw)*float(ix-1)/float(ncgrid_nx-1)
+      tmpy=ysw+(yne-ysw)*float(jy-1)/float(ncgrid_ny-1)
+      call xymeter_to_ll_wrf(tmpx,tmpy,tmplon,tmplat)
+      xl2=ncgrid_lon0+(float(ix)-0.5)*dxoutl !long
+      yl2=ncgrid_lat0+(float(jy)-0.5)*dyoutl !lat
+      ncret = nf_put_vara_real(ncid,nclonvid,(/ix,jy/),(/1,1/),xl2)
+      call check_ncerror(ncret)
+      ncret = nf_put_vara_real(ncid,nclatvid,(/ix,jy/),(/1,1/),yl2)
+      call check_ncerror(ncret)
+      xl2=ncgrid_lon0+(float(ix)-1.)*dxoutl !long
+      yl2=ncgrid_lat0+(float(jy)-1.)*dyoutl !lat
+      ncret = nf_put_vara_real(ncid,nclonvid2,(/ix,jy/),(/1,1/),xl2)
+      call check_ncerror(ncret)
+      ncret = nf_put_vara_real(ncid,nclatvid2,(/ix,jy/),(/1,1/),yl2)
+      call check_ncerror(ncret)
+
+    enddo
+    enddo
+  endif ! outgrid_option
+
+
+  ! Write information on release points: total number, then for each point:
+  ! start, end, coordinates, # of particles, name, mass
+  !************************************************************************
+  do i=1,numpoint
+    xp1=xpoint1(i)*dx+xlon0 ! This is probably wrong, but it seems to be 
+    yp1=ypoint1(i)*dy+ylat0 ! the same in writeheader*.f90, so I'll leave
+    xp2=xpoint2(i)*dx+xlon0 ! it for now... //AD
+    yp2=ypoint2(i)*dy+ylat0 !
+
+    if (option_verbose.ge.10) write(*,10) 'ReleaseTstart_end data'
+    ncret = nf_put_vara_int(ncid,ncrtvid,   & ! ReleaseTstart_end
+      (/1,i/),(/2,1/),(/ireleasestart(i),ireleaseend(i)/))
+    call check_ncerror(ncret)
+
+    if (option_verbose.ge.10) write(*,10) 'ReleaseXstart_end data'
+    ncret = nf_put_vara_real(ncid,ncrxvid,  & ! ReleaseXstart_end
+      (/1,i/),(/2,1/),(/xp1,xp2/))
+    call check_ncerror(ncret)
+
+    if (option_verbose.ge.10) write(*,10) 'ReleaseYstart_end data'
+    ncret = nf_put_vara_real(ncid,ncryvid,  & !ReleaseYstart_end
+      (/1,i/),(/2,1/),(/yp1,yp2/))
+    call check_ncerror(ncret)
+
+    if (option_verbose.ge.10) write(*,10) 'ReleaseZstart_end data'
+    ncret = nf_put_vara_real(ncid,ncrzvid,  & !ReleaseZstart_end
+      (/1,i/),(/2,1/),(/zpoint1(i),zpoint2(i)/))
+    call check_ncerror(ncret)
+
+    if (option_verbose.ge.10) write(*,10) 'ReleaseXMass data'
+    ncret = nf_put_vara_real(ncid,ncrmvid,  & !ReleaseXMass
+      (/1,i/),(/nspec,1/),xmass(i,1:nspec))
+    call check_ncerror(ncret)
+
+    if (option_verbose.ge.10) write(*,10) 'ReleaseNP data'
+    ncret = nf_put_vara_int(ncid,ncspvid,   & !ReleaseNP
+      i,1,npart(i))
+    call check_ncerror(ncret)
+
+    !Release Name/Comment
+    j=1 ! Find the length of each release point comment/name
+    do while( j.lt.45.and.compoint(i)(j+1:j+1).ne." ")
+      j=j+1
+    enddo
+    if (option_verbose.ge.10) write(*,10) 'ReleaseName data'
+    ncret = nf_put_vara_text(ncid,ncrnvid,(/1,i/),(/j,1/),compoint(i)(1:j))
+    call check_ncerror(ncret)
+  enddo
+
+  ! Write age class information
+  !****************************
+  if (option_verbose.ge.10) write(*,10) 'AGECLASSES data'
+  ncret = nf_put_var_int(ncid,ncagevid,lage(1:nageclass))
+  call check_ncerror(ncret)
+
+  ! Write topography to output file
+  !********************************
+  if (option_verbose.ge.10) write(*,10) 'TOPOGRAPHY data'
+! do ix=0,ncgrid_nx-1
+  do ix=1,ncgrid_nx
+    ncret = nf_put_vara_real(ncid,nctovid,  &
+!     (/ix+1,1/),(/1,ncgrid_ny/),ncgrid_oro(ix,0:ncgrid_ny-1))
+      (/ix,1/),(/1,ncgrid_ny/),ncgrid_oro(ix,1:ncgrid_ny))
+    call check_ncerror(ncret)
+  enddo
+
+  ! Write grid cell surface area
+  !*****************************
+  if (option_verbose.ge.10) write(*,10) 'GRIDAREA data'
+! do ix=0,ncgrid_nx-1
+  do ix=1,ncgrid_nx
+    ncret = nf_put_vara_real(ncid,ncarvid,  &
+!     (/ix+1,1/),(/1,ncgrid_ny/),ncgrid_area(ix,0:ncgrid_ny-1))
+      (/ix,1/),(/1,ncgrid_ny/),ncgrid_area(ix,1:ncgrid_ny))
+    call check_ncerror(ncret)
+  enddo
+
+  ! SAVE CREATED NETCDF TO FILE
+  !****************************
+  if (option_verbose.ge.1) write(*,*) 'write_ncheader: writing to disk'
+  ncret = nf_sync(ncid)
+  call check_ncerror(ncret)
+
+  return
+
+10 format('write_ncheader: Setting up ',A)
+
+    ncret=nf_close(ncid)
+    deallocate(ncgrid_oro,ncgrid_area)
+end subroutine write_ncheader
Index: /branches/jerome/src_flexwrf_v3.1/write_ncinfo.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/write_ncinfo.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/write_ncinfo.f90	(revision 16)
@@ -0,0 +1,786 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                *
+!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine,       *
+!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
+!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso,          *
+!* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann,   *
+!* Adam Dingwell                                                      *
+!*                                                                    *
+!* This file is part of FLEXPART WRF                                  *
+!                                                                     *
+! 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 write_ncinfo(itime,nesting_level)
+  
+  !*****************************************************************************
+  !                                                                            *
+  !  This routine perdefines a netcdf ouput file with information on flexpart  *
+  !  settings, releases and topography.                                        *
+  !                                                                            *
+  !      Author: A. Dingwell                                                   *
+  !                                                                            *
+  !      27 May 2013                                                           *
+  !                                                                            *
+  ! Modifications:                                                             *
+  ! June 5 2013: J. Brioude: Create and write attributes to netcdf output only *
+  !*****************************************************************************
+
+  use point_mod
+  use outg_mod
+  use com_mod
+
+  implicit none
+
+  include 'netcdf.inc'
+
+  integer :: itime,stat     ! seconds since simulation start
+  integer :: nesting_level  ! 0 for main grid (mother) 1 for nest (child)
+                            ! this is written to be easy to expand is additional 
+                            ! are desired in the future
+
+  real(kind=dp) :: jul          ! Julian date
+  integer   :: jjjjmmdd,ihmmss  ! date & time as integer
+  character :: adate*8,atime*6  ! date and time strings, used for filename
+
+  ! Grid related variables
+  real    :: xp1,yp1,xp2,yp2  ! temporary coordinates
+  real    :: xsw,xne,ysw,yne,tmpx,tmpy,tmplon,tmplat,xl2,yl2
+  integer :: ncgrid_nx,ncgrid_ny        ! nx,ny of current grid
+  integer :: ncgrid_dx,ncgrid_dy        ! dx,dy of current grid in m or latlon
+  real    :: ncgrid_swlon,ncgrid_swlat  ! SW corner of current grid in latlon
+  real    :: ncgrid_nelon,ncgrid_nelat  ! NE corner of current grid in latlon
+  real    :: ncgrid_xm0,ncgrid_ym0      ! lower-left grid coord in metres
+  real    :: ncgrid_lon0,ncgrid_lat0    ! lower-left grid coord in latlon
+
+  ! Grid related 2D-variables (reassigning these here is a bit inefficient but
+  ! it lets us keep a consistent structure of the code, besides it's only once
+  ! per output
+!  real,allocatable,dimension (:,:)  :: ncgrid_oro,ncgrid_area ! of current grid
+
+  ! Iterators
+  integer i,j,ix,jy
+
+  ! NETCDF file related variables
+  integer nclvlid,nclonid,nclatid,ncrecid,ncspcid,ncageid !outgrid dimension ids
+  integer ncrelid,ncrseid                                 ! release points dimension ids
+  integer ncrnvid,ncrmvid,ncspvid             ! release points: number,mass,species ids
+  integer ncrtvid,ncrxvid,ncryvid,ncrzvid     ! release points: t,x,y,z min/max limits
+  integer nctovid,ncarvid                     ! Topography and grid area variable-ids
+  integer ncstr1id,ncstr2id,ncstr3id          ! decrtiption string length dimid
+  integer nclvlvid,nclonvid,nclatvid,ncspcvid,ncagevid  ! outgrid dimension variables
+  integer ncdimsid3(6),ncdimsid2(5) ! arrays of dimension ids for outgrid 3D & 2D
+  integer ncdimsid32(7),ncdimsid22(6) ! arrays of dimension ids for outgrid 3D & 2D
+
+  ! NETCDF filename & attribute related variables
+  character descr*11,units*5,ncname*29,coord*11,coordxy*10
+  integer coordxylen
+  character unit2d*10   ! unit for deposition fields
+  integer   unit2dlen   ! length of character string
+
+  ! NETCDF misc variables
+  integer ncid    ! local container for netcdf file-id (either ncout or ncoutn)
+  integer ncret   ! Return-value of calls to nf_* utils
+  integer :: deflate_level=4 ! compression level
+  integer :: shuffle=0 ! shuffle
+! integer :: chunks(2) ! shuffle
+  ! Attribute notation:
+  descr = 'description'
+  units = 'units'
+  coord = 'coordinates'
+  coordxy = 'XLONG XLAT'
+  coordxylen = 10
+
+  ! 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 header output file
+  !************************
+  write(ncname,'(A8,I2.2,A1,I8.8,A1,I6.6,A3)') &
+    'flxout_d',nesting_level+1,'_',jjjjmmdd,'_',ihmmss,'.nc' ! filename
+
+! print*,'step0',itime,jjjjmmdd,ihmmss
+
+!  call nf_set_log_level(3)
+  if (option_verbose.ge.1) write(*,*) &
+    'write_ncinfo: creating file: ',path(1)(1:length(1))//ncname
+! call nf_set_chunk_cache(32000000)
+! ncret = nf_create(path(1)(1:length(1))//ncname, nf_clobber,ncid)
+  ncret = nf_create(path(1)(1:length(1))//ncname, NF_NETCDF4,ncid)
+! print*,'step1',ncret
+  call check_ncerror(ncret)
+  
+
+  ! Determine which nest/outfile we just created so we can set up the grid
+  !***********************************************************************
+  if (nesting_level.eq.0) then  ! current grid is main grid
+    ncout   = ncid  ! copy current file handle to ncout
+    ncgrid_nx = numxgrid
+    ncgrid_ny = numygrid
+    ncgrid_nelon = outgrid_nelon
+    ncgrid_nelat = outgrid_nelat
+    ncgrid_swlon = outgrid_swlon
+    ncgrid_swlat = outgrid_swlat
+!   allocate(ncgrid_oro(ncgrid_nx,ncgrid_ny),stat=stat)
+!   allocate(ncgrid_area(ncgrid_nx,ncgrid_ny),stat=stat)
+!   ncgrid_oro   = oroout(0:ncgrid_nx-1,0:ncgrid_ny-1)
+!   ncgrid_area  = area(0:ncgrid_nx-1,0:ncgrid_ny-1)
+!   print*,'step2'
+    if (outgrid_option.eq.1) then ! input was in latlon
+      ncgrid_dx = dxoutl
+      ncgrid_dy = dyoutl
+      ncgrid_lon0 = outlon0
+      ncgrid_lat0 = outlat0
+    else  ! input was in metres
+      ncgrid_dx = dxout
+      ncgrid_dy = dyout
+      ncgrid_xm0  = out_xm0
+      ncgrid_ym0  = out_ym0
+    endif
+  elseif (nesting_level.eq.1) then  ! current grid is nested
+    ncoutn  = ncid  ! copy current file handle to ncoutn
+    ncgrid_nx = numxgridn
+    ncgrid_ny = numygridn
+    ncgrid_nelon = outgridn_nelon
+    ncgrid_nelat = outgridn_nelat
+    ncgrid_swlon = outgridn_swlon
+    ncgrid_swlat = outgridn_swlat
+!   allocate(ncgrid_oro(ncgrid_nx,ncgrid_ny),stat=stat)
+!   allocate(ncgrid_area(ncgrid_nx,ncgrid_ny),stat=stat)
+!   ncgrid_oro   = orooutn(0:ncgrid_nx-1,0:ncgrid_ny-1)
+!   ncgrid_area  = arean(0:ncgrid_nx-1,0:ncgrid_ny-1)
+    if (outgrid_option.eq.1) then ! input was in latlon
+      ncgrid_dx = dxoutln
+      ncgrid_dy = dyoutln
+      ncgrid_lon0 = outlon0n
+      ncgrid_lat0 = outlat0n
+    else  ! input was in metres
+      ncgrid_dx = dxoutn
+      ncgrid_dy = dyoutn
+      ncgrid_xm0  = out_xm0n
+      ncgrid_ym0  = out_ym0n
+    endif
+  endif
+!   print*,'step3'
+
+  if (option_verbose.ge.10) &
+    write(*,*) 'write_ncheader: ncout,ncoutn=',ncout,ncoutn
+
+  ! Write the header information
+  !*****************************
+
+  !ncret = nf_put_att_text(ncout,nf_global,'TITLE',20,version)
+  !call check_ncerror(ncret)
+!  print*,'continue'
+  if (ldirect.eq.1) then  ! Forward simulation
+    if (option_verbose.ge.10) write(*,10) 'forward simulation attributes'
+    ncret = nf_put_att_int(ncid,nf_global,'SIMULATION_START_DATE',nf_int,1,ibdate)
+    call check_ncerror(ncret)
+    ncret = nf_put_att_int(ncid,nf_global,'SIMULATION_START_TIME',nf_int,1,ibtime)
+    call check_ncerror(ncret)
+
+    ncret = nf_put_att_int(ncid,nf_global,'SIMULATION_END_DATE',nf_int,1,iedate)
+    call check_ncerror(ncret)
+    ncret = nf_put_att_int(ncid,nf_global,'SIMULATION_END_TIME',nf_int,1,ietime)
+    call check_ncerror(ncret)
+  else                  ! Backward simulation
+    if (option_verbose.ge.10) write(*,10) 'backward simulation attributes'
+    ncret = nf_put_att_int(ncid,nf_global,'SIMULATION_START_DATE',nf_int,1,iedate)
+    call check_ncerror(ncret)
+    ncret = nf_put_att_int(ncid,nf_global,'SIMULATION_START_TIME',nf_int,1,ietime)
+    call check_ncerror(ncret)
+
+    ncret = nf_put_att_int(ncid,nf_global,'SIMULATION_END_DATE',nf_int,1,ibdate)
+    call check_ncerror(ncret)
+    ncret = nf_put_att_int(ncid,nf_global,'SIMULATION_END_TIME',nf_int,1,ibtime)
+    call check_ncerror(ncret)
+  endif
+
+  if (option_verbose.ge.10) write(*,10) 'map projection attributes'
+  if (outgrid_option .eq. 1) then
+    ncret = &
+      nf_put_att_text(ncid,nf_global,'OUTPUT_PROJECTION',20,'Regular Latit/Longit')
+    call check_ncerror(ncret)
+  else
+    if (map_proj_id.eq.1) then
+      ncret = &
+        nf_put_att_text(ncid,nf_global,'OUTPUT_PROJECTION',17,'Lambert conformal')
+      call check_ncerror(ncret)
+    elseif (map_proj_id.eq.2) then
+      ncret = &
+        nf_put_att_text(ncid,nf_global,'OUTPUT_PROJECTION',13,'stereographic')
+      call check_ncerror(ncret)
+    elseif (map_proj_id.eq.3) then
+      ncret = &
+        nf_put_att_text(ncid,nf_global,'OUTPUT_PROJECTION',8,'mercator')
+      call check_ncerror(ncret)
+    elseif (map_proj_id.eq.4) then
+      ncret = &
+        nf_put_att_text(ncid,nf_global,'OUTPUT_PROJECTION',6,'global')
+      call check_ncerror(ncret)
+    endif
+  endif
+
+  ! Write info common model settings
+  !*********************************
+  if (option_verbose.ge.10) write(*,10) 'common model attributes'
+
+  if (option_verbose.ge.10) write(*,10) 'OUTPUT_INTERVAL'
+  ncret = nf_put_att_int(ncid,nf_global,'OUTPUT_INTERVAL',nf_int,1,loutstep)
+  call check_ncerror(ncret)
+
+  if (option_verbose.ge.10) write(*,10) 'AVERAGING_TIME'
+  ncret = nf_put_att_int(ncid,nf_global,'AVERAGING_TIME',nf_int,1,loutaver)
+  call check_ncerror(ncret)
+
+  if (option_verbose.ge.10) write(*,10) 'AVERAGE_SAMPLING'
+  ncret = nf_put_att_int(ncid,nf_global,'AVERAGE_SAMPLING',nf_int,1,loutsample)
+  call check_ncerror(ncret)
+
+  ncret = nf_put_att_int(ncid,nf_global,'NSPEC',nf_int,1,nspec)
+  call check_ncerror(ncret)
+  ncret = nf_put_att_int(ncid,nf_global,'NUMRECEPTOR',nf_int,1,numreceptor)
+  call check_ncerror(ncret)
+  ncret = nf_put_att_int(ncid,nf_global,'NAGECLASS',nf_int,1,nageclass)
+  call check_ncerror(ncret)
+
+  ncret = nf_put_att_int(ncid,nf_global,'NUMRELEASES',nf_int,1,numpoint)
+  call check_ncerror(ncret)
+
+  ncret = nf_put_att_int(ncid,nf_global,'DISPERSION_METHOD',nf_int,1,method)
+  call check_ncerror(ncret)
+
+  ncret = nf_put_att_int(ncid,nf_global,'SUBGRID_TOPOGRAPHY',nf_int,1,lsubgrid)
+  call check_ncerror(ncret)
+
+  ncret = nf_put_att_int(ncid,nf_global,'CONVECTION_PARAM',nf_int,1,lconvection)
+  call check_ncerror(ncret)
+
+  ncret = nf_put_att_int(ncid,nf_global,'SUBGRID_TOPOGRAPHY',nf_int,1,lsubgrid)
+  call check_ncerror(ncret)
+
+  ! Write information on output grid setup
+  !***************************************
+  if (option_verbose.ge.10) write(*,10) 'WEST-EAST_GRID_DIMENSION'
+  ncret = nf_put_att_int(ncid,nf_global,'WEST-EAST_GRID_DIMENSION', &
+    nf_int,1,ncgrid_nx)
+  call check_ncerror(ncret)
+
+  if (option_verbose.ge.10) write(*,10) 'SOUTH-NORTH_GRID_DIMENSION'
+  ncret = nf_put_att_int(ncid,nf_global,'SOUTH-NORTH_GRID_DIMENSION', &
+    nf_int,1,ncgrid_ny)
+  call check_ncerror(ncret)
+  
+  if (option_verbose.ge.10) write(*,10) 'BOTTOM-TOP_GRID_DIMENSION'
+  ncret = nf_put_att_int(ncid,nf_global,'BOTTOM-TOP_GRID_DIMENSION', &
+    nf_int,1,numzgrid)
+
+  if (option_verbose.ge.10) write(*,10) 'DX and DY'
+  ncret = nf_put_att_int(ncid,nf_global,'DX',nf_int,1,ncgrid_dx)
+  call check_ncerror(ncret)
+
+  ncret = nf_put_att_int(ncid,nf_global,'DY',nf_int,1,ncgrid_dy)
+  call check_ncerror(ncret)
+
+  ! Set up netcdf dimensions
+  !*************************
+  if (option_verbose.ge.10) write(*,10) 'main grid dimensions'
+
+  ncret = nf_def_dim(ncid,'Time',nf_unlimited,ncrecid)
+  call check_ncerror(ncret)
+
+  ncret = nf_def_dim(ncid,'DateStrLen',15,ncstr3id) !TODO: WRF format
+  call check_ncerror(ncret)
+
+  ncret = nf_def_dim(ncid,'west_east',ncgrid_nx,nclonid)
+  call check_ncerror(ncret)
+
+  ncret = nf_def_dim(ncid,'south_north',ncgrid_ny,nclatid)
+  call check_ncerror(ncret)
+
+  ncret = nf_def_dim(ncid,'bottom_top',numzgrid,nclvlid)
+  call check_ncerror(ncret)
+
+  ncret = nf_def_dim(ncid,'species',nspec,ncspcid)
+  call check_ncerror(ncret)
+
+  ncret = nf_def_dim(ncid,'SpeciesStrLen',10,ncstr1id)
+  call check_ncerror(ncret)
+
+  ncret = nf_def_dim(ncid,'ageclass',nageclass,ncageid)
+  call check_ncerror(ncret)
+
+  if (option_verbose.ge.10) write(*,10) 'release point dimensions'
+  ncret = nf_def_dim(ncid,'releases',numpoint,ncrelid)
+  call check_ncerror(ncret)
+  
+  ncret = nf_def_dim(ncid,'ReleaseStrLen',45,ncstr2id)
+  call check_ncerror(ncret)
+
+  ncret = nf_def_dim(ncid,'ReleaseStartEnd',2,ncrseid)
+  call check_ncerror(ncret)
+
+  ! Select which dimensions to use for main output grids
+  if ((ldirect.eq.1).and.(maxpointspec_act.gt.1)) then
+  ncdimsid32(1) = nclonid ! X
+  ncdimsid32(2) = nclatid ! Y
+  ncdimsid32(3) = nclvlid ! Z
+  ncdimsid32(4) = ncrelid ! points
+  ncdimsid32(5) = ncspcid ! species
+  ncdimsid32(6) = ncageid ! ageclass
+  ncdimsid32(7) = ncrecid ! t
+
+  ncdimsid22(1) = nclonid ! X
+  ncdimsid22(2) = nclatid ! Y
+  ncdimsid22(3) = ncrelid ! points
+  ncdimsid22(4) = ncspcid ! species
+  ncdimsid22(5) = ncageid ! ageclass
+  ncdimsid22(6) = ncrecid ! t
+
+  else
+  ncdimsid3(1) = nclonid ! X
+  ncdimsid3(2) = nclatid ! Y
+  ncdimsid3(3) = nclvlid ! Z
+  if (ldirect.eq.1) ncdimsid3(4) = ncspcid ! species
+  if (ldirect.eq.-1) ncdimsid3(4) = ncrelid ! points
+  ncdimsid3(5) = ncageid ! ageclass
+  ncdimsid3(6) = ncrecid ! t
+
+  ncdimsid2(1) = nclonid ! X
+  ncdimsid2(2) = nclatid ! Y
+  if (ldirect.eq.1) ncdimsid2(3) = ncspcid ! species
+  if (ldirect.eq.-1) ncdimsid2(3) = ncrelid ! points
+  ncdimsid2(4) = ncageid ! ageclass
+  ncdimsid2(5) = ncrecid ! t
+  endif
+!
+!  ! Set up dimension variables
+!  !***************************
+!
+!  ! XLONG
+!  if (option_verbose.ge.10) write(*,10) 'XLONG dimension variable'
+!  ncret = nf_def_var(ncid,'XLONG',nf_real,2,ncdimsid2(1:2),nclonvid)
+!
+!!     Turn on deflate compression, fletcher32 checksum.
+!  ncret = NF_DEF_VAR_deflate(ncid,nclonvid, shuffle, 1, deflate_level)
+!!           if (ncret .ne. nf_noerr) call handle_err(retval)
+!!          ncret = NF_DEF_VAR_FLETCHER32(ncid, nclonvid, NF_FLETCHER32)
+!!           if (ncret .ne. nf_noerr) call handle_err(retval)
+!
+!!  ncret = nf_def_var_deflate(ncid,'XLONG',nf_real,2,ncdimsid2(1:2),nclonvid,deflate_level=deflate_level)
+!  call check_ncerror(ncret)
+!  ncret = nf_put_att_text(ncid,nclonvid,descr,27,'LONGITUDE, WEST IS NEGATIVE')
+!  call check_ncerror(ncret)
+!  ncret = nf_put_att_text(ncid,nclonvid,units,11,'degree_east')
+!  call check_ncerror(ncret)
+!
+!  ! XLAT
+!  if (option_verbose.ge.10) write(*,10) 'XLAT dimension variable'
+!  ncret = nf_def_var(ncid,'XLAT',nf_real,2,ncdimsid2(1:2),nclatvid)
+!! ncret = nf_def_var_deflate(ncid,'XLAT',nf_real,2,ncdimsid2(1:2),nclatvid,deflate_level=deflate_level)
+!  ncret = NF_DEF_VAR_deflate(ncid,nclatvid, shuffle, 1, deflate_level)
+!  call check_ncerror(ncret)
+!  ncret = nf_put_att_text(ncid,nclatvid,descr,27,'LATITUDE, SOUTH IS NEGATIVE')
+!  call check_ncerror(ncret)
+!  ncret = nf_put_att_text(ncid,nclatvid,units,12,'degree_north')
+!  call check_ncerror(ncret)
+!
+!  ! ZTOP
+!  if (option_verbose.ge.10) write(*,10) 'ZTOP dimension variable'
+!  ncret = nf_def_var(ncid,'ZTOP',nf_real,1,ncdimsid3(3),nclvlvid)
+!  ncret = NF_DEF_VAR_deflate(ncid,nclvlvid, shuffle, 1, deflate_level)
+!  call check_ncerror(ncret)
+!  ncret = nf_put_att_text(ncid,nclvlvid,descr,32, &
+!    'UPPER BOUNDARY OF MODEL LAYER')
+!  call check_ncerror(ncret)
+!  ncret = nf_put_att_text(ncid,nclvlvid,units,1,'m')
+!  call check_ncerror(ncret)
+!
+!  ! SPECIES
+!  if (option_verbose.ge.10) write(*,10) 'SPECIES dimension variable'
+!  ncret = nf_def_var(ncid,'SPECIES',nf_char,2,(/ncstr1id,ncspcid/),ncspcvid)
+!  ncret = NF_DEF_VAR_deflate(ncid,ncspcvid, shuffle, 1, deflate_level)
+!  call check_ncerror(ncret)
+!  ncret = nf_put_att_text(ncid,ncspcvid,descr,15,'NAME OF SPECIES')
+!  call check_ncerror(ncret)
+!
+!  ! AGECLASSES
+!  if (option_verbose.ge.10) write(*,10) 'AGECLASSES dimension variable'
+!  ncret = nf_def_var(ncid,'AGECLASS',nf_int,1,ncageid,ncagevid)
+!  ncret = NF_DEF_VAR_deflate(ncid,ncagevid, shuffle, 1, deflate_level)
+!  call check_ncerror(ncret)
+!  ncret = nf_put_att_text(ncid,ncagevid,descr,27,'MAX AGE OF SPECIES IN CLASS')
+!  call check_ncerror(ncret)
+!  ncret = nf_put_att_text(ncid,ncagevid,units,1,'s')
+!  call check_ncerror(ncret)
+!
+!  ! TIMES
+   if (option_verbose.ge.10) write(*,10) 'TIMES dimension variable'
+   ncret = nf_def_var(ncid,'Times',nf_char,2,(/ncstr3id,ncrecid/),ncrecvid)
+   ncret = NF_DEF_VAR_deflate(ncid,ncrecvid, shuffle, 1, deflate_level)
+   call check_ncerror(ncret)
+   ncret = nf_put_att_text(ncid,ncrecvid,descr,42, &
+     'TIME OF OUTPUT (END OF AVERAGING INTERVAL)')
+!
+!  ! Release related variables
+!  if (option_verbose.ge.10) write(*,10) 'ReleaseName variable'
+!  ncret = nf_def_var(ncid,'ReleaseName',nf_char,2,(/ncstr2id,ncrelid/),ncrnvid)
+!  ncret = NF_DEF_VAR_deflate(ncid,ncrnvid, shuffle, 1, deflate_level)
+!  call check_ncerror(ncret)
+!  ncret = nf_put_att_text(ncid,ncrnvid,descr,25,'RELEASE IDENTIFIER/COMMENT')
+!  call check_ncerror(ncret)
+!  ncret = nf_put_att_text(ncid,ncrnvid,units,1,'-')
+!  call check_ncerror(ncret)
+!
+!  if (option_verbose.ge.10) write(*,10) 'ReleaseTstart_end variable'
+!  ncret = nf_def_var(ncid,'ReleaseTstart_end', &
+!    nf_int,2,(/ncrseid,ncrelid/),ncrtvid)
+!  ncret = NF_DEF_VAR_deflate(ncid,ncrtvid, shuffle, 1, deflate_level)
+!  call check_ncerror(ncret)
+!  ncret = nf_put_att_text(ncid,ncrtvid,descr,32, &
+!    'BEGINNING/ENDING TIME OF RELEASE (SECONDS SINCE RUN START)')
+!  call check_ncerror(ncret)
+!  ncret = nf_put_att_text(ncid,ncrtvid,units,1,'s')
+!  call check_ncerror(ncret)
+!
+!  if (option_verbose.ge.10) write(*,10) 'ReleaseXstart_end variable'
+!  ncret = nf_def_var(ncid,'ReleaseXstart_end',  &
+!    nf_float,2,(/ncrseid,ncrelid/),ncrxvid)
+!  ncret = NF_DEF_VAR_deflate(ncid,ncrxvid, shuffle, 1, deflate_level)
+!  call check_ncerror(ncret)
+!  ncret = nf_put_att_text(ncid,ncrxvid,descr,32, &
+!    'WEST/EAST BOUNDARIES OF SOURCE')
+!  call check_ncerror(ncret)
+!  ncret = nf_put_att_text(ncid,ncrxvid,units,12,'degree_north')
+!  call check_ncerror(ncret)
+!
+!  if (option_verbose.ge.10) write(*,10) 'ReleaseYstart_end variable'
+!  ncret = nf_def_var(ncid,'ReleaseYstart_end',  &
+!    nf_float,2,(/ncrseid,ncrelid/),ncryvid)
+!  ncret = NF_DEF_VAR_deflate(ncid,ncryvid, shuffle, 1, deflate_level)
+!  call check_ncerror(ncret)
+!  ncret = nf_put_att_text(ncid,ncryvid,descr,32, &
+!    'SOUTH/NORTH BOUNDARIES OF SOURCE')
+!  call check_ncerror(ncret)
+!  ncret = nf_put_att_text(ncid,ncryvid,units,12,'degree_north')
+!  call check_ncerror(ncret)
+!
+!  if (option_verbose.ge.10) write(*,10) 'ReleaseZstart_end variable'
+!  ncret = nf_def_var(ncid,'ReleaseZstart_end',  &
+!    nf_float,2,(/ncrseid,ncrelid/),ncrzvid)
+!  ncret = NF_DEF_VAR_deflate(ncid,ncrzvid, shuffle, 1, deflate_level)
+!  call check_ncerror(ncret)
+!  ncret = nf_put_att_text(ncid,ncrzvid,descr,31, &
+!    'BOTTOM/TOP BOUNDARIES OF SOURCE')
+!  call check_ncerror(ncret)
+!  ncret = nf_put_att_text(ncid,ncrzvid,units,1,'m')
+!  call check_ncerror(ncret)
+!
+!  if (option_verbose.ge.10) write(*,10) 'ReleaseNP variable'
+!  ncret = nf_def_var(ncid,'ReleaseNP',nf_int,1,ncrelid,ncspvid)
+!  ncret = NF_DEF_VAR_deflate(ncid,ncspvid, shuffle, 1, deflate_level)
+!  call check_ncerror(ncret)
+!  ncret = nf_put_att_text(ncid,ncspvid,descr,34, &
+!    'TOTAL NUMBER OF PARTICLES RELEASED')
+!  ncret = nf_put_att_text(ncid,ncspvid,units,1,'-')
+!  call check_ncerror(ncret)
+!
+!  if (option_verbose.ge.10) write(*,10) 'ReleaseXMass variable'
+!  ncret = nf_def_var(ncid,'ReleaseXMass',nf_real,2,(/ncspcid,ncrelid/),ncrmvid)
+!  ncret = NF_DEF_VAR_deflate(ncid,ncrmvid, shuffle, 1, deflate_level)
+!  call check_ncerror(ncret)
+!  ncret = nf_put_att_text(ncid,ncrmvid,descr,18,'TOTAL MASS RELEASED')
+!  call check_ncerror(ncret)
+!  ncret = nf_put_att_text(ncid,ncrmvid,units,2,'kg')
+!  call check_ncerror(ncret)
+!
+!  ! Since we need to exit define mode before we can insert
+!  ! variable data, we will include the last file attributes and
+!  ! define the last variables here.
+!
+!  ! DIRECTION INDEPENDENT OUTPUT VARIABLES
+!  if (option_verbose.ge.10) write(*,10) 'TOPOGRAPHY variable'
+!  ncret = nf_def_var(ncid,'TOPOGRAPHY',NF_real,2,ncdimsid2(1:2),nctovid)
+!! ncret = nf_def_var_deflate(ncid,'TOPOGRAPHY',NF_real,2,ncdimsid2(1:2),nctovid,deflate_level=deflate_level)
+!  ncret = NF_DEF_VAR_deflate(ncid,nctovid, shuffle, 1, deflate_level)
+!  call check_ncerror(ncret)
+!  ncret = nf_put_att_text(ncid,nctovid,descr,33,  &
+!    'TERRAIN ELEVATION ABOVE SEA LEVEL')
+!  call check_ncerror(ncret)
+!  ncret = nf_put_att_text(ncid,nctovid,units,1,'m')
+!  call check_ncerror(ncret)
+!  ncret = nf_put_att_text(ncid,nctovid,coord,coordxylen,coordxy)
+!  call check_ncerror(ncret)
+!
+!  if (option_verbose.ge.10) write(*,10) 'GRIDAREA variable'
+!  ncret = nf_def_var(ncid,'GRIDAREA',NF_real,2,ncdimsid2(1:2),ncarvid)
+!! ncret = nf_def_var_deflate(ncid,'GRIDAREA',NF_real,2,ncdimsid2(1:2),ncarvid,deflate_level=deflate_level)
+!  ncret = NF_DEF_VAR_deflate(ncid,ncarvid, shuffle, 1, deflate_level)
+!  call check_ncerror(ncret)
+!  ncret = nf_put_att_text(ncid,ncarvid,descr,30, &
+!    'SURFACE AREA OF EACH GRID CELL')
+!  call check_ncerror(ncret)
+!  ncret = nf_put_att_text(ncid,ncarvid,units,2,'m2')
+!  call check_ncerror(ncret)
+!  ncret = nf_put_att_text(ncid,ncarvid,coord,coordxylen,coordxy)
+!  call check_ncerror(ncret)
+!
+  ! MAIN OUTPUT VARIABLES
+  if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then ! CONCENTRATION
+    if (option_verbose.ge.10) write(*,10) 'CONC variable'
+!   print*,ncdimsid3
+  if ((ldirect.eq.1).and.(maxpointspec_act.gt.1)) then
+    ncret = nf_def_var(ncid,'CONC',NF_REAL,7,ncdimsid32,nccovid)
+  else
+    ncret = nf_def_var(ncid,'CONC',NF_REAL,6,ncdimsid3,nccovid)
+  endif
+!   chunks(1) = ncgrid_nx
+!   chunks(2) = ncgrid_ny
+!!   ncret = NF_DEF_VAR_CHUNKING(ncid, nccovid, NF_CHUNKED, chunks)
+   if (ncret .ne. nf_noerr) call check_ncerror(ncret)
+    ncret = NF_DEF_VAR_deflate(ncid,nccovid, shuffle, 1, deflate_level)
+
+    call check_ncerror(ncret)
+    ncret = nf_put_att_text(ncid,nccovid,descr,33, &
+      'CONCENTRATION OF AIRBORNE SPECIES')
+    call check_ncerror(ncret)
+    ncret = nf_put_att_text(ncid,nccovid,coord,coordxylen,coordxy)
+    call check_ncerror(ncret)
+  endif
+
+  if ((iout.eq.2).or.(iout.eq.3)) then  ! MIXING RATIO
+    if (option_verbose.ge.10) write(*,10) 'MIXINGRATIO variable'
+  if ((ldirect.eq.1).and.(maxpointspec_act.gt.1)) then
+    ncret = nf_def_var(ncid,'MIXINGRATIO',NF_REAL,7,ncdimsid32,ncravid)
+  else
+    ncret = nf_def_var(ncid,'MIXINGRATIO',NF_REAL,6,ncdimsid3,ncravid)
+  endif
+  ncret = NF_DEF_VAR_deflate(ncid,ncravid, shuffle, 1, deflate_level)
+    call check_ncerror(ncret)
+    ncret = nf_put_att_text(ncid,ncravid,descr,37, &
+      'MASS MIXING RATIO OF AIRBORNE SPECIES')
+    call check_ncerror(ncret)
+    ncret = nf_put_att_text(ncid,ncravid,coord,coordxylen,coordxy)
+    call check_ncerror(ncret)
+  endif
+
+  if (ldirect.eq.1) then  ! Forward run
+    unit2d = 'pg m-2'
+    unit2dlen = 6
+
+    if (option_verbose.ge.10) write(*,10) 'DRYDEP variable'
+!   write(*,*) ncdimsid2
+  if ((ldirect.eq.1).and.(maxpointspec_act.gt.1)) then
+    ncret = nf_def_var(ncid,'DRYDEP',NF_REAL,6,ncdimsid22,ncddvid)
+   else
+    ncret = nf_def_var(ncid,'DRYDEP',NF_REAL,5,ncdimsid2,ncddvid)
+   endif
+  ncret = NF_DEF_VAR_deflate(ncid,ncddvid, shuffle, 1, deflate_level)
+    call check_ncerror(ncret)
+    ncret = nf_put_att_text(ncid,ncddvid,descr,32, &
+      'ACCUMULATED TOTAL DRY DEPOSITION')
+    call check_ncerror(ncret)
+    ncret = nf_put_att_text(ncid,ncddvid,units,unit2dlen,unit2d)
+    call check_ncerror(ncret)
+    ncret = nf_put_att_text(ncid,ncddvid,coord,coordxylen,coordxy)
+    call check_ncerror(ncret)
+
+    if (option_verbose.ge.10) write(*,10) 'WETDEP variable'
+  if ((ldirect.eq.1).and.(maxpointspec_act.gt.1)) then
+    ncret = nf_def_var(ncid,'WETDEP',NF_REAL,6,ncdimsid22,ncwdvid)
+  else
+    ncret = nf_def_var(ncid,'WETDEP',NF_REAL,5,ncdimsid2,ncwdvid)
+   endif
+  ncret = NF_DEF_VAR_deflate(ncid,ncwdvid, shuffle, 1, deflate_level)
+    call check_ncerror(ncret)
+    ncret = nf_put_att_text(ncid,ncwdvid,descr,32, &
+      'ACCUMULATED TOTAL WET DEPOSITION')
+!    call check_ncerror(ncret)
+    ncret = nf_put_att_text(ncid,ncwdvid,units,unit2dlen,unit2d)
+    call check_ncerror(ncret)
+    ncret = nf_put_att_text(ncid,ncwdvid,coord,coordxylen,coordxy)
+    call check_ncerror(ncret)
+
+    ! Add unit attr to mixing ratio and concentration fields
+    if (ind_samp.eq.0) then
+    ncret = nf_put_att_text(ncid,nccovid,units,6,'ng m-3') !CONC
+    call check_ncerror(ncret)
+    ncret = nf_put_att_text(ncid,ncravid,units,4,'ppt')  !MIX
+    call check_ncerror(ncret)
+    else
+    ncret = nf_put_att_text(ncid,nccovid,units,11,'ppt by mass') !CONC
+    call check_ncerror(ncret)
+!    ncret = nf_put_att_text(ncid,ncravid,units,3,'???')  !MIX
+!    call check_ncerror(ncret)
+    endif
+  else                    ! Backward run
+!   if ((ind_rel.eq.0).and.(ind_samp.eq.0) then ! release in mass
+!     write(*,*) 'A'
+      !Concentration field should be in 's' (?)
+    if ((ind_rel.eq.0).and.(ind_samp.eq.0)) ncret = nf_put_att_text(ncid,nccovid,units,1,'s') !CONC
+    if ((ind_rel.eq.0).and.(ind_samp.eq.-1)) ncret = nf_put_att_text(ncid,nccovid,units,9,'s m3 kg-1') !CONC
+    if ((ind_rel.eq.1).and.(ind_samp.eq.0)) ncret = nf_put_att_text(ncid,nccovid,units,8,'s kg m-3') !CONC
+    if ((ind_rel.eq.1).and.(ind_samp.eq.-1)) ncret = nf_put_att_text(ncid,nccovid,units,1,'s') !CONC
+      !call check_ncerror(ncret)
+      !Mixing ratio field should be in 's kg m-3' (?)
+      !ncret = nf_put_att_text(ncid,ncravid,units,8,'s kg m-3') !RATIO
+      !call check_ncerror(ncret)
+!    else  ! release in mass mix
+      !Concentration should be in 's m3 kg-1' (?)
+!     write(*,*) 'B'
+!      ncret = nf_put_att_text(ncid,nccovid,units,9,'s m3 kg-1') !CONC
+      !call check_ncerror(ncret)
+      !Mixing ratio should be in 's' (?)
+      !ncret = nf_put_att_text(ncid,ncravid,units,1,'s') !RATIO
+      !call check_ncerror(ncret)
+!    endif
+  endif ! Backward/Forward run
+
+  ! EXIT DEFINE MODE, ENTER DATA MODE
+  ncret = nf_enddef(ncid)
+  call check_ncerror(ncret)
+
+  ! DIMENSION VARIABLES
+!  if (option_verbose.ge.10) write(*,10) 'ZTOP data'
+!  ncret = nf_put_var_real(ncid,nclvlvid,outheight)
+!  call check_ncerror(ncret)
+
+!  ! X,Y - Lon,Lat
+!  if (option_verbose.ge.10) write(*,10) 'XLAT,XLONG data'
+!
+!  if (outgrid_option.eq.0) then ! irregular
+!    do jy=1,ncgrid_ny
+!    do ix=1,ncgrid_nx
+!      tmpx=ncgrid_xm0+(float(ix)-0.5)*ncgrid_dx
+!      tmpy=ncgrid_ym0+(float(jy)-0.5)*ncgrid_dy
+!      call xymeter_to_ll_wrf(tmpx,tmpy,tmplon,tmplat)
+!      ncret = nf_put_vara_real(ncid,nclonvid,(/ix,jy/),(/1,1/),tmplon)
+!      call check_ncerror(ncret)
+!      ncret = nf_put_vara_real(ncid,nclatvid,(/ix,jy/),(/1,1/),tmplat)
+!      call check_ncerror(ncret)
+!    enddo
+!    enddo
+!  else
+!    do jy=1,ncgrid_ny
+!    do ix=1,ncgrid_nx
+!      call ll_to_xymeter_wrf(ncgrid_swlon,ncgrid_swlat,xsw,ysw)
+!      call ll_to_xymeter_wrf(ncgrid_nelon,ncgrid_nelat,xne,yne)
+!      tmpx=xsw+(xne-xsw)*float(ix-1)/float(ncgrid_nx-1)
+!      tmpy=ysw+(yne-ysw)*float(jy-1)/float(ncgrid_ny-1)
+!      call xymeter_to_ll_wrf(tmpx,tmpy,tmplon,tmplat)
+!      xl2=ncgrid_lon0+(float(ix)-0.5)*dxoutl !long
+!      yl2=ncgrid_lat0+(float(jy)-0.5)*dyoutl !lat
+!      ncret = nf_put_vara_real(ncid,nclonvid,(/ix,jy/),(/1,1/),xl2)
+!      call check_ncerror(ncret)
+!      ncret = nf_put_vara_real(ncid,nclatvid,(/ix,jy/),(/1,1/),yl2)
+!      call check_ncerror(ncret)
+!    enddo
+!    enddo
+!  endif ! outgrid_option
+
+
+!  ! Write information on release points: total number, then for each point:
+!  ! start, end, coordinates, # of particles, name, mass
+!  !************************************************************************
+!  do i=1,numpoint
+!    xp1=xpoint1(i)*dx+xlon0 ! This is probably wrong, but it seems to be 
+!    yp1=ypoint1(i)*dy+ylat0 ! the same in writeheader*.f90, so I'll leave
+!    xp2=xpoint2(i)*dx+xlon0 ! it for now... //AD
+!    yp2=ypoint2(i)*dy+ylat0 !
+!
+!    if (option_verbose.ge.10) write(*,10) 'ReleaseTstart_end data'
+!    ncret = nf_put_vara_int(ncid,ncrtvid,   & ! ReleaseTstart_end
+!      (/1,i/),(/2,1/),(/ireleasestart(i),ireleaseend(i)/))
+!    call check_ncerror(ncret)
+!
+!    if (option_verbose.ge.10) write(*,10) 'ReleaseXstart_end data'
+!    ncret = nf_put_vara_real(ncid,ncrxvid,  & ! ReleaseXstart_end
+!      (/1,i/),(/2,1/),(/xp1,xp2/))
+!    call check_ncerror(ncret)
+!
+!    if (option_verbose.ge.10) write(*,10) 'ReleaseYstart_end data'
+!    ncret = nf_put_vara_real(ncid,ncryvid,  & !ReleaseYstart_end
+!      (/1,i/),(/2,1/),(/yp1,yp2/))
+!    call check_ncerror(ncret)
+!
+!    if (option_verbose.ge.10) write(*,10) 'ReleaseZstart_end data'
+!    ncret = nf_put_vara_real(ncid,ncrzvid,  & !ReleaseZstart_end
+!      (/1,i/),(/2,1/),(/zpoint1(i),zpoint2(i)/))
+!    call check_ncerror(ncret)
+!
+!    if (option_verbose.ge.10) write(*,10) 'ReleaseXMass data'
+!    ncret = nf_put_vara_real(ncid,ncrmvid,  & !ReleaseXMass
+!      (/1,i/),(/nspec,1/),xmass(i,1:nspec))
+!    call check_ncerror(ncret)
+!
+!    if (option_verbose.ge.10) write(*,10) 'ReleaseNP data'
+!    ncret = nf_put_vara_int(ncid,ncspvid,   & !ReleaseNP
+!      i,1,npart(i))
+!    call check_ncerror(ncret)
+!
+!    !Release Name/Comment
+!    j=1 ! Find the length of each release point comment/name
+!    do while( j.lt.45.and.compoint(i)(j+1:j+1).ne." ")
+!      j=j+1
+!    enddo
+!    if (option_verbose.ge.10) write(*,10) 'ReleaseName data'
+!    ncret = nf_put_vara_text(ncid,ncrnvid,(/1,i/),(/j,1/),compoint(i)(1:j))
+!    call check_ncerror(ncret)
+!  enddo
+!
+!  ! Write age class information
+!  !****************************
+!  if (option_verbose.ge.10) write(*,10) 'AGECLASSES data'
+!  ncret = nf_put_var_int(ncid,ncagevid,lage(1:nageclass))
+!  call check_ncerror(ncret)
+!
+!  ! Write topography to output file
+!  !********************************
+!  if (option_verbose.ge.10) write(*,10) 'TOPOGRAPHY data'
+!! do ix=0,ncgrid_nx-1
+!  do ix=1,ncgrid_nx
+!    ncret = nf_put_vara_real(ncid,nctovid,  &
+!!     (/ix+1,1/),(/1,ncgrid_ny/),ncgrid_oro(ix,0:ncgrid_ny-1))
+!      (/ix,1/),(/1,ncgrid_ny/),ncgrid_oro(ix,1:ncgrid_ny))
+!    call check_ncerror(ncret)
+!  enddo
+!
+!  ! Write grid cell surface area
+!  !*****************************
+!  if (option_verbose.ge.10) write(*,10) 'GRIDAREA data'
+!! do ix=0,ncgrid_nx-1
+!  do ix=1,ncgrid_nx
+!    ncret = nf_put_vara_real(ncid,ncarvid,  &
+!!     (/ix+1,1/),(/1,ncgrid_ny/),ncgrid_area(ix,0:ncgrid_ny-1))
+!      (/ix,1/),(/1,ncgrid_ny/),ncgrid_area(ix,1:ncgrid_ny))
+!    call check_ncerror(ncret)
+!  enddo
+!
+!  ! SAVE CREATED NETCDF TO FILE
+!  !****************************
+!  if (option_verbose.ge.1) write(*,*) 'write_ncheader: writing to disk'
+!  ncret = nf_sync(ncid)
+!  call check_ncerror(ncret)
+
+  return
+
+10 format('write_ncheader: Setting up ',A)
+
+!   deallocate(ncgrid_oro,ncgrid_area)
+end subroutine write_ncinfo
Index: /branches/jerome/src_flexwrf_v3.1/write_ncinfo_v3.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/write_ncinfo_v3.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/write_ncinfo_v3.f90	(revision 16)
@@ -0,0 +1,774 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                *
+!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine,       *
+!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
+!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso,          *
+!* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann,   *
+!* Adam Dingwell                                                      *
+!*                                                                    *
+!* This file is part of FLEXPART WRF                                  *
+!                                                                     *
+! 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 write_ncinfo(itime,nesting_level)
+  
+  !*****************************************************************************
+  !                                                                            *
+  !  This routine perdefines a netcdf ouput file with information on flexpart  *
+  !  settings, releases and topography.                                        *
+  !                                                                            *
+  !      Author: A. Dingwell                                                   *
+  !                                                                            *
+  !      27 May 2013                                                           *
+  !                                                                            *
+  ! Modifications:                                                             *
+  ! June 5 2013: J. Brioude: Create and write attributes to netcdf output only *
+  !*****************************************************************************
+
+  use point_mod
+  use outg_mod
+  use com_mod
+
+  implicit none
+
+  include 'netcdf.inc'
+
+  integer :: itime,stat     ! seconds since simulation start
+  integer :: nesting_level  ! 0 for main grid (mother) 1 for nest (child)
+                            ! this is written to be easy to expand is additional 
+                            ! are desired in the future
+
+  real(kind=dp) :: jul          ! Julian date
+  integer   :: jjjjmmdd,ihmmss  ! date & time as integer
+  character :: adate*8,atime*6  ! date and time strings, used for filename
+
+  ! Grid related variables
+  real    :: xp1,yp1,xp2,yp2  ! temporary coordinates
+  real    :: xsw,xne,ysw,yne,tmpx,tmpy,tmplon,tmplat,xl2,yl2
+  integer :: ncgrid_nx,ncgrid_ny        ! nx,ny of current grid
+  integer :: ncgrid_dx,ncgrid_dy        ! dx,dy of current grid in m or latlon
+  real    :: ncgrid_swlon,ncgrid_swlat  ! SW corner of current grid in latlon
+  real    :: ncgrid_nelon,ncgrid_nelat  ! NE corner of current grid in latlon
+  real    :: ncgrid_xm0,ncgrid_ym0      ! lower-left grid coord in metres
+  real    :: ncgrid_lon0,ncgrid_lat0    ! lower-left grid coord in latlon
+
+  ! Grid related 2D-variables (reassigning these here is a bit inefficient but
+  ! it lets us keep a consistent structure of the code, besides it's only once
+  ! per output
+!  real,allocatable,dimension (:,:)  :: ncgrid_oro,ncgrid_area ! of current grid
+
+  ! Iterators
+  integer i,j,ix,jy
+
+  ! NETCDF file related variables
+  integer nclvlid,nclonid,nclatid,ncrecid,ncspcid,ncageid !outgrid dimension ids
+  integer ncrelid,ncrseid                                 ! release points dimension ids
+  integer ncrnvid,ncrmvid,ncspvid             ! release points: number,mass,species ids
+  integer ncrtvid,ncrxvid,ncryvid,ncrzvid     ! release points: t,x,y,z min/max limits
+  integer nctovid,ncarvid                     ! Topography and grid area variable-ids
+  integer ncstr1id,ncstr2id,ncstr3id          ! decrtiption string length dimid
+  integer nclvlvid,nclonvid,nclatvid,ncspcvid,ncagevid  ! outgrid dimension variables
+  integer ncdimsid3(6),ncdimsid2(5) ! arrays of dimension ids for outgrid 3D & 2D
+  integer ncdimsid32(7),ncdimsid22(6) ! arrays of dimension ids for outgrid 3D & 2D
+
+  ! NETCDF filename & attribute related variables
+  character descr*11,units*5,ncname*29,coord*11,coordxy*10
+  integer coordxylen
+  character unit2d*10   ! unit for deposition fields
+  integer   unit2dlen   ! length of character string
+
+  ! NETCDF misc variables
+  integer ncid    ! local container for netcdf file-id (either ncout or ncoutn)
+  integer ncret   ! Return-value of calls to nf_* utils
+  integer :: deflate_level=4 ! compression level
+  integer :: shuffle=0 ! shuffle
+! integer :: chunks(2) ! shuffle
+  ! Attribute notation:
+  descr = 'description'
+  units = 'units'
+  coord = 'coordinates'
+  coordxy = 'XLONG XLAT'
+  coordxylen = 10
+
+  ! 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 header output file
+  !************************
+  write(ncname,'(A8,I2.2,A1,I8.8,A1,I6.6,A3)') &
+    'flxout_d',nesting_level+1,'_',jjjjmmdd,'_',ihmmss,'.nc' ! filename
+
+! print*,'step0',itime,jjjjmmdd,ihmmss
+
+!  call nf_set_log_level(3)
+  if (option_verbose.ge.1) write(*,*) &
+    'write_ncinfo: creating file: ',path(1)(1:length(1))//ncname
+! call nf_set_chunk_cache(32000000)
+  ncret = nf_create(path(1)(1:length(1))//ncname, nf_clobber,ncid)
+! ncret = nf_create(path(1)(1:length(1))//ncname, NF_NETCDF4,ncid)
+! print*,'step1',ncret
+  call check_ncerror(ncret)
+  
+
+  ! Determine which nest/outfile we just created so we can set up the grid
+  !***********************************************************************
+  if (nesting_level.eq.0) then  ! current grid is main grid
+    ncout   = ncid  ! copy current file handle to ncout
+    ncgrid_nx = numxgrid
+    ncgrid_ny = numygrid
+    ncgrid_nelon = outgrid_nelon
+    ncgrid_nelat = outgrid_nelat
+    ncgrid_swlon = outgrid_swlon
+    ncgrid_swlat = outgrid_swlat
+!   allocate(ncgrid_oro(ncgrid_nx,ncgrid_ny),stat=stat)
+!   allocate(ncgrid_area(ncgrid_nx,ncgrid_ny),stat=stat)
+!   ncgrid_oro   = oroout(0:ncgrid_nx-1,0:ncgrid_ny-1)
+!   ncgrid_area  = area(0:ncgrid_nx-1,0:ncgrid_ny-1)
+!   print*,'step2'
+    if (outgrid_option.eq.1) then ! input was in latlon
+      ncgrid_dx = dxoutl
+      ncgrid_dy = dyoutl
+      ncgrid_lon0 = outlon0
+      ncgrid_lat0 = outlat0
+    else  ! input was in metres
+      ncgrid_dx = dxout
+      ncgrid_dy = dyout
+      ncgrid_xm0  = out_xm0
+      ncgrid_ym0  = out_ym0
+    endif
+  elseif (nesting_level.eq.1) then  ! current grid is nested
+    ncoutn  = ncid  ! copy current file handle to ncoutn
+    ncgrid_nx = numxgridn
+    ncgrid_ny = numygridn
+    ncgrid_nelon = outgridn_nelon
+    ncgrid_nelat = outgridn_nelat
+    ncgrid_swlon = outgridn_swlon
+    ncgrid_swlat = outgridn_swlat
+!   allocate(ncgrid_oro(ncgrid_nx,ncgrid_ny),stat=stat)
+!   allocate(ncgrid_area(ncgrid_nx,ncgrid_ny),stat=stat)
+!   ncgrid_oro   = orooutn(0:ncgrid_nx-1,0:ncgrid_ny-1)
+!   ncgrid_area  = arean(0:ncgrid_nx-1,0:ncgrid_ny-1)
+    if (outgrid_option.eq.1) then ! input was in latlon
+      ncgrid_dx = dxoutln
+      ncgrid_dy = dyoutln
+      ncgrid_lon0 = outlon0n
+      ncgrid_lat0 = outlat0n
+    else  ! input was in metres
+      ncgrid_dx = dxoutn
+      ncgrid_dy = dyoutn
+      ncgrid_xm0  = out_xm0n
+      ncgrid_ym0  = out_ym0n
+    endif
+  endif
+!   print*,'step3'
+
+  if (option_verbose.ge.10) &
+    write(*,*) 'write_ncheader: ncout,ncoutn=',ncout,ncoutn
+
+  ! Write the header information
+  !*****************************
+
+  !ncret = nf_put_att_text(ncout,nf_global,'TITLE',20,version)
+  !call check_ncerror(ncret)
+!  print*,'continue'
+  if (ldirect.eq.1) then  ! Forward simulation
+    if (option_verbose.ge.10) write(*,10) 'forward simulation attributes'
+    ncret = nf_put_att_int(ncid,nf_global,'SIMULATION_START_DATE',nf_int,1,ibdate)
+    call check_ncerror(ncret)
+    ncret = nf_put_att_int(ncid,nf_global,'SIMULATION_START_TIME',nf_int,1,ibtime)
+    call check_ncerror(ncret)
+
+    ncret = nf_put_att_int(ncid,nf_global,'SIMULATION_END_DATE',nf_int,1,iedate)
+    call check_ncerror(ncret)
+    ncret = nf_put_att_int(ncid,nf_global,'SIMULATION_END_TIME',nf_int,1,ietime)
+    call check_ncerror(ncret)
+  else                  ! Backward simulation
+    if (option_verbose.ge.10) write(*,10) 'backward simulation attributes'
+    ncret = nf_put_att_int(ncid,nf_global,'SIMULATION_START_DATE',nf_int,1,iedate)
+    call check_ncerror(ncret)
+    ncret = nf_put_att_int(ncid,nf_global,'SIMULATION_START_TIME',nf_int,1,ietime)
+    call check_ncerror(ncret)
+
+    ncret = nf_put_att_int(ncid,nf_global,'SIMULATION_END_DATE',nf_int,1,ibdate)
+    call check_ncerror(ncret)
+    ncret = nf_put_att_int(ncid,nf_global,'SIMULATION_END_TIME',nf_int,1,ibtime)
+    call check_ncerror(ncret)
+  endif
+
+  if (option_verbose.ge.10) write(*,10) 'map projection attributes'
+  if (outgrid_option .eq. 1) then
+    ncret = &
+      nf_put_att_text(ncid,nf_global,'OUTPUT_PROJECTION',20,'Regular Latit/Longit')
+    call check_ncerror(ncret)
+  else
+    if (map_proj_id.eq.1) then
+      ncret = &
+        nf_put_att_text(ncid,nf_global,'OUTPUT_PROJECTION',17,'Lambert conformal')
+      call check_ncerror(ncret)
+    elseif (map_proj_id.eq.2) then
+      ncret = &
+        nf_put_att_text(ncid,nf_global,'OUTPUT_PROJECTION',13,'stereographic')
+      call check_ncerror(ncret)
+    elseif (map_proj_id.eq.3) then
+      ncret = &
+        nf_put_att_text(ncid,nf_global,'OUTPUT_PROJECTION',8,'mercator')
+      call check_ncerror(ncret)
+    elseif (map_proj_id.eq.4) then
+      ncret = &
+        nf_put_att_text(ncid,nf_global,'OUTPUT_PROJECTION',6,'global')
+      call check_ncerror(ncret)
+    endif
+  endif
+
+  ! Write info common model settings
+  !*********************************
+  if (option_verbose.ge.10) write(*,10) 'common model attributes'
+
+  if (option_verbose.ge.10) write(*,10) 'OUTPUT_INTERVAL'
+  ncret = nf_put_att_int(ncid,nf_global,'OUTPUT_INTERVAL',nf_int,1,loutstep)
+  call check_ncerror(ncret)
+
+  if (option_verbose.ge.10) write(*,10) 'AVERAGING_TIME'
+  ncret = nf_put_att_int(ncid,nf_global,'AVERAGING_TIME',nf_int,1,loutaver)
+  call check_ncerror(ncret)
+
+  if (option_verbose.ge.10) write(*,10) 'AVERAGE_SAMPLING'
+  ncret = nf_put_att_int(ncid,nf_global,'AVERAGE_SAMPLING',nf_int,1,loutsample)
+  call check_ncerror(ncret)
+
+  ncret = nf_put_att_int(ncid,nf_global,'NSPEC',nf_int,1,nspec)
+  call check_ncerror(ncret)
+  ncret = nf_put_att_int(ncid,nf_global,'NUMRECEPTOR',nf_int,1,numreceptor)
+  call check_ncerror(ncret)
+  ncret = nf_put_att_int(ncid,nf_global,'NAGECLASS',nf_int,1,nageclass)
+  call check_ncerror(ncret)
+
+  ncret = nf_put_att_int(ncid,nf_global,'NUMRELEASES',nf_int,1,numpoint)
+  call check_ncerror(ncret)
+
+  ncret = nf_put_att_int(ncid,nf_global,'DISPERSION_METHOD',nf_int,1,method)
+  call check_ncerror(ncret)
+
+  ncret = nf_put_att_int(ncid,nf_global,'SUBGRID_TOPOGRAPHY',nf_int,1,lsubgrid)
+  call check_ncerror(ncret)
+
+  ncret = nf_put_att_int(ncid,nf_global,'CONVECTION_PARAM',nf_int,1,lconvection)
+  call check_ncerror(ncret)
+
+  ncret = nf_put_att_int(ncid,nf_global,'SUBGRID_TOPOGRAPHY',nf_int,1,lsubgrid)
+  call check_ncerror(ncret)
+
+  ! Write information on output grid setup
+  !***************************************
+  if (option_verbose.ge.10) write(*,10) 'WEST-EAST_GRID_DIMENSION'
+  ncret = nf_put_att_int(ncid,nf_global,'WEST-EAST_GRID_DIMENSION', &
+    nf_int,1,ncgrid_nx)
+  call check_ncerror(ncret)
+
+  if (option_verbose.ge.10) write(*,10) 'SOUTH-NORTH_GRID_DIMENSION'
+  ncret = nf_put_att_int(ncid,nf_global,'SOUTH-NORTH_GRID_DIMENSION', &
+    nf_int,1,ncgrid_ny)
+  call check_ncerror(ncret)
+  
+  if (option_verbose.ge.10) write(*,10) 'BOTTOM-TOP_GRID_DIMENSION'
+  ncret = nf_put_att_int(ncid,nf_global,'BOTTOM-TOP_GRID_DIMENSION', &
+    nf_int,1,numzgrid)
+
+  if (option_verbose.ge.10) write(*,10) 'DX and DY'
+  ncret = nf_put_att_int(ncid,nf_global,'DX',nf_int,1,ncgrid_dx)
+  call check_ncerror(ncret)
+
+  ncret = nf_put_att_int(ncid,nf_global,'DY',nf_int,1,ncgrid_dy)
+  call check_ncerror(ncret)
+
+  ! Set up netcdf dimensions
+  !*************************
+  if (option_verbose.ge.10) write(*,10) 'main grid dimensions'
+
+  ncret = nf_def_dim(ncid,'Time',nf_unlimited,ncrecid)
+  call check_ncerror(ncret)
+
+  ncret = nf_def_dim(ncid,'DateStrLen',15,ncstr3id) !TODO: WRF format
+  call check_ncerror(ncret)
+
+  ncret = nf_def_dim(ncid,'west_east',ncgrid_nx,nclonid)
+  call check_ncerror(ncret)
+
+  ncret = nf_def_dim(ncid,'south_north',ncgrid_ny,nclatid)
+  call check_ncerror(ncret)
+
+  ncret = nf_def_dim(ncid,'bottom_top',numzgrid,nclvlid)
+  call check_ncerror(ncret)
+
+  ncret = nf_def_dim(ncid,'species',nspec,ncspcid)
+  call check_ncerror(ncret)
+
+  ncret = nf_def_dim(ncid,'SpeciesStrLen',10,ncstr1id)
+  call check_ncerror(ncret)
+
+  ncret = nf_def_dim(ncid,'ageclass',nageclass,ncageid)
+  call check_ncerror(ncret)
+
+  if (option_verbose.ge.10) write(*,10) 'release point dimensions'
+  ncret = nf_def_dim(ncid,'releases',numpoint,ncrelid)
+  call check_ncerror(ncret)
+  
+  ncret = nf_def_dim(ncid,'ReleaseStrLen',45,ncstr2id)
+  call check_ncerror(ncret)
+
+  ncret = nf_def_dim(ncid,'ReleaseStartEnd',2,ncrseid)
+  call check_ncerror(ncret)
+
+  ! Select which dimensions to use for main output grids
+  if ((ldirect.eq.1).and.(maxpointspec_act.gt.1)) then
+  ncdimsid32(1) = nclonid ! X
+  ncdimsid32(2) = nclatid ! Y
+  ncdimsid32(3) = nclvlid ! Z
+  ncdimsid32(4) = ncrelid ! points
+  ncdimsid32(5) = ncspcid ! species
+  ncdimsid32(6) = ncageid ! ageclass
+  ncdimsid32(7) = ncrecid ! t
+
+  ncdimsid22(1) = nclonid ! X
+  ncdimsid22(2) = nclatid ! Y
+  ncdimsid22(3) = ncrelid ! points
+  ncdimsid22(4) = ncspcid ! species
+  ncdimsid22(5) = ncageid ! ageclass
+  ncdimsid22(6) = ncrecid ! t
+
+  else
+  ncdimsid3(1) = nclonid ! X
+  ncdimsid3(2) = nclatid ! Y
+  ncdimsid3(3) = nclvlid ! Z
+  if (ldirect.eq.1) ncdimsid3(4) = ncspcid ! species
+  if (ldirect.eq.-1) ncdimsid3(4) = ncrelid ! points
+  ncdimsid3(5) = ncageid ! ageclass
+  ncdimsid3(6) = ncrecid ! t
+
+  ncdimsid2(1) = nclonid ! X
+  ncdimsid2(2) = nclatid ! Y
+  if (ldirect.eq.1) ncdimsid2(3) = ncspcid ! species
+  if (ldirect.eq.-1) ncdimsid2(3) = ncrelid ! points
+  ncdimsid2(4) = ncageid ! ageclass
+  ncdimsid2(5) = ncrecid ! t
+  endif
+!
+!  ! Set up dimension variables
+!  !***************************
+!
+!  ! XLONG
+!  if (option_verbose.ge.10) write(*,10) 'XLONG dimension variable'
+!  ncret = nf_def_var(ncid,'XLONG',nf_real,2,ncdimsid2(1:2),nclonvid)
+!
+!!     Turn on deflate compression, fletcher32 checksum.
+!  ncret = NF_DEF_VAR_deflate(ncid,nclonvid, shuffle, 1, deflate_level)
+!!           if (ncret .ne. nf_noerr) call handle_err(retval)
+!!          ncret = NF_DEF_VAR_FLETCHER32(ncid, nclonvid, NF_FLETCHER32)
+!!           if (ncret .ne. nf_noerr) call handle_err(retval)
+!
+!!  ncret = nf_def_var_deflate(ncid,'XLONG',nf_real,2,ncdimsid2(1:2),nclonvid,deflate_level=deflate_level)
+!  call check_ncerror(ncret)
+!  ncret = nf_put_att_text(ncid,nclonvid,descr,27,'LONGITUDE, WEST IS NEGATIVE')
+!  call check_ncerror(ncret)
+!  ncret = nf_put_att_text(ncid,nclonvid,units,11,'degree_east')
+!  call check_ncerror(ncret)
+!
+!  ! XLAT
+!  if (option_verbose.ge.10) write(*,10) 'XLAT dimension variable'
+!  ncret = nf_def_var(ncid,'XLAT',nf_real,2,ncdimsid2(1:2),nclatvid)
+!! ncret = nf_def_var_deflate(ncid,'XLAT',nf_real,2,ncdimsid2(1:2),nclatvid,deflate_level=deflate_level)
+!  ncret = NF_DEF_VAR_deflate(ncid,nclatvid, shuffle, 1, deflate_level)
+!  call check_ncerror(ncret)
+!  ncret = nf_put_att_text(ncid,nclatvid,descr,27,'LATITUDE, SOUTH IS NEGATIVE')
+!  call check_ncerror(ncret)
+!  ncret = nf_put_att_text(ncid,nclatvid,units,12,'degree_north')
+!  call check_ncerror(ncret)
+!
+!  ! ZTOP
+!  if (option_verbose.ge.10) write(*,10) 'ZTOP dimension variable'
+!  ncret = nf_def_var(ncid,'ZTOP',nf_real,1,ncdimsid3(3),nclvlvid)
+!  ncret = NF_DEF_VAR_deflate(ncid,nclvlvid, shuffle, 1, deflate_level)
+!  call check_ncerror(ncret)
+!  ncret = nf_put_att_text(ncid,nclvlvid,descr,32, &
+!    'UPPER BOUNDARY OF MODEL LAYER')
+!  call check_ncerror(ncret)
+!  ncret = nf_put_att_text(ncid,nclvlvid,units,1,'m')
+!  call check_ncerror(ncret)
+!
+!  ! SPECIES
+!  if (option_verbose.ge.10) write(*,10) 'SPECIES dimension variable'
+!  ncret = nf_def_var(ncid,'SPECIES',nf_char,2,(/ncstr1id,ncspcid/),ncspcvid)
+!  ncret = NF_DEF_VAR_deflate(ncid,ncspcvid, shuffle, 1, deflate_level)
+!  call check_ncerror(ncret)
+!  ncret = nf_put_att_text(ncid,ncspcvid,descr,15,'NAME OF SPECIES')
+!  call check_ncerror(ncret)
+!
+!  ! AGECLASSES
+!  if (option_verbose.ge.10) write(*,10) 'AGECLASSES dimension variable'
+!  ncret = nf_def_var(ncid,'AGECLASS',nf_int,1,ncageid,ncagevid)
+!  ncret = NF_DEF_VAR_deflate(ncid,ncagevid, shuffle, 1, deflate_level)
+!  call check_ncerror(ncret)
+!  ncret = nf_put_att_text(ncid,ncagevid,descr,27,'MAX AGE OF SPECIES IN CLASS')
+!  call check_ncerror(ncret)
+!  ncret = nf_put_att_text(ncid,ncagevid,units,1,'s')
+!  call check_ncerror(ncret)
+!
+!  ! TIMES
+   if (option_verbose.ge.10) write(*,10) 'TIMES dimension variable'
+   ncret = nf_def_var(ncid,'Times',nf_char,2,(/ncstr3id,ncrecid/),ncrecvid)
+!  ncret = NF_DEF_VAR_deflate(ncid,ncrecvid, shuffle, 1, deflate_level)
+   call check_ncerror(ncret)
+   ncret = nf_put_att_text(ncid,ncrecvid,descr,42, &
+     'TIME OF OUTPUT (END OF AVERAGING INTERVAL)')
+!
+!  ! Release related variables
+!  if (option_verbose.ge.10) write(*,10) 'ReleaseName variable'
+!  ncret = nf_def_var(ncid,'ReleaseName',nf_char,2,(/ncstr2id,ncrelid/),ncrnvid)
+!  ncret = NF_DEF_VAR_deflate(ncid,ncrnvid, shuffle, 1, deflate_level)
+!  call check_ncerror(ncret)
+!  ncret = nf_put_att_text(ncid,ncrnvid,descr,25,'RELEASE IDENTIFIER/COMMENT')
+!  call check_ncerror(ncret)
+!  ncret = nf_put_att_text(ncid,ncrnvid,units,1,'-')
+!  call check_ncerror(ncret)
+!
+!  if (option_verbose.ge.10) write(*,10) 'ReleaseTstart_end variable'
+!  ncret = nf_def_var(ncid,'ReleaseTstart_end', &
+!    nf_int,2,(/ncrseid,ncrelid/),ncrtvid)
+!  ncret = NF_DEF_VAR_deflate(ncid,ncrtvid, shuffle, 1, deflate_level)
+!  call check_ncerror(ncret)
+!  ncret = nf_put_att_text(ncid,ncrtvid,descr,32, &
+!    'BEGINNING/ENDING TIME OF RELEASE (SECONDS SINCE RUN START)')
+!  call check_ncerror(ncret)
+!  ncret = nf_put_att_text(ncid,ncrtvid,units,1,'s')
+!  call check_ncerror(ncret)
+!
+!  if (option_verbose.ge.10) write(*,10) 'ReleaseXstart_end variable'
+!  ncret = nf_def_var(ncid,'ReleaseXstart_end',  &
+!    nf_float,2,(/ncrseid,ncrelid/),ncrxvid)
+!  ncret = NF_DEF_VAR_deflate(ncid,ncrxvid, shuffle, 1, deflate_level)
+!  call check_ncerror(ncret)
+!  ncret = nf_put_att_text(ncid,ncrxvid,descr,32, &
+!    'WEST/EAST BOUNDARIES OF SOURCE')
+!  call check_ncerror(ncret)
+!  ncret = nf_put_att_text(ncid,ncrxvid,units,12,'degree_north')
+!  call check_ncerror(ncret)
+!
+!  if (option_verbose.ge.10) write(*,10) 'ReleaseYstart_end variable'
+!  ncret = nf_def_var(ncid,'ReleaseYstart_end',  &
+!    nf_float,2,(/ncrseid,ncrelid/),ncryvid)
+!  ncret = NF_DEF_VAR_deflate(ncid,ncryvid, shuffle, 1, deflate_level)
+!  call check_ncerror(ncret)
+!  ncret = nf_put_att_text(ncid,ncryvid,descr,32, &
+!    'SOUTH/NORTH BOUNDARIES OF SOURCE')
+!  call check_ncerror(ncret)
+!  ncret = nf_put_att_text(ncid,ncryvid,units,12,'degree_north')
+!  call check_ncerror(ncret)
+!
+!  if (option_verbose.ge.10) write(*,10) 'ReleaseZstart_end variable'
+!  ncret = nf_def_var(ncid,'ReleaseZstart_end',  &
+!    nf_float,2,(/ncrseid,ncrelid/),ncrzvid)
+!  ncret = NF_DEF_VAR_deflate(ncid,ncrzvid, shuffle, 1, deflate_level)
+!  call check_ncerror(ncret)
+!  ncret = nf_put_att_text(ncid,ncrzvid,descr,31, &
+!    'BOTTOM/TOP BOUNDARIES OF SOURCE')
+!  call check_ncerror(ncret)
+!  ncret = nf_put_att_text(ncid,ncrzvid,units,1,'m')
+!  call check_ncerror(ncret)
+!
+!  if (option_verbose.ge.10) write(*,10) 'ReleaseNP variable'
+!  ncret = nf_def_var(ncid,'ReleaseNP',nf_int,1,ncrelid,ncspvid)
+!  ncret = NF_DEF_VAR_deflate(ncid,ncspvid, shuffle, 1, deflate_level)
+!  call check_ncerror(ncret)
+!  ncret = nf_put_att_text(ncid,ncspvid,descr,34, &
+!    'TOTAL NUMBER OF PARTICLES RELEASED')
+!  ncret = nf_put_att_text(ncid,ncspvid,units,1,'-')
+!  call check_ncerror(ncret)
+!
+!  if (option_verbose.ge.10) write(*,10) 'ReleaseXMass variable'
+!  ncret = nf_def_var(ncid,'ReleaseXMass',nf_real,2,(/ncspcid,ncrelid/),ncrmvid)
+!  ncret = NF_DEF_VAR_deflate(ncid,ncrmvid, shuffle, 1, deflate_level)
+!  call check_ncerror(ncret)
+!  ncret = nf_put_att_text(ncid,ncrmvid,descr,18,'TOTAL MASS RELEASED')
+!  call check_ncerror(ncret)
+!  ncret = nf_put_att_text(ncid,ncrmvid,units,2,'kg')
+!  call check_ncerror(ncret)
+!
+!  ! Since we need to exit define mode before we can insert
+!  ! variable data, we will include the last file attributes and
+!  ! define the last variables here.
+!
+!  ! DIRECTION INDEPENDENT OUTPUT VARIABLES
+!  if (option_verbose.ge.10) write(*,10) 'TOPOGRAPHY variable'
+!  ncret = nf_def_var(ncid,'TOPOGRAPHY',NF_real,2,ncdimsid2(1:2),nctovid)
+!! ncret = nf_def_var_deflate(ncid,'TOPOGRAPHY',NF_real,2,ncdimsid2(1:2),nctovid,deflate_level=deflate_level)
+!  ncret = NF_DEF_VAR_deflate(ncid,nctovid, shuffle, 1, deflate_level)
+!  call check_ncerror(ncret)
+!  ncret = nf_put_att_text(ncid,nctovid,descr,33,  &
+!    'TERRAIN ELEVATION ABOVE SEA LEVEL')
+!  call check_ncerror(ncret)
+!  ncret = nf_put_att_text(ncid,nctovid,units,1,'m')
+!  call check_ncerror(ncret)
+!  ncret = nf_put_att_text(ncid,nctovid,coord,coordxylen,coordxy)
+!  call check_ncerror(ncret)
+!
+!  if (option_verbose.ge.10) write(*,10) 'GRIDAREA variable'
+!  ncret = nf_def_var(ncid,'GRIDAREA',NF_real,2,ncdimsid2(1:2),ncarvid)
+!! ncret = nf_def_var_deflate(ncid,'GRIDAREA',NF_real,2,ncdimsid2(1:2),ncarvid,deflate_level=deflate_level)
+!  ncret = NF_DEF_VAR_deflate(ncid,ncarvid, shuffle, 1, deflate_level)
+!  call check_ncerror(ncret)
+!  ncret = nf_put_att_text(ncid,ncarvid,descr,30, &
+!    'SURFACE AREA OF EACH GRID CELL')
+!  call check_ncerror(ncret)
+!  ncret = nf_put_att_text(ncid,ncarvid,units,2,'m2')
+!  call check_ncerror(ncret)
+!  ncret = nf_put_att_text(ncid,ncarvid,coord,coordxylen,coordxy)
+!  call check_ncerror(ncret)
+!
+  ! MAIN OUTPUT VARIABLES
+  if ((iout.eq.1).or.(iout.eq.3).or.(iout.eq.5)) then ! CONCENTRATION
+    if (option_verbose.ge.10) write(*,10) 'CONC variable'
+!   print*,ncdimsid3
+  if ((ldirect.eq.1).and.(maxpointspec_act.gt.1)) then
+    ncret = nf_def_var(ncid,'CONC',NF_REAL,7,ncdimsid32,nccovid)
+  else
+    ncret = nf_def_var(ncid,'CONC',NF_REAL,6,ncdimsid3,nccovid)
+  endif
+!   chunks(1) = ncgrid_nx
+!   chunks(2) = ncgrid_ny
+!!   ncret = NF_DEF_VAR_CHUNKING(ncid, nccovid, NF_CHUNKED, chunks)
+   if (ncret .ne. nf_noerr) call check_ncerror(ncret)
+!   ncret = NF_DEF_VAR_deflate(ncid,nccovid, shuffle, 1, deflate_level)
+
+    call check_ncerror(ncret)
+    ncret = nf_put_att_text(ncid,nccovid,descr,33, &
+      'CONCENTRATION OF AIRBORNE SPECIES')
+    call check_ncerror(ncret)
+    ncret = nf_put_att_text(ncid,nccovid,coord,coordxylen,coordxy)
+    call check_ncerror(ncret)
+  endif
+
+  if ((iout.eq.2).or.(iout.eq.3)) then  ! MIXING RATIO
+    if (option_verbose.ge.10) write(*,10) 'MIXINGRATIO variable'
+  if ((ldirect.eq.1).and.(maxpointspec_act.gt.1)) then
+    ncret = nf_def_var(ncid,'MIXINGRATIO',NF_REAL,7,ncdimsid32,ncravid)
+  else
+    ncret = nf_def_var(ncid,'MIXINGRATIO',NF_REAL,6,ncdimsid3,ncravid)
+  endif
+! ncret = NF_DEF_VAR_deflate(ncid,ncravid, shuffle, 1, deflate_level)
+    call check_ncerror(ncret)
+    ncret = nf_put_att_text(ncid,ncravid,descr,37, &
+      'MASS MIXING RATIO OF AIRBORNE SPECIES')
+    call check_ncerror(ncret)
+    ncret = nf_put_att_text(ncid,ncravid,coord,coordxylen,coordxy)
+    call check_ncerror(ncret)
+  endif
+
+  if (ldirect.eq.1) then  ! Forward run
+    unit2d = 'pg m-2'
+    unit2dlen = 6
+
+    if (option_verbose.ge.10) write(*,10) 'DRYDEP variable'
+!   write(*,*) ncdimsid2
+  if ((ldirect.eq.1).and.(maxpointspec_act.gt.1)) then
+    ncret = nf_def_var(ncid,'DRYDEP',NF_REAL,6,ncdimsid22,ncddvid)
+   else
+    ncret = nf_def_var(ncid,'DRYDEP',NF_REAL,5,ncdimsid2,ncddvid)
+   endif
+!  ncret = NF_DEF_VAR_deflate(ncid,ncddvid, shuffle, 1, deflate_level)
+    call check_ncerror(ncret)
+    ncret = nf_put_att_text(ncid,ncddvid,descr,32, &
+      'ACCUMULATED TOTAL DRY DEPOSITION')
+    call check_ncerror(ncret)
+    ncret = nf_put_att_text(ncid,ncddvid,units,unit2dlen,unit2d)
+    call check_ncerror(ncret)
+    ncret = nf_put_att_text(ncid,ncddvid,coord,coordxylen,coordxy)
+    call check_ncerror(ncret)
+
+    if (option_verbose.ge.10) write(*,10) 'WETDEP variable'
+  if ((ldirect.eq.1).and.(maxpointspec_act.gt.1)) then
+    ncret = nf_def_var(ncid,'WETDEP',NF_REAL,6,ncdimsid22,ncwdvid)
+  else
+    ncret = nf_def_var(ncid,'WETDEP',NF_REAL,5,ncdimsid2,ncwdvid)
+   endif
+!  ncret = NF_DEF_VAR_deflate(ncid,ncwdvid, shuffle, 1, deflate_level)
+    call check_ncerror(ncret)
+    ncret = nf_put_att_text(ncid,ncwdvid,descr,32, &
+      'ACCUMULATED TOTAL WET DEPOSITION')
+!    call check_ncerror(ncret)
+    ncret = nf_put_att_text(ncid,ncwdvid,units,unit2dlen,unit2d)
+    call check_ncerror(ncret)
+    ncret = nf_put_att_text(ncid,ncwdvid,coord,coordxylen,coordxy)
+    call check_ncerror(ncret)
+
+    ! Add unit attr to mixing ratio and concentration fields
+    if (ind_samp.eq.0) then
+    ncret = nf_put_att_text(ncid,nccovid,units,6,'ng m-3') !CONC
+    call check_ncerror(ncret)
+    ncret = nf_put_att_text(ncid,ncravid,units,4,'ppt')  !MIX
+    call check_ncerror(ncret)
+    else
+    ncret = nf_put_att_text(ncid,nccovid,units,11,'ppt by mass') !CONC
+    call check_ncerror(ncret)
+!    ncret = nf_put_att_text(ncid,ncravid,units,3,'???')  !MIX
+!    call check_ncerror(ncret)
+    endif
+  else                    ! Backward run
+!   if ((ind_rel.eq.0).and.(ind_samp.eq.0) then ! release in mass
+!     write(*,*) 'A'
+      !Concentration field should be in 's' (?)
+    if ((ind_rel.eq.0).and.(ind_samp.eq.0)) ncret = nf_put_att_text(ncid,nccovid,units,1,'s') !CONC
+    if ((ind_rel.eq.0).and.(ind_samp.eq.-1)) ncret = nf_put_att_text(ncid,nccovid,units,9,'s m3 kg-1') !CONC
+    if ((ind_rel.eq.1).and.(ind_samp.eq.0)) ncret = nf_put_att_text(ncid,nccovid,units,8,'s kg m-3') !CONC
+    if ((ind_rel.eq.1).and.(ind_samp.eq.-1)) ncret = nf_put_att_text(ncid,nccovid,units,1,'s') !CONC
+
+  endif ! Backward/Forward run
+
+  ! EXIT DEFINE MODE, ENTER DATA MODE
+  ncret = nf_enddef(ncid)
+  call check_ncerror(ncret)
+
+  ! DIMENSION VARIABLES
+!  if (option_verbose.ge.10) write(*,10) 'ZTOP data'
+!  ncret = nf_put_var_real(ncid,nclvlvid,outheight)
+!  call check_ncerror(ncret)
+
+!  ! X,Y - Lon,Lat
+!  if (option_verbose.ge.10) write(*,10) 'XLAT,XLONG data'
+!
+!  if (outgrid_option.eq.0) then ! irregular
+!    do jy=1,ncgrid_ny
+!    do ix=1,ncgrid_nx
+!      tmpx=ncgrid_xm0+(float(ix)-0.5)*ncgrid_dx
+!      tmpy=ncgrid_ym0+(float(jy)-0.5)*ncgrid_dy
+!      call xymeter_to_ll_wrf(tmpx,tmpy,tmplon,tmplat)
+!      ncret = nf_put_vara_real(ncid,nclonvid,(/ix,jy/),(/1,1/),tmplon)
+!      call check_ncerror(ncret)
+!      ncret = nf_put_vara_real(ncid,nclatvid,(/ix,jy/),(/1,1/),tmplat)
+!      call check_ncerror(ncret)
+!    enddo
+!    enddo
+!  else
+!    do jy=1,ncgrid_ny
+!    do ix=1,ncgrid_nx
+!      call ll_to_xymeter_wrf(ncgrid_swlon,ncgrid_swlat,xsw,ysw)
+!      call ll_to_xymeter_wrf(ncgrid_nelon,ncgrid_nelat,xne,yne)
+!      tmpx=xsw+(xne-xsw)*float(ix-1)/float(ncgrid_nx-1)
+!      tmpy=ysw+(yne-ysw)*float(jy-1)/float(ncgrid_ny-1)
+!      call xymeter_to_ll_wrf(tmpx,tmpy,tmplon,tmplat)
+!      xl2=ncgrid_lon0+(float(ix)-0.5)*dxoutl !long
+!      yl2=ncgrid_lat0+(float(jy)-0.5)*dyoutl !lat
+!      ncret = nf_put_vara_real(ncid,nclonvid,(/ix,jy/),(/1,1/),xl2)
+!      call check_ncerror(ncret)
+!      ncret = nf_put_vara_real(ncid,nclatvid,(/ix,jy/),(/1,1/),yl2)
+!      call check_ncerror(ncret)
+!    enddo
+!    enddo
+!  endif ! outgrid_option
+
+
+!  ! Write information on release points: total number, then for each point:
+!  ! start, end, coordinates, # of particles, name, mass
+!  !************************************************************************
+!  do i=1,numpoint
+!    xp1=xpoint1(i)*dx+xlon0 ! This is probably wrong, but it seems to be 
+!    yp1=ypoint1(i)*dy+ylat0 ! the same in writeheader*.f90, so I'll leave
+!    xp2=xpoint2(i)*dx+xlon0 ! it for now... //AD
+!    yp2=ypoint2(i)*dy+ylat0 !
+!
+!    if (option_verbose.ge.10) write(*,10) 'ReleaseTstart_end data'
+!    ncret = nf_put_vara_int(ncid,ncrtvid,   & ! ReleaseTstart_end
+!      (/1,i/),(/2,1/),(/ireleasestart(i),ireleaseend(i)/))
+!    call check_ncerror(ncret)
+!
+!    if (option_verbose.ge.10) write(*,10) 'ReleaseXstart_end data'
+!    ncret = nf_put_vara_real(ncid,ncrxvid,  & ! ReleaseXstart_end
+!      (/1,i/),(/2,1/),(/xp1,xp2/))
+!    call check_ncerror(ncret)
+!
+!    if (option_verbose.ge.10) write(*,10) 'ReleaseYstart_end data'
+!    ncret = nf_put_vara_real(ncid,ncryvid,  & !ReleaseYstart_end
+!      (/1,i/),(/2,1/),(/yp1,yp2/))
+!    call check_ncerror(ncret)
+!
+!    if (option_verbose.ge.10) write(*,10) 'ReleaseZstart_end data'
+!    ncret = nf_put_vara_real(ncid,ncrzvid,  & !ReleaseZstart_end
+!      (/1,i/),(/2,1/),(/zpoint1(i),zpoint2(i)/))
+!    call check_ncerror(ncret)
+!
+!    if (option_verbose.ge.10) write(*,10) 'ReleaseXMass data'
+!    ncret = nf_put_vara_real(ncid,ncrmvid,  & !ReleaseXMass
+!      (/1,i/),(/nspec,1/),xmass(i,1:nspec))
+!    call check_ncerror(ncret)
+!
+!    if (option_verbose.ge.10) write(*,10) 'ReleaseNP data'
+!    ncret = nf_put_vara_int(ncid,ncspvid,   & !ReleaseNP
+!      i,1,npart(i))
+!    call check_ncerror(ncret)
+!
+!    !Release Name/Comment
+!    j=1 ! Find the length of each release point comment/name
+!    do while( j.lt.45.and.compoint(i)(j+1:j+1).ne." ")
+!      j=j+1
+!    enddo
+!    if (option_verbose.ge.10) write(*,10) 'ReleaseName data'
+!    ncret = nf_put_vara_text(ncid,ncrnvid,(/1,i/),(/j,1/),compoint(i)(1:j))
+!    call check_ncerror(ncret)
+!  enddo
+!
+!  ! Write age class information
+!  !****************************
+!  if (option_verbose.ge.10) write(*,10) 'AGECLASSES data'
+!  ncret = nf_put_var_int(ncid,ncagevid,lage(1:nageclass))
+!  call check_ncerror(ncret)
+!
+!  ! Write topography to output file
+!  !********************************
+!  if (option_verbose.ge.10) write(*,10) 'TOPOGRAPHY data'
+!! do ix=0,ncgrid_nx-1
+!  do ix=1,ncgrid_nx
+!    ncret = nf_put_vara_real(ncid,nctovid,  &
+!!     (/ix+1,1/),(/1,ncgrid_ny/),ncgrid_oro(ix,0:ncgrid_ny-1))
+!      (/ix,1/),(/1,ncgrid_ny/),ncgrid_oro(ix,1:ncgrid_ny))
+!    call check_ncerror(ncret)
+!  enddo
+!
+!  ! Write grid cell surface area
+!  !*****************************
+!  if (option_verbose.ge.10) write(*,10) 'GRIDAREA data'
+!! do ix=0,ncgrid_nx-1
+!  do ix=1,ncgrid_nx
+!    ncret = nf_put_vara_real(ncid,ncarvid,  &
+!!     (/ix+1,1/),(/1,ncgrid_ny/),ncgrid_area(ix,0:ncgrid_ny-1))
+!      (/ix,1/),(/1,ncgrid_ny/),ncgrid_area(ix,1:ncgrid_ny))
+!    call check_ncerror(ncret)
+!  enddo
+!
+!  ! SAVE CREATED NETCDF TO FILE
+!  !****************************
+!  if (option_verbose.ge.1) write(*,*) 'write_ncheader: writing to disk'
+!  ncret = nf_sync(ncid)
+!  call check_ncerror(ncret)
+
+  return
+
+10 format('write_ncheader: Setting up ',A)
+
+!   deallocate(ncgrid_oro,ncgrid_area)
+end subroutine write_ncinfo
Index: /branches/jerome/src_flexwrf_v3.1/writeheader.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/writeheader.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/writeheader.f90	(revision 16)
@@ -0,0 +1,220 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                *
+!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine,       *
+!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
+!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso,          *
+!* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann,   *
+!*                                                                     *
+!* This file is part of FLEXPART WRF            
+!                                                                     *
+! 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
+  real :: xsw,xne,ysw,yne,tmpx,tmpy,tmplon,tmplat,xl2,yl2
+
+
+  !************************
+  ! Open header output file
+  !************************
+
+  open(unitheader,file=path(1)(1:length(1))//'header', &
+       form='unformatted',err=998)
+
+
+  ! Write the header information
+  !*****************************
+
+  if (ldirect.eq.1) then
+!   write(unitheader) ibdate,ibtime,'FLEXWRF  V2.1'
+  if (outgrid_option .eq. 1) then
+    write(unitheader) ibdate,ibtime,'FLEXWRF lalo '
+  else
+  if (map_proj_id.eq.1) write(unitheader) ibdate,ibtime,'FLEXWRF lamb '
+  if (map_proj_id.eq.2) write(unitheader) ibdate,ibtime,'FLEXWRF ster '
+  if (map_proj_id.eq.3) write(unitheader) ibdate,ibtime,'FLEXWRF merc '
+  if (map_proj_id.eq.4) write(unitheader) ibdate,ibtime,'FLEXWRF glob '
+  endif
+  else
+  if (outgrid_option .eq. 1) then
+    write(unitheader) iedate,ietime,'FLEXWRF lalo '
+  else
+  if (map_proj_id.eq.1) write(unitheader) iedate,ietime,'FLEXWRF lamb '
+  if (map_proj_id.eq.2) write(unitheader) iedate,ietime,'FLEXWRF ster '
+  if (map_proj_id.eq.3) write(unitheader) iedate,ietime,'FLEXWRF merc '
+  if (map_proj_id.eq.4) write(unitheader) iedate,ietime,'FLEXWRF glob '
+  endif
+  endif
+
+  ! Write info on output interval, averaging time, sampling time
+  !*************************************************************
+
+  write(unitheader) loutstep,loutaver,loutsample
+
+  ! Write information on output grid setup
+  !***************************************
+
+  if (outgrid_option .eq. 1) then
+  write(unitheader) outlon0,outlat0,numxgrid,numygrid, &
+       dxoutl,dyoutl
+  else
+  write(unitheader) outlon0,outlat0,numxgrid,numygrid, &
+       dxout,dyout
+  endif
+  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.2000) then
+      write(unitheader) compoint(i)
+    else
+      write(unitheader) compoint(2001)
+    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)
+
+
+      open(53,file=path(1)(1:length(1))//'latlon.txt',form='formatted')
+          open(54,file=path(1)(1:length(1))//'latlon_corner.txt' &
+          ,form='formatted')
+
+      if (outgrid_option.eq.0) then ! irregular
+        call ll_to_xymeter_wrf(outgrid_swlon,outgrid_swlat,xsw,ysw)
+        call ll_to_xymeter_wrf(outgrid_nelon,outgrid_nelat,xne,yne)
+        do jy=1,numygrid
+        do ix=1,numxgrid
+          tmpx=out_xm0+(float(ix)-0.5)*dxout
+          tmpy=out_ym0+(float(jy)-0.5)*dyout
+          call xymeter_to_ll_wrf(tmpx,tmpy,tmplon,tmplat)
+        write(53,*) tmplon,tmplat
+          tmpx=out_xm0+(float(ix)-1.)*dxout
+          tmpy=out_ym0+(float(jy)-1.)*dyout
+          call xymeter_to_ll_wrf_out(tmpx,tmpy,tmplon,tmplat)
+           write(54,*) tmplon,tmplat
+        enddo
+        enddo
+       else ! regular
+        call ll_to_xymeter_wrf(outgrid_swlon,outgrid_swlat,xsw,ysw)
+        call ll_to_xymeter_wrf(outgrid_nelon,outgrid_nelat,xne,yne)
+        do jy=1,numygrid
+        do ix=1,numxgrid
+          tmpx=xsw+(xne-xsw)*float(ix-1)/float(numxgrid-1)
+          tmpy=ysw+(yne-ysw)*float(jy-1)/float(numygrid-1)
+          call xymeter_to_ll_wrf(tmpx,tmpy,tmplon,tmplat)
+            xl2=outlon0+(float(ix)-0.5)*dxoutl !long  
+            yl2=outlat0+(float(jy)-0.5)*dyoutl !lat  
+           write(53,*) xl2,yl2
+            xl2=outlon0+float(ix-1)*dxoutl !long 
+            yl2=outlat0+float(jy-1)*dyoutl !lat    
+           write(54,*) xl2,yl2
+        enddo
+        enddo
+      endif
+
+
+      close(53)
+      close(54)
+
+  return
+
+998   write(*,*) ' #### FLEXPART MODEL ERROR!   THE FILE         #### '
+  write(*,*) ' #### '//path(1)(1:length(1))//'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/jerome/src_flexwrf_v3.1/writeheader_nest.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/writeheader_nest.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/writeheader_nest.f90	(revision 16)
@@ -0,0 +1,220 @@
+!***********************************************************************
+!* Copyright 2012,2013                                                *
+!* Jerome Brioude, Delia Arnold, Andreas Stohl, Wayne Angevine,       *
+!* John Burkhart, Massimo Cassiani, Adam Dingwell, Richard C Easter, Sabine Eckhardt,*
+!* Stephanie Evan, Jerome D Fast, Don Morton, Ignacio Pisso,          *
+!* Petra Seibert, Gerard Wotawa, Caroline Forster, Harald Sodemann,   *
+!*                                                                     *
+!* This file is part of FLEXPART WRF       
+!                                                                     *
+! 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
+  real :: xsw,xne,ysw,yne,tmpx,tmpy,tmplon,tmplat,xl2,yl2
+
+
+  !************************
+  ! Open header output file
+  !************************
+
+  open(unitheader,file=path(1)(1:length(1))//'header_nest', &
+       form='unformatted',err=998)
+
+
+  ! Write the header information
+  !*****************************
+
+  if (ldirect.eq.1) then
+!   write(unitheader) ibdate,ibtime,'FLEXWRF  V2.1'
+  if (outgrid_option .eq. 1) then
+    write(unitheader) ibdate,ibtime,'FLEXWRF lalo '
+  else
+  if (map_proj_id.eq.1) write(unitheader) ibdate,ibtime,'FLEXWRF lamb '
+  if (map_proj_id.eq.2) write(unitheader) ibdate,ibtime,'FLEXWRF ster '
+  if (map_proj_id.eq.3) write(unitheader) ibdate,ibtime,'FLEXWRF merc '
+  if (map_proj_id.eq.4) write(unitheader) ibdate,ibtime,'FLEXWRF glob '
+  endif
+
+  else
+!   write(unitheader) iedate,ietime,'FLEXWRF  V2.1'
+  if (outgrid_option .eq. 1) then
+    write(unitheader) iedate,ietime,'FLEXWRF lalo '
+  else
+  if (map_proj_id.eq.1) write(unitheader) iedate,ietime,'FLEXWRF lamb '
+  if (map_proj_id.eq.2) write(unitheader) iedate,ietime,'FLEXWRF ster '
+  if (map_proj_id.eq.3) write(unitheader) iedate,ietime,'FLEXWRF merc '
+  if (map_proj_id.eq.4) write(unitheader) iedate,ietime,'FLEXWRF glob '
+  endif
+
+  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.2000) then
+      write(unitheader) compoint(i)
+    else
+      write(unitheader) compoint(2001)
+   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)
+
+      open(53,file=path(1)(1:length(1))//'latlon_nest.txt' &
+          ,form='formatted')
+      open(54,file=path(1)(1:length(1))//'latlon_corner_nest.txt' &
+          ,form='formatted')
+
+      if (outgrid_option.eq.0) then ! irregular
+        call ll_to_xymeter_wrf(outgridn_swlon,outgridn_swlat,xsw,ysw)
+        call ll_to_xymeter_wrf(outgridn_nelon,outgridn_nelat,xne,yne)
+        do jy=1,numygridn
+        do ix=1,numxgridn
+          tmpx=out_xm0n+(float(ix)-0.5)*dxoutn
+          tmpy=out_ym0n+(float(jy)-0.5)*dyoutn
+          call xymeter_to_ll_wrf(tmpx,tmpy,tmplon,tmplat)
+        write(53,*) tmplon,tmplat
+          tmpx=out_xm0n+(float(ix)-1.)*dxoutn
+          tmpy=out_ym0n+(float(jy)-1.)*dyoutn
+          call xymeter_to_ll_wrf_out(tmpx,tmpy,tmplon,tmplat)
+           write(54,*) tmplon,tmplat
+        enddo
+        enddo
+       else ! regular
+        call ll_to_xymeter_wrf(outgridn_swlon,outgridn_swlat,xsw,ysw)
+        call ll_to_xymeter_wrf(outgridn_nelon,outgridn_nelat,xne,yne)
+        do jy=1,numygridn
+        do ix=1,numxgridn
+          tmpx=xsw+(xne-xsw)*float(ix-1)/float(numxgridn-1)
+          tmpy=ysw+(yne-ysw)*float(jy-1)/float(numygridn-1)
+          call xymeter_to_ll_wrf(tmpx,tmpy,tmplon,tmplat)
+            xl2=outlon0n+(float(ix)-0.5)*dxoutln !long  
+            yl2=outlat0n+(float(jy)-0.5)*dyoutln !lat  
+           write(53,*) xl2,yl2
+            xl2=outlon0n+float(ix-1)*dxoutln !long 
+            yl2=outlat0n+float(jy-1)*dyoutln !lat    
+           write(54,*) xl2,yl2
+        enddo
+        enddo
+      endif
+
+
+      close(53)
+      close(54)
+
+
+  return
+
+
+998   write(*,*) ' #### FLEXPART MODEL ERROR!   THE FILE         #### '
+  write(*,*) ' #### '//path(1)(1:length(1))//'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/jerome/src_flexwrf_v3.1/xmass_mod.f90
===================================================================
--- /branches/jerome/src_flexwrf_v3.1/xmass_mod.f90	(revision 16)
+++ /branches/jerome/src_flexwrf_v3.1/xmass_mod.f90	(revision 16)
@@ -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
