Index: /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_global/grid_var.f90
===================================================================
--- /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_global/grid_var.f90	(revision 6940)
+++ /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_global/grid_var.f90	(revision 6940)
@@ -0,0 +1,49 @@
+! ===============================================================================================================================
+! MODULE       : grid_var
+!
+! CONTACT      : orchidee-help _at_ listes.ipsl.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF
+!!
+!! \n DESCRIPTION : This module define variables for the grid module. 
+!!                The module is already USE in module grid. Therefor no need to use it seperatly if use grid is already done.
+
+!!
+!! RECENT CHANGE(S): These variables were previously in grid module. They have been moved here to avoid dependency 
+!!                   problems when the variables are needed in the parallelization modules. 
+!!
+!!
+!! SVN
+!! $HeadURL: svn://forge.ipsl.jussieu.fr/orchidee/branches/ORCHIDEE-MICT/ORCHIDEE/src_global/grid_var.f90 $
+!! $Date: 2017-07-17 12:59:54 +0200 (Mon, 17 Jul 2017) $
+!! $Revision: 4507 $
+!! \n
+!_ ================================================================================================================================
+
+MODULE grid_var
+
+  IMPLICIT NONE
+
+  !=================================================================================
+  !
+  ! Horizontal grid information
+  !
+  !=================================================================================
+
+  CHARACTER(LEN=20), SAVE                           :: GridType    !! Describes the grid it can be RegLonLat, RegXY or UnStruct
+!$OMP THREADPRIVATE(GridType)
+
+  CHARACTER(LEN=20), SAVE                           :: GridName    !! Name of the grid
+!$OMP THREADPRIVATE(GridName)
+
+  INTEGER, SAVE                                     :: NbSegments  !! Number of segments in 
+                                                                   !! the polygone defining the grid box
+!$OMP THREADPRIVATE(NbSegments)
+  
+  INTEGER, SAVE                                     :: NbNeighb    !! Number of neighbours
+!$OMP THREADPRIVATE(NbNeighb)
+  
+END MODULE grid_var
Index: /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_global/interpweight.f90
===================================================================
--- /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_global/interpweight.f90	(revision 6940)
+++ /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_global/interpweight.f90	(revision 6940)
@@ -0,0 +1,5054 @@
+MODULE interpweight
+!=================================================================================================================================
+! MODULE       : interpweight
+!
+! CONTACT      : orchidee-help _at_ listes.ipsl.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF       ! Specific module for the interpolation in ORCHIDEE
+!!
+!!\n DESCRIPTION: L. Fita, October 2016
+!!   This module is used in the re-organization done in the section of the code
+!! responsible of the interpolation of the morphology datat (PFT, albedo, LAI,
+!! ...) from different files done by L. Fita in the mark of the HEAT project.
+!! Previous version of the interpolation of these files, proceed by three 
+!! basic steps common for all the files:
+!!   1.: Modification of values from file
+!!   2.: Creation of land/sea mask using values from file
+!!   3.: Interpolate values
+!!   This module servs to generalize all these steps and construct a common 
+!! interface independently of the file. Each step is generalize and the 
+!! different processes almost specific for each file in the previous form
+!! are introduced as different methodologies. Thus now it provides:
+!!   1. Modification of initial values: Removing that wrong values from the file
+!|     `interpweight_modifying_input[1/2/3/4]D': subroutines to modify 1D, 2D, 3D
+!!     or 4D input data from file, using different methods
+!!   2. Masking input: Compute âon flyâ the values of the land/sea mask taking
+!!    the values in the file
+!!     `interpweight_masking_input[1/2/3/4]D': subroutines to compute the mask
+!!     using data from input file using different methods: nomask, mbelow, 
+!!     mabove, msumrange, var
+!!   3. Area weights: Get coincident areas from input file to the target 
+!!    projection using aggregate_p
+!!      No changes on it
+!!   4. Interpolate: Use obtained areas and interpolate values at each grid
+!!    point at the same format as it will be provided by XIOS
+!!      `interpweight_provide_fractions[1/2/3/4]D': Perform interpolation for
+!!      fraction/category data
+!!      `interpweight_provide_interpolation[2/4]D': Perform interpolation for
+!!      continuous data
+!!      `variableusetypes': Variable to provide the values along the additional
+!!      dimension to perform the interpolation. (e.g.: in case the 13 pfts
+!!      are: 1,3,6,18,23,34,35,39,48,...)
+!!   5. A new variable is added which explains the âavailabilityâ of data to 
+!!    perform the interpolation (0, 1). When it is negative it means that there
+!!    was no data for that grid point
+!!            availability = SUM(area_source)/Area_target_grid_point
+!!   This module will disappear once interpolation will be done throuhguot XIOS
+!! 
+!! More details at:
+!!   https://forge.ipsl.jussieu.fr/orchidee/wiki/DevelopmentActivities/ORCHIDEE-DYNAMICO
+!!
+!! RECENT CHANGE(S): None
+!!
+!! REFERENCE(S): None
+!!
+!! SVN         :
+!! $HeadURL: $
+!! $Date: $
+!! $Revision: $
+!! \n
+!_================================================================================================================================
+
+  USE ioipsl_para
+  USE interpol_help
+  USE grid
+
+  IMPLICIT NONE
+
+  PRIVATE
+  PUBLIC interpweight_1D, interpweight_2D, interpweight_3D, interpweight_4D, interpweight_2Dcont,     &
+    interpweight_4Dcont, interpweight_get_varNdims_file, interpweight_RangeR,                         &
+    interpweight_get_var2dims_file, interpweight_get_var3dims_file, interpweight_get_var4dims_file,   &
+    interpweight_Index2DLonLat, interpweight_ValVecR
+
+  CONTAINS
+
+!! ================================================================================================================================
+!! SUBROUTINE   : interpweight_1D
+!!
+!>\BRIEF        ! Interpolate any input file to the grid of the model for a 1D-variable  
+!!
+!! DESCRIPTION  : (definitions, functional, design, flags): 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): outvar1D, aoutvar
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  SUBROUTINE interpweight_1D(nbpt, Nvariabletypes, variabletypes, lalo, resolution, neighbours,       &
+    contfrac, filename, varname, inlonname, inlatname, varmin, varmax, noneg, masktype,               &
+    maskvalues, maskvarname, dim1, dim2, initime, typefrac,                                           &
+    maxresollon, maxresollat, outvar1D, aoutvar)
+
+    USE ioipsl
+    USE constantes_var
+    USE mod_orchidee_para
+
+    IMPLICIT NONE
+
+    !! 0. Variables and parameter declaration
+    !
+    !! 0.1 Input variables
+    !
+    INTEGER(i_std), INTENT(in)                 :: nbpt                    !! Number of points for which the data 
+                                                                          !!   needs to be interpolated
+    INTEGER(i_std), INTENT(in)                 :: Nvariabletypes          !! Number of types of the variable
+    REAL(r_std), DIMENSION(Nvariabletypes),    &                          !! Vector of values of the types
+      INTENT(in)    :: variabletypes                                      !!   (-1, not used)
+    REAL(r_std), DIMENSION(nbpt,2), INTENT(in) :: lalo                    !! Vector of latitude and longitudes 
+                                                                          !! (beware of the order = 1 : latitude, 
+                                                                          !!   2 : longitude)
+    REAL(r_std), DIMENSION(nbpt,2), INTENT(in) :: resolution              !! The size in km of each grid-box in X and Y
+    !
+    INTEGER(i_std), DIMENSION(nbpt,NbNeighb), INTENT(in) :: neighbours    !! Vector of neighbours for each grid point 
+                                                                          !!   1=N, 2=NE, 3=E, 4=SE, 5=S, 6=SW, 7=W, 8=NW) 
+                            
+    REAL(r_std), DIMENSION(nbpt),  INTENT(in)  :: contfrac                !! Fraction of land in each grid box.
+    CHARACTER(LEN=80), INTENT(in)              :: filename                !! name of the input map to read
+
+    CHARACTER(LEN=80), INTENT(in)              :: varname                 !! name of the variable to interpolate
+    CHARACTER(LEN=80), INTENT(in)              :: inlonname, inlatname    !! names of the longitude and latitude
+    REAL(r_std), INTENT(inout)                 :: varmin, varmax          !! min/max values to use for the
+                                                                          !!   renormalization
+! Transformations to apply to the original read values from the file
+    LOGICAL, INTENT(in)                        :: noneg                   !! no negative values
+    CHARACTER(LEN=50), INTENT(in)              :: masktype                !! Type of masking
+                                                                          !!   'nomask': no-mask is applied
+                                                                          !!   'mbelow': take values below maskvalues(1)
+                                                                          !!   'mabove': take values above maskvalues(1)
+                                                                          !!   'msumrange': take values within 2 ranges;
+                                                                          !!      maskvalues(2) <= SUM(vals(k)) <= maskvalues(1)
+                                                                          !!      maskvalues(1) < SUM(vals(k)) <= maskvalues(3)
+                                                                          !!        (normalized by maskvalues(3))
+                                                                          !!   'var': mask values are taken from a 
+                                                                          !!     variable (>0)
+    REAL(r_std), DIMENSION(3), INTENT(in)      :: maskvalues              !! values to use to mask (according to 
+                                                                          !!   `masktype') 
+    CHARACTER(LEN=250), INTENT(in)             :: maskvarname             !! name of the variable to use to mask 
+    INTEGER(i_std), INTENT(in)                 :: dim1, dim2              !! 4D complementary dimension sizes
+    CHARACTER(LEN=50), INTENT(in)              :: typefrac                !! Type of fraction retrieval:
+                                                                          !!   'default': standard
+
+    INTEGER(i_std), INTENT(in)                 :: initime                 !! Initial time to take (for input data 
+                                                                          !!   with time values, -1 not used)
+    REAL(r_std), INTENT(in)                    :: maxresollon,maxresollat !! lon,lat maximum resolutions (in m)
+                                                                          !!   (-un, not used)
+    !! 0.2 Modified variables
+    !
+    !! 0.3 output variables
+    !
+    REAL(r_std), DIMENSION(nbpt), INTENT(out) :: outvar1D                 !! 1D output variable and re-dimensioned
+    REAL(r_std), DIMENSION(nbpt), INTENT(out)  :: aoutvar                 !! availability of input data to
+                                                                          !!   interpolate output variable 
+                                                                          !!   (on the nbpt space)
+    !
+    !! 0.4 Local variables
+    !
+    INTEGER(i_std)                             :: iml, jml, lml, tml, fid, ib, ip, jp, it, jj, jv
+    INTEGER                                    :: inNdims                 !! Number of dimensions of the input data
+    INTEGER                                    :: inNLldims               !! Number of dimensions of the lon/lat input data
+    REAL(r_std), ALLOCATABLE, DIMENSION(:)     :: lat_in, lon_in          !! latitude and
+                                                                          !! longitude, extract from input map
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)   :: sub_area                !! the area of the fine grid in the 
+                                                                          !!   model grid ???
+                                                                          !! cf src_global/interpol_help.f90, 
+                                                                          !!   line 377, called "areaoverlap"
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:)  :: sub_index             !! the indexes from the grid boxes from the 
+                                                                          !!   data that go into the 
+                                                                          !!   model's boxes  
+                                                                          !! cf src_global/interpol_help.f90,
+                                                                          !!   line 300, called "ip"
+
+    REAL(r_std), ALLOCATABLE, DIMENSION(:)       :: invar1D               !! 1D input values
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)     :: invar2D               !! 2D input values
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:)   :: invar3D               !! 3D input values
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:,:) :: invar4D               !! 4D input values
+
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:)   :: resol_in
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:)    :: mask
+    REAL(r_std), ALLOCATABLE, DIMENSION(:)       :: maskvar
+    INTEGER(i_std)                             :: nix, njx
+    INTEGER(i_std)                             :: idi, nbvmax             !! nbvmax : number of maximum vegetation map
+                                                                          !! points in the GCM grid ; idi : its counter
+    CHARACTER(LEN=30)                          :: callsign                !! Allows to specify which variable is beeing
+                                                                          !! treated
+    LOGICAL                                    :: ok_interpol             !! optionnal return of aggregate_2d
+    INTEGER                                    :: ALLOC_ERR 
+    CHARACTER(LEN=50)                          :: S1
+    REAL(r_std), ALLOCATABLE, DIMENSION(:)     :: variableusetypes
+    CHARACTER(LEN=256)                         :: msg
+    INTEGER, DIMENSION(:), ALLOCATABLE         :: indims
+
+! Debug vars
+    INTEGER                                    :: nb_coord, nb_var, nb_gat
+
+
+!_ ================================================================================================================================
+! Allocating input data
+
+    IF (printlev >= 3) WRITE(numout,*)"In interpweight_1D filename: ",TRIM(filename),          &
+      " varname:'" // TRIM(varname) // "'"
+    
+    IF (is_root_prc) THEN
+       IF (printlev >=5) THEN
+          WRITE(numout,*) "Entering 'interpweight_1D'. Debug mode."
+          WRITE(numout,*)'(/," --> fliodmpf")'
+          CALL fliodmpf (TRIM(filename))
+          WRITE(numout,*)'(/," --> flioopfd")'
+       ENDIF
+       CALL flioopfd (TRIM(filename),fid,nb_dim=nb_coord,nb_var=nb_var,nb_gat=nb_gat)
+       IF (printlev >=5) THEN
+          WRITE (numout,'(" Number of coordinate        in the file : ",I2)') nb_coord
+          WRITE (numout,'(" Number of variables         in the file : ",I2)') nb_var
+          WRITE (numout,'(" Number of global attributes in the file : ",I2)') nb_gat
+       ENDIF
+    ENDIF
+
+! Getting shape of input variable from input file
+    inNdims = interpweight_get_varNdims_file(filename, varname)
+    IF (is_root_prc) CALL flininfo(filename, iml, jml, lml, tml, fid)
+
+    InputDims: SELECT CASE (inNdims)
+      CASE (1)
+        CALL bcast(iml)
+
+        ALLOCATE(invar1D(iml), STAT=ALLOC_ERR)
+        IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_1D',"Problem in allocation of variable '" //     &
+          TRIM(varname) ,'','')
+        IF (is_root_prc) CALL flinget(fid, TRIM(varname), iml, 0, 0, 0, 1, 1, invar1D)
+        IF (printlev >= 5) THEN
+          WRITE(numout,*)'  interpweight_1D input data dimensions _______'
+          WRITE(numout,*)'    iml:',iml
+        END IF
+
+      CASE DEFAULT
+        WRITE (S1,'(I3)') inNdims
+        CALL ipslerr_p(3,'interpweight_1D',"Input number of dimensions: '" // TRIM(S1) // "' not ready !!", &
+          '','')
+
+    END SELECT InputDims
+    CALL bcast(invar1D)
+
+    IF (printlev >= 5) WRITE(numout,*)'  interpweight_1D getting variable ended!'
+
+! Getting longitudes/latitudes from input file
+    inNLldims = interpweight_get_varNdims_file(filename, inlonname)
+    
+    IF (inNLldims == 1) THEN
+      ! Allocate memory for latitudes
+      ALLOCATE(lon_in(iml), STAT=ALLOC_ERR)
+      IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_1D','Problem in allocation of variable lon_in','','')
+
+      ALLOCATE(lat_in(iml), STAT=ALLOC_ERR)
+      IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_1D','Problem in allocation of variable lat_in','','')
+
+      IF (is_root_prc) THEN
+        CALL flinget(fid, TRIM(inlonname), iml, 0, 0, 0, 1, 1, lon_in)
+        CALL flinget(fid, TRIM(inlatname), iml, 0, 0, 0, 1, 1, lat_in)
+      ENDIF
+
+    END IF
+    CALL bcast(lon_in)
+    CALL bcast(lat_in)
+
+    IF (noneg) THEN
+      IF (is_root_prc) THEN
+        SELECT CASE (inNdims)
+          CASE(1)
+            CALL interpweight_modifying_input1D(iml, 0, 0, 0, 1, 1, zero, invar1D)
+        END SELECT       
+      END IF
+    END IF
+    IF (printlev >= 5) WRITE(numout,*)'  interpweight_1D modifying input ended!'
+
+    IF (is_root_prc) CALL flinclo(fid)
+
+    !
+    ! Consider all points a priori
+    !
+    ALLOCATE(mask(iml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_1D','Problem in allocation of variable mask','','')
+    mask = zero
+
+    IF (TRIM(masktype) == 'var') THEN
+      ALLOCATE(maskvar(iml), STAT=ALLOC_ERR)
+      IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_1D','Problem in allocation of variable maskvar','','')
+      maskvar = zero
+! Reads the mask from the file
+      IF (is_root_prc) THEN
+! ATTTENTION!! One can not use flinget in this way. It always spect to have a REAL variable!
+        CALL flinget(fid, TRIM(maskvarname), iml, 0, 0, 0, 1, 1, maskvar)
+        WHERE (maskvar > zero)
+          mask = un 
+        END WHERE
+      END IF
+      CALL bcast(mask)
+    ELSE
+      SELECT CASE (inNdims)
+        CASE(1)
+          CALL interpweight_masking_input1D(iml, 0, 0, 0, 0, 0, masktype, maskvalues, invar1D,        &
+            mask)
+      END SELECT
+    END IF
+    IF (printlev >= 5) WRITE(numout,*)'  interpweight_1D masking input ended!'
+
+    ! Computation of nbvmax
+    ! In 'condveg_soilalb, slowproc_update' nbvmax=200
+    !
+    ! The number of maximum vegetation map points in the GCM grid is estimated.
+    ! Some lmargin is taken.
+    !
+    IF (is_root_prc) THEN
+      IF ( (maxresollon /= -un) .AND. (maxresollat /= -un) ) THEN
+!       Assuming regular lon/lat projection for the input data but it is not caluclated assuming a maximum  &
+!         lon,lat resolution given as input paramater
+         nix=INT(MAXVAL(resolution(:,1))/maxresollon)+2
+         njx=INT(MAXVAL(resolution(:,2))/maxresollat)+2
+      ELSE
+!       Assuming regular lon/lat projection for the input data
+        CALL interpweight_calc_resolution_in(lon_in, lat_in, iml, jml, mincos, R_Earth, pi, resol_in)
+        nix=INT(MAXVAL(resolution(:,1))/MAXVAL(resol_in(:,:,1)))+2
+        njx=INT(MAXVAL(resolution(:,2))/MAXVAL(resol_in(:,:,2)))+2
+      END IF
+      nbvmax = MAX(nix*njx, 200)
+    END IF  
+    CALL bcast(nbvmax)
+    CALL bcast(nix)
+    CALL bcast(njx)
+
+    !
+    callsign = TRIM(varname) // ' map'
+    !
+    ok_interpol = .FALSE.
+    DO WHILE ( .NOT. ok_interpol )
+       IF (printlev>=3) WRITE(numout,*) "Projection arrays for ",callsign," : "
+       IF (printlev>=3) WRITE(numout,*) "nbvmax = ",nbvmax, nix, njx
+
+
+       ALLOCATE(sub_index(nbpt, nbvmax), STAT=ALLOC_ERR)
+       IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_1D','Problem in allocation of variable sub_index','','')
+
+       sub_index(:,:)=zero
+
+       ALLOCATE(sub_area(nbpt, nbvmax), STAT=ALLOC_ERR)
+       IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_1D','Problem in allocation of variable sub_area','','')
+
+       sub_area(:,:)=zero
+       IF (printlev>=3) WRITE(numout,*) 'Input data range LON:', MINVAL(lon_in), MAXVAL(lon_in)
+       IF (printlev>=3) WRITE(numout,*) 'Input data range LAT:', MINVAL(lat_in), MAXVAL(lat_in)
+
+       !
+       CALL aggregate_p(nbpt, lalo, neighbours, resolution, contfrac,  &
+            &                iml, lon_in, lat_in, maxresollon, maxresollat, callsign, &
+            &                nbvmax, sub_index, sub_area, ok_interpol)
+       
+       !
+       IF ( .NOT. ok_interpol ) THEN
+          DEALLOCATE(sub_area)
+          DEALLOCATE(sub_index)
+          nbvmax = nbvmax * 2
+       ENDIF
+    ENDDO
+    IF (printlev>=4) WRITE (numout,*) '  interpweight_1D: read/allocate OK'
+
+! Getting variables thresholds
+    ALLOCATE(variableusetypes(Nvariabletypes), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_1D','Problem in allocation of variableusetypes','','')
+
+    IF (variabletypes(1) == -un) THEN
+      variableusetypes = (/ (ip*1., ip=1,Nvariabletypes) /)
+      IF (printlev>=4) WRITE(numout,*) 'interpweight_1D: Note: Using default ',&
+           'equivalence between dimension in the file and dimension in the variable, for file ', filename
+      varmin = 1._r_std
+      varmax = Nvariabletypes*1._r_std
+    ELSE
+      variableusetypes = variabletypes    
+    END IF
+
+    outvar1D = zero
+
+! Providing the fractions of each type for each interpolated grid point
+    CALL interpweight_provide_fractions1D(typefrac, nbpt, Nvariabletypes, variableusetypes,           &
+      iml, jml, lml, tml, nbvmax, zero, invar1D, sub_area, sub_index, varmax, varmin,                 &
+      deux, lalo, outvar1D, aoutvar)
+    IF (printlev>=5) WRITE (numout,*)'  interpweight_1D end of interp_provide_fractions1D'
+
+    IF (printlev>=3) THEN
+       IF (COUNT(aoutvar == -1) >= AINT(nbpt*0.4)) THEN
+          WRITE(numout,*) '  interpweight_1D total number of points: ', nbpt
+          WRITE(numout,*) '  interpweight_1D interpolated: ', COUNT(aoutvar /= -1),                 &
+               ' non-interpolated: ', COUNT(aoutvar == -1)
+          msg = "Less than 60% of points '" // TRIM(filename) // "' variable '" // TRIM(varname) //       & 
+               "' have been succesfully interpolated !!"
+          WRITE(numout,*) '  interpweight_1D: ' // TRIM(msg)
+       ELSE
+          msg = TRIM(filename) // "' variable: '" // TRIM(varname) // "' interpolation Done _______"
+          WRITE(numout,*) "  interpweight_1D: '" // TRIM(msg)
+          WRITE(numout,*) '  interpweight_1D total number of points: ', nbpt
+          WRITE(numout,*) '  interpweight_1D interpolated: ', COUNT(aoutvar /= -1),               &
+               ' non-interpolated: ', COUNT(aoutvar == -1)
+       END IF
+    END IF
+
+! Scaling to 1 the quality variable
+    DO ip=1, nbpt
+      IF (aoutvar(ip) /= -1) aoutvar(ip) = aoutvar(ip)/(resolution(ip,1)*resolution(ip,2))/contfrac(ip)
+    END DO
+
+    IF (ALLOCATED(lon_in)) DEALLOCATE(lon_in)
+    IF (ALLOCATED(lat_in)) DEALLOCATE(lat_in)
+    IF (ALLOCATED(invar1D)) DEALLOCATE(invar1D)
+    DEALLOCATE(mask)
+    IF (ALLOCATED(maskvar)) DEALLOCATE(maskvar)
+    DEALLOCATE(sub_area)
+    DEALLOCATE(sub_index)
+
+    RETURN
+
+  END SUBROUTINE interpweight_1D
+
+!! ================================================================================================================================
+!! SUBROUTINE   : interpweight_2D
+!!
+!>\BRIEF        ! Interpolate any input file to the grid of the model for a 2D-variable  
+!!
+!! DESCRIPTION  : (definitions, functional, design, flags): 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): outvar2D, aoutvar
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  SUBROUTINE interpweight_2D(nbpt, Nvariabletypes, variabletypes, lalo, resolution, neighbours,       &
+    contfrac, filename, varname, inlonname, inlatname, varmin, varmax, noneg, masktype,               &
+    maskvalues, maskvarname, dim1, dim2, initime, typefrac,                                           & 
+    maxresollon, maxresollat, outvar2D, aoutvar)
+
+    USE ioipsl
+    USE constantes_var
+    USE mod_orchidee_para
+
+    IMPLICIT NONE
+
+    !! 0. Variables and parameter declaration
+    !
+    !! 0.1 Input variables
+    !
+    INTEGER(i_std), INTENT(in)                 :: nbpt                    !! Number of points for which the data 
+                                                                          !!   needs to be interpolated
+    INTEGER(i_std), INTENT(in)                 :: Nvariabletypes          !! Number of types of the variable
+    REAL(r_std), DIMENSION(Nvariabletypes),    &                          !! Vector of values of the types
+      INTENT(in)    :: variabletypes                                      !!   (-1, not used)
+    REAL(r_std), DIMENSION(nbpt,2), INTENT(in) :: lalo                    !! Vector of latitude and longitudes 
+                                                                          !! (beware of the order = 1 : latitude, 
+                                                                          !!   2 : longitude)
+    REAL(r_std), DIMENSION(nbpt,2), INTENT(in) :: resolution              !! The size in km of each grid-box in X and Y
+    !
+    INTEGER(i_std), DIMENSION(nbpt,NbNeighb), INTENT(in) :: neighbours    !! Vector of neighbours for each grid point 
+                                                                          !!   1=N, 2=NE, 3=E, 4=SE, 5=S, 6=SW, 7=W, 8=NW) 
+                            
+    REAL(r_std), DIMENSION(nbpt),  INTENT(in)  :: contfrac                !! Fraction of land in each grid box.
+    CHARACTER(LEN=80), INTENT(in)              :: filename                !! name of the input map to read
+
+    CHARACTER(LEN=80), INTENT(in)              :: varname                 !! name of the variable to interpolate
+    CHARACTER(LEN=80), INTENT(in)              :: inlonname, inlatname    !! names of the longitude and latitude
+    REAL(r_std), INTENT(inout)                 :: varmin, varmax          !! min/max values to use for the
+                                                                          !!   renormalization
+! Transformations to apply to the original read values from the file
+    LOGICAL, INTENT(in)                        :: noneg                   !! no negative values
+    CHARACTER(LEN=50), INTENT(in)              :: masktype                !! Type of masking
+                                                                          !!   'nomask': no-mask is applied
+                                                                          !!   'mbelow': take values below maskvalues(1)
+                                                                          !!   'mabove': take values above maskvalues(1)
+                                                                          !!   'msumrange': take values within 2 ranges;
+                                                                          !!      maskvalues(2) <= SUM(vals(k)) <= maskvalues(1)
+                                                                          !!      maskvalues(1) < SUM(vals(k)) <= maskvalues(3)
+                                                                          !!        (normalized by maskvalues(3))
+                                                                          !!   'var': mask values are taken from a 
+                                                                          !!     variable (>0)
+    REAL(r_std), DIMENSION(3), INTENT(in)      :: maskvalues              !! values to use to mask (according to 
+                                                                          !!   `masktype') 
+    CHARACTER(LEN=250), INTENT(in)             :: maskvarname             !! name of the variable to use to mask 
+    CHARACTER(LEN=50), INTENT(in)              :: typefrac                !! Type of fraction retrieval:
+                                                                          !!   'default': standard
+    INTEGER(i_std), INTENT(in)                 :: dim1, dim2              !! 4D complementary dimension sizes
+    INTEGER(i_std), INTENT(in)                 :: initime                 !! Initial time to take (for input data 
+                                                                          !!   with time values, -1 not used)
+    REAL(r_std), INTENT(in)                    :: maxresollon,maxresollat !! lon,lat maximum resolutions (in m)
+    !! 0.2 Modified variables
+    !
+    !  0.3 OUTPUT
+    !
+!    REAL(r_std), INTENT(out)                   ::  laimap(nbpt,nvm,12)    !! lai read variable and re-dimensioned
+    REAL(r_std), DIMENSION(nbpt,Nvariabletypes), INTENT(out) :: outvar2D  !! 2D output variable and re-dimensioned
+    REAL(r_std), DIMENSION(nbpt), INTENT(out)  :: aoutvar                 !! availability of input data to
+                                                                          !!   interpolate output variable 
+                                                                          !!   (on the nbpt space)
+    !
+    !  0.4 LOCAL
+    !
+    INTEGER(i_std)                             :: iml, jml, lml, tml, fid, ib, ip, jp, it, jj, jv
+    INTEGER                                    :: inNdims                 !! Number of dimensions of the input data
+    INTEGER                                    :: inNLldims               !! Number of dimensions of the lon/lat input data
+    REAL(r_std), ALLOCATABLE, DIMENSION(:)     :: lat_in, lon_in          !! latitude and
+                                                                          !! longitude, extract from input map
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)   :: lat, lon                !! en 2D ???
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)   :: sub_area                !! the area of the fine grid in the 
+                                                                          !!   model grid ???
+                                                                          !! cf src_global/interpol_help.f90, 
+                                                                          !!   line 377, called "areaoverlap"
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:,:)  :: sub_index           !! the indexes from the grid boxes from the 
+                                                                          !!   data that go into the 
+                                                                          !!   model's boxes  
+                                                                          !! cf src_global/interpol_help.f90,
+                                                                          !!   line 300, called "ip"
+
+!    REAL(r_std), ALLOCATABLE, DIMENSION(:)       :: invar1D               !! 1D input values
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)     :: invar2D               !! 2D input values
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:)   :: invar3D               !! 3D input values
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:,:) :: invar4D               !! 4D input values
+
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:)   :: resol_in
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:)  :: mask
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)     :: maskvar
+    INTEGER(i_std)                             :: nix, njx
+    INTEGER(i_std)                             :: idi, nbvmax             !! nbvmax : number of maximum vegetation map
+                                                                          !! points in the GCM grid ; idi : its counter
+    CHARACTER(LEN=30)                          :: callsign                !! Allows to specify which variable is beeing
+                                                                          !! treated
+    LOGICAL                                    :: ok_interpol             !! optionnal return of aggregate_2d
+    !
+    INTEGER                                    :: ALLOC_ERR 
+    CHARACTER(LEN=50)                          :: S1
+    REAL(r_std), ALLOCATABLE, DIMENSION(:)     :: variableusetypes
+    CHARACTER(LEN=256)                         :: msg
+    INTEGER, DIMENSION(:), ALLOCATABLE         :: indims
+
+! Debug vars
+    INTEGER                                    :: nb_coord, nb_var, nb_gat
+
+
+!_ ================================================================================================================================
+! Allocating input data
+
+    IF (printlev >= 3) WRITE(numout,*)"In interpweight_2D filename: ",TRIM(filename),          &
+      " varname:'" // TRIM(varname) // "'"
+    !
+    IF (is_root_prc) THEN
+       IF (printlev >=5) THEN
+          WRITE(numout,*) "Entering 'interpweight_2D'. Debug mode."
+          WRITE(numout,*)'(/," --> fliodmpf")'
+          CALL fliodmpf (TRIM(filename))
+          WRITE(numout,*)'(/," --> flioopfd")'
+       ENDIF
+       CALL flioopfd (TRIM(filename),fid,nb_dim=nb_coord,nb_var=nb_var,nb_gat=nb_gat)
+       IF (printlev >=5) THEN
+          WRITE (numout,'(" Number of coordinate        in the file : ",I2)') nb_coord
+          WRITE (numout,'(" Number of variables         in the file : ",I2)') nb_var
+          WRITE (numout,'(" Number of global attributes in the file : ",I2)') nb_gat
+       ENDIF
+    ENDIF
+
+! Getting shape of input variable from input file
+    inNdims = interpweight_get_varNdims_file(filename, varname)
+    IF (is_root_prc) CALL flininfo(filename, iml, jml, lml, tml, fid)
+    
+    ! Read variable (varname) from input file
+    InputDims: SELECT CASE (inNdims)
+      CASE (2)
+        CALL bcast(iml)
+        CALL bcast(jml)
+
+        ALLOCATE(invar2D(iml,jml), STAT=ALLOC_ERR)
+        IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_2D',"Problem in allocation of variable '" //     &
+          TRIM(varname) ,'','')
+        IF (is_root_prc) CALL flinget(fid, TRIM(varname), iml, jml, 0, 0, 1, 1, invar2D)
+        IF (printlev >= 5) THEN
+          WRITE(numout,*)'  interpweight_2D input data dimensions: '
+          WRITE(numout,*)'    iml, jml:',iml, jml
+        END IF
+
+      CASE (3)
+        ALLOCATE(indims(3), STAT=ALLOC_ERR)
+        IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_2D','Problem in allocation of indims','','')
+        indims = interpweight_get_var3dims_file(filename, varname)
+
+        lml = indims(3)
+        CALL bcast(iml)
+        CALL bcast(jml)
+        CALL bcast(lml)
+
+        ALLOCATE(invar3D(iml,jml, lml), STAT=ALLOC_ERR)
+        IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_2D',"Problem in allocation of variable '" //     &
+          TRIM(varname) ,'','')
+        IF (is_root_prc) CALL flinget(fid, TRIM(varname), iml, jml, lml, 0, 1, 1, invar3D)
+        IF (printlev >= 5) THEN
+          WRITE(numout,*)'  interpweight_2D input data dimensions:'
+          WRITE(numout,*)'    iml, jml, lml:',iml, jml, lml
+        END IF
+
+      CASE (4)
+        ALLOCATE(indims(4), STAT=ALLOC_ERR)
+        IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_2D','Problem in allocation of indims','','')
+        indims = interpweight_get_var4dims_file(filename, varname)
+        lml = indims(3)
+        CALL bcast(iml)
+        CALL bcast(jml)
+        CALL bcast(lml)
+!       Taken from `slowproc_update'
+        IF (initime /= -1) THEN
+          inNdims = 3
+          IF (printlev >= 3)  WRITE(numout,*) &
+               'interpweight_2D: taking into account the initial reading time:',initime
+          IF (initime <= 0) tml = 0
+
+          CALL bcast(tml)
+          ALLOCATE(invar3D(iml,jml,lml), STAT=ALLOC_ERR)
+          IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_2D',"Problem in allocation of variable '" //   &
+            TRIM(varname) ,'','')
+          IF ( initime > 0 ) THEN
+            IF (is_root_prc) THEN
+              IF (initime <= tml) THEN
+                 CALL flinget(fid, TRIM(varname), iml, jml, lml, 1, initime, 1, invar3D)
+              ELSE
+                 CALL flinget(fid, TRIM(varname), iml, jml, lml, 1, tml, 1, invar3D)
+              ENDIF
+            ENDIF
+          ELSE
+            IF (is_root_prc) THEN
+              CALL flinget(fid, TRIM(varname), iml, jml, lml, 1, 1, 1, invar3D)
+            ENDIF
+          ENDIF
+        ELSE
+          CALL bcast(tml)
+          ALLOCATE(invar4D(iml,jml,lml,tml), STAT=ALLOC_ERR)
+          IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_2D',"Problem in allocation of variable '" //   &
+            TRIM(varname) ,'','')
+          IF (is_root_prc) CALL flinget(fid, TRIM(varname), iml, jml, lml, tml, 1, tml, invar4D)
+        END IF
+
+        IF (printlev >= 5) THEN
+          WRITE(numout,*)'  interpweight_2D input data dimensions'
+          WRITE(numout,*)'    iml, jml, lml, tml :',iml, jml, lml, tml
+        END IF
+
+      CASE DEFAULT
+        WRITE (S1,'(I3)') inNdims
+        CALL ipslerr_p(3,'interpweight_2D',"Input number of dimensions: '" // TRIM(S1) // "' not ready !!", &
+          '','')
+
+    END SELECT InputDims
+    CALL bcast(invar2D)
+
+    IF (printlev >= 5) WRITE(numout,*)'  interpweight_2D getting variable ended!'
+
+! Getting longitudes/latitudes from input file
+    inNLldims = interpweight_get_varNdims_file(filename, inlonname)
+    
+    IF (inNLldims == 1) THEN
+      ! Allocate memory for latitudes
+      ALLOCATE(lon_in(iml), STAT=ALLOC_ERR)
+      IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_2D','Problem in allocation of variable lon_in','','')
+
+      ALLOCATE(lat_in(jml), STAT=ALLOC_ERR)
+      IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_2D','Problem in allocation of variable lat_in','','')
+
+      IF (is_root_prc) THEN
+        CALL flinget(fid, TRIM(inlonname), iml, 0, 0, 0, 1, 1, lon_in)
+        CALL flinget(fid, TRIM(inlatname), jml, 0, 0, 0, 1, 1, lat_in)
+      ENDIF
+      CALL bcast(lon_in)
+      CALL bcast(lat_in)
+
+      ALLOCATE(lon(iml,jml), STAT=ALLOC_ERR)
+      IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_2D','Problem in allocation of variable lon','','')
+      ALLOCATE(lat(iml,jml), STAT=ALLOC_ERR)
+      IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_2D','Problem in allocation of variable lat','','')
+
+      DO ip=1,iml
+         lat(ip,:) = lat_in(:)
+      ENDDO
+      DO jp=1,jml
+         lon(:,jp) = lon_in(:)
+      ENDDO
+    ELSE
+      ! Allocate memory for longitude
+      ALLOCATE(lon(iml,jml), STAT=ALLOC_ERR)
+      IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_2D','Pb in allocation for lon','','')
+      ! Allocate memory for latitudes
+      ALLOCATE(lat(iml,jml), STAT=ALLOC_ERR)
+      IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_2D','Pb in allocation for lat','','')
+
+      IF (is_root_prc) THEN
+        CALL flinget(fid, TRIM(inlonname), iml, jml, 0, 0, 1, 1, lon)
+        CALL flinget(fid, TRIM(inlatname), iml, jml, 0, 0, 1, 1, lat)
+      ENDIF
+    END IF
+    CALL bcast(lon)
+    CALL bcast(lat)
+
+    IF (is_root_prc) THEN
+      ALLOCATE(resol_in(iml,jml,2), STAT=ALLOC_ERR)
+      IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_2D','Problem in allocation of variable resol_in','','')
+    END IF
+
+    IF (noneg) THEN
+      IF (is_root_prc) THEN
+        SELECT CASE (inNdims)
+          CASE(2)
+            CALL interpweight_modifying_input2D(iml, jml, 0, 0, 1, 1, zero, invar2D)
+          CASE(3)
+            CALL interpweight_modifying_input3D(iml, jml, lml, 0, 1, 1, zero, invar3D)
+          CASE(4)
+            CALL interpweight_modifying_input4D(iml, jml, lml, tml, 1, tml, zero, invar4D)
+        END SELECT       
+      END IF
+    END IF
+    IF (printlev >= 5) WRITE(numout,*)'  interpweight_2D modifying input ended!'
+
+    !
+    ! Consider all points a priori
+    !
+    ALLOCATE(mask(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_2D','Problem in allocation of variable mask','','')
+    mask = zero
+
+    IF (TRIM(masktype) == 'var') THEN
+      ALLOCATE(maskvar(iml,jml), STAT=ALLOC_ERR)
+      IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_2D','Problem in allocation of variable maskvar','','')
+      maskvar(:,:) = 0
+! Reads the mask from the file
+      IF (is_root_prc) THEN
+! ATTTENTION!! One can not use flinget in this way. It always spect to have a REAL variable!
+        CALL flinget(fid, TRIM(maskvarname), iml, jml, 0, 0, 1, 1, maskvar)
+        WHERE (maskvar > zero)
+          mask = un 
+        END WHERE
+      END IF
+      CALL bcast(mask)
+    ELSE
+      ! Create land-sea mask based on values from the variable according to maskvalues and masktype
+      SELECT CASE (inNdims)
+        CASE(2)
+          CALL interpweight_masking_input2D(iml, jml, 0, 0, 0, 0, masktype, maskvalues, invar2D,      &
+            mask)
+        CASE(3)
+          CALL interpweight_masking_input3D(iml, jml, 0, 0, lml, 0, masktype, maskvalues, invar3D,    &
+            mask)
+        CASE(4)
+          CALL interpweight_masking_input4D(iml, jml, 0, 0, lml, tml, masktype, maskvalues, invar4D,  &
+            mask)
+      END SELECT
+    END IF
+    IF (printlev >= 5) WRITE(numout,*)'  interpweight_2D masking input ended!'
+
+    IF (is_root_prc) CALL flinclo(fid)
+
+! Assuming regular lon/lat projection for the input data
+    IF (is_root_prc) THEN
+      CALL interpweight_calc_resolution_in(lon, lat, iml, jml, mincos, R_Earth, pi, resol_in)
+    END IF
+
+    ! Computation of nbvmax
+    ! In 'condveg_soilalb, slowproc_update' nbvmax=200
+    !
+    ! The number of maximum vegetation map points in the GCM grid is estimated.
+    ! Some lmargin is taken.
+    !
+    IF (is_root_prc) THEN
+      IF ( (maxresollon /= -un) .AND. (maxresollat /= -un) ) THEN
+!       Assuming regular lon/lat projection for the input data but it is not caluclated assuming a maximum  &
+!         lon,lat resolution given as input paramater
+         nix=INT(MAXVAL(resolution(:,1))/maxresollon)+2
+         njx=INT(MAXVAL(resolution(:,2))/maxresollat)+2
+      ELSE
+!       Assuming regular lon/lat projection for the input data
+        CALL interpweight_calc_resolution_in(lon, lat, iml, jml, mincos, R_Earth, pi, resol_in)
+        nix=INT(MAXVAL(resolution(:,1))/MAXVAL(resol_in(:,:,1)))+2
+        njx=INT(MAXVAL(resolution(:,2))/MAXVAL(resol_in(:,:,2)))+2
+      END IF
+      nbvmax = MAX(nix*njx, 200)
+    END IF  
+    CALL bcast(nbvmax)
+    CALL bcast(nix)
+    CALL bcast(njx)
+
+    !
+    callsign = TRIM(varname) // ' map'
+    !
+    ok_interpol = .FALSE.
+    DO WHILE ( .NOT. ok_interpol )
+       IF (printlev>=3) WRITE(numout,*) "Projection arrays for ",callsign," : "
+       IF (printlev>=3) WRITE(numout,*) "nbvmax = ",nbvmax, nix, njx
+
+
+       ALLOCATE(sub_index(nbpt, nbvmax, 2), STAT=ALLOC_ERR)
+       IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_2D','Problem in allocation of variable sub_index','','')
+
+       sub_index(:,:,:)=zero
+
+       ALLOCATE(sub_area(nbpt, nbvmax), STAT=ALLOC_ERR)
+       IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_2D','Problem in allocation of variable sub_area','','')
+
+       sub_area(:,:)=zero
+       IF (printlev>=3) WRITE(numout,*) 'Input data range LON:', MINVAL(lon), MAXVAL(lon)
+       IF (printlev>=3) WRITE(numout,*) 'Input data range LAT:', MINVAL(lat), MAXVAL(lat)
+
+       !
+       CALL aggregate_p(nbpt, lalo, neighbours, resolution, contfrac, &
+            &                iml, jml, lon, lat, mask, callsign, &
+            &                nbvmax, sub_index, sub_area, ok_interpol)
+       
+       !
+       IF ( .NOT. ok_interpol ) THEN
+          DEALLOCATE(sub_area)
+          DEALLOCATE(sub_index)
+          nbvmax = nbvmax * 2
+       ENDIF
+    ENDDO
+    IF (printlev>=4) WRITE (numout,*) '  interpweight_2D: read/allocate OK'
+
+! Getting variables thresholds
+    ALLOCATE(variableusetypes(Nvariabletypes), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_2D','Problem in allocation of variableusetypes','','')
+    
+
+    IF (variabletypes(1) == -un) THEN
+      variableusetypes = (/ (ip*1., ip=1,Nvariabletypes) /)
+      IF (printlev>=4) THEN
+         WRITE(numout,*)'  interpweight_2D: Note: Using default equivalence between dimension ',&
+              'in the file and dimension in the variable, for file ', filename
+      END IF
+      varmin = 1._r_std
+      varmax = Nvariabletypes*1._r_std
+    ELSE
+      variableusetypes = variabletypes    
+    END IF
+
+    outvar2D = zero
+
+! Providing the fractions of each type for each interpolated grid point
+    CALL interpweight_provide_fractions2D(typefrac, nbpt, Nvariabletypes, variableusetypes,           &
+      iml, jml, lml, tml, nbvmax, zero, invar2D, sub_area, sub_index, varmax, varmin,                 &
+      deux, lalo, outvar2D, aoutvar)
+    IF (printlev>=5) WRITE (numout,*)'  interpweight_2D end of provide_fractions2D'
+
+    IF (printlev>=3) THEN
+       IF (COUNT(aoutvar == -1) >= AINT(nbpt*0.4)) THEN
+          WRITE(numout,*) '  interpweight_2D total number of points: ', nbpt
+          WRITE(numout,*) '  interpweight_2D interpolated: ', COUNT(aoutvar /= -1),                   &
+               ' non-interpolated: ', COUNT(aoutvar == -1)
+          msg = "Less than 60% of points '" // TRIM(filename) // "' variable '" // TRIM(varname) //       & 
+               "' have been succesfully interpolated !!"
+          WRITE(numout,*) '  interpweight_2D: ' // TRIM(msg)
+       ELSE
+          msg = TRIM(filename) // "' variable: '" // TRIM(varname) // "' interpolation Done _______"
+          WRITE(numout,*) "interpweight_2D: '" // TRIM(msg)
+          WRITE(numout,*) '  Total number of points: ', nbpt
+          WRITE(numout,*) '  Interpolated: ', COUNT(aoutvar /= -1),                 &
+               ' Non-interpolated: ', COUNT(aoutvar == -1)
+       END IF
+    END IF
+
+! Scaling to 1 the quality variable
+    DO ip=1, nbpt
+      IF (aoutvar(ip) /= -1) aoutvar(ip) = aoutvar(ip)/(resolution(ip,1)*resolution(ip,2))/contfrac(ip)
+    END DO
+
+    IF (ALLOCATED(lon_in)) DEALLOCATE(lon_in)
+    IF (ALLOCATED(lat_in)) DEALLOCATE(lat_in)
+    DEALLOCATE(lon)
+    DEALLOCATE(lat)
+    IF (ALLOCATED(invar2D)) DEALLOCATE(invar2D)
+    IF (ALLOCATED(invar3D)) DEALLOCATE(invar3D)
+    IF (ALLOCATED(invar4D)) DEALLOCATE(invar4D)
+    DEALLOCATE(mask)
+    IF (ALLOCATED(maskvar)) DEALLOCATE(maskvar)
+    DEALLOCATE(sub_area)
+    DEALLOCATE(sub_index)
+    IF (ALLOCATED(resol_in)) DEALLOCATE(resol_in)
+
+    RETURN
+
+  END SUBROUTINE interpweight_2D
+
+!! ================================================================================================================================
+!! SUBROUTINE   : interpweight_3D
+!!
+!>\BRIEF        ! Interpolate any input file to the grid of the model for a 3D-variable  
+!!
+!! DESCRIPTION  : (definitions, functional, design, flags): 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): outvar3D, aoutvar
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  SUBROUTINE interpweight_3D(nbpt, Nvariabletypes, variabletypes, lalo, resolution, neighbours,       &
+    contfrac, filename, varname, inlonname, inlatname, varmin, varmax, noneg, masktype,               &
+    maskvalues, maskvarname, dim1, dim2, initime, typefrac,                                           &
+    maxresollon, maxresollat, outvar3D, aoutvar)
+
+    USE ioipsl
+    USE constantes_var
+    USE mod_orchidee_para
+
+    IMPLICIT NONE
+
+    !! 0. Variables and parameter declaration
+    !
+    !  0.1 INPUT
+    !
+    INTEGER(i_std), INTENT(in)                 :: nbpt                    !! Number of points for which the data 
+                                                                          !!   needs to be interpolated
+    INTEGER(i_std), INTENT(in)                 :: Nvariabletypes          !! Number of types of the variable
+    REAL(r_std), DIMENSION(Nvariabletypes),    &                          !! Vector of values of the types
+      INTENT(in)    :: variabletypes                                      !!   (-1, not used)
+    REAL(r_std), DIMENSION(nbpt,2), INTENT(in) :: lalo                    !! Vector of latitude and longitudes 
+                                                                          !! (beware of the order = 1 : latitude, 
+                                                                          !!   2 : longitude)
+    REAL(r_std), DIMENSION(nbpt,2), INTENT(in) :: resolution              !! The size in km of each grid-box in X and Y
+    INTEGER(i_std), DIMENSION(nbpt,NbNeighb), INTENT(in) :: neighbours    !! Vector of neighbours for each grid point 
+                                                                          !!   1=N, 2=NE, 3=E, 4=SE, 5=S, 6=SW, 7=W, 8=NW) 
+                            
+    REAL(r_std), DIMENSION(nbpt), INTENT(in)   :: contfrac                !! Fraction of land in each grid box.
+    CHARACTER(LEN=80), INTENT(in)              :: filename                !! name of the input map to read
+
+    CHARACTER(LEN=80), INTENT(in)              :: varname                 !! name of the variable to interpolate
+    CHARACTER(LEN=80), INTENT(in)              :: inlonname, inlatname    !! names of the longitude and latitude
+                                                                          !!   in the input file
+! Transformations to apply to the original read values from the file
+    LOGICAL, INTENT(in)                        :: noneg                   !! no negative values
+    CHARACTER(LEN=50), INTENT(in)              :: masktype                !! Type of masking
+                                                                          !!   'nomask': no-mask is applied
+                                                                          !!   'mbelow': take values below maskvalues(1)
+                                                                          !!   'mabove': take values above maskvalues(1)
+                                                                          !!   'msumrange': take values within 2 ranges;
+                                                                          !!      maskvalues(2) <= SUM(vals(k)) <= maskvalues(1)
+                                                                          !!      maskvalues(1) < SUM(vals(k)) <= maskvalues(3)
+                                                                          !!        (normalized by maskvalues(3))
+                                                                          !!   'var': mask values are taken from a 
+                                                                          !!     variable (>0)
+    REAL(r_std), DIMENSION(3), INTENT(in)      :: maskvalues              !! values to use to mask (according to 
+                                                                          !!   `masktype') 
+    CHARACTER(LEN=250), INTENT(in)             :: maskvarname             !! name of the variable to use to mask 
+    INTEGER, INTENT(in)                        :: dim1, dim2              !! 3/4D dimensions of the output variable
+    REAL(r_std), DIMENSION(dim1), INTENT(inout) :: varmin, varmax          !! min/max values to use for the renormalization
+    CHARACTER(LEN=50), INTENT(in)              :: typefrac                !! Type of fraction retrieval:
+                                                                          !!   'default': standard
+    INTEGER(i_std), INTENT(in)                 :: initime                 !! Initial time to take (for input data 
+                                                                          !!   with time values, -1 not used)
+    REAL(r_std), INTENT(in)                    :: maxresollon,maxresollat !! lon,lat maximum resolutions (in m)
+                                                                          !!   (-un, not used)
+    !! 0.2 Modified variables
+    !
+    !  0.3 OUTPUT
+    !
+    REAL(r_std), DIMENSION(nbpt,dim1), INTENT(out) :: outvar3D            !! 3D output variable and re-dimensioned
+! aovar: availability of input data to interpolate output variable (on the nbpt space)
+    REAL(r_std), DIMENSION(nbpt), INTENT(out)  :: aoutvar                 !! availability of input data to
+                                                                          !!   interpolate output variable 
+                                                                          !!   (on the nbpt space)
+    !
+    !  0.4 Local variables
+    !
+    INTEGER(i_std)                             :: iml, jml, lml, tml, fid, ib, ip, jp, zp, it, jj, jv
+    INTEGER                                    :: inNdims                 !! Number of dimensions of the input data
+    INTEGER                                    :: inNLldims               !! Number of dimensions of the lon/lat input data
+    REAL(r_std), ALLOCATABLE, DIMENSION(:)     :: lat_in, lon_in          !! latitude and
+                                                                          !! longitude, extract from input map
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)   :: lat, lon                !! en 2D ???
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)   :: sub_area                !! the area of the fine grid in the 
+                                                                          !!   model grid ???
+                                                                          !! cf src_global/interpol_help.f90, 
+                                                                          !!   line 377, called "areaoverlap"
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:,:)  :: sub_index           !! the indexes from the grid boxes from the 
+                                                                          !!   data that go into the 
+                                                                          !!   model's boxes  
+                                                                          !! cf src_global/interpol_help.f90,
+                                                                          !!   line 300, called "ip"
+
+!    REAL(r_std), ALLOCATABLE, DIMENSION(:)       :: invar1D               !! 1D input values
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)     :: invar2D               !! 2D input values
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:)   :: invar3D               !! 3D input values
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:,:) :: invar4D               !! 4D input values
+
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:)   :: resol_in
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:)  :: mask
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)     :: maskvar
+    INTEGER(i_std)                             :: nix, njx
+    INTEGER(i_std)                             :: idi, nbvmax             !! nbvmax : number of maximum vegetation map
+                                                                          !! points in the GCM grid ; idi : its counter
+    CHARACTER(LEN=30)                          :: callsign                !! Allows to specify which variable is beeing
+                                                                          !! treated
+    LOGICAL                                    :: ok_interpol             !! optionnal return of aggregate_2d
+    INTEGER                                    :: ALLOC_ERR 
+
+    CHARACTER(LEN=50)                          :: S1
+    REAL(r_std), ALLOCATABLE, DIMENSION(:)     :: variableusetypes
+    CHARACTER(LEN=256)                         :: msg
+
+! Debug vars
+    INTEGER                                    :: nb_coord, nb_var, nb_gat
+    CHARACTER(LEN=5)                           :: iS
+    CHARACTER(LEN=50)                          :: suminS
+
+    INTEGER, ALLOCATABLE, DIMENSION(:)         :: indims
+
+
+!_ ================================================================================================================================
+    IF (printlev >= 3) WRITE(numout, *)"In interpweight_3D filename: ",TRIM(filename),         &
+      " varname:'" // TRIM(varname) // "'"
+! Allocating input data
+    IF (is_root_prc) THEN
+       IF (printlev >=5) THEN
+          WRITE(numout,*) "Entering 'interpweight_3D'. Debug mode."
+          WRITE(numout,*)'(/," --> fliodmpf")'
+          CALL fliodmpf (TRIM(filename))
+          WRITE(numout,*)'(/," --> flioopfd")'
+       ENDIF
+       CALL flioopfd (TRIM(filename),fid,nb_dim=nb_coord,nb_var=nb_var,nb_gat=nb_gat)
+       IF (printlev >=5) THEN
+          WRITE (numout,'(" Number of coordinate        in the file : ",I2)') nb_coord
+          WRITE (numout,'(" Number of variables         in the file : ",I2)') nb_var
+          WRITE (numout,'(" Number of global attributes in the file : ",I2)') nb_gat
+       ENDIF
+    ENDIF
+
+! Getting shape of input variable from input file
+    inNdims = interpweight_get_varNdims_file(filename, varname)
+    IF (is_root_prc) CALL flininfo(filename, iml, jml, lml, tml, fid)
+
+    InputDims: SELECT CASE (inNdims)
+      CASE (2)
+        CALL bcast(iml)
+        CALL bcast(jml)
+
+        ALLOCATE(invar2D(iml,jml), STAT=ALLOC_ERR)
+        IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_3D',"Problem in allocation of variable '" //     &
+          TRIM(varname) ,'','')
+        IF (is_root_prc) CALL flinget(fid, TRIM(varname), iml, jml, 0, 0, 1, 1, invar2D)
+        IF (printlev >= 5) THEN
+          WRITE(numout,*)'  interpweight_3D input data dimensions'
+          WRITE(numout,*)'    iml, jml:',iml, jml
+        END IF
+
+      CASE (3)
+        ALLOCATE(indims(3), STAT=ALLOC_ERR)
+        IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_3D','Problem in allocation of indims','','')
+        indims = interpweight_get_var3dims_file(filename, varname)
+
+        lml = indims(3)
+        CALL bcast(iml)
+        CALL bcast(jml)
+        CALL bcast(lml)
+
+        ALLOCATE(invar3D(iml,jml, lml), STAT=ALLOC_ERR)
+        IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_3D',"Problem in allocation of variable '" //     &
+          TRIM(varname) ,'','') 
+        IF (is_root_prc) CALL flinget(fid, TRIM(varname), iml, jml, lml, 0, 2, 1, invar3D)
+        IF (printlev >= 5) THEN
+          WRITE(numout,*)'  interpweight_3D input data dimensions'
+          WRITE(numout,*)'    iml, jml, lml :',iml, jml, lml
+        END IF
+
+      CASE (4)
+        ALLOCATE(indims(4), STAT=ALLOC_ERR)
+        IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_3D','Problem in allocation of indims','','')
+        
+        indims = interpweight_get_var4dims_file(filename, varname)
+        lml = indims(3)
+        CALL bcast(iml)
+        CALL bcast(jml)
+        CALL bcast(lml)
+!       Taken from `slowproc_update'
+        IF (initime /= -1) THEN
+          inNdims = 3
+          IF (printlev >= 3) WRITE (numout,*) &
+               'interpweight_3D: taking into account the initial reading time:',initime
+          IF (initime <= 0) tml = 0
+
+          CALL bcast(tml)
+          ALLOCATE(invar3D(iml,jml,lml), STAT=ALLOC_ERR)
+          IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_3D','Problem in allocation of variable invar3D','','')
+          IF ( initime > 0 ) THEN
+            IF (is_root_prc) THEN
+              IF (initime <= tml) THEN
+                CALL flinget(fid, TRIM(varname), iml, jml, lml, 1, initime, 1, invar3D)
+              ELSE
+                CALL flinget(fid, TRIM(varname), iml, jml, lml, 1, tml, 1, invar3D)
+              ENDIF
+            ENDIF
+          ELSE
+            IF (is_root_prc) THEN
+              CALL flinget(fid, TRIM(varname), iml, jml, lml, 1, 1, 1, invar3D)
+            ENDIF
+          ENDIF
+        ELSE
+          CALL bcast(tml)
+          ALLOCATE(invar4D(iml,jml,lml,tml), STAT=ALLOC_ERR)
+          IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_3D','Problem in allocation of variable invar4D','','')
+          IF (is_root_prc) CALL flinget(fid, TRIM(varname), iml, jml, lml, tml, 1, tml, invar4D)
+        END IF
+
+        IF (printlev >= 5) THEN
+          WRITE(numout,*)'  interpweight_3D input data dimensions'
+          WRITE(numout,*)'    iml, jml, lml, tml:',iml, jml, lml, tml
+        END IF
+
+      CASE DEFAULT
+        WRITE (S1,'(I3)') inNdims
+        CALL ipslerr_p(3,'interpweight_3D',"Input number of dimensions: '" // TRIM(S1) // "' not ready !!", &
+          '','')
+
+    END SELECT InputDims
+    CALL bcast(invar3D)
+  
+    IF (printlev >= 5) WRITE(numout,*)'  interpweight_3D getting variable ended!'
+! Nan values are not allowed
+    DO ip=1,SIZE(invar3d, DIM=1)
+      DO jp=1,SIZE(invar3d, DIM=2)
+        DO zp=1,SIZE(invar3d, DIM=3)
+          IF ( invar3D(ip, jp, zp) /= invar3d(ip, jp, zp) ) THEN
+            CALL ipslerr_p(3, 'interpweight_3D', 'Nan values are not allowed in', 'netcdf orchidee files', 'missing_values have to be defined as 1.e+20f')
+          ENDIF
+        ENDDO
+      ENDDO
+    ENDDO
+
+! Test lecture
+    DO ip=1,lml
+      IF ( SUM(invar3D(:,:,ip)) < 0.00001 ) THEN
+        WRITE(iS, '(i5)')ip 
+        WRITE(suminS, '(f20.10)')SUM(invar3d(:,:,ip)) 
+        msg = 'Wrong lecture of data for type ' // TRIM(iS) // ' all values are zero !!'
+        CALL ipslerr_p(3,'interpweight_3D',TRIM(msg),'','')
+      END IF
+    END DO
+
+! Getting longitudes/latitudes from input file
+    inNLldims = interpweight_get_varNdims_file(filename, inlonname)
+    IF (inNLldims == 1) THEN
+      ! Allocate memory for latitudes
+      ALLOCATE(lon_in(iml), STAT=ALLOC_ERR)
+      IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_3D','Problem in allocation of variable lon_in','','')
+
+      ALLOCATE(lat_in(jml), STAT=ALLOC_ERR)
+      IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_3D','Problem in allocation of variable lat_in','','')
+
+      IF (is_root_prc) THEN
+        CALL flininspect(fid)
+        CALL flinget(fid, TRIM(inlonname), iml, 0, 0, 0, 1, 1, lon_in)
+        CALL flinget(fid, TRIM(inlatname), jml, 0, 0, 0, 1, 1, lat_in)
+      ENDIF
+      CALL bcast(lon_in)
+      CALL bcast(lat_in)
+
+      ALLOCATE(lon(iml,jml), STAT=ALLOC_ERR)
+      IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_3D','Problem in allocation of variable lon','','')
+      ALLOCATE(lat(iml,jml), STAT=ALLOC_ERR)
+      IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_3D','Problem in allocation of variable lat','','')
+
+      DO ip=1,iml
+         lat(ip,:) = lat_in(:)
+      ENDDO
+      DO jp=1,jml
+         lon(:,jp) = lon_in(:)
+      ENDDO
+    ELSE
+      ! Allocate memory for longitude
+      ALLOCATE(lon(iml,jml), STAT=ALLOC_ERR)
+      IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_3D','Pb in allocation for lon','','')
+      ! Allocate memory for latitudes
+      ALLOCATE(lat(iml,jml), STAT=ALLOC_ERR)
+      IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_3D','Pb in allocation for lat','','')
+
+      IF (is_root_prc) THEN
+        CALL flinget(fid, TRIM(inlonname), iml, jml, 0, 0, 1, 1, lon)
+        CALL flinget(fid, TRIM(inlatname), iml, jml, 0, 0, 1, 1, lat)
+      ENDIF
+    END IF
+    CALL bcast(lon)
+    CALL bcast(lat)
+
+    ALLOCATE(resol_in(iml,jml,2), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_3D','Problem in allocation of variable resol_in','','')
+
+    IF (noneg) THEN
+      IF (is_root_prc) THEN
+        SELECT CASE (inNdims)
+          CASE(2)
+            CALL interpweight_modifying_input2D(iml, jml, 0, 0, 1, 1, zero, invar2D)
+          CASE(3)
+            CALL interpweight_modifying_input3D(iml, jml, lml, 0, 1, 1, zero, invar3D)
+          CASE(4)
+            CALL interpweight_modifying_input4D(iml, jml, lml, tml, 1, tml, zero, invar4D)
+        END SELECT       
+      END IF
+    END IF
+    IF (printlev >= 5) WRITE(numout,*)'  interpweight_3D modifying input ended!'
+
+    ALLOCATE(mask(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_3D','Problem in allocation of variable mask','','')
+    mask(:,:) = 0
+
+    IF (TRIM(masktype) == 'var') THEN
+      ALLOCATE(maskvar(iml,jml), STAT=ALLOC_ERR)
+      IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_3D','Problem in allocation of variable maskvar','','')
+      maskvar(:,:) = 0.
+! Reads the mask from the file
+      IF (is_root_prc) THEN
+! ATTTENTION!! One can not use flinget in this way. It always spect to have a REAL variable!
+        CALL flinget(fid, TRIM(maskvarname), iml, jml, 0, 0, 1, 1, maskvar)
+        WHERE (maskvar > zero)
+          mask = un 
+        END WHERE
+      END IF
+      CALL bcast(mask)
+    ELSE
+      SELECT CASE (inNdims)
+        CASE(2)
+          CALL interpweight_masking_input2D(iml, jml, 0, 0, 0, 0, masktype, maskvalues, invar2D,      &
+            mask)
+        CASE(3)
+          CALL interpweight_masking_input3D(iml, jml, 0, 0, lml, 0, masktype, maskvalues, invar3D,    &
+            mask)
+        CASE(4)
+          CALL interpweight_masking_input4D(iml, jml, 0, 0, lml, tml, masktype, maskvalues, invar4D,  &
+            mask)
+      END SELECT
+    END IF
+    IF (printlev >= 5) WRITE(numout,*)'  interpweight_3D masking input ended!'
+
+    IF (is_root_prc) CALL flinclo(fid)
+
+    ! Computation of nbvmax
+    ! In 'condveg_soilalb, slowproc_update' nbvmax=200
+    !
+    ! The number of maximum vegetation map points in the GCM grid is estimated.
+    ! Some lmargin is taken.
+    !
+    IF (is_root_prc) THEN
+      IF ( (maxresollon /= -un) .AND. (maxresollat /= -un) ) THEN
+!       Assuming regular lon/lat projection for the input data but it is not caluclated assuming a maximum  &
+!         lon,lat resolution given as input paramater
+         nix=INT(MAXVAL(resolution(:,1))/maxresollon)+2
+         njx=INT(MAXVAL(resolution(:,2))/maxresollat)+2
+      ELSE
+!       Assuming regular lon/lat projection for the input data
+        CALL interpweight_calc_resolution_in(lon, lat, iml, jml, mincos, R_Earth, pi, resol_in)
+        nix=INT(MAXVAL(resolution(:,1))/MAXVAL(resol_in(:,:,1)))+2
+        njx=INT(MAXVAL(resolution(:,2))/MAXVAL(resol_in(:,:,2)))+2
+      END IF
+      nbvmax = MAX(nix*njx, 200)
+    END IF  
+    CALL bcast(nbvmax)
+    CALL bcast(nix)
+    CALL bcast(njx)
+
+    !
+    callsign = TRIM(varname) // ' map'
+    !
+    ok_interpol = .FALSE.
+    DO WHILE ( .NOT. ok_interpol )
+       IF (printlev>=3) WRITE(numout,*) "Projection arrays for ",callsign," : "
+       IF (printlev>=3) WRITE(numout,*) "nbvmax = ",nbvmax, nix, njx
+
+       ALLOCATE(sub_index(nbpt, nbvmax, 2), STAT=ALLOC_ERR)
+       IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_3D','Problem in allocation of variable sub_index','','')
+
+       sub_index(:,:,:)=zero
+
+       ALLOCATE(sub_area(nbpt, nbvmax), STAT=ALLOC_ERR)
+       IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_3D','Problem in allocation of variable sub_area','','')
+
+       sub_area(:,:)=zero
+
+       IF (printlev >= 3) THEN
+         WRITE(numout,*) 'interpweight_3D:'
+         WRITE(numout,*) '  Carteveg range LON:', MINVAL(lon), MAXVAL(lon)
+         WRITE(numout,*) '  Carteveg range LAT:', MINVAL(lat), MAXVAL(lat)
+       END IF
+       
+       CALL aggregate_p(nbpt, lalo, neighbours, resolution, contfrac, &
+            &                iml, jml, lon, lat, mask, callsign, &
+            &                nbvmax, sub_index, sub_area, ok_interpol)
+       
+       IF ( .NOT. ok_interpol ) THEN
+          DEALLOCATE(sub_area)
+          DEALLOCATE(sub_index)
+          nbvmax = nbvmax * 2
+       ENDIF
+    ENDDO
+
+! Getting variables thresholds
+    ALLOCATE(variableusetypes(Nvariabletypes),STAT=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_3D','Problem in allocation of variable variableusetypes','','')
+
+    IF (variabletypes(1) == -un) THEN
+      variableusetypes = (/ (ip*1., ip=1,Nvariabletypes) /)
+      IF (printlev>=4) WRITE(numout,*)'interpweight_3D: Note: Using default equivalence between ',&
+           'dimension in the file and dimension in the variable, for file ', filename
+      varmin = 1._r_std
+      varmax = Nvariabletypes*1._r_std
+    ELSE
+      variableusetypes = variabletypes
+    END IF
+    
+    outvar3D = zero
+
+! Providing the fractions of each type for each interpolated grid point
+    CALL interpweight_provide_fractions3D(typefrac, nbpt, Nvariabletypes, variableusetypes,           &
+      iml, jml, lml, tml, nbvmax, zero, invar3D, sub_area, sub_index, varmax, varmin,                 &
+      deux, lalo, outvar3D, aoutvar)
+    IF (printlev >= 5) WRITE(numout,*)'interpweight_3D end of interpweight_provide_fractions3D'
+
+    IF (printlev>=2) THEN
+       IF (COUNT(aoutvar == -1) >= AINT(nbpt*0.4)) THEN
+          WRITE(numout,*) 'interpweight_3D total number of points: ', nbpt
+          WRITE(numout,*) '  Interpolated: ', COUNT(aoutvar /= -1),                 &
+               ' Non-interpolated: ', COUNT(aoutvar == -1)
+          msg = "Less than 60% of points '" // TRIM(filename) // "' variable '" // TRIM(varname) //       & 
+               "' have been succesfully interpolated on the current process !!"
+          WRITE(numout,*)'   ' // TRIM(msg)
+       ELSE
+          msg = TRIM(filename) // "' variable: '" // TRIM(varname) // "' interpolation Done"
+          WRITE(numout,*) "interpweight_3D: '" // TRIM(msg)
+          WRITE(numout,*) '  Total number of points: ', nbpt
+          WRITE(numout,*) '  Interpolated: ', COUNT(aoutvar /= -1),                 &
+               ' Non-interpolated: ', COUNT(aoutvar == -1)
+       END IF
+    END IF
+
+! Scaling to 1 the quality variable
+    DO ip=1, nbpt
+      IF (aoutvar(ip) /= -1) aoutvar(ip) = aoutvar(ip)/(resolution(ip,1)*resolution(ip,2))/contfrac(ip)
+    END DO
+
+    IF (ALLOCATED(lat_in)) DEALLOCATE(lat_in)
+    IF (ALLOCATED(lon_in)) DEALLOCATE(lon_in)
+    DEALLOCATE(lon)
+    DEALLOCATE(lat)
+    IF (ALLOCATED(invar2D)) DEALLOCATE(invar2D)
+    IF (ALLOCATED(invar3D)) DEALLOCATE(invar3D)
+    IF (ALLOCATED(invar4D)) DEALLOCATE(invar4D)
+    DEALLOCATE(mask)
+    IF (ALLOCATED(maskvar)) DEALLOCATE(maskvar)
+    DEALLOCATE(sub_area)
+    DEALLOCATE(sub_index)
+    IF (ALLOCATED(resol_in)) DEALLOCATE(resol_in)
+
+    RETURN
+
+  END SUBROUTINE interpweight_3D
+
+!! ================================================================================================================================
+!! SUBROUTINE   : interpweight_4D
+!!
+!>\BRIEF        ! Interpolate any input file to the grid of the model for a 4D-variable  
+!!
+!! DESCRIPTION  : (definitions, functional, design, flags): 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): outvar4D, aoutvar
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  SUBROUTINE interpweight_4D(nbpt, Nvariabletypes, variabletypes, lalo, resolution, neighbours,       &
+    contfrac, filename, varname, inlonname, inlatname, varmin, varmax, noneg, masktype,               &
+    maskvalues, maskvarname, dim1, dim2, initime, typefrac,                                           &
+    maxresollon, maxresollat, outvar4D, aoutvar)
+
+    USE ioipsl
+    USE constantes_var
+    USE mod_orchidee_para
+
+    IMPLICIT NONE
+
+    !! 0. Variables and parameter declaration
+    !
+    !! 0.1 Input variables
+    !
+    INTEGER(i_std), INTENT(in)                 :: nbpt                    !! Number of points for which the data 
+                                                                          !!   needs to be interpolated
+    INTEGER(i_std), INTENT(in)                 :: Nvariabletypes          !! Number of types of the variable
+    REAL(r_std), DIMENSION(Nvariabletypes),    &                          !! Vector of values of the types
+      INTENT(in)    :: variabletypes                                      !!   (-1, not used)
+    REAL(r_std), DIMENSION(nbpt,2), INTENT(in) :: lalo                    !! Vector of latitude and longitudes 
+                                                                          !! (beware of the order = 1 : latitude, 
+                                                                          !!   2 : longitude)
+    REAL(r_std), DIMENSION(nbpt,2), INTENT(in) :: resolution              !! The size in km of each grid-box in X and Y
+    INTEGER(i_std), DIMENSION(nbpt,NbNeighb), INTENT(in) :: neighbours    !! Vector of neighbours for each grid point 
+                                                                          !!   1=N, 2=NE, 3=E, 4=SE, 5=S, 6=SW, 7=W, 8=NW) 
+                            
+    REAL(r_std), DIMENSION(nbpt), INTENT(in)   :: contfrac                !! Fraction of land in each grid box.
+    CHARACTER(LEN=80), INTENT(in)              :: filename                !! name of the input map to read
+
+    CHARACTER(LEN=80), INTENT(in)              :: varname                 !! name of the variable to interpolate
+    CHARACTER(LEN=80), INTENT(in)              :: inlonname, inlatname    !! names of the longitude and latitude
+! Transformations to apply to the original read values from the file
+    LOGICAL, INTENT(in)                        :: noneg                   !! no negative values
+    CHARACTER(LEN=50), INTENT(in)              :: masktype                !! Type of masking
+                                                                          !!   'nomask': no-mask is applied
+                                                                          !!   'mbelow': take values below maskvalues(1)
+                                                                          !!   'mabove': take values above maskvalues(1)
+                                                                          !!   'msumrange': take values within 2 ranges;
+                                                                          !!      maskvalues(2) <= SUM(vals(k)) <= maskvalues(1)
+                                                                          !!      maskvalues(1) < SUM(vals(k)) <= maskvalues(3)
+                                                                          !!        (normalized by maskedvalues(3))
+                                                                          !!   'var': mask values are taken from a 
+                                                                          !!     variable (>0)
+    REAL(r_std), DIMENSION(3), INTENT(in)      :: maskvalues              !! values to use to mask (according to 
+                                                                          !!   `masktype') 
+    CHARACTER(LEN=250), INTENT(in)             :: maskvarname             !! name of the variable to use to mask 
+    INTEGER, INTENT(in)                        :: dim1, dim2              !! 3/4D dimensions of the output variable
+                                                                          !! dim1 = 1 fpr outvar2D
+                                                                          !!   in the input file
+    REAL(r_std), DIMENSION(dim1), INTENT(inout) :: varmin, varmax         !! min/max values to use for the renormalization
+    CHARACTER(LEN=50), INTENT(in)              :: typefrac                !! Type of fractions retrieval:
+                                                                          !!   'default': standard
+
+    INTEGER(i_std), INTENT(in)                 :: initime                 !! Initial time to take (for input data 
+                                                                          !!   with time values, -1 not used)
+    REAL(r_std), INTENT(in)                    :: maxresollon,maxresollat !! lon,lat maximum resolutions (in m)
+                                                                          !!   (-un, not used)
+    !! 0.2 Modified variables
+    !
+    !! 0.3 Output variables
+    !
+!    REAL(r_std), INTENT(out)                   ::  laimap(nbpt,nvm,12)    !! lai read variable and re-dimensioned
+    REAL(r_std), DIMENSION(nbpt,dim1,dim2), INTENT(out) :: outvar4D       !! 4D output variable and re-dimensioned
+    REAL(r_std), DIMENSION(nbpt), INTENT(out)  :: aoutvar                 !! availability of input data to
+                                                                          !!   interpolate output variable 
+                                                                          !!   (on the nbpt space)
+    !
+    !! 0.4 Local variables
+    !
+    INTEGER(i_std)                             :: iml, jml, lml, tml, fid, ib, ip, jp, it, jj, jv
+    INTEGER                                    :: inNdims                 !! Number of dimensions of the input data
+    INTEGER                                    :: inNLldims               !! Number of dimensions of the lon/lat input data
+    REAL(r_std), ALLOCATABLE, DIMENSION(:)     :: lat_in, lon_in          !! latitude and
+                                                                          !! longitude, extract from input map
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)   :: lat, lon                !! en 2D ???
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)   :: sub_area                !! the area of the fine grid in the 
+                                                                          !!   model grid ???
+                                                                          !! cf src_global/interpol_help.f90, 
+                                                                          !!   line 377, called "areaoverlap"
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:,:)  :: sub_index           !! the indexes from the grid boxes from the 
+                                                                          !!   data that go into the 
+                                                                          !!   model's boxes  
+                                                                          !! cf src_global/interpol_help.f90,
+                                                                          !!   line 300, called "ip"
+
+    INTEGER                                      :: ALLOC_ERR
+!    REAL(r_std), ALLOCATABLE, DIMENSION(:)       :: invar1D               !! 1D input values
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)     :: invar2D               !! 2D input values
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:)   :: invar3D               !! 3D input values
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:,:) :: invar4D               !! 4D input values
+
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:)   :: resol_in
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:)  :: mask
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)     :: maskvar
+    INTEGER(i_std)                             :: nix, njx
+    INTEGER(i_std)                             :: idi, nbvmax             !! nbvmax : number of maximum vegetation map
+                                                                          !! points in the GCM grid ; idi : its counter
+    CHARACTER(LEN=30)                          :: callsign                !! Allows to specify which variable is beeing
+                                                                          !! treated
+    LOGICAL                                    :: ok_interpol             !! optionnal return of aggregate_2d
+    CHARACTER(LEN=50)                          :: S1
+    REAL(r_std), ALLOCATABLE, DIMENSION(:)     :: variableusetypes
+    CHARACTER(LEN=256)                         :: msg
+
+! Debug vars
+    INTEGER                                    :: nb_coord, nb_var, nb_gat
+
+    INTEGER, ALLOCATABLE, DIMENSION(:)         :: indims
+
+
+!_ ================================================================================================================================
+    IF (printlev >= 3) WRITE(numout, *)"In interpweight_4D filename: ",TRIM(filename),         &
+      " varname:'" // TRIM(varname) // "'"
+
+! Allocating input data
+    IF (is_root_prc) THEN
+       IF (printlev >=5) THEN
+          WRITE(numout,*) "Entering 'interpweight_4D'. Debug mode."
+          WRITE(numout,*)'(/," --> fliodmpf")'
+          CALL fliodmpf (TRIM(filename))
+          WRITE(numout,*)'(/," --> flioopfd")'
+       ENDIF
+       CALL flioopfd (TRIM(filename),fid,nb_dim=nb_coord,nb_var=nb_var,nb_gat=nb_gat)
+       IF (printlev >=5) THEN
+          WRITE (numout,'(" Number of coordinate        in the file : ",I2)') nb_coord
+          WRITE (numout,'(" Number of variables         in the file : ",I2)') nb_var
+          WRITE (numout,'(" Number of global attributes in the file : ",I2)') nb_gat
+       ENDIF
+    ENDIF
+
+! Getting shape of input variable from input file
+    inNdims = interpweight_get_varNdims_file(filename, varname)
+    IF (is_root_prc) CALL flininfo(filename, iml, jml, lml, tml, fid)
+
+    InputDims: SELECT CASE (inNdims)
+      CASE (2)
+        CALL bcast(iml)
+        CALL bcast(jml)
+
+        ALLOCATE(invar2D(iml,jml), STAT=ALLOC_ERR)
+        IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_4D',"Problem in allocation of variable '" //     &
+          TRIM(varname) ,'','')
+        IF (is_root_prc) CALL flinget(fid, TRIM(varname), iml, jml, 0, 0, 1, 1, invar2D)
+        IF (printlev >= 5) THEN
+          WRITE(numout,*)'  interpweight_4D input data dimensions _______'
+          WRITE(numout,*)'    iml, jml:',iml, jml
+        END IF
+
+      CASE (3)
+        ALLOCATE(indims(3), STAT=ALLOC_ERR)
+        IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_4D','Problem in allocation of indims','','')
+        indims = interpweight_get_var3dims_file(filename, varname)
+        lml = indims(3)
+        CALL bcast(iml)
+        CALL bcast(jml)
+        CALL bcast(lml)
+
+        ALLOCATE(invar3D(iml,jml, lml), STAT=ALLOC_ERR)
+        IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_4D',"Problem in allocation of variable '" //     &
+          TRIM(varname) ,'','')
+        IF (is_root_prc) CALL flinget(fid, TRIM(varname), iml, jml, lml, 0, 1, 1, invar3D)
+        IF (printlev >= 5) THEN
+          WRITE(numout,*)'  interpweight_4D input data dimensions:'
+          WRITE(numout,*)'    iml, jml, lml:',iml, jml, lml
+        END IF
+
+      CASE (4)
+        ALLOCATE(indims(4), STAT=ALLOC_ERR)
+        IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_4D','Problem in allocation of indims','','')
+        indims = interpweight_get_var4dims_file(filename, varname)
+        lml = indims(3)
+        CALL bcast(iml)
+        CALL bcast(jml)
+        CALL bcast(lml)
+!       Taken from `slowproc_update'
+        IF (initime /= -1) THEN
+          inNdims = 3
+          IF (printlev >= 3) WRITE(numout,*) &
+               'interpweight_4D: taking into account the initial reading time:',initime
+          IF (initime <= 0) tml = 0
+
+          CALL bcast(tml)
+          ALLOCATE(invar3D(iml,jml,lml), STAT=ALLOC_ERR)
+          IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_4D',"Problem in allocation of variable '" //   &
+            TRIM(varname) ,'','')
+          IF ( initime > 0 ) THEN
+            IF (is_root_prc) THEN
+              IF (initime <= tml) THEN
+                CALL flinget(fid, TRIM(varname), iml, jml, lml, 1, initime, 1, invar3D)
+              ELSE
+                CALL flinget(fid, TRIM(varname), iml, jml, lml, 1, tml, 1, invar3D)
+              ENDIF
+            ENDIF
+          ELSE
+            IF (is_root_prc) THEN
+              CALL flinget(fid, TRIM(varname), iml, jml, lml, 1, 1, 1, invar3D)
+            ENDIF
+          ENDIF
+        ELSE
+          CALL bcast(tml)
+          ALLOCATE(invar4D(iml,jml,lml,tml), STAT=ALLOC_ERR)
+          IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_4D',"Problem in allocation of variable '" //   &
+            TRIM(varname) ,'','')
+          IF (is_root_prc) CALL flinget(fid, TRIM(varname), iml, jml, lml, tml, 1, tml, invar4D)
+        END IF
+
+        IF (printlev >= 5) THEN
+          WRITE(numout,*)'  interpweight_4D input data dimensions'
+          WRITE(numout,*)'    iml, jml, lml, tml:',iml, jml, lml, tml
+        END IF
+
+      CASE DEFAULT
+        WRITE (S1,'(I3)') inNdims
+        CALL ipslerr_p(3,'interpweight_4D',"Input number of dimensions: '" // TRIM(S1) // "' not ready !!", &
+          '','')
+
+    END SELECT InputDims
+    CALL bcast(invar4D)
+  
+! Getting longitudes/latitudes from input file
+    inNLldims = interpweight_get_varNdims_file(filename, inlonname)
+    IF (inNLldims == 1) THEN
+      ! Allocate memory for latitudes
+      ALLOCATE(lon_in(iml), STAT=ALLOC_ERR)
+      IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_4D','Problem in allocation of variable lon_in','','')
+
+      ALLOCATE(lat_in(jml), STAT=ALLOC_ERR)
+      IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_4D','Problem in allocation of variable lat_in','','')
+
+      IF (is_root_prc) THEN
+        CALL flinget(fid, TRIM(inlonname), iml, 0, 0, 0, 1, 1, lon_in)
+        CALL flinget(fid, TRIM(inlatname), jml, 0, 0, 0, 1, 1, lat_in)
+      ENDIF
+      CALL bcast(lon_in)
+      CALL bcast(lat_in)
+
+      ALLOCATE(lon(iml,jml), STAT=ALLOC_ERR)
+      IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_4D','Problem in allocation of variable lon','','')
+      ALLOCATE(lat(iml,jml), STAT=ALLOC_ERR)
+      IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_4D','Problem in allocation of variable lat','','')
+
+      DO ip=1,iml
+         lat(ip,:) = lat_in(:)
+      ENDDO
+      DO jp=1,jml
+         lon(:,jp) = lon_in(:)
+      ENDDO
+    ELSE
+      ! Allocate memory for longitude
+      ALLOCATE(lon(iml,jml), STAT=ALLOC_ERR)
+      IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_4D','Pb in allocation for lon','','')
+      ! Allocate memory for latitudes
+      ALLOCATE(lat(iml,jml), STAT=ALLOC_ERR)
+      IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_4D','Pb in allocation for lat','','')
+
+      IF (is_root_prc) THEN
+        CALL flinget(fid, TRIM(inlonname), iml, jml, 0, 0, 1, 1, lon)
+        CALL flinget(fid, TRIM(inlatname), iml, jml, 0, 0, 1, 1, lat)
+      ENDIF
+    END IF
+    CALL bcast(lon)
+    CALL bcast(lat)
+
+    IF (is_root_prc) THEN
+      ALLOCATE(resol_in(iml,jml,2), STAT=ALLOC_ERR)
+      IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_4D','Problem in allocation of variable resol_in','','')
+    END IF
+
+    IF (noneg) THEN
+      IF (is_root_prc) THEN
+        SELECT CASE (inNdims)
+          CASE(2)
+            CALL interpweight_modifying_input2D(iml, jml, 0, 0, 1, 1, zero, invar2D)
+          CASE(3)
+            CALL interpweight_modifying_input3D(iml, jml, lml, 0, 1, 1, zero, invar3D)
+          CASE(4)
+            CALL interpweight_modifying_input4D(iml, jml, lml, tml, 1, tml, zero, invar4D)
+        END SELECT       
+      END IF
+    END IF
+
+    IF (printlev >= 5) WRITE(numout,*)'  interpweight_4D modifying input ended!'
+
+    ALLOCATE(mask(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_4D','Problem in allocation of variable mask','','')
+
+    IF (TRIM(masktype) == 'var') THEN
+      ALLOCATE(maskvar(iml,jml), STAT=ALLOC_ERR)
+      IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_4D','Problem in allocation of variable maskvar','','')
+      maskvar(:,:) = 0
+! Reads the mask from the file
+      IF (is_root_prc) THEN
+! ATTTENTION!! One can not use flinget in this way. It always spect to have a REAL variable!
+        CALL flinget(fid, TRIM(maskvarname), iml, jml, 0, 0, 1, 1, maskvar)
+        WHERE (maskvar > zero)
+          mask = un 
+        END WHERE
+      END IF
+      CALL bcast(mask)
+    ELSE
+      SELECT CASE (inNdims)
+        CASE(2)
+          CALL interpweight_masking_input2D(iml, jml, 0, 0, 0, 0, masktype, maskvalues, invar2D,      &
+            mask)
+        CASE(3)
+          CALL interpweight_masking_input3D(iml, jml, 0, 0, lml, 0, masktype, maskvalues, invar3D,    &
+            mask)
+        CASE(4)
+          CALL interpweight_masking_input4D(iml, jml, 0, 0, lml, tml, masktype, maskvalues, invar4D,  &
+            mask)
+      END SELECT
+    END IF
+    IF (printlev >= 5) WRITE(numout,*)'  interpweight_4D masking input ended!'
+
+    IF (is_root_prc) CALL flinclo(fid)
+
+    ! Computation of nbvmax
+    ! In 'condveg_soilalb, slowproc_update' nbvmax=200
+    !
+    ! The number of maximum vegetation map points in the GCM grid is estimated.
+    ! Some lmargin is taken.
+    !
+    IF (is_root_prc) THEN
+      IF ( (maxresollon /= -un) .AND. (maxresollat /= -un) ) THEN
+!       Assuming regular lon/lat projection for the input data but it is not caluclated assuming a maximum  &
+!         lon,lat resolution given as input paramater
+         nix=INT(MAXVAL(resolution(:,1))/maxresollon)+2
+         njx=INT(MAXVAL(resolution(:,2))/maxresollat)+2
+      ELSE
+!       Assuming regular lon/lat projection for the input data
+        CALL interpweight_calc_resolution_in(lon, lat, iml, jml, mincos, R_Earth, pi, resol_in)
+        nix=INT(MAXVAL(resolution(:,1))/MAXVAL(resol_in(:,:,1)))+2
+        njx=INT(MAXVAL(resolution(:,2))/MAXVAL(resol_in(:,:,2)))+2
+      END IF
+      nbvmax = MAX(nix*njx, 200)
+    END IF  
+    CALL bcast(nbvmax)
+    CALL bcast(nix)
+    CALL bcast(njx)
+
+    callsign = TRIM(varname) // ' map'
+
+    ok_interpol = .FALSE.
+    DO WHILE ( .NOT. ok_interpol )
+       IF (printlev>=3) WRITE(numout,*) "Projection arrays for ",callsign," : "
+       IF (printlev>=3) WRITE(numout,*) "nbvmax = ",nbvmax, nix, njx
+
+       ALLOCATE(sub_index(nbpt, nbvmax, 2), STAT=ALLOC_ERR)
+       IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_4D','Problem in allocation of variable sub_index','','')
+
+       sub_index(:,:,:)=zero
+
+       ALLOCATE(sub_area(nbpt, nbvmax), STAT=ALLOC_ERR)
+       IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_4D','Problem in allocation of variable sub_area','','')
+
+       sub_area(:,:)=zero
+       CALL aggregate_p(nbpt, lalo, neighbours, resolution, contfrac, &
+            &                iml, jml, lon, lat, mask, callsign, &
+            &                nbvmax, sub_index, sub_area, ok_interpol)
+       
+       IF ( .NOT. ok_interpol ) THEN
+          DEALLOCATE(sub_area)
+          DEALLOCATE(sub_index)
+          nbvmax = nbvmax * 2
+       ENDIF
+    ENDDO
+
+! Getting variables thresholds
+    ALLOCATE(variableusetypes(Nvariabletypes), STAT=ALLOC_ERR)
+            IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_4D','Problem in allocation of variable variableusetypesr','','')
+
+    IF (variabletypes(1) == -un) THEN
+      variableusetypes = (/ (ip*1., ip=1,Nvariabletypes) /)
+      IF (printlev>=4) WRITE(numout,*)'  interpweight_4D: Note: Using default ',&
+           'equivalence between dimension in the file and dimension in the variable, for file ', filename
+      varmin = 1._r_std
+      varmax = Nvariabletypes*1._r_std
+    ELSE
+      variableusetypes = variabletypes
+    END IF
+    
+    outvar4D = zero
+
+! Doing the interpolation as function of the type fo the values
+    CALL interpweight_provide_fractions4D(typefrac, nbpt, Nvariabletypes, variableusetypes,           &
+      iml, jml, lml, tml, nbvmax, zero, invar4D, sub_area, sub_index, varmax, varmin,                 &
+      deux, lalo, outvar4D, aoutvar)
+    IF (printlev >= 5) WRITE(numout,*)'  interpweight_4D end of interpweight_provide_fractions4D'
+
+    IF (printlev>=2) THEN
+       IF (COUNT(aoutvar == -1) >= AINT(nbpt*0.4)) THEN
+          WRITE(numout,*) 'interpweight_4D total number of points: ', nbpt
+          WRITE(numout,*) '  Interpolated: ', COUNT(aoutvar /= -1),                 &
+               ' Non-interpolated: ', COUNT(aoutvar == -1)
+          msg = "Less than 60% of points '" // TRIM(filename) // "' variable '" // TRIM(varname) //       & 
+               "' have been succesfully interpolated !!"
+          WRITE(numout,*)'  ' // TRIM(msg)
+       ELSE
+          msg = TRIM(filename) // "' variable: '" // TRIM(varname) // "' interpolation Done _______"
+          WRITE(numout,*) "interpweight_4D: '" // TRIM(msg)
+          WRITE(numout,*) '  Total number of points: ', nbpt
+          WRITE(numout,*) '  Interpweight_4D interpolated: ', COUNT(aoutvar /= -1),                 &
+               ' Non-interpolated: ', COUNT(aoutvar == -1)
+       END IF
+    END IF
+
+! Scaling to 1 the quality variable
+    DO ip=1, nbpt
+      IF (aoutvar(ip) /= -1) aoutvar(ip) = aoutvar(ip)/(resolution(ip,1)*resolution(ip,2))/contfrac(ip)
+    END DO
+
+    IF (ALLOCATED(lat_in)) DEALLOCATE(lat_in)
+    IF (ALLOCATED(lon_in)) DEALLOCATE(lon_in)
+    DEALLOCATE(lon)
+    DEALLOCATE(lat)
+    IF (ALLOCATED(invar2D)) DEALLOCATE(invar2D)
+    IF (ALLOCATED(invar3D)) DEALLOCATE(invar3D)
+    IF (ALLOCATED(invar4D)) DEALLOCATE(invar4D)
+    DEALLOCATE(mask)
+    IF (ALLOCATED(maskvar)) DEALLOCATE(maskvar)
+    DEALLOCATE(sub_area)
+    DEALLOCATE(sub_index)
+    IF (ALLOCATED(resol_in)) DEALLOCATE(resol_in)
+
+    RETURN
+
+  END SUBROUTINE interpweight_4D
+
+!! ================================================================================================================================
+!! SUBROUTINE   : interpweight_2Dcont
+!!
+!>\BRIEF        ! Interpolate any input file to the grid of the model for a continuos 2D-variable  
+!!
+!! DESCRIPTION  : (definitions, functional, design, flags): 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): outvar2D, aoutvar
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  SUBROUTINE interpweight_2Dcont(nbpt, dim1, dim2, lalo, resolution, neighbours,                      &
+    contfrac, filename, varname, inlonname, inlatname, varmin, varmax, noneg, masktype,               &
+    maskvalues, maskvarname, initime, typefrac, defaultvalue, defaultNOvalue,                         &
+    outvar2D, aoutvar)
+
+    USE ioipsl
+    USE constantes_var
+    USE mod_orchidee_para
+
+    IMPLICIT NONE
+
+    !! 0. Variables and parameter declaration
+    !
+    !! 0.1 Input variables
+    !
+    INTEGER(i_std), INTENT(in)                 :: nbpt                    !! Number of points for which the data 
+                                                                          !!   needs to be interpolated
+    INTEGER(i_std), INTENT(in)                 :: dim1, dim2              !! 4D complementary dimension sizes
+    REAL(r_std), DIMENSION(nbpt,2), INTENT(in) :: lalo                    !! Vector of latitude and longitudes 
+                                                                          !! (beware of the order = 1 : latitude, 
+                                                                          !!   2 : longitude)
+    REAL(r_std), DIMENSION(nbpt,2), INTENT(in) :: resolution              !! The size in km of each grid-box in X and Y
+    INTEGER(i_std), DIMENSION(nbpt,NbNeighb), INTENT(in) :: neighbours    !! Vector of neighbours for each grid point 
+                                                                          !!   1=N, 2=NE, 3=E, 4=SE, 5=S, 6=SW, 7=W, 8=NW) 
+                            
+    REAL(r_std), DIMENSION(nbpt), INTENT(in)   :: contfrac                !! Fraction of land in each grid box.
+    CHARACTER(LEN=80), INTENT(in)              :: filename                !! name of the input map to read
+
+    CHARACTER(LEN=80), INTENT(in)              :: varname                 !! name of the variable to interpolate
+    CHARACTER(LEN=80), INTENT(in)              :: inlonname, inlatname    !! names of the longitude and latitude
+    REAL(r_std), INTENT(in)                    :: varmin, varmax          !! min/max values to use for the
+                                                                          !!   renormalization
+    REAL(r_std), INTENT(in)                    :: defaultvalue            !! default interpolated value 
+    REAL(r_std), INTENT(in)                    :: defaultNOvalue          !! default interpolated NO-value 
+
+! Transformations to apply to the original read values from the file
+    LOGICAL, INTENT(in)                        :: noneg                   !! no negative values
+    CHARACTER(LEN=50), INTENT(in)              :: masktype                !! Type of masking
+                                                                          !!   'nomask': no-mask is applied
+                                                                          !!   'mbelow': take values below maskvalues(1)
+                                                                          !!   'mabove': take values above maskvalues(1)
+                                                                          !!   'msumrange': take values within 2 ranges;
+                                                                          !!      maskvalues(2) <= SUM(vals(k)) <= maskvalues(1)
+                                                                          !!      maskvalues(1) < SUM(vals(k)) <= maskvalues(3)
+                                                                          !!        (normalized by maskedvalues(3))
+                                                                          !!   'var': mask values are taken from a 
+                                                                          !!     variable (1/0)
+    REAL(r_std), DIMENSION(3), INTENT(in)      :: maskvalues              !! values to use to mask (according to 
+                                                                          !!   `masktype') 
+    CHARACTER(LEN=250), INTENT(in)             :: maskvarname             !! name of the variable to use to mask 
+                                                                          !!   (according to `masktype') 
+    CHARACTER(LEN=50), INTENT(in)              :: typefrac                !! Type of fraction retrieval:
+                                                                          !!   'default': standard
+
+    INTEGER(i_std), INTENT(in)                 :: initime                 !! Initial time to take (for input data 
+                                                                          !!   with time values, -1: not used)
+    !! 0.2 Modified variables
+    !
+    !! 0.3 Output variables
+    !
+    REAL(r_std), DIMENSION(nbpt), INTENT(out)  :: outvar2D                !! 2D output variable and re-dimensioned
+    REAL(r_std), DIMENSION(nbpt), INTENT(out)  :: aoutvar                 !! availability of input data to
+                                                                          !!   interpolate output variable 
+                                                                          !!   (on the nbpt space)
+    !
+    !! 0.4 Local variables
+    !
+    INTEGER(i_std)                             :: iml, jml, lml, tml, fid, ib, ip, jp, it, jj, jv
+    INTEGER                                    :: inNdims                 !! Number of dimensions of the input data
+    INTEGER                                    :: inNLldims               !! Number of dimensions of the lon/lat input data
+    REAL(r_std), ALLOCATABLE, DIMENSION(:)     :: lat_in, lon_in          !! latitude and
+                                                                          !! longitude, extract from input map
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)   :: lat, lon                !! en 2D ???
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)   :: sub_area                !! the area of the fine grid in the 
+                                                                          !!   model grid ???
+                                                                          !! cf src_global/interpol_help.f90, 
+                                                                          !!   line 377, called "areaoverlap"
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:,:)  :: sub_index           !! the indexes from the grid boxes from the 
+                                                                          !!   data that go into the 
+                                                                          !!   model's boxes  
+                                                                          !! cf src_global/interpol_help.f90,
+                                                                          !!   line 300, called "ip"
+
+!    REAL(r_std), ALLOCATABLE, DIMENSION(:)       :: invar1D               !! 1D input values
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)     :: invar2D               !! 2D input values
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:)   :: invar3D               !! 3D input values
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:,:) :: invar4D               !! 4D input values
+
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:)   :: resol_in
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:)  :: mask
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)     :: maskvar
+    INTEGER(i_std)                             :: nix, njx
+    INTEGER(i_std)                             :: idi, nbvmax             !! nbvmax : number of maximum vegetation map
+                                                                          !! points in the GCM grid ; idi : its counter
+    CHARACTER(LEN=30)                          :: callsign                !! Allows to specify which variable is beeing
+                                                                          !! treated
+    LOGICAL                                    :: ok_interpol             !! optionnal return of aggregate_2d
+    INTEGER                                    :: ALLOC_ERR 
+
+    CHARACTER(LEN=50)                          :: S1
+    CHARACTER(LEN=250)                         :: msg
+
+
+! Debug vars
+    INTEGER                                    :: nb_coord, nb_var, nb_gat
+
+!_ ================================================================================================================================
+    IF (printlev >= 3) WRITE(numout,*)"In interpweight_2Dcont filename: ",TRIM(filename),          &
+      " varname:'" // TRIM(varname) // "'"
+! Allocating input data
+    IF (is_root_prc) THEN
+       IF (printlev >=5) THEN
+          WRITE(numout,*) "Entering 'interpweight_2Dcont'. Debug mode."
+          WRITE(numout,*)'(/," --> fliodmpf")'
+          CALL fliodmpf (TRIM(filename))
+          WRITE(numout,*)'(/," --> flioopfd")'
+       ENDIF
+       CALL flioopfd (TRIM(filename),fid,nb_dim=nb_coord,nb_var=nb_var,nb_gat=nb_gat)
+       IF (printlev >=5) THEN
+          WRITE (numout,'(" Number of coordinate        in the file : ",I2)') nb_coord
+          WRITE (numout,'(" Number of variables         in the file : ",I2)') nb_var
+          WRITE (numout,'(" Number of global attributes in the file : ",I2)') nb_gat
+       ENDIF
+    ENDIF
+
+! Getting shape of input variable from input file
+    inNdims = interpweight_get_varNdims_file(filename, varname)
+    IF (is_root_prc) CALL flininfo(filename, iml, jml, lml, tml, fid)
+
+    InputDims: SELECT CASE (inNdims)
+      CASE (2)
+        CALL bcast(iml)
+        CALL bcast(jml)
+
+        ALLOCATE(invar2D(iml,jml), STAT=ALLOC_ERR)
+        IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_2Dcont',"Problem in allocation of variable '" //     &
+          TRIM(varname) ,'','')
+        IF (is_root_prc) CALL flinget(fid, TRIM(varname), iml, jml, 0, 0, 1, 1, invar2D)
+        IF (printlev >= 5) THEN
+          WRITE(numout,*)'  interpweight_2Dcont input data dimensions _______'
+          WRITE(numout,*)'    iml, jml:',iml, jml
+        END IF
+
+      CASE (3)
+        CALL bcast(iml)
+        CALL bcast(jml)
+        CALL bcast(lml)
+
+        ALLOCATE(invar3D(iml,jml, lml), STAT=ALLOC_ERR)
+        IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_2Dcont',"Problem in allocation of variable '" //     &
+          TRIM(varname) ,'','')
+        IF (is_root_prc) CALL flinget(fid, TRIM(varname), iml, jml, lml, 0, 1, 1, invar3D)
+        IF (printlev >= 5) THEN
+          WRITE(numout,*)'  interpweight_2Dcont input data dimensions:'
+          WRITE(numout,*)'    iml, jml, lml:',iml, jml, lml
+        END IF
+
+      CASE (4)
+        CALL bcast(iml)
+        CALL bcast(jml)
+        CALL bcast(lml)
+!       Taken from `slowproc_update'
+        IF (initime /= -1) THEN
+          inNdims = 3
+          IF (printlev >= 3) WRITE(numout,*) &
+               'interpweight_2Dcont: taking into account the initial reading time:',initime
+          IF (initime <= 0) tml = 0
+          
+          CALL bcast(tml)
+          ALLOCATE(invar3D(iml,jml,lml), STAT=ALLOC_ERR)
+          IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_2Dcont',"Problem in allocation of variable '" //   &
+            TRIM(varname) ,'','')
+          IF ( initime > 0 ) THEN
+            IF (is_root_prc) THEN
+              IF (initime <= tml) THEN
+                CALL flinget(fid, TRIM(varname), iml, jml, lml, 1, initime, 1, invar3D)
+              ELSE
+                CALL flinget(fid, TRIM(varname), iml, jml, lml, 1, tml, 1, invar3D)
+              ENDIF
+            ENDIF
+          ELSE
+            IF (is_root_prc) THEN
+              CALL flinget(fid, TRIM(varname), iml, jml, lml, 1, 1, 1, invar3D)
+            ENDIF
+          ENDIF
+        ELSE
+          CALL bcast(tml)
+          ALLOCATE(invar4D(iml,jml,lml,tml), STAT=ALLOC_ERR)
+          IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_2Dcont',"Problem in allocation of variable '" //   &
+            TRIM(varname) ,'','')
+          IF (is_root_prc) CALL flinget(fid, TRIM(varname), iml, jml, lml, tml, 1, tml, invar4D)
+        END IF
+
+        IF (printlev >= 5) THEN
+          WRITE(numout,*)'  interpweight_2Dcont input data dimensions:'
+          WRITE(numout,*)'    iml, jml, lml, tml :',iml, jml, lml, tml
+        END IF
+
+      CASE DEFAULT
+        WRITE (S1,'(I3)') inNdims
+        CALL ipslerr_p(3,'interpweight_2Dcont',"Input number of dimensions: '" // TRIM(S1) // "' not ready !!", &
+          '','')
+
+    END SELECT InputDims
+    CALL bcast(invar2D)
+
+    IF (printlev >= 5) WRITE(numout,*)'  interpweight_2Dcont getting variable ended!'
+
+! Getting longitudes/latitudes from input file
+    inNLldims = interpweight_get_varNdims_file(filename, inlonname)
+
+    IF (inNLldims == 1) THEN
+      ! Allocate memory for latitudes
+      ALLOCATE(lon_in(iml), STAT=ALLOC_ERR)
+      IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_2Dcont','Problem in allocation of variable lon_in','','')
+
+      ALLOCATE(lat_in(jml), STAT=ALLOC_ERR)
+      IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_2Dcont','Problem in allocation of variable lat_in','','')
+
+      IF (is_root_prc) THEN
+        CALL flinget(fid, TRIM(inlonname), iml, 0, 0, 0, 1, 1, lon_in)
+        CALL flinget(fid, TRIM(inlatname), jml, 0, 0, 0, 1, 1, lat_in)
+      ENDIF
+      CALL bcast(lon_in)
+      CALL bcast(lat_in)
+
+      ALLOCATE(lon(iml,jml), STAT=ALLOC_ERR)
+      IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_2Dcont','Problem in allocation of variable lon','','')
+      ALLOCATE(lat(iml,jml), STAT=ALLOC_ERR)
+      IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_2Dcont','Problem in allocation of variable lat','','')
+
+      DO ip=1,iml
+         lat(ip,:) = lat_in(:)
+      ENDDO
+      DO jp=1,jml
+         lon(:,jp) = lon_in(:)
+      ENDDO
+    ELSE
+      ! Allocate memory for longitude
+      ALLOCATE(lon(iml,jml), STAT=ALLOC_ERR)
+      IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_2Dcont','Pb in allocation for lon','','')
+      ! Allocate memory for latitudes
+      ALLOCATE(lat(iml,jml), STAT=ALLOC_ERR)
+      IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_2Dcont','Pb in allocation for lat','','')
+
+      IF (is_root_prc) THEN
+        CALL flinget(fid, TRIM(inlonname), iml, jml, 0, 0, 1, 1, lon)
+        CALL flinget(fid, TRIM(inlatname), iml, jml, 0, 0, 1, 1, lat)
+      ENDIF
+    END IF
+    CALL bcast(lon)
+    CALL bcast(lat)
+
+    IF (is_root_prc) THEN
+      ALLOCATE(resol_in(iml,jml,2), STAT=ALLOC_ERR)
+      IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_2Dcont','Problem in allocation of variable resol_in','','')
+    END IF
+
+    IF (noneg) THEN
+      IF (is_root_prc) THEN
+        SELECT CASE (inNdims)
+          CASE(2)
+            CALL interpweight_modifying_input2D(iml, jml, 0, 0, 1, 1, zero, invar2D)
+          CASE(3)
+            CALL interpweight_modifying_input3D(iml, jml, lml, 0, 1, 1, zero, invar3D)
+          CASE(4)
+            CALL interpweight_modifying_input4D(iml, jml, lml, tml, 1, tml, zero, invar4D)
+        END SELECT       
+      END IF
+    END IF
+    IF (printlev >= 5) WRITE(numout,*)'  interpweight_2Dcont modifying input ended!'
+
+    !
+    ! Consider all points a priori
+    !
+    ALLOCATE(mask(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_2Dcont','Problem in allocation of variable mask','','')
+    mask(:,:) = 0
+
+    IF (TRIM(masktype) == 'var') THEN
+      ALLOCATE(maskvar(iml,jml), STAT=ALLOC_ERR)
+      IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_2Dcont','Problem in allocation of variable maskvar','','')
+      maskvar(:,:) = 0
+! Reads the mask from the file
+      IF (is_root_prc) THEN
+! ATTTENTION!! One can not use flinget in this way. It always spect to have a REAL variable!
+        CALL flinget(fid, TRIM(maskvarname), iml, jml, 0, 0, 1, 1, maskvar)
+        WHERE (maskvar > zero)
+          mask = un 
+        END WHERE
+      END IF
+      CALL bcast(mask)
+    ELSE
+      SELECT CASE (inNdims)
+        CASE(2)
+          CALL interpweight_masking_input2D(iml, jml, 0, 0, 0, 0, masktype, maskvalues, invar2D,      &
+            mask)
+        CASE(3)
+          CALL interpweight_masking_input3D(iml, jml, 0, 0, lml, 0, masktype, maskvalues, invar3D,    &
+            mask)
+        CASE(4)
+          CALL interpweight_masking_input4D(iml, jml, 0, 0, lml, tml, masktype, maskvalues, invar4D,  &
+            mask)
+      END SELECT
+    END IF
+    IF (printlev >= 5) WRITE(numout,*)'  interpweight_2Dcont masking input ended!'
+    IF (is_root_prc) CALL flinclo(fid)
+
+    IF (printlev>=5) WRITE(numout,*)"  interpweight_2Dcont '" // TRIM(typefrac) // "' interpolation"
+
+! Assuming regular lon/lat projection for the input data
+    IF (is_root_prc) THEN
+      CALL interpweight_calc_resolution_in(lon, lat, iml, jml, mincos, R_Earth, pi, resol_in)
+    END IF
+
+!   Computation of nbvmax
+!   In 'condveg_soilalb, slowproc_update' nbvmax=200
+
+!
+!   The number of maximum vegetation map points in the GCM grid is estimated.
+!   Some lmargin is taken.
+!
+    IF (is_root_prc) THEN
+       nix=INT(MAXVAL(resolution(:,1))/MAXVAL(resol_in(:,:,1)))+2
+       njx=INT(MAXVAL(resolution(:,2))/MAXVAL(resol_in(:,:,2)))+2
+       nbvmax = MAX(nix*njx, 200)
+    ENDIF
+    CALL bcast(nbvmax)
+    CALL bcast(nix)
+    CALL bcast(njx)
+
+    callsign = TRIM(varname) // ' map'
+
+    ok_interpol = .FALSE.
+    DO WHILE ( .NOT. ok_interpol )
+       IF (printlev>=3) WRITE(numout,*) "Projection arrays for ",callsign," : "
+       IF (printlev>=3) WRITE(numout,*) "nbvmax = ",nbvmax, nix, njx
+
+       ALLOCATE(sub_index(nbpt, nbvmax, 2), STAT=ALLOC_ERR)
+       IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_2Dcont','Problem in allocation of variable sub_index','','')
+
+       sub_index(:,:,:)=0
+
+       ALLOCATE(sub_area(nbpt, nbvmax), STAT=ALLOC_ERR)
+       IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_2Dcont','Problem in allocation of variable sub_area','','')
+
+       sub_area(:,:)=zero
+       IF (printlev>=3) WRITE(numout,*) 'Input data range LON:', MINVAL(lon), MAXVAL(lon)
+       IF (printlev>=3) WRITE(numout,*) 'Input data range LAT:', MINVAL(lat), MAXVAL(lat)
+
+       CALL aggregate_p(nbpt, lalo, neighbours, resolution, contfrac, &
+            &                iml, jml, lon, lat, mask, callsign, &
+            &                nbvmax, sub_index, sub_area, ok_interpol)
+       
+       IF ( .NOT. ok_interpol ) THEN
+          DEALLOCATE(sub_area)
+          DEALLOCATE(sub_index)
+          nbvmax = nbvmax * 2
+       ENDIF
+    ENDDO
+    IF (printlev>=4) WRITE (numout,*) '  interpweight_2Dcont: read/allocate OK'
+
+    outvar2D = zero
+! Providing the interpolated grid point
+
+    CALL interpweight_provide_interpolation2D(typefrac, nbpt, 0, 0, iml, jml, lml, tml,               &
+      nbvmax, zero, invar2D, sub_area, sub_index, varmax, varmin, un, deux, lalo,                     &
+      defaultvalue, defaultNOvalue, outvar2D, aoutvar)
+    IF (printlev >= 5) WRITE(numout,*)'  interpweight_2Dcont end of interpweight_provide_interpolation2D'
+
+    IF (printlev>=2) THEN
+       IF (COUNT(aoutvar == -1) >= AINT(nbpt*0.4)) THEN
+          WRITE(numout,*) 'interpweight_2Dcont total number of points: ', nbpt
+          WRITE(numout,*) '  Interpolated: ', COUNT(aoutvar /= -1),                 &
+               ' non-interpolated: ', COUNT(aoutvar == -1)
+          msg = "Less than 60% of points '" // TRIM(filename) // "' variable '" // TRIM(varname) //       &
+               "' have been succesfully interpolated !!"
+          WRITE(numout,*) '  ' // TRIM(msg)
+       ELSE
+          msg = TRIM(filename) // "' variable: '" // TRIM(varname) // "' interpolation Done _______"
+          WRITE(numout,*) "interpweight_2Dcont: '" // TRIM(msg)
+          WRITE(numout,*) '  Total number of points: ', nbpt
+          WRITE(numout,*) '  Interpolated: ', COUNT(aoutvar /= -1),                 &
+               ' Non-interpolated: ', COUNT(aoutvar == -1)
+       END IF
+    END IF
+
+! Scaling to 1 the quality variable
+    DO ip=1, nbpt
+      IF (aoutvar(ip) /= -1) aoutvar(ip) = aoutvar(ip)/(resolution(ip,1)*resolution(ip,2))/contfrac(ip)
+    END DO
+
+    IF (printlev>=5) WRITE(numout,*) '  interpweight_2Dcont: Interpolation Done'
+
+    IF (ALLOCATED(lat_in)) DEALLOCATE(lat_in)
+    IF (ALLOCATED(lon_in)) DEALLOCATE(lon_in)
+    DEALLOCATE(lon)
+    DEALLOCATE(lat)
+    IF (ALLOCATED(invar2D)) DEALLOCATE(invar2D)
+    IF (ALLOCATED(invar3D)) DEALLOCATE(invar3D)
+    IF (ALLOCATED(invar4D)) DEALLOCATE(invar4D)
+    DEALLOCATE(mask)
+    IF (ALLOCATED(maskvar)) DEALLOCATE(maskvar)
+    IF (ALLOCATED(invar4D)) DEALLOCATE(sub_area)
+    IF (ALLOCATED(invar4D)) DEALLOCATE(sub_index)
+    IF (ALLOCATED(resol_in)) DEALLOCATE(resol_in)
+
+    RETURN
+
+  END SUBROUTINE interpweight_2Dcont
+
+!! ================================================================================================================================
+!! SUBROUTINE   : interpweight_4Dcont
+!!
+!>\BRIEF        ! Interpolate any input file to the grid of the model for a continuos 4D-variable  
+!!
+!! DESCRIPTION  : (definitions, functional, design, flags): 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): outvar4D, aoutvar
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  SUBROUTINE interpweight_4Dcont(nbpt, dim1, dim2, lalo, resolution, neighbours,                      &
+    contfrac, filename, varname, inlonname, inlatname, varmin, varmax, noneg, masktype,               &
+    maskvalues, maskvarname, initime, typefrac, defaultvalue, defaultNOvalue,                         &
+    outvar4D, aoutvar)
+
+    USE ioipsl
+    USE constantes_var
+    USE mod_orchidee_para
+
+    IMPLICIT NONE
+
+    !! 0. Variables and parameter declaration
+    !
+    !  0.1 INPUT
+    !
+    INTEGER(i_std), INTENT(in)                 :: nbpt                    !! Number of points for which the data 
+                                                                          !!   needs to be interpolated
+    INTEGER(i_std), INTENT(in)                 :: dim1, dim2              !! 4D complementary dimension sizes
+    REAL(r_std), DIMENSION(nbpt,2), INTENT(in) :: lalo                    !! Vector of latitude and longitudes 
+                                                                          !! (beware of the order = 1 : latitude, 
+                                                                          !!   2 : longitude)
+    REAL(r_std), DIMENSION(nbpt,2), INTENT(in) :: resolution              !! The size in km of each grid-box in X and Y
+    INTEGER(i_std), DIMENSION(nbpt,NbNeighb), INTENT(in) :: neighbours    !! Vector of neighbours for each grid point 
+                                                                          !!   1=N, 2=NE, 3=E, 4=SE, 5=S, 6=SW, 7=W, 8=NW) 
+                            
+    REAL(r_std), DIMENSION(nbpt), INTENT(in)   :: contfrac                !! Fraction of land in each grid box.
+    CHARACTER(LEN=80), INTENT(in)              :: filename                !! name of the input map to read
+
+    CHARACTER(LEN=80), INTENT(in)              :: varname                 !! name of the variable to interpolate
+    CHARACTER(LEN=80), INTENT(in)              :: inlonname, inlatname    !! names of the longitude and latitude
+    REAL(r_std), INTENT(in)                    :: varmin, varmax          !! min/max values to use for the
+                                                                          !!   renormalization
+    REAL(r_std), DIMENSION(dim1,dim2), INTENT(in) :: defaultvalue         !! default interpolated value 
+    REAL(r_std), INTENT(in)                    :: defaultNOvalue          !! default interpolated NO-value 
+
+! Transformations to apply to the original read values from the file
+    LOGICAL, INTENT(in)                        :: noneg                   !! no negative values
+    CHARACTER(LEN=50), INTENT(in)              :: masktype                !! Type of masking
+                                                                          !!   'nomask': no-mask is applied
+                                                                          !!   'mbelow': take values below maskvalues(1)
+                                                                          !!   'mabove': take values above maskvalues(1)
+                                                                          !!   'msumrange': take values within 2 ranges;
+                                                                          !!      maskvalues(2) <= SUM(vals(k)) <= maskvalues(1)
+                                                                          !!      maskvalues(1) < SUM(vals(k)) <= maskvalues(3)
+                                                                          !!        (normalized by maskedvalues(3))
+                                                                          !!   'var': mask values are taken from a 
+                                                                          !!     variable (1/0)
+    REAL(r_std), DIMENSION(3), INTENT(in)      :: maskvalues              !! values to use to mask (according to 
+                                                                          !!   `masktype') 
+    CHARACTER(LEN=250), INTENT(in)             :: maskvarname             !! name of the variable to use to mask 
+                                                                          !!   (according to `masktype') 
+    CHARACTER(LEN=50), INTENT(in)              :: typefrac                !! Type of fraction retrieval:
+                                                                          !!   'default': standard
+
+    INTEGER(i_std), INTENT(in)                 :: initime                 !! Initial time to take (for input data 
+                                                                          !!   with time values, -1: not used)
+    !! 0.2 Modified variables
+    !
+    !! 0.3 Output variables
+    !
+    REAL(r_std), DIMENSION(nbpt,dim1,dim2), INTENT(out) :: outvar4D       !! 2D output variable and re-dimensioned
+    REAL(r_std), DIMENSION(nbpt), INTENT(out)  :: aoutvar                 !! availability of input data to
+                                                                          !!   interpolate output variable 
+                                                                          !!   (on the nbpt space)
+    !
+    !! 0.4 Local variables
+    !
+    INTEGER(i_std)                             :: iml, jml, lml, tml, fid, ib, ip, jp, it, jj, jv
+    INTEGER                                    :: inNdims                 !! Number of dimensions of the input data
+    INTEGER                                    :: inNLldims               !! Number of dimensions of the lon/lat input data
+    REAL(r_std), ALLOCATABLE, DIMENSION(:)     :: lat_in, lon_in          !! latitude and
+                                                                          !! longitude, extract from input map
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)   :: lat, lon                !! en 2D ???
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)   :: sub_area                !! the area of the fine grid in the 
+                                                                          !!   model grid ???
+                                                                          !! cf src_global/interpol_help.f90, 
+                                                                          !!   line 377, called "areaoverlap"
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:,:)  :: sub_index           !! the indexes from the grid boxes from the 
+                                                                          !!   data that go into the 
+                                                                          !!   model's boxes  
+                                                                          !! cf src_global/interpol_help.f90,
+                                                                          !!   line 300, called "ip"
+
+!    REAL(r_std), ALLOCATABLE, DIMENSION(:)       :: invar1D               !! 1D input values
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)     :: invar2D               !! 2D input values
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:)   :: invar3D               !! 3D input values
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:,:) :: invar4D               !! 4D input values
+
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:)   :: resol_in
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)     :: maskvar
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:)  :: mask
+    INTEGER(i_std)                             :: nix, njx
+    INTEGER(i_std)                             :: idi, nbvmax             !! nbvmax : number of maximum vegetation map
+                                                                          !! points in the GCM grid ; idi : its counter
+    CHARACTER(LEN=30)                          :: callsign                !! Allows to specify which variable is beeing
+                                                                          !! treated
+    LOGICAL                                    :: ok_interpol             !! optionnal return of aggregate_2d
+    INTEGER                                    :: ALLOC_ERR 
+
+    CHARACTER(LEN=50)                          :: S1
+    INTEGER, ALLOCATABLE, DIMENSION(:)         :: indims
+    CHARACTER(LEN=250)                         :: msg
+
+! Debug vars
+    INTEGER                                    :: nb_coord, nb_var, nb_gat
+    INTEGER                                    :: nblL
+    INTEGER, DIMENSION(2)                      :: lLpt
+
+!_ ================================================================================================================================
+    IF (printlev >= 3) WRITE(numout, *)"In interpweight_4Dcont filename: '",TRIM(filename),         &
+      " varname:'" // TRIM(varname) // "'"
+! Allocating input data
+    IF (is_root_prc) THEN
+       IF (printlev >=5) THEN
+          WRITE(numout,*) "Entering 'interpweight_4Dcont'. Debug mode."
+          WRITE(numout,*)'(/," --> fliodmpf")'
+          CALL fliodmpf (TRIM(filename))
+          WRITE(numout,*)'(/," --> flioopfd")'
+       ENDIF
+       CALL flioopfd (TRIM(filename),fid,nb_dim=nb_coord,nb_var=nb_var,nb_gat=nb_gat)
+       IF (printlev >=5) THEN
+          WRITE (numout,'(" Number of coordinate        in the file : ",I2)') nb_coord
+          WRITE (numout,'(" Number of variables         in the file : ",I2)') nb_var
+          WRITE (numout,'(" Number of global attributes in the file : ",I2)') nb_gat
+       ENDIF
+    ENDIF
+
+! Getting shape of input variable from input file
+    inNdims = interpweight_get_varNdims_file(filename, varname)
+    IF (is_root_prc) CALL flininfo(filename, iml, jml, lml, tml, fid)
+
+    InputDims: SELECT CASE (inNdims)
+      CASE (2)
+        CALL bcast(iml)
+        CALL bcast(jml)
+
+        ALLOCATE(invar2D(iml,jml), STAT=ALLOC_ERR)
+        IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_4Dcont',"Problem in allocation of variable '" //     &
+          TRIM(varname) ,'','')
+        IF (is_root_prc) CALL flinget(fid, TRIM(varname), iml, jml, 0, 0, 1, 1, invar2D)
+        IF (printlev >= 5) THEN
+          WRITE(numout,*)'  interpweight_4Dcont input data dimensions:'
+          WRITE(numout,*)'    iml, jml:',iml, jml
+        END IF
+
+      CASE (3)
+        ALLOCATE(indims(3),STAT=ALLOC_ERR)
+        IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_4Dcont','Problem in allocation of variable indims','','')
+        indims = interpweight_get_var3dims_file(filename, varname)
+        lml = indims(3)
+        CALL bcast(iml)
+        CALL bcast(jml)
+        CALL bcast(lml)
+
+        ALLOCATE(invar3D(iml,jml, lml), STAT=ALLOC_ERR)
+        IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_4Dcont',"Problem in allocation of variable '" //     &
+          TRIM(varname) ,'','')
+        IF (is_root_prc) CALL flinget(fid, TRIM(varname), iml, jml, lml, 0, 1, 1, invar3D)
+        IF (printlev >= 5) THEN
+          WRITE(numout,*)'  interpweight_4Dcont input data dimensions:'
+          WRITE(numout,*)'    iml, jml, lml:',iml, jml, lml
+        END IF
+
+      CASE (4)
+        ALLOCATE(indims(4), STAT=ALLOC_ERR)
+        IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_4Dcont','Problem in allocation of indims','','')
+        indims = interpweight_get_var4dims_file(filename, varname)
+        lml = indims(3)
+        CALL bcast(iml)
+        CALL bcast(jml)
+        CALL bcast(lml)
+!       Taken from `slowproc_update'
+        IF (initime /= -1) THEN
+          inNdims = 3
+          IF (printlev >= 3) WRITE(numout,*) &
+               'interpweight_4Dcont: taking into account the initial reading time:',initime
+          IF (initime <= 0) tml = 0
+
+          CALL bcast(tml)
+          ALLOCATE(invar3D(iml,jml,lml), STAT=ALLOC_ERR)
+          IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_4Dcont',"Problem in allocation of variable '" //   &
+            TRIM(varname) ,'','')
+          IF ( initime > 0 ) THEN
+            IF (is_root_prc) THEN
+              IF (initime <= tml) THEN
+                CALL flinget(fid, TRIM(varname), iml, jml, lml, 1, initime, 1, invar3D)
+              ELSE
+                CALL flinget(fid, TRIM(varname), iml, jml, lml, 1, tml, 1, invar3D)
+              ENDIF
+            ENDIF
+          ELSE
+            IF (is_root_prc) THEN
+              CALL flinget(fid, TRIM(varname), iml, jml, lml, 1, 1, 1, invar3D)
+            ENDIF
+          ENDIF
+        ELSE
+          CALL bcast(tml)
+          ALLOCATE(invar4D(iml,jml,lml,tml), STAT=ALLOC_ERR)
+          IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_4Dcont',"Problem in allocation of variable '" //   &
+            TRIM(varname) ,'','')
+          IF (is_root_prc) CALL flinget(fid, TRIM(varname), iml, jml, lml, tml, 1, tml, invar4D)
+        END IF
+
+        IF (printlev >= 5) THEN
+          WRITE(numout,*)'interpweight_4Dcont input data dimensions:'
+          WRITE(numout,*)'    iml, jml, lml, tml:',iml, jml, lml, tml
+        END IF
+
+      CASE DEFAULT
+        WRITE (S1,'(I3)') inNdims
+        CALL ipslerr_p(3,'interpweight_4Dcont',"Input number of dimensions: '" // S1 // "' not ready !!",'','')
+
+    END SELECT InputDims
+    CALL bcast(invar4D)
+
+    IF (printlev >= 5) WRITE(numout,*)'  interpweight_4Dcont getting variable ended!'
+
+! Getting longitudes/latitudes from input file
+    inNLldims = interpweight_get_varNdims_file(filename, inlonname)
+
+    IF (inNLldims == 1) THEN
+      ! Allocate memory for latitudes
+      ALLOCATE(lon_in(iml), STAT=ALLOC_ERR)
+      IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_4Dcont','Problem in allocation of variable lon_in','','')
+
+      ALLOCATE(lat_in(jml), STAT=ALLOC_ERR)
+      IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_4Dcont','Problem in allocation of variable lat_in','','')
+
+      IF (is_root_prc) THEN
+        CALL flinget(fid, TRIM(inlonname), iml, 0, 0, 0, 1, 1, lon_in)
+        CALL flinget(fid, TRIM(inlatname), jml, 0, 0, 0, 1, 1, lat_in)
+      ENDIF
+      CALL bcast(lon_in)
+      CALL bcast(lat_in)
+
+      ALLOCATE(lon(iml,jml), STAT=ALLOC_ERR)
+      IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_4Dcont','Problem in allocation of variable lon','','')
+      ALLOCATE(lat(iml,jml), STAT=ALLOC_ERR)
+      IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_4Dcont','Problem in allocation of variable lat','','')
+
+      DO ip=1,iml
+         lat(ip,:) = lat_in(:)
+      ENDDO
+      DO jp=1,jml
+         lon(:,jp) = lon_in(:)
+      ENDDO
+    ELSE
+      ! Allocate memory for longitude
+      ALLOCATE(lon(iml,jml), STAT=ALLOC_ERR)
+      IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_4Dcont','Pb in allocation for lon','','')
+      ! Allocate memory for latitudes
+      ALLOCATE(lat(iml,jml), STAT=ALLOC_ERR)
+      IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_4Dcont','Pb in allocation for lat','','')
+
+      IF (is_root_prc) THEN
+        CALL flinget(fid, TRIM(inlonname), iml, jml, 0, 0, 1, 1, lon)
+        CALL flinget(fid, TRIM(inlatname), iml, jml, 0, 0, 1, 1, lat)
+      ENDIF
+    END IF
+    CALL bcast(lon)
+    CALL bcast(lat)
+
+    IF (is_root_prc) THEN
+      ALLOCATE(resol_in(iml,jml,2), STAT=ALLOC_ERR)
+      IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_4Dcont','Problem in allocation of variable resol_in','','')
+    END IF
+
+    IF (noneg) THEN
+      IF (is_root_prc) THEN
+        SELECT CASE (inNdims)
+          CASE(2)
+            CALL interpweight_modifying_input2D(iml, jml, 0, 0, 0, 0, zero, invar2D)
+          CASE(3)
+            CALL interpweight_modifying_input3D(iml, jml, lml, 0, 0, 0, zero, invar3D)
+          CASE(4)
+            CALL interpweight_modifying_input4D(iml, jml, lml, tml, 1, tml, zero, invar4D)
+        END SELECT       
+      END IF
+    END IF
+    CALL bcast(invar4D)
+    IF (printlev >= 5) WRITE(numout,*)'  interpweight_4Dcont modifying input ended!'
+
+    !
+    ! Consider all points a priori
+    !
+    ALLOCATE(mask(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_4Dcont','Problem in allocation of variable mask','','')
+    mask(:,:) = zero
+
+    IF (TRIM(masktype) == 'var') THEN
+      ALLOCATE(maskvar(iml,jml), STAT=ALLOC_ERR)
+      maskvar(:,:) = zero
+      IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_4Dcont','Problem in allocation of variable maskvar','','')
+      ! Reads the mask from the file
+      IF (is_root_prc) THEN
+         ! ATTTENTION!! One can not use flinget in this way. It always spect to have a REAL variable!
+        CALL flinget(fid, TRIM(maskvarname), iml, jml, 0, 0, 1, 1, maskvar)
+        WHERE (maskvar > zero)
+          mask = un 
+        ENDWHERE
+      END IF
+      CALL bcast(mask)
+    ELSE
+      SELECT CASE (inNdims)
+        CASE(2)
+          CALL interpweight_masking_input2D(iml, jml, 0, 0, 0, 0, masktype, maskvalues, invar2D,      &
+            mask)
+        CASE(3)
+          CALL interpweight_masking_input3D(iml, jml, 0, 0, lml, 0, masktype, maskvalues, invar3D,    &
+            mask)
+        CASE(4)
+          CALL interpweight_masking_input4D(iml, jml, 0, 0, lml, tml, masktype, maskvalues, invar4D,  &
+            mask)
+      END SELECT
+    END IF
+
+    IF (is_root_prc) CALL flinclo(fid)
+
+! Assuming regular lon/lat projection for the input data
+    IF (is_root_prc) THEN
+      CALL interpweight_calc_resolution_in(lon, lat, iml, jml, mincos, R_Earth, pi, resol_in)
+    END IF
+
+    ! Computation of nbvmax
+    ! In 'condveg_soilalb, slowproc_update' nbvmax=200
+
+    !
+    ! The number of maximum vegetation map points in the GCM grid is estimated.
+    ! Some lmargin is taken.
+    !
+    IF (is_root_prc) THEN
+       nix=INT(MAXVAL(resolution(:,1))/MAXVAL(resol_in(:,:,1)))+2
+       njx=INT(MAXVAL(resolution(:,2))/MAXVAL(resol_in(:,:,2)))+2
+       nbvmax = MAX(nix*njx, 200)
+    ENDIF
+    CALL bcast(nbvmax)
+    CALL bcast(nix)
+    CALL bcast(njx)
+
+    !
+    callsign = TRIM(varname) // ' map'
+    !
+    ok_interpol = .FALSE.
+    DO WHILE ( .NOT. ok_interpol )
+       IF (printlev>=3) WRITE(numout,*) "Projection arrays for ",callsign," : "
+       IF (printlev>=3) WRITE(numout,*) "nbvmax = ",nbvmax, nix, njx
+
+
+       ALLOCATE(sub_index(nbpt, nbvmax, 2), STAT=ALLOC_ERR)
+       IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_4Dcont','Problem in allocation of variable sub_index','','')
+
+       sub_index(:,:,:)=0
+
+       ALLOCATE(sub_area(nbpt, nbvmax), STAT=ALLOC_ERR)
+       IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_4Dcont','Problem in allocation of variable sub_area','','')
+
+       sub_area(:,:)=zero
+       IF (printlev>=3) WRITE(numout,*) 'Input data range LON:', MINVAL(lon), MAXVAL(lon)
+       IF (printlev>=3) WRITE(numout,*) 'Input data range LAT:', MINVAL(lat), MAXVAL(lat)
+
+       CALL aggregate_p(nbpt, lalo, neighbours, resolution, contfrac, &
+            &                iml, jml, lon, lat, mask, callsign, &
+            &                nbvmax, sub_index, sub_area, ok_interpol)
+       
+       IF ( .NOT. ok_interpol ) THEN
+          DEALLOCATE(sub_area)
+          DEALLOCATE(sub_index)
+          nbvmax = nbvmax * 2
+       ENDIF
+    ENDDO
+    IF (printlev>=4) WRITE (numout,*) '  interpweight_4Dcont: read/allocate OK'
+
+    outvar4D = zero
+
+! Providing the interpolated grid point
+    CALL interpweight_provide_interpolation4D(typefrac, nbpt, dim1, dim2, iml, jml, lml, tml,         &
+      nbvmax, zero, invar4D, sub_area, sub_index, varmax, varmin, un, deux, lalo,                     &
+      defaultvalue, defaultNOvalue, outvar4D, aoutvar)
+    IF (printlev >= 5) WRITE(numout,*)'  interpweight_4Dcont end of interpweight_provide_interpolation4D'
+    
+    IF (printlev>=2) THEN
+       IF (COUNT(aoutvar == -1) >= AINT(nbpt*0.4)) THEN
+          WRITE(numout,*) 'interpweight_4Dcont total number of points: ', nbpt
+          WRITE(numout,*) '  Interpolated: ', COUNT(aoutvar /= -1),                 &
+               ' non-interpolated: ', COUNT(aoutvar == -1)
+          msg = "Less than 60% of points '" // TRIM(filename) // "' variable '" // TRIM(varname) //       &
+               "' have been succesfully interpolated !!"
+          WRITE(numout,*) '  ' // TRIM(msg)
+       ELSE
+          msg = TRIM(filename) // "' variable: '" // TRIM(varname) // "' interpolation Done _______"
+          WRITE(numout,*) "interpweight_4Dcont: '" // TRIM(msg)
+          WRITE(numout,*) '  Total number of points: ', nbpt
+          WRITE(numout,*) '  Interpolated: ', COUNT(aoutvar /= -1),                 &
+               ' Non-interpolated: ', COUNT(aoutvar == -1)
+       END IF
+    END IF
+
+! Scaling to 1 the quality variable
+    DO ip=1, nbpt
+      IF (aoutvar(ip) /= -1) aoutvar(ip) = aoutvar(ip)/(resolution(ip,1)*resolution(ip,2))/contfrac(ip)
+    END DO
+
+    IF (printlev>=5) WRITE(numout,*) '  interpweight_4Dcont: Interpolation Done'
+
+    IF (ALLOCATED(lat_in)) DEALLOCATE(lat_in)
+    IF (ALLOCATED(lon_in)) DEALLOCATE(lon_in)
+    DEALLOCATE(lon)
+    DEALLOCATE(lat)
+    IF (ALLOCATED(invar2D)) DEALLOCATE(invar2D)
+    IF (ALLOCATED(invar3D)) DEALLOCATE(invar3D)
+    IF (ALLOCATED(invar4D)) DEALLOCATE(invar4D)
+    DEALLOCATE(mask)
+    IF (ALLOCATED(maskvar)) DEALLOCATE(maskvar)
+    DEALLOCATE(sub_area)
+    DEALLOCATE(sub_index)
+    IF (ALLOCATED(resol_in)) DEALLOCATE(resol_in)
+
+    RETURN
+
+  END SUBROUTINE interpweight_4Dcont
+
+!! ================================================================================================================================
+!! SUBROUTINE   : interpweight_calc_resolution_in
+!!
+!>\BRIEF        ! Subroutine to compute the resolution of the input data
+!!
+!! DESCRIPTION  : (definitions, functional, design, flags): 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): resolin
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  SUBROUTINE interpweight_calc_resolution_in(lons, lats, dx, dy, mcos, REarth, piv, resolin)
+
+    USE constantes_var
+
+    IMPLICIT NONE
+
+    !! 0. Variables and parameter declaration
+    !
+    !! 0.1 Input variables
+    !
+    INTEGER(i_std), INTENT(in)                           :: dx, dy        !! Resolution input data
+    REAL(r_std), INTENT(in)                              :: mcos          !! cosinus
+    REAL(r_std), INTENT(in)                              :: REarth        !! Earth Radius
+    REAL(r_std), INTENT(in)                              :: piv           !! pi
+    REAL(r_std), DIMENSION(dx,dy), INTENT(in)            :: lons, lats    !! longitude and latitudes (degrees)
+    !! 0.2 Modified variables
+    !
+    !! 0.3 Output variables
+    !
+    REAL(r_std), DIMENSION(dx,dy,2), INTENT(out)         :: resolin       !! distance between grid points (km)
+    !
+    !! 0.4 Local variables
+    !
+    INTEGER                                              :: ip,jp
+    REAL(r_std)                                          :: coslat
+
+    DO ip=1,dx
+       DO jp=1,dy
+          !
+          ! Resolution in longitude
+          !
+          coslat = MAX( COS( lats(ip,jp) * piv/180. ), mcos )     
+          IF ( ip .EQ. 1 ) THEN
+             resolin(ip,jp,1) = ABS( lons(ip+1,jp) - lons(ip,jp) ) * piv/180. * REarth * coslat
+          ELSEIF ( ip .EQ. dx ) THEN
+             resolin(ip,jp,1) = ABS( lons(ip,jp) - lons(ip-1,jp) ) * piv/180. * REarth * coslat
+          ELSE
+             resolin(ip,jp,1) = ABS( lons(ip+1,jp) - lons(ip-1,jp) )/2. * piv/180. * REarth * coslat
+          ENDIF
+          !
+          ! Resolution in latitude
+          !
+          IF ( jp .EQ. 1 ) THEN
+             resolin(ip,jp,2) = ABS( lats(ip,jp) - lats(ip,jp+1) ) * piv/180. * REarth
+          ELSEIF ( jp .EQ. dy ) THEN
+             resolin(ip,jp,2) = ABS( lats(ip,jp-1) - lats(ip,jp) ) * piv/180. * REarth
+          ELSE
+             resolin(ip,jp,2) =  ABS( lats(ip,jp-1) - lats(ip,jp+1) )/2. * piv/180. * REarth
+          ENDIF
+          !
+       ENDDO
+    ENDDO
+
+  END SUBROUTINE interpweight_calc_resolution_in
+
+!! ================================================================================================================================
+!! SUBROUTINE   : interpweight_modifying_input1D
+!!
+!>\BRIEF        ! modify the initial 1D values from the given file
+!!
+!! DESCRIPTION  : (definitions, functional, design, flags): 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ivar
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  SUBROUTINE interpweight_modifying_input1D(dim1, dim2, dim3, dim4, stime, etime, zeroval, ivar)
+
+    USE constantes_var
+    USE ioipsl_para
+
+    IMPLICIT NONE
+
+    !! 0. Variables and parameter declaration
+    !! 0.1 Input variables
+    INTEGER, INTENT(in)                                  :: dim1, dim2, dim3, dim4  !! size of the dimensions to get
+    INTEGER, INTENT(in)                                  :: stime, etime  !! starting/ending time step to get
+    REAL(r_std), INTENT(in)                              :: zeroval       !! zero value
+    !! 0.2 Modified variables
+    REAL(r_std), DIMENSION(dim1), INTENT(inout)          :: ivar          !! modified input data
+
+
+    WHERE (ivar(:) < zeroval )
+      ivar(:) = zeroval
+    END WHERE
+
+  END SUBROUTINE interpweight_modifying_input1D
+
+!! ================================================================================================================================
+!! SUBROUTINE   : interpweight_modifying_input2D
+!!
+!>\BRIEF        ! modify the initial 2D values from the given file
+!!
+!! DESCRIPTION  : (definitions, functional, design, flags): 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ivar
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  SUBROUTINE interpweight_modifying_input2D(dim1, dim2, dim3, dim4, stime, etime, zeroval, ivar)
+
+    USE constantes_var
+    USE ioipsl_para
+
+    IMPLICIT NONE
+
+    !! 0. Variables and parameter declaration
+    !! 0.1 Input variables
+    INTEGER, INTENT(in)                                  :: dim1, dim2, & !! size of the dimensions to get
+      dim3, dim4
+    INTEGER, INTENT(in)                                  :: stime, etime  !! starting/ending time step to get
+    REAL(r_std), INTENT(in)                              :: zeroval       !! zero value
+    !! 0.2 Modified variables
+    REAL(r_std), DIMENSION(dim1,dim2), INTENT(inout)     :: ivar          !! modified input data
+
+    WHERE (ivar(:,:) < zeroval )
+      ivar(:,:) = zeroval
+    END WHERE
+
+  END SUBROUTINE interpweight_modifying_input2D
+
+!! ================================================================================================================================
+!! SUBROUTINE   : interpweight_modifying_input3D
+!!
+!>\BRIEF        ! modify the initial 3D values from the given file
+!!
+!! DESCRIPTION  : (definitions, functional, design, flags): 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ivar
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  SUBROUTINE interpweight_modifying_input3D(dim1, dim2, dim3, dim4, stime, etime, zeroval, ivar)
+
+    USE constantes_var
+    USE ioipsl_para
+
+    IMPLICIT NONE
+
+    !! 0. Variables and parameter declaration
+    !! 0.1 Input variables
+    INTEGER, INTENT(in)                                  :: dim1, dim2, & !! size of the dimensions to get
+      dim3, dim4
+    INTEGER, INTENT(in)                                  :: stime, etime  !! starting/ending time step to get
+    REAL(r_std), INTENT(in)                              :: zeroval       !! zero value
+    !! 0.2 Modified variables
+    REAL(r_std), DIMENSION(dim1,dim2,dim3), INTENT(inout):: ivar          !! modified input data
+
+    WHERE (ivar(:,:,:) < zeroval )
+      ivar(:,:,:) = zeroval
+    END WHERE
+
+  END SUBROUTINE interpweight_modifying_input3D
+
+!! ================================================================================================================================
+!! SUBROUTINE   : interpweight_modifying_input4D
+!!
+!>\BRIEF        ! modify the initial 4D values from the given file
+!!
+!! DESCRIPTION  : (definitions, functional, design, flags): 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ivar
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  SUBROUTINE interpweight_modifying_input4D(dim1, dim2, dim3, dim4, stime, etime, zeroval, ivar)
+
+    USE constantes_var
+    USE ioipsl_para
+
+    IMPLICIT NONE
+
+    !! 0. Variables and parameter declaration
+    !! 0.1 Input variables
+    INTEGER, INTENT(in)                                  :: dim1, dim2, & !! size of the dimensions to get
+      dim3, dim4
+    INTEGER, INTENT(in)                                  :: stime, etime  !! starting/ending time step to get
+    REAL(r_std), INTENT(in)                              :: zeroval       !! zero value
+    !! 0.2 Modified variables
+    REAL(r_std), DIMENSION(dim1,dim2,dim3,dim4), INTENT(inout) :: ivar          !! modified input data
+
+    WHERE (ivar(:,:,:,:) < zeroval )
+      ivar(:,:,:,:) = zeroval
+    END WHERE
+
+  END SUBROUTINE interpweight_modifying_input4D
+
+!! ================================================================================================================================
+!! SUBROUTINE   : interpweight_interpweight_1D
+!!
+!>\BRIEF        ! mask 1D input values
+!!
+!! DESCRIPTION  : (definitions, functional, design, flags): 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): msk
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  SUBROUTINE interpweight_masking_input1D(dx, dy, d1, d2, d3, d4, mtype, mvalues, var,                &
+    msk)
+
+    USE constantes_var
+
+    IMPLICIT NONE
+  
+    !! 0. Variables and parameter declaration
+    !! 0.1 Input variables
+    INTEGER, INTENT(in)                                  :: dx, dy, d1, & !! shapes of the input variables
+      d2, d3, d4
+    CHARACTER(LEN=50), INTENT(in)                        :: mtype         !! Type of masking
+                                                                          !!   'nomask': no-mask is applied
+                                                                          !!   'mbelow': take values below values(1)
+                                                                          !!   'mabove': take values above values(1)
+                                                                          !!   'msumrange': take values within 2 ranges;
+                                                                          !!      values(2) <= SUM(vals(k)) <= values(1)
+                                                                          !!      values(1) < SUM(vals(k)) <= values(3): 
+                                                                          !!        renormalize
+                                                                          !!   'var': mask values are taken from a 
+                                                                          !!     variable (>0)
+    REAL(r_std), DIMENSION(3), INTENT(in)                :: mvalues       !! values to use to mask (according to `mtype') 
+    !! 0.2 Modified variables
+    REAL(r_std), DIMENSION(dx), INTENT(inout)            :: var           !! variable from which provide the mask
+    INTEGER(i_std), DIMENSION(dx), INTENT(inout)         :: msk           !! mask to retrieve
+    !! 0.3 Output variables
+    !! 0.4 Local variables
+    INTEGER                                              :: i,j,k,l
+
+    SELECT CASE (mtype)
+      CASE('nomask')
+        msk=un
+      CASE('mbelow')
+        ! e.g.: 
+        ! Exclude the points where there is never a LAI value. It is probably 
+        ! an ocean point.
+        !
+        DO i=1,dx
+          IF ( var(i) < mvalues(1) ) msk(i) = un
+        END DO
+      CASE('mabove')
+        DO i=1,dx
+          IF ( var(i) > mvalues(1) ) msk(i) = un 
+        ENDDO
+      CASE('msumrange')
+        CALL ipslerr_p(3, 'interpweight_masking_input1D',"'msumrange' no sens on a 1D variable",'','')
+      CASE DEFAULT
+        CALL ipslerr_p(3, 'interpweight_masking_input1D',"mask with '" // TRIM(mtype) // "' not ready !!",'','')
+    END SELECT
+
+  END SUBROUTINE interpweight_masking_input1D
+
+!! ================================================================================================================================
+!! SUBROUTINE   : interpweight_masking_input2D
+!!
+!>\BRIEF        ! mask 2D input values
+!!
+!! DESCRIPTION  : (definitions, functional, design, flags): 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): msk
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  SUBROUTINE interpweight_masking_input2D(dx, dy, d1, d2, d3, d4, mtype, mvalues, var,                &
+    msk)
+
+    USE constantes_var
+
+    IMPLICIT NONE
+  
+    !! 0. Variables and parameter declaration
+    !! 0.1 Input variables
+    INTEGER, INTENT(in)                                  :: dx, dy, d1, & !! shapes of the input variables
+      d2, d3, d4
+    CHARACTER(LEN=50), INTENT(in)                        :: mtype         !! Type of masking
+                                                                          !!   'nomask': no-mask is applied
+                                                                          !!   'mbelow': take values below values(1)
+                                                                          !!   'mabove': take values above values(1)
+                                                                          !!   'msumrange': take values within 2 ranges;
+                                                                          !!      values(2) <= SUM(vals(k)) <= values(1)
+                                                                          !!      values(1) < SUM(vals(k)) <= values(3): 
+                                                                          !!        renormalize
+                                                                          !!   'var': mask values are taken from a 
+                                                                          !!     variable (>0)
+    REAL(r_std), DIMENSION(3), INTENT(in)                :: mvalues       !! values to use to mask (according to `mtype') 
+    !! 0.2 Modified variables
+    REAL(r_std), DIMENSION(dx,dy), INTENT(inout)         :: var           !! variable from which provide the mask
+    INTEGER(i_std), DIMENSION(dx,dy), INTENT(inout)      :: msk           !! mask to retrieve
+    !! 0.3 Output variables
+    !! 0.4 Local variables
+    INTEGER                                              :: i,j,k,l
+    REAL(r_std)                                          :: sumval
+
+
+    SELECT CASE (mtype)
+      CASE('nomask')
+        msk=un
+      CASE('mbelow')
+        ! e.g.: 
+        ! Exclude the points where there is never a LAI value. It is probably 
+        ! an ocean point.
+        !
+        DO i=1,dx
+          DO j=1,dy
+            IF ( var(i,j) < mvalues(1) ) msk(i,j) = un
+          END DO
+        END DO
+      CASE('mabove')
+        DO i=1,dx
+          DO j=1,dy
+            IF ( var(i,j) > mvalues(1) ) msk(i,j) = un 
+          ENDDO
+        ENDDO
+      CASE('msumrange')
+        IF (printlev>=3) WRITE(numout,*) &
+             'interpweight_masking_input2D: masking with mask sum range. Interval:', mvalues
+         DO i=1,dx
+           DO j=1,dy
+              sumval=SUM(var(i,:))
+              IF ( sumval .GE. mvalues(2) .AND. sumval .LE. mvalues(1) ) THEN
+                 msk(i,j) = un 
+              ELSEIF ( sumval .GT. mvalues(1) .AND. sumval .LE. mvalues(3) ) THEN
+                 ! normalization
+                 var(i,j) = var(i,j) / sumval
+                 msk(i,j) = un 
+              ENDIF
+           ENDDO
+        ENDDO
+      CASE DEFAULT
+        CALL ipslerr_p(3, 'interpweight_masking_input2D',"mask with '" // TRIM(mtype) // "' not ready !!",'','')
+    END SELECT
+
+  END SUBROUTINE interpweight_masking_input2D
+
+!! ================================================================================================================================
+!! SUBROUTINE   : interpweight_masking_input3D
+!!
+!>\BRIEF        ! mask 3D input values
+!!
+!! DESCRIPTION  : (definitions, functional, design, flags): 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): msk
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  SUBROUTINE interpweight_masking_input3D(dx, dy, d1, d2, d3, d4, mtype, mvalues, var,                &
+    msk)
+
+    USE constantes_var
+
+    IMPLICIT NONE
+  
+    !! 0. Variables and parameter declaration
+    !! 0.1 Input variables
+    INTEGER, INTENT(in)                                  :: dx, dy, d1, & !! shapes of the input variables
+      d2, d3, d4
+    CHARACTER(LEN=50), INTENT(in)                        :: mtype         !! Type of masking
+                                                                          !!   'nomask': no-mask is applied
+                                                                          !!   'mbelow': take values below values(1)
+                                                                          !!   'mabove': take values above values(1)
+                                                                          !!   'msumrange': take values within 2 ranges;
+                                                                          !!      values(2) <= SUM(vals(k)) <= values(1)
+                                                                          !!      values(1) < SUM(vals(k)) <= values(3): 
+                                                                          !!        renormalize
+                                                                          !!   'var': mask values are taken from a 
+                                                                          !!     variable (>0)
+    REAL(r_std), DIMENSION(3), INTENT(in)                :: mvalues       !! values to use to mask (according to `mtype') 
+    !! 0.2 Modified variables
+    REAL(r_std), DIMENSION(dx,dy,d3), INTENT(inout)      :: var           !! variable from which provide the mask
+    INTEGER(i_std), DIMENSION(dx,dy), INTENT(inout)      :: msk           !! mask to retrieve
+    !! 0.3 Output variables
+    !! 0.4 Local variables
+    INTEGER                                              :: i,j,k,l
+    REAL(r_std)                                          :: sumval
+
+
+    SELECT CASE (mtype)
+      CASE('nomask')
+        msk=un
+      CASE('mbelow')
+        ! e.g.: 
+        ! Exclude the points where there is never a LAI value. It is probably 
+        ! an ocean point.
+        !
+        DO i=1,dx
+          DO j=1,dy
+            IF ( ANY(var(i,j,:) < mvalues(1)) ) msk(i,j) = un
+          END DO
+        END DO
+      CASE('mabove')
+        DO i=1,dx
+          DO j=1,dy
+            IF ( ANY(var(i,j,:) > mvalues(1)) ) msk(i,j) = un 
+          ENDDO
+        ENDDO
+      CASE('msumrange')
+         DO i=1,dx
+           DO j=1,dy
+             sumval=SUM(var(i,j,:))
+             IF ( sumval .GE. mvalues(2) .AND. sumval .LE. mvalues(1)) THEN
+                msk(i,j) = un 
+             ELSEIF ( sumval .GT. mvalues(1) .AND. sumval .LE. mvalues(3)) THEN
+                ! normalization
+                var(i,j,:) = var(i,j,:) / sumval
+                msk(i,j) = un 
+             ENDIF
+           ENDDO
+        ENDDO
+      CASE DEFAULT
+        CALL ipslerr_p(3, 'interpweight_masking_input3D',"mask with '" // TRIM(mtype) // "' not ready !!",'','')
+    END SELECT
+  END SUBROUTINE interpweight_masking_input3D
+
+!! ================================================================================================================================
+!! SUBROUTINE   : interpweight_masking_input4D
+!!
+!>\BRIEF        ! mask 4D input values
+!!
+!! DESCRIPTION  : (definitions, functional, design, flags): 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): msk
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  SUBROUTINE interpweight_masking_input4D(dx, dy, d1, d2, d3, d4, mtype, mvalues, var,                &
+    msk)
+
+    USE constantes_var
+
+    IMPLICIT NONE
+  
+    !! 0. Variables and parameter declaration
+    !! 0.1 Input variables
+    INTEGER, INTENT(in)                                  :: dx, dy, d1, & !! shapes of the input variables
+      d2, d3, d4
+    CHARACTER(LEN=50), INTENT(in)                        :: mtype         !! Type of masking
+                                                                          !!   'nomask': no-mask is applied
+                                                                          !!   'mbelow': take values below values(1)
+                                                                          !!   'mabove': take values above values(1)
+                                                                          !!   'msumrange': take values within 2 ranges;
+                                                                          !!      values(2) <= SUM(vals(k)) <= values(1)
+                                                                          !!      values(1) < SUM(vals(k)) <= values(3): 
+                                                                          !!        renormalize
+                                                                          !!   'var': mask values are taken from a 
+                                                                          !!     variable (>0)
+    REAL(r_std), DIMENSION(3), INTENT(in)                :: mvalues       !! values to use to mask (according to `mtype') 
+    !! 0.2 Modified variables
+    REAL(r_std), DIMENSION(dx,dy,d3,d4), INTENT(inout)   :: var           !! variable from which provide the mask
+    INTEGER(i_std), DIMENSION(dx,dy), INTENT(inout)      :: msk           !! mask to retrieve
+    !! 0.3 Output variables
+    !! 0.4 Local variables
+    INTEGER                                              :: i,j,k,l
+    REAL(r_std)                                          :: sumval
+
+
+    SELECT CASE (mtype)
+      CASE('nomask')
+        msk=un
+      CASE('mbelow')
+        ! e.g.: 
+        ! Exclude the points where there is never a LAI value. It is probably 
+        ! an ocean point.
+        !
+        DO i=1,dx
+          DO j=1,dy
+            IF ( ANY(var(i,j,:,:) < mvalues(1)) ) msk(i,j) = un
+          END DO
+        END DO
+      CASE('mabove')
+        DO i=1,dx
+          DO j=1,dy
+            IF ( ANY(var(i,j,:,:) > mvalues(1)) ) msk(i,j) = un 
+          ENDDO
+        ENDDO
+      CASE('msumrange')
+        IF (printlev>=3) WRITE(numout,*) &
+             'interpweight_masking_input4D: masking with mask sum range. Interval:', mvalues
+         DO i=1,dx
+           DO j=1,dy
+             DO l=1,d4
+               sumval=SUM(var(i,j,:,l))
+               IF ( sumval .GE. mvalues(2) .AND. sumval .LE. mvalues(1) .AND. msk(i,j) /= un) THEN
+                  msk(i,j) = un 
+               ELSEIF ( sumval .GT. mvalues(1) .AND. sumval .LE. mvalues(3)) THEN
+                  ! normalization
+                  var(i,j,:,l) = var(i,j,:,l) / sumval
+                  msk(i,j) = un 
+               ENDIF
+             ENDDO
+           ENDDO
+        ENDDO
+      CASE DEFAULT
+        CALL ipslerr_p(3, 'interpweight_masking_input4D',"mask with '" // TRIM(mtype) // "' not ready !!",'','')
+    END SELECT
+
+  END SUBROUTINE interpweight_masking_input4D
+
+!! ================================================================================================================================
+!! SUBROUTINE   : interpweight_provide_fractions1D
+!!
+!>\BRIEF        ! provide fractions from a 1D incoming variable
+!!
+!! DESCRIPTION  : (definitions, functional, design, flags): 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ovar, aovar
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  SUBROUTINE interpweight_provide_fractions1D(tint, npt, Ntypes, valstypes,                           &
+    dx, dy, d3, d4, nbmax, zeroval, ivar1D, sarea, sindex, vmax, vmin,                                &
+    two, latlon, ovar, aovar)
+
+    USE constantes_var
+
+    IMPLICIT NONE
+  
+    !! 0. Variables and parameter declaration
+    !! 0.1 Input variables
+    CHARACTER(LEN=50), INTENT(in)                        :: tint          !! tint: type of interpolation
+                                                                          !!   'XYKindTime': Input values are kinds 
+                                                                          !!     of something with a temporal 
+                                                                          !!     evolution on the dx*dy matrix
+    INTEGER, INTENT(in)                                  :: npt           !! total number of grid points
+    INTEGER, INTENT(in)                                  :: dx,dy,d3,d4   !! shape of the input values
+    INTEGER, INTENT(in)                                  :: nbmax         !! maximum input grid cells to use 
+                                                                          !!   for in 1 grid point
+    REAL(r_std), INTENT(in)                              :: zeroval, two  !! zero and 2. real values
+    INTEGER, INTENT(in)                                  :: Ntypes        !! number of types
+    REAL(r_std), DIMENSION(Ntypes), INTENT(in)           :: valstypes     !! value for each type 
+    REAL(r_std), DIMENSION(dx), INTENT(in)               :: ivar1D        !! values of the input data
+    REAL(r_std), DIMENSION(npt,nbmax), INTENT(in)        :: sarea         !! overlaping area of a given input 
+                                                                          !!   grid point
+    INTEGER(i_std), DIMENSION(npt,nbmax), INTENT(in)     :: sindex        !! index of the overlaping input 
+                                                                          !!   grid point
+    REAL(r_std), DIMENSION(npt,2), INTENT(in)            :: latlon        !! longitude and latitude of the destiny
+                                                                          !!   grid points
+    !! 0.2 Modified variables
+    REAL(r_std), INTENT(inout)                           :: vmax, vmin    !! thresholds of the values
+    !! 0.3 Output variables
+    REAL(r_std), DIMENSION(npt,Ntypes), INTENT(out)      :: ovar          !! output variable (on the nbpt space)
+    REAL(r_std), DIMENSION(npt), INTENT(out)             :: aovar         !! availability of input data to 
+                                                                          !!   interpolate output variable (on 
+                                                                          !!   the nbpt space)
+                                                                          !!     >0.: As the total sum of the 
+                                                                          !!       space fraction used from the 
+                                                                          !!       source
+                                                                          !!     -1: Did not find any required values 
+                                                                          !!       from input data
+    !! 0.4 Local variables
+    INTEGER                                              :: i,j,k,ij,ib,idi,jj,ip,jp,jv,it
+    CHARACTER(LEN=250)                                   :: msg
+
+
+! Initialization
+!!
+    ovar = zeroval
+
+    SELECT CASE (tint)
+      CASE ('default')
+        IF (printlev>=4) WRITE(numout,*)'  interpweight_provide_fractions1D Fractions following default1D method'
+        IF (ALL(ivar1D == zeroval)) THEN
+          msg = "' wrong 1D input variable"
+          CALL ipslerr_p(3,'interpweight_provide_fractions1D',"'" // TRIM(tint) // TRIM(msg),'','')
+        END IF 
+        DO ib=1,npt
+          aovar(ib) = zeroval
+          idi = COUNT(sarea(ib,:) > zeroval)
+          IF ( idi > 0 ) THEN
+            DO jj=1,idi
+               ip = sindex(ib,jj)
+               DO it = 1, Ntypes
+                 IF (ivar1d(ip) == valstypes(it)*un) THEN
+                   ovar(ib,it) = ovar(ib,it) + sarea(ib,jj)
+                 END IF
+               END DO
+               aovar(ib) = aovar(ib) + sarea(ib,jj)
+            ENDDO
+            !
+            ! Normalize
+            !
+            ovar(ib,:) = ovar(ib,:)/aovar(ib)
+            !
+            ! Quality variable
+          ELSE
+             ! No points found.
+            aovar(ib) = -un
+            ovar(ib,INT((vmax+vmin)/two)) = un
+          ENDIF
+          IF (SUM(ovar(ib,:)) > 1.0000001) THEN
+            IF (printlev>=3) WRITE(numout,*) '  interpweight_provide_fractions1D On point ', ib, &
+                 ' location: ', latlon(ib,2), latlon(ib,1),' total fractions=', SUM(ovar(ib,:))
+            IF (printlev>=3) THEN
+               WRITE(numout,*) '  type fraction: '
+               DO i=1, Ntypes
+                  WRITE(numout,*) i, ovar(ib,i)
+               END DO
+            END IF
+            msg='total of fractions above 1.!'
+            CALL ipslerr_p(3,'interpweight_provide_fractions1D',TRIM(msg),'','')
+          END IF
+        END DO
+
+        IF (printlev >= 3 .AND. ANY(aovar == -un)) THEN
+           WRITE(numout,*) 'interpweight_provide_fractions1D: '
+           WRITE(numout,*) 'Some points on the model grid did not have any points on the source grid for interpolation.'
+           WRITE(numout,*) 'These points are initialized by putting the average VAR ', INT((vmax+vmin)/two), ' to 1.'
+           WRITE(numout,*) 'The points are (ib, lon, lat) :'
+           DO ib=1, npt
+              IF (aovar(ib) == -un) WRITE(numout,*) ib, latlon(ib,2), latlon(ib,1)
+           END DO
+        END IF
+      CASE DEFAULT
+        CALL ipslerr_p(3,'interpweight_provide_fractions1D',"Inerpolation type '" // TRIM(tint) // "' not ready!",'','')
+    END SELECT
+
+  END SUBROUTINE interpweight_provide_fractions1D
+
+!! ================================================================================================================================
+!! SUBROUTINE   : interpweight_provide_fractions2D
+!!
+!>\BRIEF        ! provide fractions from a 2D incoming variable
+!!
+!! DESCRIPTION  : (definitions, functional, design, flags): 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ovar, aovar
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  SUBROUTINE interpweight_provide_fractions2D(tint, npt, Ntypes, valstypes,                           &
+    dx, dy, d3, d4, nbmax, zeroval, ivar2D, sarea, sindex, vmax, vmin,                                &
+    two, latlon, ovar, aovar)
+
+    USE constantes_var
+
+    IMPLICIT NONE
+
+    !! 0. Variables and parameter declaration
+    !! 0.1 Input variables
+    CHARACTER(LEN=50), INTENT(in)                        :: tint          !! tint: type of interpolation
+                                                                          !!   'XYKindTime': Input values are kinds 
+                                                                          !!     of something with a temporal 
+                                                                          !!     evolution on the dx*dy matrix
+    INTEGER, INTENT(in)                                  :: npt           !! total number of grid points
+    INTEGER, INTENT(in)                                  :: dx,dy,d3,d4   !! shape of the input values
+    INTEGER, INTENT(in)                                  :: nbmax         !! maximum input grid cells to use 
+                                                                          !!   for in 1 grid point
+    REAL(r_std), INTENT(in)                              :: zeroval, two  !! zero and 2. real values
+    INTEGER, INTENT(in)                                  :: Ntypes        !! number of types
+    REAL(r_std), DIMENSION(Ntypes), INTENT(in)           :: valstypes     !! value for each type 
+    REAL(r_std), DIMENSION(dx,dy), INTENT(in)            :: ivar2D        !! values of the input data
+    REAL(r_std), DIMENSION(npt,nbmax), INTENT(in)        :: sarea         !! overlaping area of a given input 
+                                                                          !!   grid point
+    INTEGER(i_std), DIMENSION(npt,nbmax,2), INTENT(in)   :: sindex        !! index of the overlaping input 
+                                                                          !!   grid point
+    REAL(r_std), DIMENSION(npt,2), INTENT(in)            :: latlon        !! longitude and latitude of the destiny
+                                                                          !!   grid points
+    !! 0.2 Modified variables
+    REAL(r_std), INTENT(inout)                           :: vmax, vmin    !! thresholds of the values
+    !! 0.3 Output variables
+    REAL(r_std), DIMENSION(npt,Ntypes), INTENT(out)      :: ovar          !! output variable (on the nbpt space)
+    REAL(r_std), DIMENSION(npt), INTENT(out)             :: aovar         !! availability of input data to 
+                                                                          !!   interpolate output variable (on 
+                                                                          !!   the nbpt space)
+                                                                          !!     >0.: As the total sum of the 
+                                                                          !!       space fraction used from the 
+                                                                          !!       source
+                                                                          !!     -1: Found any required values 
+                                                                          !!       from input data
+    !! 0.4 Local variables
+    INTEGER                                              :: i,j,k,ij,ib,idi,jj,ip,jp,jv,it
+    CHARACTER(LEN=250)                                   :: msg
+
+
+! Initialization
+!!
+    ovar = zeroval
+
+    SELECT CASE (tint)
+      CASE ('default')
+        IF (printlev>=3) WRITE(numout,*)'  interpweight_provide_fractions2D Fractions following default2D method'
+        IF (ALL(ivar2D == zeroval)) THEN
+          msg = "' wrong 2D input variable"
+          CALL ipslerr_p(3,'interpweight_provide_fractions2D',"'" // TRIM(tint) // TRIM(msg),'','')
+        END IF 
+        DO ib=1,npt
+          aovar(ib) = zeroval
+          idi = COUNT(sarea(ib,:) > zeroval)
+          IF ( idi > 0 ) THEN
+            DO jj=1,idi
+               ip = sindex(ib,jj,1)
+               jp = sindex(ib,jj,2)
+               DO it = 1, Ntypes
+                 IF (ivar2d(ip,jp) == valstypes(it)*un) THEN
+                   ovar(ib,it) = ovar(ib,it) + sarea(ib,jj)
+                 END IF
+               END DO
+               aovar(ib) = aovar(ib) + sarea(ib,jj)
+            ENDDO
+            !
+            ! Normalize
+            !
+            ovar(ib,:) = ovar(ib,:)/aovar(ib)
+            !
+            ! Quality variable
+          ELSE
+            ! No points on the source grid were found for the current point. 
+            ! We provide here a default value.
+            aovar(ib) = -un
+            ovar(ib,INT((vmax+vmin)/two)) = un
+          ENDIF
+
+          IF (SUM(ovar(ib,:)) > 1.0000001) THEN
+            WRITE(numout,*) '  interpweight_provide_fractions2D On point ', ib, ' location: ', latlon(ib,2),     &
+              latlon(ib,1),' total fractions=', SUM(ovar(ib,:))
+            WRITE(numout,*) '  type fraction _______'
+            DO i=1, Ntypes
+              WRITE(numout,*) i, ovar(ib,i)
+            END DO
+            msg='total of fractions above 1.!'
+            CALL ipslerr_p(3,'interpweight_provide_fractions2D',TRIM(msg),'','')
+          END IF
+        END DO
+
+        IF (printlev >= 3 .AND. ANY(aovar == -un)) THEN
+           WRITE(numout,*) 'interpweight_provide_fractions2D: '
+           WRITE(numout,*) 'Some points on the model grid did not have any points on the source grid for interpolation.'
+           WRITE(numout,*) 'These points are initialized by putting the average VAR ', INT((vmax+vmin)/two), ' to 1.'
+           WRITE(numout,*) 'The points are (ib, lon, lat) :'
+           DO ib=1, npt
+              IF (aovar(ib) == -un) WRITE(numout,*) ib, latlon(ib,2), latlon(ib,1)
+           END DO
+        END IF
+ 
+      CASE DEFAULT
+        CALL ipslerr_p(3,'interpweight_provide_fractions2D',"Inerpolation type '" // TRIM(tint) // "' not ready!",'','')
+    END SELECT
+
+  END SUBROUTINE interpweight_provide_fractions2D
+
+!! ================================================================================================================================
+!! SUBROUTINE   : interpweight_provide_fractions3D
+!!
+!>\BRIEF        ! provide fractions from a 3D incoming variable
+!!
+!! DESCRIPTION  : (definitions, functional, design, flags): 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ovar, aovar
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  SUBROUTINE interpweight_provide_fractions3D(tint, npt, Ntypes, valstypes,                           &
+    dx, dy, d3, d4, nbmax, zeroval, ivar3D, sarea, sindex, vmax, vmin,                                &
+    two, latlon, ovar, aovar)
+
+    USE constantes_var
+
+    IMPLICIT NONE
+
+    !! 0. Variables and parameter declaration
+    !! 0.1 Input variables
+    CHARACTER(LEN=50), INTENT(in)                        :: tint          !! tint: type of interpolation
+                                                                          !!   'XYKindTime': Input values are kinds 
+                                                                          !!     of something with a temporal 
+                                                                          !!     evolution on the dx*dy matrix
+    INTEGER, INTENT(in)                                  :: npt           !! total number of grid points
+    INTEGER, INTENT(in)                                  :: dx,dy,d3,d4   !! shape of the input values
+    INTEGER, INTENT(in)                                  :: nbmax         !! maximum input grid cells to use 
+                                                                          !!   for in 1 grid point
+    REAL(r_std), INTENT(in)                              :: zeroval, two  !! zero and 2. real values
+    INTEGER, INTENT(in)                                  :: Ntypes        !! number of types
+    REAL(r_std), DIMENSION(Ntypes), INTENT(in)           :: valstypes     !! value for each type 
+    REAL(r_std), DIMENSION(dx,dy,d3), INTENT(in)         :: ivar3D        !! values of the input data
+    REAL(r_std), DIMENSION(npt,nbmax), INTENT(in)        :: sarea         !! overlaping area of a given input 
+                                                                          !!   grid point
+    INTEGER(i_std), DIMENSION(npt,nbmax,2), INTENT(in)   :: sindex        !! index of the overlaping input 
+                                                                          !!   grid point
+    REAL(r_std), DIMENSION(npt,2), INTENT(in)            :: latlon        !! longitude and latitude of the destiny
+                                                                          !!   grid points
+    !! 0.2 Modified variables
+    REAL(r_std), DIMENSION(Ntypes), INTENT(inout)        :: vmax, vmin    !! thresholds of the values
+    !! 0.3 Output variables
+    REAL(r_std), DIMENSION(npt,Ntypes), INTENT(out)      :: ovar          !! output variable (on the nbpt space)
+    REAL(r_std), DIMENSION(npt), INTENT(out)             :: aovar         !! availability of input data to 
+                                                                          !!   interpolate output variable (on 
+                                                                          !!   the nbpt space)
+                                                                          !!     >0.: As the total sum of the 
+                                                                          !!       space fraction used from the 
+                                                                          !!       source
+                                                                          !!     -1: Found any required values 
+                                                                          !!       from input data
+    !! 0.4 Local variables
+    INTEGER                                              :: i,j,k,ij,ib,idi,jj,ip,jp,jv,it
+    CHARACTER(LEN=250)                                   :: msg
+    INTEGER                                              :: Nzeros
+    INTEGER                                              :: ALLOC_ERR 
+    REAL(r_std), ALLOCATABLE, DIMENSION(:)               :: subfrac
+    REAL(r_std)                                          :: sumpt
+
+
+! Initialization
+!!
+    ovar = zeroval
+
+    IF (Ntypes /= d3) THEN
+      msg = 'Different number of types than third dimension in the input data!!'
+      CALL ipslerr_p(3,'interpweight_provide_fractions3D',TRIM(msg),'','')
+    END IF
+
+    Nzeros = 0
+    SELECT CASE (tint)
+      CASE ('default')
+        IF (printlev>=3) WRITE(numout,*)'Fractions following default3D method'
+        IF (ALL(ivar3D == zeroval)) THEN
+          msg = "' wrong 3D input variable"
+          CALL ipslerr_p(3,'interpweight_provide_fractions3D',"'" // TRIM(tint) // TRIM(msg),'','')
+        END IF
+        DO ib=1,npt
+          aovar(ib) = zeroval
+          idi = COUNT(sarea(ib,:) > zeroval)
+          IF ( idi > 0 ) THEN
+            sumpt = zeroval
+            DO jj=1,idi
+               ip = sindex(ib,jj,1)
+               jp = sindex(ib,jj,2)
+               DO it = 1, Ntypes
+! Do not get that areas with zero input value and with missing value
+                 IF (ivar3D(ip,jp,it) > zeroval .AND. ivar3D(ip,jp,it) < two) THEN
+                   ovar(ib,it) = ovar(ib,it) + ivar3D(ip,jp,it)*sarea(ib,jj)
+                   sumpt = sumpt + ivar3D(ip,jp,it)*sarea(ib,jj)
+                 END IF
+               END DO
+               aovar(ib) = aovar(ib) + sarea(ib,jj)
+            ENDDO
+            !
+            ! Normalize
+            !
+            ovar(ib,:) = ovar(ib,:)/aovar(ib)
+            !
+            ! Quality variable
+          ELSE
+            Nzeros = Nzeros + 1
+            aovar(ib) = -un
+
+            DO it = 1, d3
+              ovar(ib,INT((vmax(it)+vmin(it))/two)) = un
+            END DO
+          ENDIF
+! Tests
+!
+          IF (SUM(ovar(ib,:)) > 1.0000001) THEN
+            idi = COUNT(sarea(ib,:) > zeroval)
+            ALLOCATE(subfrac(idi), STAT=ALLOC_ERR)
+            IF (ALLOC_ERR /= 0) CALL ipslerr_p(3,'interpweight_provide_fractions3D','Problem in allocation of subfrac','','')
+            IF (printlev>=3) THEN
+               WRITE(numout,*) 'interpweight_provide_fractions3D On point ', ib, &
+                    ' location: ', latlon(ib,2), latlon(ib,1),' total fractions=', SUM(ovar(ib,:)), &
+                    ' total points from invar: ', idi, ' total invar area: ', aovar(ib)
+               WRITE(numout,*) '  type ivar3D jj sarea fraction: '
+
+               DO it = 1, Ntypes
+                  DO jj=1,idi
+                     ip = sindex(ib,jj,1)
+                     jp = sindex(ib,jj,2)
+                     IF (ivar3D(ip,jp,it) > zeroval) THEN
+                        WRITE(numout,*) it, ivar3D(ip,jp,it), jj, sarea(ib,jj), ovar(ib,it)
+                     END IF
+                  END DO
+               END DO
+            END IF
+            msg='total of fractions above 1.!'
+            CALL ipslerr_p(3,'interpweight_provide_fractions3D',TRIM(msg),'','')
+         END IF
+
+        END DO
+
+        IF (printlev >= 3 .AND. ANY(aovar == -un)) THEN
+           WRITE(numout,*) 'interpweight_provide_fractions3D: '
+           WRITE(numout,*) 'Some points on the model grid did not have any points on the source grid for interpolation.'
+           WRITE(numout,*) 'These points are initialized by putting the average VAR ', INT((vmax+vmin)/two), ' to 1.'
+           WRITE(numout,*) 'The points are (ib, lon, lat) :'
+           DO ib=1, npt
+              IF (aovar(ib) == -un) WRITE(numout,*) ib, latlon(ib,2), latlon(ib,1)
+           END DO
+        END IF
+
+        IF (COUNT(aovar == -1) == npt) THEN
+          msg='No grid points could be interpolated from the source grid for the current process'
+          CALL ipslerr_p(2,'interpweight_provide_fractions3D',TRIM(msg),'','')
+        END IF
+
+        IF (printlev >=3) WRITE(numout,*) 'interpweight_provide_fractions3D: Nzeros=', &
+             Nzeros,' aovar=', COUNT(aovar == -1), ' nbpt=', npt
+
+        IF (COUNT(aovar == -1) /= Nzeros) THEN
+          msg='Something went wrong COUNT(aovar == -1) /= Nzeros'
+          CALL ipslerr_p(3,'interpweight_provide_fractions3D',TRIM(msg),'','')
+        END IF
+ 
+      CASE DEFAULT
+        CALL ipslerr_p(3,'interpweight_provide_fractions3D',"Inerpolation type '" // TRIM(tint) // "' not ready!",'','')
+    END SELECT
+
+  END SUBROUTINE interpweight_provide_fractions3D
+
+!! ================================================================================================================================
+!! SUBROUTINE   : interpweight_provide_fractions4D
+!!
+!>\BRIEF        ! provide fractions from a 4D incoming variable
+!!
+!! DESCRIPTION  : (definitions, functional, design, flags): 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ovar, aovar
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  SUBROUTINE interpweight_provide_fractions4D(tint, npt, Ntypes, valstypes,                           &
+    dx, dy, d3, d4, nbmax, zeroval, ivar4D, sarea, sindex, vmax, vmin,                                &
+    two, latlon, ovar, aovar)
+
+    USE constantes_var
+
+    IMPLICIT NONE
+
+    !! 0. Variables and parameter declaration
+    !! 0.1 Input variables
+    CHARACTER(LEN=50), INTENT(in)                        :: tint          !! tint: type of interpolation
+                                                                          !!   'XYKindTime': Input values are kinds 
+                                                                          !!     of something with a temporal 
+                                                                          !!     evolution on the dx*dy matrix
+    INTEGER, INTENT(in)                                  :: npt           !! total number of grid points
+    INTEGER, INTENT(in)                                  :: dx,dy,d3,d4   !! shape of the input values
+    INTEGER, INTENT(in)                                  :: nbmax         !! maximum input grid cells to use 
+                                                                          !!   for in 1 grid point
+    REAL(r_std), INTENT(in)                              :: zeroval, two  !! zero and 2. real values
+    INTEGER, INTENT(in)                                  :: Ntypes        !! number of types
+    REAL(r_std), DIMENSION(Ntypes), INTENT(in)           :: valstypes     !! value for each type 
+    REAL(r_std), DIMENSION(dx,dy,d3,d4), INTENT(in)      :: ivar4D        !! values of the input data
+    REAL(r_std), DIMENSION(npt,nbmax), INTENT(in)        :: sarea         !! overlaping area of a given input 
+                                                                          !!   grid point
+    INTEGER(i_std), DIMENSION(npt,nbmax,2), INTENT(in)   :: sindex        !! index of the overlaping input 
+                                                                          !!   grid point
+    REAL(r_std), DIMENSION(npt,2), INTENT(in)            :: latlon        !! longitude and latitude of the destiny
+                                                                          !!   grid points
+    !! 0.2 Modified variables
+    REAL(r_std), DIMENSION(Ntypes), INTENT(inout)        :: vmax, vmin    !! thresholds of the values
+    !! 0.3 Output variables
+    REAL(r_std), DIMENSION(npt,Ntypes,d4), INTENT(out)   :: ovar          !! output variable (on the nbpt space)
+    REAL(r_std), DIMENSION(npt), INTENT(out)             :: aovar         !! availability of input data to 
+                                                                          !!   interpolate output variable (on 
+                                                                          !!   the nbpt space)
+                                                                          !!     >0.: As the total sum of the 
+                                                                          !!       space fraction used from the 
+                                                                          !!       source
+                                                                          !!     -1: Found any required values 
+                                                                          !!       from input data
+    !! 0.4 Local variables
+    INTEGER                                              :: i,j,k,ij,ib,idi,jj,ip,jp,jv,it,itt
+    CHARACTER(LEN=250)                                   :: msg
+
+
+! Initialization
+!!
+    ovar = zeroval
+
+    IF (Ntypes /= d3) THEN
+      msg = 'Different number of types than third dimension in the input data!!'
+      CALL ipslerr_p(3,'interpweight_provide_fractions4D',TRIM(msg),'','')
+    END IF
+
+    SELECT CASE (tint)
+      CASE ('default')
+        IF (printlev>=3) WRITE(numout,*)'Fractions following default4D method'
+        IF (ALL(ivar4D == zeroval)) THEN
+          msg = "' wrong 4D input variable"
+          CALL ipslerr_p(3,'interpweight_provide_fractions4D',"'" // TRIM(tint) // TRIM(msg),'','')
+        END IF
+        DO ib=1,npt
+          aovar(ib) = zeroval
+          idi = COUNT(sarea(ib,:) > zeroval)
+          IF ( idi > 0 ) THEN
+            DO jj=1,idi
+               ip = sindex(ib,jj,1)
+               jp = sindex(ib,jj,2)
+               DO it = 1, Ntypes
+                 DO itt = 1, d4
+                   ! Do not get that areas with zero input value and with missing value
+                   IF (ivar4D(ip,jp,it,itt) > zeroval .AND. ivar4D(ip,jp,it,itt) < 20.) THEN
+                     ovar(ib,it,itt) = ovar(ib,it,itt) + ivar4D(ip,jp,it,itt)*sarea(ib,jj)
+                   END IF
+                 END DO
+               END DO
+               aovar(ib) = aovar(ib) + sarea(ib,jj)
+            ENDDO
+            !
+            ! Normalize
+            !
+            ovar(ib,:,:) = ovar(ib,:,:)/aovar(ib)
+            !
+            ! Quality variable
+          ELSE
+            ! No points found. Set the average of input threashold (vmax, vmin) as value. 
+            aovar(ib) = -un
+            IF (printlev >= 3) WRITE(numout,*) 'interpweight_provide_fractions4D: ',&
+                 'No points found for interpolating of point ib=',ib,&
+                 ' with location lon, lat = ',latlon(ib,2), latlon(ib,1)
+            DO it=1, Ntypes
+              DO itt=1, d4
+                ovar(ib,INT((vmax(it)+vmin(it))/two),itt) = un
+              END DO
+            END DO
+          ENDIF
+!          DO itt = 1, d4
+!             IF (SUM(ovar(ib,:,itt)) > 1.0000001) THEN
+!                IF (printlev>=3) THEN
+!                   WRITE(numout,*) '  interpweight_provide_fractions4D On point ', ib, &
+!                        ' location: ', latlon(ib,2), latlon(ib,1),' itt=', itt, &
+!                        ' total fractions=', SUM(ovar(ib,:,itt))
+!                   WRITE(numout,*) '  type fraction:'
+!                   DO i=1, Ntypes
+!                      WRITE(numout,*) i, ovar(ib,:,itt)
+!                   END DO
+!                END IF
+!                msg='total of fractions above 1.!'
+!                CALL ipslerr_p(3,'interpweight_provide_fractions4D',TRIM(msg),'','')
+!             END IF
+!          END DO
+       END DO
+       
+      CASE DEFAULT
+        CALL ipslerr_p(3,'interpweight_provide_fractions4D',"Inerpolation type '" // TRIM(tint) // "' not ready!",'','')
+    END SELECT
+
+  END SUBROUTINE interpweight_provide_fractions4D
+
+!! ================================================================================================================================
+!! SUBROUTINE   : interpweight_provide_interpolation2D
+!!
+!>\BRIEF        ! perform the interpolation for a continuos 2D field
+!!
+!! DESCRIPTION  : (definitions, functional, design, flags): 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ovar, aovar
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  SUBROUTINE interpweight_provide_interpolation2D(tint, npt, d1, d2, dx, dy, d3, d4,                  &
+    nbmax, zeroval, ivar2D, sarea, sindex, vmax, vmin, one, two, latlon,                              &
+    defaultval, defaultNOval, ovar, aovar)
+
+    USE constantes_var
+
+    IMPLICIT NONE
+
+    !! 0. Variables and parameter declaration
+    !! 0.1 Input variables
+    CHARACTER(LEN=50), INTENT(in)                        :: tint          !! tint: type of interpolation
+                                                                          !!   'XYKindTime': Input values are kinds 
+                                                                          !!     of something with a temporal 
+                                                                          !!     evolution on the dx*dy matrix
+    INTEGER, INTENT(in)                                  :: npt           !! total number of grid points
+    INTEGER, INTENT(in)                                  :: d1, d2, d3, & !! shape of the input values
+      d4, dx, dy
+    INTEGER, INTENT(in)                                  :: nbmax         !! maximum input grid cells to use 
+                                                                          !!   for in 1 grid point
+    REAL(r_std), INTENT(in)                              :: zeroval,one,two !! zero 1. and 2. real values
+    REAL(r_std), DIMENSION(dx,dy), INTENT(in)            :: ivar2D        !! values of the input data
+    REAL(r_std), DIMENSION(npt,nbmax), INTENT(in)        :: sarea         !! overlaping area of a given input 
+                                                                          !!   grid point
+    INTEGER(i_std), DIMENSION(npt,nbmax,2), INTENT(in)   :: sindex        !! index of the overlaping input 
+                                                                          !!   grid point
+    REAL(r_std), DIMENSION(npt,2), INTENT(in)            :: latlon        !! longitude and latitude of the destiny
+                                                                          !!   grid points
+    REAL(r_std), INTENT(in)                              :: defaultval    !! default interpolated value, only usef if tint='default'
+    REAL(r_std), INTENT(in)                              :: defaultNOval  !! default interpolated NO value, only used if tint='slopecalc'
+    !! 0.2 Modified variables
+    REAL(r_std), INTENT(in)                              :: vmax, vmin    !! thresholds of the values
+    !! 0.3 Output variables
+    REAL(r_std), DIMENSION(npt), INTENT(out)             :: ovar          !! output variable (on the nbpt space)
+    REAL(r_std), DIMENSION(npt), INTENT(out)             :: aovar         !! availability of input data to 
+                                                                          !!   interpolate output variable (on 
+                                                                          !!   the nbpt space)
+                                                                          !!     >0.: As the total sum of the 
+                                                                          !!       space fraction used from the 
+                                                                          !!       source
+                                                                          !!     -1: Found any required values 
+                                                                          !!       from input data
+    !! 0.4 Local variables
+    INTEGER                                              :: i,j,k,ij,ib,idi,jj,ip,jp,jv,it
+    INTEGER                                              :: idi_last
+    REAL(r_std)                                          :: int1D
+    CHARACTER(LEN=250)                                   :: msg
+
+
+! Initialization
+!!
+    ovar = zeroval
+
+    SELECT CASE (tint)
+      CASE ('default')
+        IF (printlev>=3) WRITE(numout,*)'Fractions following default method'
+        IF (ALL(ivar2D == zeroval)) THEN
+          msg = "' wrong 2D input variable"
+          CALL ipslerr_p(3,'interpweight_provide_interpolation2D',"'" // TRIM(tint) // TRIM(msg),'','')
+        END IF
+
+        DO ib = 1, npt
+          !-
+          !- Reinfiltration coefficient due to the slope: Calculation with parameteres maxlope_ro 
+          !-
+          int1D = zeroval
+
+          ! Initialize last index to the highest possible 
+          idi_last=nbmax
+          aovar(ib) = zero
+          DO idi=1, nbmax
+             ! Leave the do loop if all sub areas are treated, sub_area <= 0
+             IF ( sarea(ib,idi) <= zeroval ) THEN
+                ! Set last index to the last one used
+                idi_last=idi-1
+                ! Exit do loop
+                EXIT
+             END IF
+
+             ip = sindex(ib,idi,1)
+             jp = sindex(ib,idi,2)
+
+             int1D = int1D + ivar2D(ip,jp) * sarea(ib,idi)
+             aovar(ib) = aovar(ib) + sarea(ib,idi)
+          ENDDO
+
+          IF ( idi_last >= 1 ) THEN
+             ovar(ib) = int1D / aovar(ib)
+          ELSE
+             ovar(ib) = defaultval
+            !
+            ! Quality variable
+            aovar(ib) = -1.
+          ENDIF
+        ENDDO
+      CASE ('slopecalc')
+        IF (printlev>=3) WRITE(numout,*)'Fractions following slopecalc method'
+        IF (ALL(ivar2D == zeroval)) THEN
+          msg = "' requires a 2D input variable"
+          CALL ipslerr_p(3,'interpweight_provide_interpolation2D',"'" // TRIM(tint) // TRIM(msg),'','')
+        END IF
+
+        DO ib = 1, npt
+          !-
+          !- Reinfiltration coefficient due to the slope: Calculation with parameteres maxlope_ro 
+          !-
+          int1D = zeroval
+
+          ! Initialize last index to the highest possible 
+          idi_last=nbmax
+          aovar(ib) = zero
+          DO idi=1, nbmax
+             ! Leave the do loop if all sub areas are treated, sub_area <= 0
+             IF ( sarea(ib,idi) <= zeroval ) THEN
+                ! Set last index to the last one used
+                idi_last=idi-1
+                ! Exit do loop
+                EXIT
+             END IF
+
+             ip = sindex(ib,idi,1)
+             jp = sindex(ib,idi,2)
+
+             int1D = int1D + MIN(ivar2D(ip,jp)/defaultNOval,un) * sarea(ib,idi)
+             aovar(ib) = aovar(ib) + sarea(ib,idi)
+          ENDDO
+
+          IF ( idi_last >= 1 ) THEN
+             ovar(ib) = un - int1D / aovar(ib)
+          ELSE
+             ovar(ib) = defaultval
+            !
+            ! Quality variable
+            aovar(ib) = -1.
+          ENDIF
+        ENDDO
+
+      CASE DEFAULT
+        CALL ipslerr_p(3,'interpweight_provide_interpolation2D',"Inerpolation type '" // TRIM(tint) // "' not ready!",'','')
+    END SELECT
+
+  END SUBROUTINE interpweight_provide_interpolation2D
+
+!! ================================================================================================================================
+!! SUBROUTINE   : interpweight_provide_interpolation4D
+!!
+!>\BRIEF        ! perform the interpolation for a continuos 4D field
+!!
+!! DESCRIPTION  : (definitions, functional, design, flags): 
+!!
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): ovar, aovar
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  SUBROUTINE interpweight_provide_interpolation4D(tint, npt, d1, d2, dx, dy, d3, d4,                  &
+    nbmax, zeroval, ivar4D, sarea, sindex, vmax, vmin, one, two, latlon,                              &
+    defaultval, defaultNOval, ovar, aovar)
+
+    USE constantes_var
+
+    IMPLICIT NONE
+
+    !! 0. Variables and parameter declaration
+    !! 0.1 Input variables
+    CHARACTER(LEN=50), INTENT(in)                        :: tint          !! tint: type of interpolation
+                                                                          !!   'XYKindTime': Input values are kinds 
+                                                                          !!     of something with a temporal 
+                                                                          !!     evolution on the dx*dy matrix
+    INTEGER, INTENT(in)                                  :: npt           !! total number of grid points
+    INTEGER, INTENT(in)                                  :: d1, d2, d3, & !! shape of the input values
+      d4, dx, dy
+    INTEGER, INTENT(in)                                  :: nbmax         !! maximum input grid cells to use 
+                                                                          !!   for in 1 grid point
+    REAL(r_std), INTENT(in)                              :: zeroval,two,one  !! zero 1. and 2. real values
+    REAL(r_std), DIMENSION(dx,dy,d3,d4), INTENT(in)      :: ivar4D        !! values of the input data
+    REAL(r_std), DIMENSION(npt,nbmax), INTENT(in)        :: sarea         !! overlaping area of a given input 
+                                                                          !!   grid point
+    INTEGER(i_std), DIMENSION(npt,nbmax,2), INTENT(in)   :: sindex        !! index of the overlaping input 
+                                                                          !!   grid point
+    REAL(r_std), DIMENSION(npt,2), INTENT(in)            :: latlon        !! longitude and latitude of the destiny
+                                                                          !!   grid points
+    REAL(r_std), DIMENSION(d1,d2), INTENT(in)            :: defaultval    !! default interpolated value
+    REAL(r_std), INTENT(in)                              :: defaultNOval  !! default interpolated NO value
+    !! 0.2 Modified variables
+    REAL(r_std), INTENT(in)                              :: vmax, vmin    !! thresholds of the values
+    !! 0.3 Output variables
+    REAL(r_std), DIMENSION(npt,d1,d2), INTENT(out)       :: ovar          !! output variable (on the nbpt space)
+    REAL(r_std), DIMENSION(npt), INTENT(out)             :: aovar         !! availability of input data to 
+                                                                          !!   interpolate output variable (on 
+                                                                          !!   the nbpt space)
+                                                                          !!     >0.: As the total sum of the 
+                                                                          !!       space fraction used from the 
+                                                                          !!       source
+                                                                          !!     -1: Found any required values 
+                                                                          !!       from input data
+    !! 0.4 Local variables
+    INTEGER                                              :: i,j,k,ij,ib,idi,jj,ip,jp,jv,it
+    INTEGER                                              :: ilf, fopt
+    REAL(r_std)                                          :: totarea
+    CHARACTER(LEN=250)                                   :: msg
+! Debug
+    INTEGER                                              :: nbptlL
+    REAL(r_std), DIMENSION(npt,d1,d2)                    :: ovartst
+
+
+! Initialization
+!!
+    ovar = zero
+    ovartst = zero
+
+    SELECT CASE (tint)
+      CASE ('default')
+        IF (printlev>=3) WRITE(numout,*)'Fractions following default method'
+        IF ( ALL(ivar4D == zeroval) ) THEN
+          msg = "' wrong 4D input variable"
+          CALL ipslerr_p(3,'provide_interpolation4D',"'" // TRIM(tint) // TRIM(msg),'','')
+        END IF
+
+        DO ib = 1, npt
+
+          fopt = COUNT(sarea(ib,:) > zero)
+          aovar(ib) = zero
+
+          IF ( fopt > 0 ) THEN
+            !-
+            !- Reinfiltration coefficient
+            !-
+            totarea = zeroval
+ 
+            DO ilf=1, fopt
+               ! Leave the do loop if all sub areas are treated, sub_area <= 0
+               ip = sindex(ib,ilf,1)
+               jp = sindex(ib,ilf,2)
+
+               DO jv=1,d1
+                 DO it=1,d2
+                   ovar(ib,jv,it) = ovar(ib,jv,it) + ivar4D(ip,jp,jv,it)*sarea(ib,ilf)
+                 END DO
+               END DO
+               totarea = totarea + sarea(ib,ilf)
+            ENDDO
+            ! Normalize
+            ovar(ib,:,:) = ovar(ib,:,:)/totarea
+            aovar(ib) = totarea
+          ELSE
+        ! Set defalut value for points where the interpolation fail
+            IF (printlev>=3) THEN
+               WRITE(numout,*) 'provide_interpolation4D: no point found !!'
+               WRITE(numout,*) 'On point ', ib, ' no points were found for interpolation data. ' //      &
+                    'Default values are used.'
+               WRITE(numout,*) 'Location : ', latlon(ib,2), latlon(ib,1)
+            END IF
+            ovar(ib,ivis,:) = defaultval(ivis,:)
+            ovar(ib,inir,:) = defaultval(inir,:) 
+            aovar(ib) = -un
+          END IF
+        ENDDO
+
+      CASE DEFAULT
+        CALL ipslerr_p(3,'provide_interpolation4D',"Inerpolation type '" // TRIM(tint) // "' not ready!",'','')
+    END SELECT
+
+  END SUBROUTINE interpweight_provide_interpolation4D
+
+
+!!================================================================================================================================
+!! FUNCTION     : interpweight_get_var2dims_file
+!!
+!>\BRIEF        ! Function to get the dimensions of a given 2D variable inside a file
+!!
+!! DESCRIPTION : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : interpweight_get_var2dims_file
+!!
+!! REFERENCE(S) : See above, module description.
+!!
+!! FLOWCHART    : None
+!! \n
+!_================================================================================================================================
+  FUNCTION interpweight_get_var2dims_file(filename, varname)
+
+    USE netcdf
+
+    IMPLICIT NONE
+
+    !! 0. Variables and parameter declaration
+    !! 0.1 Input variables
+    CHARACTER(LEN=*), INTENT(in)                         :: filename      !! filename: name of the file to open
+    CHARACTER(LEN=*), INTENT(in)                         :: varname       !! varname: name of the variable 
+    !! 0.2 Modified variables
+    !! 0.3 Output variables
+! Following: http://stackoverflow.com/questions/3828094/function-returning-an-array-in-fortran
+    INTEGER, DIMENSION(2)                                :: interpweight_get_var2dims_file
+    !! 0.4 Local variables
+    INTEGER                                              :: nid, vid, Ndims
+    INTEGER                                              :: rcode
+    INTEGER, DIMENSION(2)                                :: dimsid
+    CHARACTER(LEN=250)                                   :: msg
+
+
+    IF (LEN_TRIM(varname) < 1) THEN
+      msg = "  interpweight_get_var2dims_file: any variable name '" // TRIM(varname) // "' was provided !!"
+      CALL ipslerr_p(3,'interpweight_get_var2dims_file',TRIM(msg), '', '')
+    END IF
+
+    IF (is_root_prc) THEN
+       ! Open file for read only mode
+       rcode = nf90_open(TRIM(filename), NF90_NOWRITE, nid)
+       IF (rcode /= NF90_NOERR) CALL ipslerr_p(3, 'interpweight_get_var2dims_file', 'Error in ng90_open', &
+            TRIM(nf90_strerror(rcode)),'')
+
+       rcode = nf90_inq_varid(nid, varname, vid)
+       IF (rcode /= NF90_NOERR) CALL ipslerr_p(3, 'interpweight_get_var2dims_file', 'Error in ng90_inq_varid', &
+            TRIM(nf90_strerror(rcode)),'')
+
+       rcode = nf90_inquire_variable(nid, vid, NDIMS = Ndims)
+       IF (rcode /= NF90_NOERR) CALL ipslerr_p(3, 'interpweight_get_var2dims_file', 'Error in ng90_inquire_variable 1', &
+            TRIM(nf90_strerror(rcode)),'')
+       
+       IF (Ndims /= 2) THEN
+          msg = "variable '" // TRIM(varname) // "' has not 2 dimensions!!"
+          CALL ipslerr_p(3,'interpweight_get_var2dims_file',TRIM(msg), '', '')
+       END IF
+       
+       rcode = nf90_inquire_variable(nid, vid, DIMIDS = dimsid)
+       IF (rcode /= NF90_NOERR) CALL ipslerr_p(3, 'interpweight_get_var2dims_file', 'Error in ng90_inquire_variable 2', &
+            TRIM(nf90_strerror(rcode)),'')
+       
+       rcode = nf90_inquire_dimension(nid, dimsid(1), LEN = interpweight_get_var2dims_file(1))
+       IF (rcode /= NF90_NOERR) CALL ipslerr_p(3, 'interpweight_get_var2dims_file', 'Error in ng90_inquire_dimension 1', &
+            TRIM(nf90_strerror(rcode)),'')
+       
+       rcode = nf90_inquire_dimension(nid, dimsid(2), LEN = interpweight_get_var2dims_file(2))
+       IF (rcode /= NF90_NOERR) CALL ipslerr_p(3, 'interpweight_get_var2dims_file', 'Error in ng90_inquire_dimension 2', &
+            TRIM(nf90_strerror(rcode)),'')
+       
+       rcode = NF90_CLOSE(nid)
+       IF (rcode /= NF90_NOERR) CALL ipslerr_p(3, 'interpweight_get_var2dims_file', 'Error in ng90_close', &
+            TRIM(nf90_strerror(rcode)),'')
+    END IF
+
+    CALL bcast(interpweight_get_var2dims_file)
+
+  END FUNCTION interpweight_get_var2dims_file
+
+!!================================================================================================================================
+!! FUNCTION     : interpweight_get_var3dims_file
+!!
+!>\BRIEF        ! Function to get the dimensions of a given 3D variable inside a file
+!!
+!! DESCRIPTION : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : interpweight_get_var3dims_file
+!!
+!! REFERENCE(S) : See above, module description.
+!!
+!! FLOWCHART    : None
+!! \n
+!_================================================================================================================================
+  FUNCTION interpweight_get_var3dims_file(filename, varname)
+
+    USE netcdf
+
+    IMPLICIT NONE
+
+    !! 0. Variables and parameter declaration
+    !! 0.1 Input variables
+    CHARACTER(LEN=*), INTENT(in)                         :: filename      !! filename: name of the file to open
+    CHARACTER(LEN=*), INTENT(in)                         :: varname       !! varname: name of the variable 
+    !! 0.2 Modified variables
+    !! 0.3 Output variables
+    INTEGER, DIMENSION(3)                                :: interpweight_get_var3dims_file
+    !! 0.4 Local variables
+    INTEGER                                              :: nid, vid, Ndims
+    INTEGER                                              :: rcode
+    INTEGER, DIMENSION(3)                                :: dimsid
+    CHARACTER(LEN=250)                                   :: msg
+
+
+    IF (LEN_TRIM(varname) < 1) THEN
+      msg = "  interpweight_get_var3dims_file: any variable name '" // TRIM(varname) // "' was provided !!"
+      CALL ipslerr_p(3,'interpweight_get_var3dims_file',TRIM(msg), '', '')
+    END IF
+
+    IF (is_root_prc) THEN
+       ! Open file for read only mode
+       rcode = nf90_open(TRIM(filename), NF90_NOWRITE, nid)
+       IF (rcode /= NF90_NOERR) CALL ipslerr_p(3,'interpweight_get_var3dims_file', 'Error in ng90_open', &
+            TRIM(nf90_strerror(rcode)),'')
+       
+       rcode = nf90_inq_varid(nid, varname, vid)
+       IF (rcode /= NF90_NOERR) CALL ipslerr_p(3,'interpweight_get_var3dims_file', 'Error in ng90_inq_varid', &
+            TRIM(nf90_strerror(rcode)),'')
+
+       rcode = nf90_inquire_variable(nid, vid, NDIMS = Ndims)
+       IF (rcode /= NF90_NOERR) CALL ipslerr_p(3,'interpweight_get_var3dims_file', 'Error in ng90_inquire_variable 1', &
+            TRIM(nf90_strerror(rcode)),'')
+       
+       IF (Ndims /= 3) THEN
+          msg = "variable '" // TRIM(varname) // "' has not 3 dimensions!!"
+          CALL ipslerr_p(3,'interpweight_get_var3dims_file',TRIM(msg), '', '')
+       END IF
+       
+       rcode = nf90_inquire_variable(nid, vid, DIMIDS = dimsid)
+       IF (rcode /= NF90_NOERR) CALL ipslerr_p(3,'interpweight_get_var3dims_file', 'Error in ng90_inquire_variable 2', &
+            TRIM(nf90_strerror(rcode)),'')
+       
+       rcode = nf90_inquire_dimension(nid, dimsid(1), LEN = interpweight_get_var3dims_file(1))
+       IF (rcode /= NF90_NOERR) CALL ipslerr_p(3,'interpweight_get_var3dims_file', 'Error in ng90_dimesion 1', &
+            TRIM(nf90_strerror(rcode)),'')
+       
+       rcode = nf90_inquire_dimension(nid, dimsid(2), LEN = interpweight_get_var3dims_file(2))
+       IF (rcode /= NF90_NOERR) CALL ipslerr_p(3,'interpweight_get_var3dims_file', 'Error in ng90_dimension 2', &
+            TRIM(nf90_strerror(rcode)),'')
+       
+       rcode = nf90_inquire_dimension(nid, dimsid(3), LEN = interpweight_get_var3dims_file(3))
+       IF (rcode /= NF90_NOERR) CALL ipslerr_p(3,'interpweight_get_var3dims_file', 'Error in ng90_dimension 3', &
+            TRIM(nf90_strerror(rcode)),'')
+       
+       rcode = NF90_CLOSE(nid)
+       IF (rcode /= NF90_NOERR) CALL ipslerr_p(3,'interpweight_get_var3dims_file', 'Error in ng90_close', &
+            TRIM(nf90_strerror(rcode)),'')
+    END IF
+    CALL bcast(interpweight_get_var3dims_file)
+
+  END FUNCTION interpweight_get_var3dims_file
+
+!!================================================================================================================================
+!! FUNCTION     : interpweight_get_var4dims_file
+!!
+!>\BRIEF        ! Function to get the dimensions of a given 4D variable inside a file
+!!
+!! DESCRIPTION : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : interpweight_get_var4dims_file
+!!
+!! REFERENCE(S) : See above, module description.
+!!
+!! FLOWCHART    : None
+!! \n
+!_================================================================================================================================
+  FUNCTION interpweight_get_var4dims_file(filename, varname)
+
+    USE netcdf
+
+    IMPLICIT NONE
+
+    !! 0. Variables and parameter declaration
+    !! 0.1 Input variables
+    CHARACTER(LEN=*), INTENT(in)                         :: filename      !! filename: name of the file to open
+    CHARACTER(LEN=*), INTENT(in)                         :: varname       !! varname: name of the variable 
+    !! 0.2 Modified variables
+    !! 0.3 Output variables
+    INTEGER, DIMENSION(4)                                :: interpweight_get_var4dims_file
+    !! 0.4 Local variables
+    INTEGER                                              :: nid, vid, Ndims
+    INTEGER                                              :: rcode
+    INTEGER, DIMENSION(4)                                :: dimsid
+    CHARACTER(LEN=250)                                   :: msg
+
+    IF (LEN_TRIM(varname) < 1) THEN
+      msg = "  interpweight_get_var4dims_file: any variable name '" // TRIM(varname) // "' was provided !!"
+      CALL ipslerr_p(3,'interpweight_get_var4dims_file',TRIM(msg), '', '')
+    END IF
+
+    IF (is_root_prc) THEN
+       ! Open file for read only mode
+       rcode = nf90_open(TRIM(filename), NF90_NOWRITE, nid)
+       IF (rcode /= NF90_NOERR) CALL ipslerr_p(3,'interpweight_get_var4dims_file','Problem with nf90_open', &
+            TRIM(nf90_strerror(rcode)),'')
+       
+       rcode = nf90_inq_varid(nid, varname, vid)
+       IF (rcode /= NF90_NOERR) CALL ipslerr_p(3,'interpweight_get_var4dims_file','Problem with nf90_inq_varid', &
+            TRIM(nf90_strerror(rcode)),'')
+
+       rcode = nf90_inquire_variable(nid, vid, NDIMS = Ndims)
+       IF (rcode /= NF90_NOERR) CALL ipslerr_p(3,'interpweight_get_var4dims_file','Problem with nf90_inquire_variable 1', &
+            TRIM(nf90_strerror(rcode)),'')
+
+       IF (Ndims /= 4) THEN
+          msg = "variable '" // TRIM(varname) // "' has not 4 dimensions!!"
+          CALL ipslerr_p(3,'interpweight_get_var4dims_file',TRIM(msg), '', '')
+       END IF
+
+       rcode = nf90_inquire_variable(nid, vid, DIMIDS = dimsid)
+       IF (rcode /= NF90_NOERR) CALL ipslerr_p(3,'interpweight_get_var4dims_file','Problem with nf90_inquire_variable 2', &
+            TRIM(nf90_strerror(rcode)),'')
+       
+       rcode = nf90_inquire_dimension(nid, dimsid(1), LEN = interpweight_get_var4dims_file(1))
+       IF (rcode /= NF90_NOERR) CALL ipslerr_p(3,'interpweight_get_var4dims_file','Problem with nf90_inquire_dimension 1', &
+            TRIM(nf90_strerror(rcode)),'')
+       
+       rcode = nf90_inquire_dimension(nid, dimsid(2), LEN = interpweight_get_var4dims_file(2))
+       IF (rcode /= NF90_NOERR) CALL ipslerr_p(3,'interpweight_get_var4dims_file','Problem with nf90_inquire_dimension 2', &
+            TRIM(nf90_strerror(rcode)),'')
+
+       rcode = nf90_inquire_dimension(nid, dimsid(3), LEN = interpweight_get_var4dims_file(3))
+       IF (rcode /= NF90_NOERR) CALL ipslerr_p(3,'interpweight_get_var4dims_file','Problem with nf90_inquire_dimension 3', &
+            TRIM(nf90_strerror(rcode)),'')
+       
+       rcode = nf90_inquire_dimension(nid, dimsid(4), LEN = interpweight_get_var4dims_file(4))
+       IF (rcode /= NF90_NOERR) CALL ipslerr_p(3,'interpweight_get_var4dims_file','Problem with nf90_inquire_dimension 4', &
+            TRIM(nf90_strerror(rcode)),'')
+
+       rcode = NF90_CLOSE(nid)
+       IF (rcode /= NF90_NOERR) CALL ipslerr_p(3,'interpweight_get_var4dims_file','Problem with nf90_close', &
+            TRIM(nf90_strerror(rcode)),'')
+    END iF
+    CALL bcast(interpweight_get_var4dims_file)
+
+  END FUNCTION interpweight_get_var4dims_file
+
+!!================================================================================================================================
+!! FUNCTION     : interpweight_get_varNdims_file
+!!
+!>\BRIEF        ! Function to get the rank(number of dimensions) of a given variable inside a file
+!!
+!! DESCRIPTION : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : interpweight_get_varNdims_file
+!!
+!! REFERENCE(S) : See above, module description.
+!!
+!! FLOWCHART    : None
+!! \n
+!_================================================================================================================================
+  INTEGER FUNCTION interpweight_get_varNdims_file(filename, varname)
+
+    USE netcdf
+
+    IMPLICIT NONE
+
+    !! 0. Variables and parameter declaration
+    !! 0.1 Input variables
+    CHARACTER(LEN=*), INTENT(in)                         :: filename      !! filename: name of the file to open
+    CHARACTER(LEN=*), INTENT(in)                         :: varname       !! varname: name of the variable 
+    !! 0.2 Modified variables
+    !! 0.3 Output variables
+    !! 0.4 Local variables
+    INTEGER                                              :: nid, vid
+    INTEGER                                              :: rcode
+    CHARACTER(LEN=256)                                   :: msg
+
+
+    IF (LEN_TRIM(varname) < 1) THEN
+      msg = "  interpweight_get_varNdims_file: any variable name '" // TRIM(varname) // "' was provided !!"
+      CALL ipslerr_p(3,'interpweight_get_varNdims_file',TRIM(msg), '', '')
+    END IF
+
+    IF (is_root_prc) THEN
+       
+       ! Open file for read only mode
+       rcode = nf90_open(TRIM(filename), NF90_NOWRITE, nid)
+       IF (rcode /= NF90_NOERR) CALL ipslerr_p(3,'interpweight_get_varNdims_file','Problem with nf90_open', &
+            TRIM(nf90_strerror(rcode)), '')
+       
+       rcode = nf90_inq_varid(nid, varname, vid)
+       IF (rcode /= NF90_NOERR) CALL ipslerr_p(3,'interpweight_get_varNdims_file','Problem with nf90_inq_varid', &
+            TRIM(nf90_strerror(rcode)), '')
+       
+       rcode = nf90_inquire_variable(nid, vid, NDIMS = interpweight_get_varNdims_file)
+       IF (rcode /= NF90_NOERR) CALL ipslerr_p(3,'interpweight_get_varNdims_file','Problem with nf90_inquire_variable', &
+            TRIM(nf90_strerror(rcode)), '')
+
+       rcode = NF90_CLOSE(nid)
+       IF (rcode /= NF90_NOERR) CALL ipslerr_p(3,'interpweight_get_varNdims_file','Problem with nf90_close', &
+            TRIM(nf90_strerror(rcode)), '')
+    END IF
+    CALL bcast(interpweight_get_varNdims_file)
+
+  END FUNCTION interpweight_get_varNdims_file
+
+!!================================================================================================================================
+!! FUNCTION     : isin_file
+!!
+!>\BRIEF        ! Function to tell if a given variable is inside a file
+!!
+!! DESCRIPTION : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : isin_file
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART    : None
+!! \n
+!_================================================================================================================================
+LOGICAL FUNCTION isin_file(filename, varname)
+
+    USE netcdf
+
+    IMPLICIT NONE
+
+    !! 0. Variables and parameter declaration
+    !! 0.1 Input variables
+    CHARACTER(LEN=*), INTENT(in)                         :: filename      !! filename: name of the file to open
+    CHARACTER(LEN=*), INTENT(in)                         :: varname       !! varname: name of the variable 
+    !! 0.2 Modified variables
+    !! 0.3 Output variables
+    !! 0.4 Local variables
+    INTEGER                                              :: nid, vid, Ndims, Nvars
+    INTEGER                                              :: iv, rcode
+    CHARACTER(LEN=1000)                                  :: varinfile
+    CHARACTER(LEN=250)                                   :: msg
+
+
+    IF (is_root_prc) THEN
+       rcode = nf90_open(TRIM(filename), NF90_NOWRITE, nid)
+       IF (rcode /= NF90_NOERR) CALL ipslerr_p(3,'isin_file','Problem with nf90_open',TRIM(nf90_strerror(rcode)),'')
+
+       rcode = nf90_inquire(nid, Ndims, Nvars)
+       IF (rcode /= NF90_NOERR) CALL ipslerr_p(3,'isin_file','Problem with nf90_inquire',TRIM(nf90_strerror(rcode)),'')
+
+       DO iv=1, Nvars
+          rcode = nf90_inquire_variable(nid, iv, name=varinfile)
+          IF (rcode /= NF90_NOERR) CALL ipslerr_p(3,'isin_file','Problem with nf90_inquire_variable',TRIM(nf90_strerror(rcode)),'')
+          
+          IF (TRIM(varinfile) == TRIM(varname)) THEN
+             isin_file = .TRUE.
+             EXIT
+          ELSE
+             isin_file = .FALSE.
+          END IF
+       END DO
+
+       rcode = NF90_CLOSE(nid)
+       IF (rcode /= NF90_NOERR) CALL ipslerr_p(3,'isin_file','Problem with nf90_close',TRIM(nf90_strerror(rcode)),'')
+    END IF
+
+    CALL bcast(isin_file)
+
+  END FUNCTION isin_file
+
+!!!!!!! !!!!!! !!!!! !!!! !!! !! !
+! Generic functions no netCDF
+
+!!================================================================================================================================
+!! FUNCTION     : interpweight_Index1DArrayI
+!!
+!>\BRIEF        ! Function to provide the first index of a given value inside a 1D intger array
+!!
+!! DESCRIPTION : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : interpweight_Index1DArrayI
+!!
+!! REFERENCE(S) : See above, module description.
+!!
+!! FLOWCHART    : None
+!! \n
+!_================================================================================================================================
+  INTEGER FUNCTION interpweight_Index1DArrayI(array1D, d1, val)
+
+    IMPLICIT NONE
+
+    !! 0. Variables and parameter declaration
+    !! 0.1 Input variables
+    INTEGER, INTENT(in)                                  :: d1            !! size of the array
+    INTEGER, INTENT(in)                                  :: val           !! value to search
+    INTEGER, DIMENSION(d1), INTENT(in)                   :: array1D       !! values of the array
+    !! 0.2 Modified variables
+    !! 0.3 Output variables
+    !! 0.4 Local variables
+    INTEGER                                              :: i
+
+
+    interpweight_Index1DArrayI = -1
+
+    DO i=1,d1
+      IF (array1d(i) == val) THEN
+        interpweight_Index1DArrayI = i
+        EXIT
+      END IF
+    END DO
+
+  END FUNCTION interpweight_Index1DArrayI
+
+!!================================================================================================================================
+!! FUNCTION     : interpweight_Index1DArrayR
+!!
+!>\BRIEF        ! Function to provide the first index of a given value inside a 1D real array
+!!
+!! DESCRIPTION : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : interpweight_Index1DArrayR
+!!
+!! REFERENCE(S) : See above, module description.
+!!
+!! FLOWCHART    : None
+!! \n
+!_================================================================================================================================
+  INTEGER FUNCTION interpweight_Index1DArrayR(array1D, d1, val)
+
+    IMPLICIT NONE
+
+    !! 0. Variables and parameter declaration
+    !! 0.1 Input variables
+    INTEGER, INTENT(in)                                  :: d1            !! size of the array 
+    REAL, INTENT(in)                                     :: val           !! value to search
+    REAL, DIMENSION(d1), INTENT(in)                      :: array1D       !! values of the array
+    !! 0.2 Modified variables
+    !! 0.3 Output variables
+    !! 0.4 Local variables
+    INTEGER                                              :: i
+
+    interpweight_Index1DArrayR = -1
+
+    DO i=1,d1
+      IF (array1d(i) == val) THEN
+        interpweight_Index1DArrayR = i
+        EXIT
+      END IF
+    END DO
+
+  END FUNCTION interpweight_Index1DArrayR
+
+!!================================================================================================================================
+!! FUNCTION     : interpweight_Index2DArrayI
+!!
+!>\BRIEF        ! Function to provide the first index of a given value inside a 2D integer array
+!!
+!! DESCRIPTION : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : interpweight_Index2DArrayI
+!!
+!! REFERENCE(S) : See above, module description.
+!!
+!! FLOWCHART    : None
+!! \n
+!_================================================================================================================================
+  FUNCTION interpweight_Index2DArrayI(array2D, d1, d2, val)
+
+    IMPLICIT NONE
+
+    !! 0. Variables and parameter declaration
+    !! 0.1 Input variables
+    INTEGER, INTENT(in)                                  :: d1, d2        !! size of the array 
+    INTEGER, INTENT(in)                                  :: val           !! value to search
+    INTEGER, DIMENSION(d1,d2), INTENT(in)                :: array2D       !! values of the array
+    !! 0.2 Modified variables
+    !! 0.3 Output variables
+    INTEGER, DIMENSION(2)                                :: interpweight_Index2DArrayI
+    !! 0.4 Local variables
+    INTEGER                                              :: i, j
+
+
+    interpweight_Index2DArrayI = -1
+
+    DO i=1,d1
+      DO j=1,d2
+        IF (array2d(i,j) == val) THEN
+          interpweight_Index2DArrayI(1) = i
+          interpweight_Index2DArrayI(2) = j
+          EXIT
+        END IF
+      END DO
+    END DO
+
+  END FUNCTION interpweight_Index2DArrayI
+
+!!================================================================================================================================
+!! FUNCTION     : interpweight_Index2DArrayR
+!!
+!>\BRIEF        ! Function to provide the first index of a given value inside a 2D real array
+!!
+!! DESCRIPTION : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : bm_vol
+!!
+!! REFERENCE(S) : See above, module description.
+!!
+!! FLOWCHART    : None
+!! \n
+!_================================================================================================================================
+  FUNCTION interpweight_Index2DArrayR(array2D, d1, d2, val)
+
+    IMPLICIT NONE
+
+    !! 0. Variables and parameter declaration
+    !! 0.1 Input variables
+    INTEGER, INTENT(in)                                  :: d1, d2        !! size of the array 
+    REAL, INTENT(in)                                     :: val           !! value to search
+    REAL, DIMENSION(d1,d2), INTENT(in)                   :: array2D       !! values of the array
+    !! 0.2 Modified variables
+    !! 0.3 Output variables
+    INTEGER, DIMENSION(2)                                :: interpweight_Index2DArrayR
+    !! 0.4 Local variables
+    INTEGER                                              :: i, j
+
+    interpweight_Index2DArrayR = -1
+
+    DO i=1,d1
+      DO j=1,d2
+        IF (array2d(i,j) == val) THEN
+          interpweight_Index2DArrayR(1) = i
+          interpweight_Index2DArrayR(2) = j
+          EXIT
+        END IF
+      END DO
+    END DO
+
+  END FUNCTION interpweight_Index2DArrayR
+
+!!================================================================================================================================
+!! FUNCTION     : interpweight_Index1DLonLat
+!!
+!>\BRIEF        ! Function to provide the first index of a given pair of 
+!! longitude and latitude from a set of lon, lat 1D arrays
+!!
+!! DESCRIPTION : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : interpweight_Index1DLonLat
+!!
+!! REFERENCE(S) : See above, module description.
+!!
+!! FLOWCHART    : None
+!! \n
+!_================================================================================================================================
+  INTEGER FUNCTION interpweight_Index1DLonLat(lon, lat, d1, lonval, latval)
+
+    USE constantes_var
+
+    IMPLICIT NONE
+
+    !! 0. Variables and parameter declaration
+    !! 0.1 Input variables
+    INTEGER, INTENT(in)                                  :: d1            !! size of the array 
+    REAL(r_std), INTENT(in)                              :: lonval,latval !! longitude and latitude value
+    REAL(r_std), DIMENSION(d1), INTENT(in)               :: lon, lat      !! longitude and latitudes to search in
+    !! 0.2 Modified variables
+    !! 0.3 Output variables
+    !! 0.4 Local variables
+    INTEGER                                              :: i
+    REAL(r_std)                                          :: mindist
+    REAL(r_std), DIMENSION(d1)                           :: dist
+
+
+    interpweight_Index1DLonLat = -1
+
+    dist = SQRT((lon - lonval)**2. + (lat - latval)**2.)
+!    mindist = MINVAL(ABS(dist))
+    mindist = 0.
+
+    DO i=1,d1
+      IF (dist(i) == mindist) THEN
+        interpweight_Index1DLonLat = i
+        EXIT
+      END IF
+    END DO
+
+  END FUNCTION interpweight_Index1DLonLat
+
+!!================================================================================================================================
+!! FUNCTION     : interpweight_Index2DLonLat
+!!
+!>\BRIEF          Function to provide the first index of a given pair of longitude and latitude
+!!                from a set of lon, lat 2D arrays
+!!
+!!
+!! DESCRIPTION : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : interpweight_Index2DLonLat
+!!
+!! REFERENCE(S) : See above, module description.
+!!
+!! FLOWCHART    : None
+!! \n
+!_================================================================================================================================
+  FUNCTION interpweight_Index2DLonLat(lon, lat, d1, d2, lonval, latval)
+
+    USE constantes_var
+
+    IMPLICIT NONE
+
+    !! 0. Variables and parameter declaration
+    !! 0.1 Input variables
+    INTEGER, INTENT(in)                                  :: d1, d2        !! size of the array 
+    REAL(r_std), INTENT(in)                              :: lonval,latval !! longitude and latitude value
+    REAL(r_std), DIMENSION(d1,d2), INTENT(in)            :: lon, lat      !! longitude and latitudes to search in
+    !! 0.2 Modified variables
+    !! 0.3 Output variables
+    INTEGER, DIMENSION(2)                                :: interpweight_Index2DLonLat
+    !! 0.4 Local variables
+    INTEGER                                              :: i, j
+    REAL(r_std)                                          :: mindist
+    REAL(r_std), DIMENSION(d1,d2)                        :: dist
+
+
+    interpweight_Index2DLonLat = -1
+
+    dist = SQRT((lon - lonval)**2. + (lat - latval)**2.)
+    mindist = 0.
+
+    DO i=1,d1
+      DO j=1,d2
+        IF (dist(i,j) == mindist) THEN
+          interpweight_Index2DLonLat(1) = i
+          interpweight_Index2DLonLat(2) = j
+          EXIT
+        END IF
+      END DO
+    END DO
+
+  END FUNCTION interpweight_Index2DLonLat
+
+!!================================================================================================================================
+!! FUNCTION     : interpweight_RangeI
+!!
+!>\BRIEF        ! Function to provide a range of d1 values from 'iniv' to 
+!!  'endv', of integer values in a vector
+!!
+!! DESCRIPTION : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : interpweight_RangeI
+!!
+!! REFERENCE(S) : See above, module description.
+!!
+!! FLOWCHART    : None
+!! \n
+!_================================================================================================================================
+  FUNCTION interpweight_RangeI(d1, iniv, endv)
+
+    IMPLICIT NONE
+
+    !! 0. Variables and parameter declaration
+    !! 0.1 Input variables
+    INTEGER, INTENT(in)                                  :: d1            !! number of values
+    INTEGER, INTENT(in)                                  :: iniv          !! initial value
+    INTEGER, INTENT(in)                                  :: endv          !! end value
+    !! 0.2 Modified variables
+    !! 0.3 Output variables
+    INTEGER, DIMENSION(d1)                               :: interpweight_RangeI
+    !! 0.4 Local variables
+    INTEGER                                              :: i, intv
+
+    intv = (endv - iniv) / (d1*1 - 1)
+
+    interpweight_RangeI(1) = iniv
+    DO i=2,d1
+      interpweight_RangeI(i) = interpweight_RangeI(i-1) + intv
+    END DO
+
+  END FUNCTION interpweight_RangeI 
+
+!!================================================================================================================================
+!! FUNCTION     : interpweight_RangeR
+!!
+!>\BRIEF        ! Function to provide a range of d1 values from 'iniv' to 
+!!  'endv', of real values in a vector
+!!
+!! DESCRIPTION : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : interpweight_RangeR
+!!
+!! REFERENCE(S) : See above, module description.
+!!
+!! FLOWCHART    : None
+!! \n
+!_================================================================================================================================
+  FUNCTION interpweight_RangeR(d1, iniv, endv)
+
+    IMPLICIT NONE
+
+    !! 0. Variables and parameter declaration
+    !! 0.1 Input variables
+    INTEGER, INTENT(in)                                  :: d1            !! number of values
+    REAL, INTENT(in)                                     :: iniv          !! initial value
+    REAL, INTENT(in)                                     :: endv          !! end value
+    !! 0.2 Modified variables
+    !! 0.3 Output variables
+    REAL, DIMENSION(d1)                                  :: interpweight_RangeR
+    !! 0.4 Local variables
+    INTEGER                                              :: i
+    REAL                                                 :: intv
+
+    intv = (endv - iniv) / (d1*1. - 1.)
+
+    interpweight_RangeR(1) = iniv
+    DO i=2,d1
+      interpweight_RangeR(i) = interpweight_RangeR(i-1) + intv
+    END DO
+
+  END FUNCTION interpweight_RangeR
+
+!!================================================================================================================================
+!! FUNCTION     : interpweight_ValVecI
+!!
+!>\BRIEF        ! Function to provide the number of times and where that a 
+!!  given value 'oper' on a vector of integers
+!!
+!! DESCRIPTION : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : interpweight_ValVecI
+!!
+!! REFERENCE(S) : See above, module description.
+!!
+!! FLOWCHART    : None
+!! \n
+!_================================================================================================================================
+  FUNCTION interpweight_ValVecI(vec, d1, val, oper)
+
+    IMPLICIT NONE
+
+    !! 0. Variables and parameter declaration
+    !! 0.1 Input variables
+    INTEGER, INTENT(in)                                  :: d1            !! Number of values
+    INTEGER, DIMENSION(d1), INTENT(in)                   :: vec           !! vector of integer values
+    INTEGER, INTENT(in)                                  :: val           !! value to search
+    CHARACTER(LEN=*), INTENT(in)                         :: oper          !! operation:
+                                                                          !!   'eq': equal
+                                                                          !!   'ge': greater or equal
+                                                                          !!   'le': less or equal
+                                                                          !!   'ne': not equal
+    !! 0.2 Modified variables
+    !! 0.3 Output variables
+    INTEGER, DIMENSION(d1)                               :: interpweight_ValVecI !! Vector with positions 
+                                                                                 !! (NtimesVal, pos1, pos2, ..., posNtimesVal, ...)
+                                                                                 !! NtimesVal=number of correspondencies with 'oper'
+    !! 0.4 Local variables
+    INTEGER                                              :: i, NtimesVal
+    CHARACTER(LEN=50)                                    :: errormsg
+
+    errormsg = 'ERROR -- error -- ERROR -- error'
+
+    NtimesVal = 0
+    DO i=1,d1
+      SELECT CASE(oper)
+        CASE ('eq')
+          IF (vec(i) == val) THEN
+            NtimesVal = NtimesVal + 1
+            IF (NtimesVal < d1) interpweight_ValVecI(NtimesVal + 1) = i
+          END IF
+        CASE ('ge')
+          IF (vec(i) >= val) THEN
+            NtimesVal = NtimesVal + 1
+            IF (NtimesVal < d1) interpweight_ValVecI(NtimesVal + 1) = i
+          END IF
+        CASE ('le')
+          IF (vec(i) <= val) THEN
+            NtimesVal = NtimesVal + 1
+            IF (NtimesVal < d1) interpweight_ValVecI(NtimesVal + 1) = i
+          END IF
+        CASE ('neq')
+          IF (vec(i) /= val) THEN
+            NtimesVal = NtimesVal + 1
+            IF (NtimesVal < d1) interpweight_ValVecI(NtimesVal + 1) = i
+          END IF
+        CASE DEFAULT
+          WRITE(numout,*)TRIM(errormsg)
+          WRITE(numout,*)"  interpweight_ValVecI: operation '" // TRIM(oper) // "' not ready!!"
+          WRITE(numout,*)"    only available: 'eq', 'ge', 'le', 'neq'"
+          CALL ipslerr_p (3, 'interpweight_ValVecI', 'wrong operation', 'provide another one', '')
+      END SELECT
+    END DO
+    interpweight_ValVecI(1) = NtimesVal
+
+
+  END FUNCTION interpweight_ValVecI
+
+!!================================================================================================================================
+!! FUNCTION     : interpweight_ValVecR
+!!
+!>\BRIEF         Function to provide the number of times and where that a 
+!!  given value 'oper' on a vector of reals
+!!
+!! DESCRIPTION : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : interpweight_ValVecR
+!!
+!! REFERENCE(S) : See above, module description.
+!!
+!! FLOWCHART    : None
+!! \n
+!_================================================================================================================================
+  FUNCTION interpweight_ValVecR(vec, d1, val, oper)
+
+    IMPLICIT NONE
+
+    !! 0. Variables and parameter declaration
+    !! 0.1 Input variables
+    INTEGER, INTENT(in)                                  :: d1            !! Number of values
+    REAL, DIMENSION(:), INTENT(in)                       :: vec           !! vector of integer values
+    REAL, INTENT(in)                                     :: val           !! value to search
+    CHARACTER(LEN=*), INTENT(in)                         :: oper          !! operation:
+                                                                          !!   'eq': equal
+                                                                          !!   'ge': greater or equal
+                                                                          !!   'le': less or equal
+                                                                          !!   'neq': not equal
+    !! 0.2 Modified variables
+    !! 0.3 Output variables
+    INTEGER, DIMENSION(d1)                               :: interpweight_ValVecR !! Vector with positions 
+                                                                                 !! (NtimesVal, pos1, pos2, ..., posNtimesVal, ...)
+                                                                                 !! NtimesVal=number of correspondencies with 'oper'
+    !! 0.4 Local variables
+    INTEGER                                              :: i, NtimesVal
+    CHARACTER(LEN=50)                                    :: errormsg
+
+    errormsg = 'ERROR -- error -- ERROR -- error'
+
+    NtimesVal = 0
+    DO i=1,d1
+      SELECT CASE(oper)
+        CASE ('eq')
+          IF (vec(i) == val) THEN
+            NtimesVal = NtimesVal + 1
+            IF (NtimesVal < d1) interpweight_ValVecR(NtimesVal + 1) = i
+          END IF
+        CASE ('ge')
+          IF (vec(i) >= val) THEN
+            NtimesVal = NtimesVal + 1
+            IF (NtimesVal < d1) interpweight_ValVecR(NtimesVal + 1) = i
+          END IF
+        CASE ('le')
+          IF (vec(i) <= val) THEN
+            NtimesVal = NtimesVal + 1
+            IF (NtimesVal < d1) interpweight_ValVecR(NtimesVal + 1) = i
+          END IF
+        CASE ('neq')
+          IF (vec(i) /= val) THEN
+            NtimesVal = NtimesVal + 1
+            IF (NtimesVal < d1) interpweight_ValVecR(NtimesVal + 1) = i
+          END IF
+        CASE DEFAULT
+          WRITE(numout,*)TRIM(errormsg)
+          WRITE(numout,*)"  interpweight_ValVecR: operation '" // TRIM(oper) // "' not ready!!"
+          WRITE(numout,*)"    only available: 'eq', 'ge', 'le', 'neq'"
+          CALL ipslerr_p (3, 'interpweight_ValVecR', 'wrong operation', 'provide another one', '')
+      END SELECT
+    END DO
+    interpweight_ValVecR(1) = NtimesVal
+
+
+  END FUNCTION interpweight_ValVecR
+
+!!================================================================================================================================
+!! FUNCTION     : interpweight_From2DmatTo1Dvec
+!!
+!>\BRIEF        ! Suroutine to provide value on a transformation from a 2D 
+!!  matrix to a 1D vector
+!!    e.g.: from T2(i,j) to T2M(ijklon)
+!!
+!! DESCRIPTION : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : interpweight_From2DmatTo1Dvec
+!!
+!! REFERENCE(S) : See above, module description.
+!!
+!! FLOWCHART    : None
+!! \n
+!_================================================================================================================================
+  INTEGER FUNCTION interpweight_From2DmatTo1Dvec(ix,iy,dx,dy)
+
+    IMPLICIT NONE
+
+    !! 0. Variables and parameter declaration
+    !! 0.1 Input variables
+    INTEGER, INTENT(in)                                  :: ix,iy         !! location within the 2D matrix
+    INTEGER, INTENT(in)                                  :: dx,dy         !! dimension of the 2D matrix
+
+    IF (ix > dx) THEN
+      WRITE(numout,*) "Error: "
+      WRITE(numout,*)"  interpweight_From2DmatTo1Dvec: 'ix' too large ix > dx ", ix, '>', dx, '!!'
+      CALL ipslerr_p (3, 'interpweight_From2DmatTo1Dvec', 'ix value too big', 'out of bounds', '')
+    END IF
+
+    IF (iy > dy) THEN
+      WRITE(numout,*) "Error: "
+      WRITE(numout,*)"  interpweight_From2DmatTo1Dvec: 'iy' too large iy > dy ", iy, '>', dy, '!!'
+      CALL ipslerr_p (3, 'interpweight_From2DmatTo1Dvec', 'iy value too big', 'out of bounds', '')
+    END IF
+
+    interpweight_From2DmatTo1Dvec = (ix-1)*dy + iy
+
+  END FUNCTION interpweight_From2DmatTo1Dvec
+
+!!================================================================================================================================
+!! FUNCTION     : interpweight_From1DvecTo2Dmat
+!!
+!>\BRIEF        ! Suroutine to provide value on a transformation from a 1D 
+!!  vector to a 2D matrix 
+!!     e.g.: from T2M(ijklon) to T2(i,j)
+!!
+!! DESCRIPTION : None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! RETURN VALUE : interpweight_From1DvecTo2Dmat
+!!
+!! REFERENCE(S) : See above, module description.
+!!
+!! FLOWCHART    : None
+!! \n
+!_================================================================================================================================
+  FUNCTION interpweight_From1DvecTo2Dmat(ivec,dx,dy)
+
+    IMPLICIT NONE
+
+    !! 0. Variables and parameter declaration
+    !! 0.1 Input variables
+    INTEGER, INTENT(in)                                  :: ivec              !! position within the 1D vec
+    INTEGER, INTENT(in)                                  :: dx,dy             !! dimension of the 2D matrix
+    !! 0.2 Modified variables
+    !! 0.3 Output variables
+    INTEGER, DIMENSION(2)                                :: interpweight_From1DvecTo2Dmat
+
+
+    IF (ivec > dx*dy) THEN
+      WRITE(numout,*) "Error: "
+      WRITE(numout,*)"  interpweight_From1DvecTo2Dmat: 'ivec' too large ivec > dx*dy ", ivec, '>', dx*dy, '!!'
+      CALL ipslerr_p (3, 'interpweight_From1DvecTo2Dmat', "'ivec' too large", 'out of bounds!!', '')
+    END IF
+
+    interpweight_From1DvecTo2Dmat(1) = INT((ivec-1)/dy) + 1
+    interpweight_From1DvecTo2Dmat(2) = ivec - (interpweight_From1DvecTo2Dmat(1)-1)*dy
+
+  END FUNCTION interpweight_From1DvecTo2Dmat
+
+END MODULE interpweight
Index: /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_global/time.f90
===================================================================
--- /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_global/time.f90	(revision 6940)
+++ /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_global/time.f90	(revision 6940)
@@ -0,0 +1,318 @@
+! ================================================================================================================================
+!  MODULE       : time
+!
+!  CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+!  LICENCE      : IPSL (2006)
+!  This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF   This module contians the time information for ORCHIDEE
+!!
+!!\n DESCRIPTION: This module contains the time information for ORCHIDEE.
+!! Time variables are calculated and updated at each time step. The variables are public and can be used from other modules.
+!! The time variables must not be modified outside this module. 
+!!
+!! Time variables in this module are given for the interval corresponding to current time-step. 
+!! The variables xxx_start and xxx_end are given to describe the time interval, either on julian(julian_start, julian_end) or 
+!! yymmddsec format (year_start/end, month_start/end, day_start/end, sec_start/end). The variables can be used in all other modules. 
+!! Logical variables telling if it's the last or first time-step of the day, of the month or of the year are also available.  
+!!
+!! Subroutines in module time : 
+!!   time_initialize : To initialize time variables. 
+!!                     Public subroutine called from intersurf_initialize_2d, intersurf_initialize_gathered or orchideedriver.
+!!                     This subroutine is called before the first call to sechiba.
+!!   time_nextstep   : Update time variables in the beginning at each new time step.
+!!                     Public subroutine called from intersurf_main_2d, intersurf_main_gathered or orchideedriver.
+!!   time_interval   : Calculate the interval for a given time step. Local subroutine, called from time_nextstep. 
+!!
+!! REFERENCE(S)	: None
+!!
+!! SVN          :
+!! $HeadURL: $
+!! $Date: $
+!! $Revision: $
+!! \n
+!_ ================================================================================================================================
+MODULE time
+
+  USE defprec
+  USE constantes_var
+  USE mod_orchidee_para_var, ONLY : numout
+  USE ioipsl
+  USE ioipsl_para
+  
+  IMPLICIT NONE
+  PRIVATE
+
+  PUBLIC :: time_initialize, time_nextstep
+
+  REAL(r_std), PUBLIC                 :: dt_sechiba         !! Lenght of time step in sechiba (s)
+!$OMP THREADPRIVATE(dt_sechiba)
+  REAL(r_std), PUBLIC                 :: dt_stomate         !! Length of time step in slow processes in stomate (s)
+!$OMP THREADPRIVATE(dt_stomate)
+  CHARACTER(LEN=20), PUBLIC           :: calendar_str       !! The calendar type
+!$OMP THREADPRIVATE(calendar_str)
+  INTEGER(i_std), SAVE, PUBLIC        :: year_start         !! Year at beginng of current time step
+!$OMP THREADPRIVATE(year_start)
+  INTEGER(i_std), SAVE, PUBLIC        :: month_start        !! Month at beginng of current time step
+!$OMP THREADPRIVATE(month_start)
+  INTEGER(i_std), SAVE, PUBLIC        :: day_start          !! Day in month at beginng of current time step
+!$OMP THREADPRIVATE(day_start)
+  REAL(r_std), SAVE, PUBLIC           :: sec_start          !! Seconds in the day at beginng of current time step
+!$OMP THREADPRIVATE(sec_start)
+  INTEGER(i_std), SAVE, PUBLIC        :: year_end           !! Year at end of current time step
+!$OMP THREADPRIVATE(year_end)
+  INTEGER(i_std), SAVE, PUBLIC        :: month_end          !! Month at end of current time step
+!$OMP THREADPRIVATE(month_end)
+  INTEGER(i_std), SAVE, PUBLIC        :: day_end            !! Day in month at end of current time step
+!$OMP THREADPRIVATE(day_end)
+  REAL(r_std), SAVE, PUBLIC           :: sec_end            !! Seconds in the day at end of current time step
+!$OMP THREADPRIVATE(sec_end)
+  CHARACTER(LEN=6), SAVE, PUBLIC      :: tstepint_type      !! Position of time step in the time interval
+!$OMP THREADPRIVATE(tstepint_type)
+  INTEGER(i_std), PUBLIC              :: month_len          !! Lenght of current month (d)
+!$OMP THREADPRIVATE(month_len)
+  INTEGER(i_std), PRIVATE             :: year_length        !! Lenght of current year in time step (tstp)
+!$OMP THREADPRIVATE(year_length)
+  REAL(r_std), PUBLIC                 :: one_day            !! Lenght of one day in seconds (s)
+!$OMP THREADPRIVATE(one_day)
+  REAL(r_std), PUBLIC                 :: one_year           !! Length of current year in days (d)
+!$OMP THREADPRIVATE(one_year)
+  REAL(r_std), PARAMETER, PUBLIC      :: one_hour = 3600.0  !! Lenght of hour in seconds (s)  
+
+  LOGICAL, PUBLIC                     :: FirstTsYear        !! Flag is true for the first sechiba time step on the year.
+!$OMP THREADPRIVATE(FirstTsYear)
+  LOGICAL, PUBLIC                     :: LastTsYear         !! Flag is true for the last sechiba time step of the year, previously named EndOfYear
+!$OMP THREADPRIVATE(LastTsYear)
+  LOGICAL, PUBLIC                     :: FirstTsMonth       !! Flag is true for the first sechiba time step of the month. 
+!$OMP THREADPRIVATE(FirstTsMonth)
+  LOGICAL, PUBLIC                     :: LastTsMonth        !! Flag is true for the last sechiba time step of the month. 
+!$OMP THREADPRIVATE(LastTsMonth)
+  LOGICAL, PUBLIC                     :: FirstTsDay         !! Flag is true for the first sechiba time step of the day. 
+!$OMP THREADPRIVATE(FirstTsDay)
+  LOGICAL, PUBLIC                     :: LastTsDay          !! Flag is true for the last sechiba time step of the day. 
+!$OMP THREADPRIVATE(LastTsDay)
+  REAL(r_std), SAVE, PUBLIC           :: date0_save         !! Start date of simulation, in juilan calendar
+!$OMP THREADPRIVATE(date0_save)
+  REAL(r_std), PUBLIC                 :: julian_diff        !! Days since the beginning of current year
+!$OMP THREADPRIVATE(julian_diff)
+  REAL(r_std), PUBLIC                 :: julian_start       !! Beginning of the interval for current time step, in juilan calendar
+!$OMP THREADPRIVATE(julian_start)
+  REAL(r_std), PUBLIC                 :: julian_end         !! End of the interval for current time step, in juilan calendar
+!$OMP THREADPRIVATE(julian_end)
+  REAL(r_std), SAVE, PUBLIC           :: julian0            !! First day of this year in julian caledrier
+!$OMP THREADPRIVATE(julian0)
+  INTEGER(i_std), SAVE, PRIVATE       :: printlev_loc       !! Local level of text output for current module
+!$OMP THREADPRIVATE(printlev_loc)
+  
+
+CONTAINS
+
+!!  =============================================================================================================================
+!! SUBROUTINE:    time_initialize()
+!!
+!>\BRIEF	  Initalize time information
+!!
+!! DESCRIPTION:	  Initialize time information. This subroutine is called only in the intialization phase of the model and gives
+!!                the basic information on the calendar and time interval.
+!!
+!! \n
+!_ ==============================================================================================================================
+
+  SUBROUTINE time_initialize(kjit, date0_loc, dt_sechiba_loc, tstepint)
+
+    !! 0.1 Input arguments
+    INTEGER(i_std), INTENT(in)   :: kjit           !! Time step of the restart file
+    REAL(r_std), INTENT(in)      :: date0_loc      !! The date at which kjit=0
+    REAL(r_std), INTENT(in)      :: dt_sechiba_loc !! Time step of sechiba component
+    CHARACTER(LEN=*), INTENT(in) :: tstepint       !! Position of the time stamp: beginning, centre or end of time step 
+                                                   !! Possible values for tstepint : START, CENTER, END
+
+    !! Initialize local printlev variable
+    !! It is not possible here to use the function get_printlev for problems with circular dependecies between modules
+    printlev_loc=printlev
+    CALL getin_p('PRINTLEV_time', printlev_loc)
+
+    !! Save length of sechiba time step in module variable
+    !! Time step for sechiba comes from the atmospheric model or from the 
+    !! offline driver which reads it from parameter DT_SECHIBA
+    dt_sechiba = dt_sechiba_loc
+
+    !! Save tstepint in global variable
+    tstepint_type = tstepint
+    IF (tstepint_type /= "START" .AND. tstepint_type /= "END") THEN
+       WRITE(numout,*) 'Unknown option for time interval, tstepint_type=', tstepint_type
+       CALL ipslerr_p(3,'time_initialize', 'Unknown time iterval type.',&
+            'The time stamp given can have 2 position on the interval :',' START or END')
+    END IF
+
+    !! Save the start date in the module
+    date0_save = date0_loc
+
+    !! Get the calendar from IOIPSL, it is already initialized
+    CALL ioget_calendar(calendar_str)
+
+    !! Get year lenght in days and day lenght in seconds
+    CALL ioget_calendar(one_year, one_day)
+
+    !! Get the number of sechiba time steps for 1 year (for the current year)
+    CALL tlen2itau('1Y', dt_sechiba, date0_save, year_length)
+
+    !Config Key   = DT_STOMATE
+    !Config Desc  = Time step of STOMATE and other slow processes
+    !Config If    = OK_STOMATE
+    !Config Def   = one_day
+    !Config Help  = Time step (s) of regular update of vegetation
+    !Config         cover, LAI etc. This is also the time step of STOMATE.
+    !Config Units = [seconds]
+    dt_stomate = one_day
+    CALL getin_p('DT_STOMATE', dt_stomate)
+
+ 
+    IF (printlev_loc >=1) THEN
+       WRITE(numout,*) "time_initialize : calendar_str= ",calendar_str
+       WRITE(numout,*) "time_initialize : dt_sechiba(s)= ",dt_sechiba," dt_stomate(s)= ", dt_stomate
+       WRITE(numout,*) "time_initialize : date0_save= ",date0_save," kjit= ",kjit
+    ENDIF
+    
+    CALL time_nextstep(kjit)
+    
+  END SUBROUTINE time_initialize
+  
+!!  =============================================================================================================================
+!! SUBROUTINE:    time_nextstep()
+!!
+!>\BRIEF	  Update the time information for the next time step.
+!!
+!! DESCRIPTION:	  This subroutine will place in the public variables of the module all the time information
+!!                needed by ORCHIDEE for this new time step.
+!!
+!! \n
+!_ ==============================================================================================================================
+  SUBROUTINE time_nextstep(kjit)
+    
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT(in)   :: kjit       !! Current time step
+
+
+    !! Calculate the new time interval for current time step
+    CALL time_interval(kjit, year_start, month_start, day_start, sec_start, &
+                             year_end,   month_end,   day_end,   sec_end)
+    
+    !! Calculate julian0: the julian date for the 1st of January in current year
+    CALL ymds2ju(year_start,1,1,zero, julian0)
+
+    !! Caluclate julian_diff: The diffrence of the end of current time-step and the beginning of the year in julian days
+    julian_diff = julian_end - julian0
+
+    !! Update variables for year length
+    CALL ioget_calendar(one_year, one_day)
+    CALL tlen2itau('1Y', dt_sechiba, date0_save, year_length)
+
+    !! Calculate number of days in the current month, using the start of the time-interval for current time-step
+    month_len = ioget_mon_len(year_start,month_start)
+
+
+    !! Calculate logical variables true if the current time-step corresponds to the end or beggining of a day, month or year
+    FirstTsDay = .FALSE.
+    FirstTsMonth = .FALSE.
+    FirstTsYear = .FALSE.
+    LastTsDay = .FALSE.
+    LastTsMonth = .FALSE.
+    LastTsYear = .FALSE.
+ 
+    IF (sec_start >= -1 .AND. sec_start < dt_sechiba-1 ) THEN
+       FirstTsDay = .TRUE.
+       IF ( day_start == 1 ) THEN
+          FirstTsMonth = .TRUE.
+          IF ( month_start == 1) THEN
+             FirstTsYear = .TRUE.
+          END IF
+       END IF
+    ELSE IF (sec_start >= one_day-dt_sechiba-1 .AND. sec_start < one_day-1 ) THEN
+       LastTsDay = .TRUE.
+       IF ( day_start == month_len ) THEN
+          LastTsMonth = .TRUE.
+          IF ( month_start == 12) THEN
+             LastTsYear = .TRUE.
+          END IF
+       END IF
+    END IF
+
+
+    !! Write debug information depending on printlev_loc.
+    IF ( ((printlev_loc >= 4) .OR. (printlev_loc >=2 .AND. FirstTsMonth)) .OR. (printlev_loc>=1 .AND. FirstTsYear)) THEN
+       WRITE(numout,*) "time_nextstep: Time interval for time step :", kjit
+       WRITE(numout,"(' time_nextstep: Start of interval         ', I4.4,'-',I2.2,'-',I2.2,' ',F12.4)") &
+            year_start, month_start, day_start, sec_start
+       WRITE(numout,"(' time_nextstep: End of interval           ', I4.4,'-',I2.2,'-',I2.2,' ',F12.4)") &
+            year_end, month_end, day_end, sec_end
+       WRITE(numout,*) "time_nextstep: month_len=",month_len, " one_year=",one_year
+       WRITE(numout,*) ""
+    END IF
+    IF (printlev_loc >= 4) THEN
+       WRITE(numout,*) "time_nextstep: FirstTsDay=", FirstTsDay," FirstTsMonth=",FirstTsMonth," FirstTsYear=", FirstTsYear
+       WRITE(numout,*) "time_nextstep: LastTsDay=", LastTsDay," LastTsMonth=",LastTsMonth," LastTsYear=", LastTsYear
+       WRITE(numout,*) "time_nextstep: julian0=",julian0, " julian_diff=",julian_diff
+       WRITE(numout,*) ""
+    END IF
+    IF ((printlev_loc >= 2) .AND. FirstTsDay) THEN
+       WRITE(numout,"(' Date: ', I4.4,'-',I2.2,'-',I2.2,' ',F8.4,'sec at timestep ',I12.4)") &
+            year_start, month_start, day_start, sec_start, kjit
+    END IF
+
+  END SUBROUTINE time_nextstep
+
+!!  =============================================================================================================================
+!! SUBROUTINE:    time_interval()
+!!
+!>\BRIEF	  Computes the interval corresponging to the given time step.
+!!
+!! DESCRIPTION:	  This subroutine will compute the interval of time for the given time step.
+!!                It will use the tstepint_type variable which was set at initilisation. 
+!!
+!! \n
+!_ ==============================================================================================================================
+
+  SUBROUTINE time_interval(kjit, year_s, month_s, day_s, sec_s, &
+                                 year_e, month_e, day_e, sec_e)
+
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT(in)                  :: kjit      !! Current time step
+
+    !! 0.2 Output variables
+    INTEGER(i_std), INTENT(out)                 :: year_s, month_s, day_s
+    INTEGER(i_std), INTENT(out)                 :: year_e, month_e, day_e
+    REAL(r_std), INTENT(out)                    :: sec_s
+    REAL(r_std), INTENT(out)                    :: sec_e
+    
+
+    !! Calculate the interval for current time step
+    !! tstepint_type is used to know how the interval is defined around the time-stamp of the time-step 
+    SELECT CASE (TRIM(tstepint_type))
+       CASE ("START ")
+          !! Calculate the start date of the interval
+          julian_start = itau2date(kjit, date0_save, dt_sechiba)
+          !! Calculate the end date of the interval using kjti+1
+          julian_end = itau2date(kjit+1, date0_save, dt_sechiba)
+       CASE("END")
+          !! Calculate the start date of the interval
+          julian_start = itau2date(kjit-1, date0_save, dt_sechiba)
+          !! Calculate the end date of the interval
+          julian_end = itau2date(kjit, date0_save, dt_sechiba)
+       CASE DEFAULT
+          WRITE(numout,*) "time_interval: tstepint_type = ", tstepint_type
+          CALL ipslerr_p(3,'time_interval', 'Unknown time iterval type.', &
+               'The time stamp given can have 3 position on the interval :',' START, CENTER or END')
+       END SELECT
+
+       !! Calculate year, month, day and sec for julian_start date
+       CALL ju2ymds (julian_start, year_s, month_s, day_s, sec_s)
+
+       !! Calculate year, month, day and sec for julian_end date
+       CALL ju2ymds (julian_end, year_e, month_e, day_e, sec_e)
+
+    
+  END SUBROUTINE time_interval
+
+END MODULE time
Index: /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_global/utils.f90
===================================================================
--- /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_global/utils.f90	(revision 6940)
+++ /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_global/utils.f90	(revision 6940)
@@ -0,0 +1,51 @@
+!
+! Place here all those small routines that do not fit in orchidee logic yet
+!
+!
+!< $HeadURL: svn://forge.ipsl.jussieu.fr/orchidee/branches/ORCHIDEE-MICT/ORCHIDEE/src_global/interpol_help.f90 $
+!< $Date: 2016-06-17 13:26:43 +0200 (Fri, 17 Jun 2016) $
+!< $Author: albert.jornet $
+!< $Revision: 3564 $
+!
+!
+MODULE utils 
+
+  ! Modules used :
+
+  USE netcdf
+  USE defprec
+  USE ioipsl_para
+
+  IMPLICIT NONE
+
+  PRIVATE
+  PUBLIC nccheck 
+  !
+CONTAINS
+  !
+!! ================================================================================================================================
+!! SUBROUTINE 	: nccheck 
+!!
+!>\BRIEF        Check for netcdf exit status 
+!!
+!! DESCRIPTION  : Launch an orchidee error message if status variable contains a netcdf error
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! REFERENCE(S)	: None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  SUBROUTINE nccheck(status)
+    INTEGER(i_std), INTENT (IN)         :: status
+    CHARACTER(LEN=200)                  :: mesg
+    
+    IF(status /= nf90_noerr) THEN
+      
+      WRITE(numout, *) trim(nf90_strerror(status))
+      CALL ipslerr_p(3, 'nccheck', 'Netcdf error', 'Check out_orchide_XXXX output files', 'for more information')
+    END IF  
+  END SUBROUTINE nccheck
+!
+END MODULE utils 
Index: /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_sechiba/gammad_inc.f90
===================================================================
--- /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_sechiba/gammad_inc.f90	(revision 6940)
+++ /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_sechiba/gammad_inc.f90	(revision 6940)
@@ -0,0 +1,466 @@
+! =================================================================================================================================
+! MODULE        : gammad_inc
+!
+! CONTACT       : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE       : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF        This module computes the parameters for TOPMODEL, gamma distribution fitting. 
+!!
+!!\n DESCRIPTION : contains.
+!! 
+!! RECENT CHANGE(S) : None
+!!
+!! REFERENCE(S) : None
+!!
+!! SVN          :
+!! $HeadURL: svn://forge.ipsl.jussieu.fr/orchidee/perso/shushi.peng/ORCHIDEE/src_sechiba/gammad_inc.f90 $
+!! $Date: 2015-03-10 10:16:04 +0100 (Tue, 10 Mar 2015) $
+!! $Revision: 2535 $
+!! \n
+!_ ================================================================================================================================
+
+!C######################################################################
+!C######################################################################
+!C
+!C       THIS ROUTINE COMPUTE THE INCOMPLETE AND THE COMPLEMENTARY 
+!C INCOMPLETE GAMMA FUNCTION DOUBLE PRECISION. IN BRIEF, THIS 
+!C FUNCTION HELP TO COMPUTE THE DIFFERENT FRACTION PRESENT IN THE 
+!C TOPMODEL FRAMEWORK. 
+!C       MORE EXPLANATION ON THE SUBROUTINE USE ARE GIVEN IN THE NEXT 
+!C COMMENTARY 
+!C
+!C THIS ROUTINE WAS FOUND ON http://www.netlib.org WEB SITE.
+!C      
+!C REFERENCE - W. GAUTSCHI, :: A COMPUTATIONAL PROCEDURE FOR INCOMPLETE 
+!C GAMMA FUNCTIONS, ACM TRANS. MATH. SOFTWARE., (1979) 482-489
+!C
+!C######################################################################
+!C######################################################################
+!C
+!C     LET  GAMMA(A)  DENOTE THE GAMMA FUNCTION AND  GAM(A,X)  THE
+!C (COMPLEMENTARY) INCOMPLETE GAMMA FUNCTION,
+!C
+!C    GAM(A,X)=INTEGRAL FROM T=X TO T=INFINITY OF EXP(-T)*T**(A-1).
+!C
+!C LET  GAMSTAR(A,X)  DENOTE TRICOMI:S FORM OF THE INCOMPLETE GAMMA
+!C FUNCTION, WHICH FOR A.GT.0. IS DEFINED BY
+!C
+!C  GAMSTAR(A,X)=(X**(-A)/GAMMA(A))*INTEGRAL FROM T=0 TO T=X OF
+!C                EXP(-T)*T**(A-1),
+!C
+!C AND FOR A.LE.0. BY ANALYTIC CONTINUATION. FOR THE PURPOSE OF
+!C THIS SUBROUTINE, THESE FUNCTIONS ARE NORMALIZED AS FOLLOWS&
+!C
+!C             GAM(A,X)/GAMMA(A),  IF A.GT.0.,
+!C     G(A,X)=
+!C             EXP(X)*X**(-A)*GAM(A,X),  IF A.LE.0.,
+!C
+!C     GSTAR(A,X)=(X**A)*GAMSTAR(A,X)
+!C               =(1/GAMMA(A))*INTEGRAL FROM T=0 TO T=X OF EXP(-T)*T**(A-1)
+!C
+!C THE PROGRAM BELOW ATTEMPTS TO EVALUATE  G(A,X)  AND  GSTAR(A,X),
+!C BOTH TO AN ACCURACY OF ACC SIGNIFICANT DECIMAL DIGITS, FOR ARBI-
+!C TRARY REAL VALUES OF  A  AND NONNEGATIVE VALUES OF  X. THE SUB-
+!C ROUTINE AUTOMATICALLY CHECKS FOR UNDERFLOW AND OVERFLOW CONDI-
+!C TIONS AND RETURNS APPROPRIATE WARNINGS THROUGH THE OUTPUT PARA-
+!C METERS  IFLG, IFLGST. A RESULT THAT UNDERFLOWS IS RETURNED WITH
+!C THE VALUE 0., ONE THAT OVERFLOWS WITH THE VALUE OF THE LARGEST
+!C MACHINE-REPRESENTABLE NUMBER.
+!C
+!C     NEAR LINES IN THE (A,X)-PLANE, A.LT.0., ALONG WHICH  GSTAR
+!C VANISHES, THE ACCURACY SPECIFIED WILL BE ATTAINED ONLY IN TERMS
+!C OF ABSOLUTE ERROR, NOT RELATIVE ERROR. THERE ARE OTHER (RARE)
+!C INSTANCES IN WHICH THE ACCURACY ATTAINED IS SOMEWHAT LESS THAN
+!C THE ACCURACY SPECIFIED. THE DISCREPANCY, HOWEVER, SHOULD NEVER
+!C EXCEED ONE OR TWO (DECIMAL) ORDERS OF ACCURACY# NO INDICATION
+!C OF THIS IS GIVEN THROUGH ERROR FLAGS.
+!C
+!C     PARAMETER LIST&
+!C
+!C        A - - THE FIRST ARGUMENT OF G AND GSTAR. TYPE REAL.
+!C        X - - THE SECOND ARGUMENT OF G AND GSTAR. TYPE REAL.
+!C      ACC - - THE NUMBER OF CORRECT SIGNIFICANT DECIMAL DIGITS
+!C              DESIRED IN THE RESULTS. TYPE REAL.
+!C        G - - AN OUTPUT VARIABLE RETURNING THE VALUE OF G(A,X).
+!C              TYPE REAL.
+!C    GSTAR - - AN OUTPUT VARIABLE RETURNING THE VALUE OF
+!C              GSTAR(A,X). TYPE REAL.
+!C     IFLG - - AN ERROR FLAG INDICATING A NUMBER OF ERROR CONDI-
+!C              TIONS IN G UPON EXECUTION. TYPE INTEGER.
+!C!   IFLGST - - AN ERROR FLAG INDICATING A NUMBER OF ERROR CONDI-
+!C              TIONS IN GSTAR UPON EXECUTION. TYPE INTEGER.
+!C              THE VALUES OF IFLG AND IFLGST HAVE THE FOLLOWING
+!C              MEANINGS&
+!C              0 - NO ERROR CONDITION.
+!C              1 - ILLEGAL NEGATIVE ARGUMENT X. THE ROUTINE EXITS
+!C                  WITH THE VALUES ZERO FOR G AND GSTAR.
+!C              2 - INFINITELY LARGE RESULT AT X=0. THE ROUTINE
+!C                  RETURNS THE LARGEST MACHINE-REPRESENTABLE NUMBER.
+!C              3 - (ONLY FOR IFLGST) GSTAR IS INDETERMINATE AT
+!C                  A=0. AND X=0. THE ROUTINE RETURNS THE VALUE 1.,
+!C                  WHICH IS THE LIMIT VALUE AS X TENDS TO ZERO FOR
+!C                  FIXED A=0.
+!C              4 - THE RESULT UNDERFLOWS. IT IS SET EQUAL TO 0.
+!C              5 - THE RESULT OVERFLOWS. IT IS SET EQUAL TO THE
+!C                  LARGEST MACHINE-REPRESENTABLE NUMBER, WITH
+!C                  PROPER SIGN.
+!C              6 - CONVERGENCE FAILS WITHIN 600 ITERATIONS, EITHER
+!C                  IN TAYLOR:S SERIES OR IN LEGENDRE:S CONTINUED
+!C                  FRACTION. REASON UNKNOWN. THE COMPUTATION IS
+!C                  ABORTED AND THE ROUTINE RETURNS WITH ZERO
+!C                  VALUES FOR G AND GSTAR.
+!C
+!C     ALL MACHINE-DEPENDENT PARAMETERS ARE COLLECTED IN THE FIRST
+!C DATA DECLARATION. THEY ARE AS FOLLOWS&
+!C
+!C     PREC - - THE SINGLE PRECISION ACCURACY, TO BE SET APPROXI-
+!C              MATELY EQUAL TO BETA*ALOG(2.)/ALOG(10.), WHERE BETA
+!C              IS THE NUMBER OF BINARY DIGITS AVAILABLE IN THE MAN-
+!C              TISSA OF THE SINGLE PRECISION FLOATING-POINT WORD.
+!C              TYPE REAL.
+!C   TOPEXP - - APPROXIMATELY THE LARGEST POSITIVE NUMBER T SUCH
+!C              THAT 10.**T IS STILL REPRESENTABLE ON THE COMPUTER
+!C              IN SINGLE PRECISION FLOATING-POINT ARITHMETIC.
+!C              TYPE REAL.
+!C   BOTEXP - - APPROXIMATELY THE SMALLEST NEGATIVE NUMBER T SUCH
+!C              THAT 10.**T IS STILL REPRESENTABLE ON THE COMPUTER
+!C              IN SINGLE PRECISION FLOATING-POINT ARITHMETIC.
+!C              TYPE REAL.
+!C
+!C IN THE PROGRAM BELOW THESE PARAMETERS ARE SET TO CORRESPOND TO
+!C THE MACHINE CHARACTERISTICS OF THE CDC 6500 COMPUTER.
+!C
+!C     THE SECOND DATA DECLARATION CONTAINS THE SINGLE PRECISION
+!C VALUE OF ALOG(10.). THE NEXT DATA DECLARATION CONTAINS THE SUCCES-
+!C SIVE COEFFICIENTS IN THE MACLAURIN EXPANSION OF (1/GAMMA(A+1))-1.
+!C THEY ARE GIVEN TO AS MANY DECIMAL PLACES AS IS NECESSARY TO ACHIEVE
+!C MACHINE PRECISION (ON THE CDC 6500 COMPUTER) IN THE RANGE
+!C ABS(A).LE..5. MORE ACCURATE VALUES OF THESE COEFFICIENTS (TO
+!C 31 DECIMAL PLACES) CAN BE FOUND IN TABLE 5 OF J.W.WRENCH,JR.,
+!C CONCERNING TWO SERIES FOR THE GAMMA FUNCTION, MATH. COMPUT.
+!C 22, 1968, 617-626.
+!C
+!C     THE SUBROUTINE CALLS ON A FUNCTION SUBROUTINE, NAMED  ALGA,
+!C WHICH IS TO PROVIDE SINGLE PRECISION VALUES OF THE LOGARITHM OF
+!C THE GAMMA FUNCTION FOR ARGUMENTS LARGER THAN OR EQUAL TO .5.
+!C A POSSIBLE VERSION OF SUCH A FUNCTION SUBROUTINE IS APPENDED
+!C TO THE PRESENT SUBROUTINE. IT IS TAYLORED TO THE ACCURACY RE-
+!C QUIREMENTS OF THE CDC 6500 COMPUTER, AND USES RATIONAL APPROXI-
+!C MATIONS DUE TO CODY AND HILLSTROM (MATH. COMPUT. 21, 1967, 198-
+!C 203).
+!C
+!C     REFERENCE - W. GAUTSCHI, ::A COMPUTATIONAL PROCEDURE FOR
+!C INCOMPLETE GAMMA FUNCTIONS, ACM TRANS. MATH. SOFTWARE.
+!C
+!!     ################     
+      MODULE gammad_inc 
+!     ################
+!
+!
+      INTERFACE
+!      
+!
+      SUBROUTINE DGAM(A, X, ACC, G, GSTAR, IFLG, IFLGST)                
+      
+        DOUBLE PRECISION :: A, X, G, GSTAR, C, AL10, ALX, ALPHA, ALPREC, &
+     & TOP, BOT, AINF, EPS, EPS1, ES, SGA, AE, AA, AP1, AM1, AEP1, &
+     & AEM1, FMA, AEPS, SGAE, AAEPS, ALGP1, SGGA, ALGEP1, SGGS, ALGS, &
+     & ALG, SUMM, GA, Y, TERM, U, P, Q, R, V, T, H, SGT, A1X, RHO, XPA, &
+     & XMA, S, DLGA
+!
+      END
+!
+      END INTERFACE
+!
+      END MODULE gammad_inc 
+!
+!################################################################
+!
+      SUBROUTINE DGAM(A, X, ACC, G, GSTAR, IFLG, IFLGST)                
+!
+!################################################################
+      DOUBLE PRECISION :: A, X, G, GSTAR, C, AL10, ALX, ALPHA, ALPREC, &
+     & TOP, BOT, AINF, EPS, EPS1, ES, SGA, AE, AA, AP1, AM1, AEP1, &
+     & AEM1, FMA, AEPS, SGAE, AAEPS, ALGP1, SGGA, ALGEP1, SGGS, ALGS, &
+     & ALG, SUMM, GA, Y, TERM, U, P, Q, R, V, T, H, SGT, A1X, RHO, XPA, &
+     & XMA, S, DLGA
+      DIMENSION C(29)
+      DATA PREC, TOPEXP, BOTEXP /15.9545,308.,-308./
+      DATA AL10 /2.3025850929940456840179914547D0/
+      DATA C /.57721566490153286060651209008D0, &
+     &       -.65587807152025388107701951515D0, &
+     &       -4.200263503409523552900393488D-2, &
+     &        .1665386113822914895017007951D0, &
+     &       -4.21977345555443367482083013D-2, &
+     &       -9.6219715278769735621149217D-3, &
+     &       7.2189432466630995423950103D-3, &
+     &       -1.165167591859065112113971D-3, &
+     &       -2.15241674114950972815730D-4, &
+     &       1.2805028238811618615320D-4, &
+     &       -2.013485478078823865569D-5, &
+     &       -1.2504934821426706573D-6, &
+     &       1.1330272319816958824D-6, &
+     &       -2.056338416977607103D-7, &
+     &       6.1160951044814158D-9, &
+     &       5.0020076444692229D-9, &
+     &       -1.181274570487020D-9, &
+     &       1.04342671169110D-10, &
+     &       7.782263439905D-12, &
+     &       -3.696805618642D-12, &
+     &       5.1003702875D-13, &
+     &       -2.058326054D-14, -5.34812254D-15, &
+     &       1.2267786D-15, -1.181259D-16,1.187D-18, &
+     &       1.412D-18,-2.30D-19,1.7D-20/ 
+      G = 0.D0
+      GSTAR = 0.D0
+      IF (X.LT.0.D0) GO TO 290
+!C
+!C INITIALIZATION
+!C
+      IFLG = 0
+      IFLGST = 0
+      I = 0
+      IF (X.GT.0.D0) ALX = DLOG(X)
+      ALPHA = X + .25D0
+      IF (X.LT..25D0 .AND. X.GT.0.D0) ALPHA = DLOG(.5D0)/ALX
+!C      ALPREC = AL10*DBLE(PREC)
+!C      TOP    = AL10*DBLE(TOPEXP)
+!C      BOT    = AL10*DBLE(BOTEXP)
+      ALPREC =DBLE(DIGITS(1.D0))*DLOG(2.D0)
+      TOP    =DLOG10(HUGE(1.D0))
+      BOT    =DLOG10(TINY(1.D0))
+      AINF   = 10.D0**TOPEXP
+      EPS = .5D0*10.D0**(-ACC)
+      EPS1 = EPS/1.D2
+      SGA = 1.D0
+      IF (A.LT.0.D0) SGA = -SGA
+      AE = A
+      AA = DABS(A)
+      AP1 = A + 1.D0
+      AEP1 = AP1
+      MA = SNGL(.5D0-A)
+      FMA = DBLE(FLOAT(MA))
+      AEPS = A + FMA
+      SGAE = 1.D0
+      IF (AEPS.LT.0.D0) SGAE = -SGAE
+      AAEPS = DABS(AEPS)
+      ALGP1 = 0.D0
+!C
+!C EVALUATION OF THE LOGARITHM OF THE ABSOLUTE VALUE OF
+!C GAMMA(A+1.) AND DETERMINATION OF THE SIGN OF GAMMA(A+1.)
+!C
+      SGGA = 1.D0
+      IF (MA.LE.0) GO TO 10
+      IF (AEPS.EQ.0.D0) GO TO 20
+      SGGA = SGAE
+      IF (MA.EQ.2*(MA/2)) SGGA = -SGGA
+      ALGP1 = DLGA(AEPS+1.D0) - DLOG(AAEPS)
+      IF (MA.EQ.1) GO TO 20
+      ALGP1 = ALGP1 + DLGA(1.D0-AEPS) - DLGA(FMA-AEPS)
+      GO TO 20
+   10 ALGP1 = DLGA(AP1)
+   20 ALGEP1 = ALGP1
+      IF (X.GT.0.D0) GO TO 60
+!C
+!C EVALUATION OF GSTAR(A,0.) AND G(A,0.)
+!C
+      IF (A) 30, 40, 50
+   30 IFLGST = 2
+      GSTAR = AINF
+      G = 1.D0/AA
+      RETURN
+   40 IFLGST = 3
+      GSTAR = 1.D0
+      IFLG = 2
+      G = AINF
+      RETURN
+   50 G = 1.D0
+      RETURN
+   60 IF (A.GT.ALPHA) GO TO 220
+      IF (X.GT.1.5D0) GO TO 240
+      IF (A.LT.-.5D0) GO TO 170
+!C
+!C DIRECT EVALUATION OF G(A,X) AND GSTAR(A,X) FOR X.LE.1.5
+!C AND -.5.LE.A.LE.ALPHA(X)
+!C
+      GSTAR = 1.D0
+      IF (A.GE..5D0) GO TO 110
+   70 SUMM = C(29)
+      DO 80 K=1,28
+        K1 = 29 - K
+        SUMM = AE*SUMM + C(K1)
+   80 CONTINUE
+      GA = -SUMM/(1.D0+AE*SUMM)
+      Y = AE*ALX
+      IF (DABS(Y).GE.1.D0) GO TO 100
+      SUMM = 1.D0
+      TERM = 1.D0
+      K = 1
+   90 K = K + 1
+      IF (K.GT.600) GO TO 330
+      TERM = Y*TERM/DBLE(FLOAT(K))
+      SUMM = SUMM + TERM
+      IF (DABS(TERM).GT.EPS1*SUMM) GO TO 90
+      U = GA - SUMM*ALX
+      GO TO 120
+  100 U = GA - (DEXP(Y)-1.D0)/AE
+      GO TO 120
+  110 U = DEXP(DLGA(A)) - (X**A)/A
+  120 P = AE*X
+      Q = AEP1
+      R = AE + 3.D0
+      TERM = 1.D0
+      SUMM = 1.D0
+      K = 1
+  130 K = K + 1
+      IF (K.GT.600) GO TO 330
+      P = P + X
+      Q = Q + R
+      R = R + 2.D0
+      TERM = -P*TERM/Q
+      SUMM = SUMM + TERM
+      IF (DABS(TERM).GT.EPS1*SUMM) GO TO 130
+      V = (X**AEP1)*SUMM/AEP1
+      G = U + V
+      IF (I.EQ.1) GO TO 180
+      IF (A) 140, 150, 160
+  140 T = DEXP(X)*X**(-A)
+      G = T*G
+      GSTAR = 1.D0 - A*G*DEXP(-ALGP1)/T
+      RETURN
+  150 G = DEXP(X)*G
+      RETURN
+  160 G = A*G*DEXP(-ALGP1)
+      GSTAR = 1.D0 - G
+      RETURN
+!C
+!C RECURSIVE EVALUATION OF G(A,X) FOR X.LE.1.5 AND A.LT.-.5
+!C
+  170 I = 1
+      AE = AEPS
+      AEP1 = AEPS + 1.D0
+      IF (X.LT..25D0 .AND. AE.GT.ALPHA) GO TO 210
+      GO TO 70
+  180 G = G*DEXP(X)*X**(-AE)
+      DO 190 K=1,MA
+        G = (1.D0-X*G)/(DBLE(FLOAT(K))-AE)
+  190 CONTINUE
+      ALG = DLOG(G)
+!C
+!C EVALUATION OF GSTAR(A,X) IN TERMS OF G(A,X)
+!C
+  200 GSTAR = 1.D0
+      IF (MA.GE.0 .AND. AEPS.EQ.0.D0) RETURN
+      SGT = SGA*SGGA
+      T = DLOG(AA) - X + A*ALX + ALG - ALGP1
+      IF (T.LT.-ALPREC) RETURN
+      IF (T.GE.TOP) GO TO 320
+      GSTAR = 1.D0 - SGT*DEXP(T)
+      RETURN
+  210 I = 2
+      ALGEP1 = DLGA(AEP1)
+!C
+!C EVALUATION OF GSTAR(A,X) FOR A.GT.ALPHA(X) BY TAYLOR
+!C EXPANSION
+!C
+  220 G = 1.D0
+      TERM = 1.D0
+      SUMM = 1.D0
+      K = 0
+  230 K = K + 1
+      IF (K.GT.600) GO TO 340
+      TERM = X*TERM/(AE+DBLE(FLOAT(K)))
+      SUMM = SUMM + TERM
+      IF (DABS(TERM).GT.EPS*SUMM) GO TO 230
+      ALGS = AE*ALX - X + DLOG(SUMM) - ALGEP1
+      IF (ALGS.LE.BOT) GO TO 310
+      GSTAR = DEXP(ALGS)
+      G = 1.D0 - GSTAR
+      IF (I.NE.2) RETURN
+      G = G*DEXP(ALGEP1)/AE
+      GO TO 180
+!C
+!C EVALUATION OF G(A,X) FOR X.GT.1.5 AND A.LE.ALPHA(X) BY
+!C MEANS OF THE LEGENDRE CONTINUED FRACTION
+!C
+  240 GSTAR = 1.D0
+      XPA = X + 1.D0 - A
+      XMA = X - 1.D0 - A
+      P = 0.D0
+      Q = XPA*XMA
+      R = 4.D0*XPA
+      S = -A + 1.D0
+      TERM = 1.D0
+      SUMM = 1.D0
+      RHO = 0.D0
+      K = 1
+  250 K = K + 1
+      IF (K.GT.600) GO TO 330
+      P = P + S
+      Q = Q + R
+      R = R + 8.D0
+      S = S + 2.D0
+      T = P*(1.D0+RHO)
+      RHO = T/(Q-T)
+      TERM = RHO*TERM
+      SUMM = SUMM + TERM
+      IF (DABS(TERM).GT.EPS*SUMM) GO TO 250
+      IF (A) 260, 270, 280
+  260 G = SUMM/XPA
+      ALG = DLOG(G)
+      GO TO 200
+  270 G = SUMM/XPA
+      RETURN
+  280 ALG = A*ALX - X + DLOG(A*SUMM/XPA) - ALGP1
+      IF (ALG.LE.BOT) GO TO 300
+      G = DEXP(ALG)
+      GSTAR = 1.D0 - G
+      RETURN
+  290 IFLG = 1
+      IFLGST = 1
+      RETURN
+  300 IFLG = 4
+      RETURN
+  310 IFLGST = 4
+      RETURN
+  320 IFLGST = 5
+      GSTAR = -SGT*AINF
+      RETURN
+  330 IFLG = 6
+      RETURN
+  340 IFLGST = 6
+      RETURN
+      END
+      
+      DOUBLE PRECISION FUNCTION DLGA(DX)                                
+      DOUBLE PRECISION DBNUM, DBDEN, DX, DC, DP, DY, DT, DS
+      DIMENSION DBNUM(8), DBDEN(8)
+      DATA DBNUM /-3.617D3,1.D0,-6.91D2,1.D0,-1.D0,1.D0,-1.D0,1.D0/, &
+     & DBDEN /1.224D5,1.56D2,3.6036D5,1.188D3,1.68D3,1.26D3,3.6D2,1.2D1/
+      DC = .5D0*DLOG(8.D0*DATAN(1.D0))
+      DP = 1.D0
+      DY = DX
+      Y = SNGL(DY)
+!C
+!C THE CONDITIONAL CLAUSE IN THE NEXT STATEMENT EXPRESSES THE
+!C INEQUALITY Y.GT.EXP(.121189*DPREC+.053905), WHERE DPREC IS THE
+!C NUMBER OF DECIMAL DIGITS CARRIED IN DOUBLE PRECISION FLOATING-POINT
+!C ARITHMETIC.
+!C
+   10 IF (Y.GT.35.027) GO TO 20
+      DP = DY*DP
+      DY = DY + 1.D0
+      Y = SNGL(DY)
+      GO TO 10
+   20 DT = 1.D0/(DY*DY)
+      DS = 4.3867D4/2.44188D5
+      DO 30 I=1,8
+        DS = DT*DS + DBNUM(I)/DBDEN(I)
+   30 CONTINUE
+      DLGA = (DY-.5D0)*DLOG(DY) - DY + DC + DS/DY - DLOG(DP)
+      RETURN
+      END
+
+
Index: /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_sechiba/hydro_subgrid.f90
===================================================================
--- /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_sechiba/hydro_subgrid.f90	(revision 6940)
+++ /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_sechiba/hydro_subgrid.f90	(revision 6940)
@@ -0,0 +1,249 @@
+! =================================================================================================================================
+! MODULE        : hydro_subgrid
+!
+! CONTACT       : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE       : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF        This module computes TOPMODEL saturated fraction. 
+!!
+!!\n DESCRIPTION : contains.
+!! 
+!! RECENT CHANGE(S) : None
+!!
+!! REFERENCE(S) : None
+!!
+!! SVN          :
+!! $HeadURL: svn://forge.ipsl.jussieu.fr/orchidee/perso/shushi.peng/ORCHIDEE/src_sechiba/hydro_subgrid.f90 $
+!! $Date: 2015-03-10 10:16:04 +0100 (Tue, 10 Mar 2015) $
+!! $Revision: 2535 $
+!! \n
+!_ ================================================================================================================================
+
+!-----------------------------------------------------------------
+!--------------- special set of characters for SCCS information
+!-----------------------------------------------------------------
+!      %Z% Lib:%F%, Version:%I%, Date:%D%, Last modified:%E%
+!-----------------------------------------------------------------
+!     #################
+MODULE hydro_subgrid 
+!     #################
+!
+      USE ioipsl
+      USE constantes
+      USE constantes_soil
+!pss!      USE constantes_veg
+!!      USE reqdprec
+!
+      IMPLICIT NONE
+CONTAINS
+!
+      SUBROUTINE hydro_subgrid_main(kjpindex, PTAB_FSAT, PTAB_WTOP, phumtot, profil_froz_hydro, PFSAT,&
+    & PTAB_FWET,PTAB_WTOP_WET,PFWET, PD_TOP, &
+    & ruu_ch, PWT1,PWT2,PWT3,PWT4,PM,PTI_MIN,PTI_MAX,PAS, dz)
+!
+!
+!-------------------------------------------------------------------------------
+!
+!*       0.     DECLARATIONS
+!               ------------
+!
+!*      0.1    declarations of arguments
+!
+!
+INTEGER(i_std), INTENT(in)                         :: kjpindex         !! Domain size
+REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: ruu_ch
+REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: PM
+REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: PTI_MIN
+REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: PTI_MAX
+REAL(r_std),DIMENSION (kjpindex), INTENT (in)      :: PAS
+REAL(r_std),DIMENSION (nslm+1),   INTENT (in)      :: dz
+!                                   PW_TOP  = total liquid volumetric water
+!                                             content of the upper layer
+!                                   PWI_TOP = total ice volumetric water
+!                                             content of the below layer
+
+REAL(r_std), INTENT (in)       :: PD_TOP
+
+!
+REAL(r_std), DIMENSION(kjpindex), INTENT(OUT)  :: PFSAT,PFWET,PWT1,PWT2,PWT3,PWT4
+!                                   PFSAT   = satured fraction
+!                                   PFWET   = wetland fraction
+!
+REAL(r_std), DIMENSION(kjpindex,1000), INTENT(IN) :: PTAB_FSAT, PTAB_WTOP, PTAB_FWET, PTAB_WTOP_WET 
+!                                   PTAB_FSAT = Satured fraction array
+!                                   PTAB_WTOP = Active TOPMODEL-layer array
+!                                   PTAB_FWET = Wetland fraction array
+!
+REAL(r_std),DIMENSION (kjpindex), INTENT (in) :: phumtot
+REAL(r_std),DIMENSION (kjpindex, nslm), INTENT (in) :: profil_froz_hydro 
+!REAL(r_std),DIMENSION (kjpindex,nstm), INTENT (in) :: psoiltile
+
+!*      0.2    declarations of local variables
+!
+REAL, DIMENSION(kjpindex)                     :: ZW_TOP,ZW_TOP_WET
+!REAL, DIMENSION(kjpindex)                     :: ZFSAT, ZW_TOP, ZFWET
+!                                        ZW_TOP  = ative TOPMODEL-soil moisture at 't' (m3 m-3)
+!
+REAL, DIMENSION(:,:), ALLOCATABLE     :: ZCOMP,ZCOMP_WET
+!                                                      ZCOMP     = array for wt comparaison with wt_array
+!
+INTEGER, DIMENSION(kjpindex)                  :: I_IND,I_IND_WET,I_IND_WT1,I_IND_WT2,I_IND_WT3,I_IND_WT4
+!                                        I_IND = change in xsat (or fsat) index
+!
+INTEGER                               :: INI, IND, I 
+!                                        INI      = nombre de mailles        
+!                                        IND      = Indice de boucle        
+!REAL(r_std), DIMENSION(kjpindex)                     :: PW_TOP, PWI_TOP
+REAL(r_std), DIMENSION (kjpindex)                    :: phumtot_ave
+INTEGER(i_std)                                      :: ji,jv
+REAL(r_std), DIMENSION (kjpindex)                    :: pfrac_froz_fsat
+INTEGER(r_std), DIMENSION (kjpindex)                 :: nb_count
+!-------------------------------------------------------------------------------
+!
+!valeur pr chaque grid-cell
+    phumtot_ave(:) = 0.0
+!
+    DO ji = 1, kjpindex
+       !!pmc_ave(ji) = SUM(pmc(ji,:,1)*psoiltile(ji,1)+pmc(ji,:,2)*psoiltile(ji,2)+pmc(ji,:,3)*psoiltile(ji,3))!SUM sur les 11 couches
+       !variable _ave servait initialement a faire la somme sur les PFT ou sur les types de sol. inutile maintenant
+       phumtot_ave(ji) = phumtot(ji)      
+    ENDDO
+
+    DO ji = 1, kjpindex
+       pfrac_froz_fsat(ji)= (SUM(profil_froz_hydro(ji,1:9) * dz(1:9)) / SUM(dz(1:9)))
+    ENDDO
+!
+INI=kjpindex
+ALLOCATE(ZCOMP(INI,SIZE(PTAB_WTOP,2)))
+ALLOCATE(ZCOMP_WET(INI,SIZE(PTAB_WTOP_WET,2)))
+!
+I_IND (:) =0 !indice seuil pr calcul de fraction a saturation
+I_IND_WET (:) =0 !indice seuil pr fraction de wetland (avc WTD=0)
+I_IND_WT1 (:) =0 !indice des fractions de wetland avec une WTD en-dessous du sol
+I_IND_WT2 (:) =0
+I_IND_WT3 (:) =0
+I_IND_WT4 (:) =0
+
+ZW_TOP(:) =0.0
+ZW_TOP_WET(:) =0.0
+PFSAT (:) =0.0
+PFWET (:) =0.0
+!
+!        
+IND=SIZE(PTAB_WTOP,2)
+!  
+! Here, we determinate the new fsat by comparaison between wt_array and WT
+!
+!ZW_TOP(:) = MIN(((PW_TOP(:) + PWI_TOP(:)+pdrainage_t(:)))/(PD_TOP(:)*1000.), PTAB_WTOP(:,1))
+!ZW_TOP_WET(:) = MIN(((PW_TOP(:) + PWI_TOP(:)+pdrainage_t(:)))/(PD_TOP(:)*1000.), PTAB_WTOP_WET(:,1))
+ZW_TOP(:) = MIN((phumtot_ave(:))/(PD_TOP*1000.), PTAB_WTOP(:,1))
+ZW_TOP_WET(:) = MIN((phumtot_ave(:))/(PD_TOP*1000.), PTAB_WTOP_WET(:,1))
+
+!
+! compare wt_array and WT
+!
+ZCOMP(:,:) = 999.0
+ZCOMP_WET(:,:) = 999.0
+!
+DO I=1,IND
+  !prise en compte du gel pour le calcul de fsat:
+  !soluce 1: diminue la quantitÃ© d eau utilise pour calculer le deficit
+  !soluce 2: utilise la qte d eau totale (liq + solide) puis diminue le fsat obtenu avec ce calcul
+  ! ZCOMP(:,I) = ABS(PTAB_WTOP(:,I) - ((pfrac_froz_gqsb(:)* dsg_ave(:) + &
+  !    & (PD_TOP(:)-dsg_ave(:))*pfrac_froz_bqsb(:))/PD_TOP(:))*(ruu_ch(:)/1000.0) - ZW_TOP(:))
+  ZCOMP(:,I) = ABS(PTAB_WTOP(:,I) - ZW_TOP(:))
+  ZCOMP_WET(:,I) = ABS(PTAB_WTOP_WET(:,I) - ZW_TOP_WET(:))
+ENDDO
+!
+! calculate array index where tab_wt = WT
+!
+!recherche de l indice seuil pour les fractions a saturation et fractions de wetland
+I_IND(:)=INT(MINLOC(ZCOMP(:,:),2))
+I_IND_WET(:)=INT(MINLOC(ZCOMP_WET(:,:),2))
+
+!boucle de type ci-dessus peut etre utilise si la fonction MINLOC n est pas vectorise par le compilo
+!DO ji = 1, kjpindex
+!   I_IND(ji)=INT(MINLOC(ZCOMP(ji,:),1))
+!ENDDO
+
+
+WHERE ((PTI_MAX(:) /= -99.99 ) .AND. &
+        & (ruu_ch(:) .GE. min_sechiba) .AND. (PD_TOP .GE. min_sechiba) .AND. (PAS(:) .GE. min_sechiba))
+    I_IND_WT1(:)=INT(I_IND_WET(:) - ((4*WTD1_borne/PD_TOP)/(ruu_ch(:)*PD_TOP/1000.))/PAS(:))! indice pour deficit entre 0 et -6cm
+    I_IND_WT2(:)=INT(I_IND_WET(:) - ((4*WTD2_borne/PD_TOP)/(ruu_ch(:)*PD_TOP/1000.))/PAS(:))! indice pour deficit entre 0 et -12 cm
+    I_IND_WT3(:)=INT(I_IND_WET(:) - ((4*WTD3_borne/PD_TOP)/(ruu_ch(:)*PD_TOP/1000.))/PAS(:))! indice pour deficit entre 0 et -18cm
+    I_IND_WT4(:)=INT(I_IND_WET(:) - ((4*WTD4_borne/PD_TOP)/(ruu_ch(:)*PD_TOP/1000.))/PAS(:))! indice pour deficit entre 0 et -24cm
+    ! le pd_top au denominateur est un peu etrange 
+    ! pourtant ce calcul donne les bonnes fractions:
+    ! un test a ete realise en utilisant I_IND et en calculant la fraction pour un deficit entre 0 et 2 m => fraction ~ 1
+elsewhere
+    I_IND_WT1(:)=999
+    I_IND_WT2(:)=999
+    I_IND_WT3(:)=999
+    I_IND_WT4(:)=999
+endwhere
+
+WHERE ( I_IND_WT1(:) .LE. 0.0 )  
+    I_IND_WT1(:)=1
+endwhere
+WHERE ( I_IND_WT2(:) .LE. 0.0 )  
+    I_IND_WT2(:)=1
+endwhere
+WHERE ( I_IND_WT3(:) .LE. 0.0 )  
+    I_IND_WT3(:)=1
+endwhere
+WHERE ( I_IND_WT4(:) .LE. 0.0 )  
+    I_IND_WT4(:)=1
+endwhere
+
+DO I=1,INI
+  nb_count(I)=COUNT(PTAB_FSAT (I,:)>0.0)!!= COUNT(PTAB_FWET (I,:)>0.0) aussi
+ENDDO
+
+DO I=1,INI
+!  calculate fsat
+  IF(nb_count(I)>0.0)THEN
+      PFSAT(I) = PTAB_FSAT (I,I_IND(I))
+      PFWET(I) = PTAB_FWET (I,I_IND_WET(I))
+      !PFWET(I) = PTAB_FWET (I,I_IND(I)) ! test pour voir si somme des fractions de deficit entre 0 et 2m ~ 1
+      PWT1(I) = PTAB_FWET (I,I_IND_WT1(I))-PFWET(I) 
+      PWT2(I) = PTAB_FWET (I,I_IND_WT2(I))-(PWT1(I)+PFWET(I))
+      PWT3(I) = PTAB_FWET (I,I_IND_WT3(I))-(PWT2(I)+PWT1(I)+PFWET(I))
+      PWT4(I) = PTAB_FWET (I,I_IND_WT4(I))-(PWT3(I)+PWT2(I)+PWT1(I)+PFWET(I))
+   ELSE
+       PFSAT(I) = 0.0 !Australia
+       PFWET(I) = 0.0
+       PWT1(I) = 0.0
+       PWT2(I) = 0.0
+       PWT3(I) = 0.0
+       PWT4(I) = 0.0
+   ENDIF
+ENDDO
+!
+
+WHERE ( PTAB_WTOP(:,1) .EQ. PTAB_WTOP(:,900) )  
+    PFSAT(:)=0.0
+    PFWET(:)=0.0
+    PWT1(:)=0.0
+    PWT2(:)=0.0
+    PWT3(:)=0.0
+    PWT4(:)=0.0
+endwhere
+
+!prise en compte du gel pour diminuer les differentes fractions 
+WHERE ( phumtot_ave(:).GT. 0.0 )
+    PFSAT(:)=(1-pfrac_froz_fsat(:))*PFSAT(:)
+    PFWET(:)=(1-pfrac_froz_fsat(:))*PFWET(:)  
+    PWT1(:)= (1-pfrac_froz_fsat(:))*PWT1(:)
+    PWT2(:)= (1-pfrac_froz_fsat(:))*PWT2(:)
+    PWT3(:)= (1-pfrac_froz_fsat(:))*PWT3(:)
+    PWT4(:)= (1-pfrac_froz_fsat(:))*PWT4(:)
+ENDWHERE
+
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE hydro_subgrid_main
+END MODULE hydro_subgrid 
Index: /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_sechiba/init_top.f90
===================================================================
--- /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_sechiba/init_top.f90	(revision 6940)
+++ /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_sechiba/init_top.f90	(revision 6940)
@@ -0,0 +1,539 @@
+! =================================================================================================================================
+! MODULE        : init_top
+!
+! CONTACT       : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE       : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF        This module computes the parameters for TOPMODEL. 
+!!
+!!\n DESCRIPTION : contains.
+!! 
+!! RECENT CHANGE(S) : None
+!!
+!! REFERENCE(S) : None
+!!
+!! SVN          :
+!! $HeadURL: svn://forge.ipsl.jussieu.fr/orchidee/perso/shushi.peng/ORCHIDEE/src_sechiba/init_top.f90 $
+!! $Date: 2015-03-10 10:16:04 +0100 (Tue, 10 Mar 2015) $
+!! $Revision: 2535 $
+!! \n
+!_ ================================================================================================================================
+
+!-----------------------------------------------------------------
+!--------------- special set of characters for SCCS information
+!-----------------------------------------------------------------
+!      %Z% Lib:%F%, Version:%I%, Date:%D%, Last modified:%E%
+!-----------------------------------------------------------------
+!     ######################
+MODULE init_top 
+!     ######################
+!
+!
+!
+        USE ioipsl
+        USE constantes
+!        USE constantes_soil
+        USE pft_parameters
+!pss:!        USE constantes_veg
+!!        USE reqdprec
+        USE gammad_inc
+
+        IMPLICIT NONE
+        INTEGER, PARAMETER              :: IDOUBLE=KIND(1.D0)  ! Double precision
+CONTAINS
+!
+!     ######spl
+      SUBROUTINE init_top_main(kjpindex, lalo, veget_max, PWWILT, PWSAT, PD_TOP, PM, PTI_MIN, PTI_MAX, &
+                           PTI_MOY, PTI_STD, PTI_SKEW, PTAB_FSAT, PTAB_WTOP, PTAB_FWET, PTAB_WTOP_WET, ZPAS)
+!
+!
+!     #####################################################################
+!
+!!****  *INIT_TOP*  
+!!
+!!    PURPOSE
+!!    =======
+!
+!     Calculates the new array of the Datin-Saulnier TOPMODEL framework fonction for xsat and compute each 
+!     satured fraction for each xsat value of the grids cells but also the active TOPMODEL-layer array, 
+!     the normalized mean deficit array.
+!     For calculate new array, we use the incomplete gamma function. (see gamma_inc.f for more detail)
+!         
+!     
+!-------------------------------------------------------------------------------
+!
+!*       0.     DECLARATIONS
+!        ===================
+!
+!*      0.1    declarations of arguments
+!
+INTEGER(i_std), INTENT(in)                         :: kjpindex         !! Domain size
+REAL(r_std),DIMENSION (kjpindex,2), INTENT (in)     :: lalo       !! Geogr. coordinates (latitude,longitude) (degrees)
+REAL(r_std),DIMENSION (kjpindex,nvm), INTENT (in)  :: veget_max        !! Max. fraction of vegetation type (LAI -> infty)
+REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: PWWILT
+REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: PWSAT
+!                                       PWWILT = the wilting point volumetric 
+!                                                water content (m3 m-3)
+!                                       PWSAT  = saturation volumetric water content
+!                                                of the soil (m3 m-3)
+!
+
+REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: PTI_MIN
+REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: PTI_MAX
+REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: PTI_STD
+REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: PTI_SKEW
+REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: PM
+REAL(r_std), INTENT (in)       :: PD_TOP
+REAL(r_std),DIMENSION (kjpindex), INTENT (in)       :: PTI_MOY
+!                                       PTI_MOY  = ti mean
+!                                       PTI_MIN  = ti min
+!                                       PTI_MAX  = ti max
+!                                       PTI_STD  = ti standard deviation
+!                                       PTI_SKEW = ti skewness
+!                                       PM       = exponential decay factor of the local deficit
+!                                       PD_TOP   = Topmodel active soil depth
+!
+REAL(r_std), DIMENSION(kjpindex,1000), INTENT(OUT) :: PTAB_FSAT, PTAB_WTOP,PTAB_FWET, PTAB_WTOP_WET
+REAL(r_std), DIMENSION(kjpindex), INTENT (OUT)       :: ZPAS
+!                                       PTAB_FWET = Wetland fraction array
+!                                       PTAB_FSAT = Satured fraction array
+!                                       PTAB_WTOP = Active TOPMODEL-layer array
+!
+!*      0.2    declarations of local variables
+!
+REAL(KIND=IDOUBLE), DIMENSION(kjpindex)    :: ZXSAT
+!                                             ZXSAT = Initial satured index for all index 
+
+
+
+!
+REAL(KIND=IDOUBLE)    :: ZXI, ZPHI, ZNU, ZTI_MOY, ZTI_MAX, ZTI_MIN
+!                        ZTI_MOY = ti mean after regression
+!                        ZXI     = ti pdf parameter
+!                        ZPHI    = ti pdf parameter
+!                        ZNU     = ti pdf parameter
+!
+REAL(KIND=IDOUBLE)    :: ZFTOT, ZYMAX, ZYMIN
+REAL(KIND=IDOUBLE)    :: ZGYMAX, ZGYMIN
+!                        ZFTOT   = total fraction of a grid cell
+!                        ZYMAX   = yi maximum variable
+!                        ZYMIN   = yi minimum variable
+!                        ZGYMAX  = incomplete gamma function for ymax (GAMSTAR result)
+!                        ZGYMIN  = incomplete gamma function for ymin (GAMSTAR result)
+!
+REAL(KIND=IDOUBLE)    :: ZXSAT_IND, ZYSAT, ZY0, ZDMOY, ZXMOY, ZFMED, ZF0
+!                        ZXSAT_IND = Satured index for all index 
+!                        ZYSAT     = changing variable of satured index
+!                        ZY0       = changing variable of dry index
+!                        ZDMOY     = grid cell average deficit (= Dbar/M)
+!                        ZXMOY     = ti mean value on wet (1-fsat-f0) fraction
+!                        ZF0       = dry fraction
+!                        ZFMED     = wet (1-fsat-f0) fraction
+!
+REAL(KIND=IDOUBLE)    :: ZG, ZGYSAT, ZGY0
+!                        ZG     = GAM result 
+!                        ZGYSAT = the incomplete gamma function for ysat (GAMSTAR result)
+!                        ZGY0   = the incomplete gamma function for y0 (GAMSTAR result)
+!
+REAL(KIND=IDOUBLE)    :: ZD0, ZGAM_PHI
+!                        ZD0  = Normalized TOPMODEL maximum deficit D0/M coefficient
+!                        ZPAS = pas for calculate the new xsat values array
+!
+!
+INTEGER               :: IFLG, IFLGST
+!                        IFLG   = incomplete gamma function error flag (GAM result)
+!                        IFLGST = incomplete gamma function error flag (GAMSTAR result)
+!                                 (see gamma_inc.f for more detail)
+!
+INTEGER               :: INI, I, IND, JSI_MIN, JSI_MAX, IPAS, qq, I_zti_moy
+!    
+REAL(r_std),DIMENSION(kjpindex)              :: sum_veget
+
+!-------------------------------------------------------------------------------
+!
+!       1 TOPMODEL SURFACE RUNOFF SCHEME
+!       ================================
+!
+!  1.1     initialisation of local variable
+!  ----------------------------------------
+!
+
+sum_veget=SUM(veget_max(:,2:13),2)
+
+
+! Grid cells number
+!
+
+INI = kjpindex 
+IPAS = SIZE(PTAB_FSAT,2)
+!
+! GAM result (not use here !)
+!
+ZG  = 0.0
+!       
+! ti_sat values
+!
+ZXSAT(:) = PTI_MIN(:)-ZPAS(:)
+
+!
+!  1.2     Algorithme
+!  ------------------
+!
+!grid cells loops 
+!
+DO I=1,INI
+
+!la boucle suivante permet de calculer la fraction a wfc (1er pas de boucle) et la fraction wetland (2nd pas de temps de boucle)
+DO I_zti_moy=1,2
+
+!
+!   IF(PTI_SKEW(I)/=-99.99)THEN
+IF((PTI_SKEW(I)/=-99.99) .AND. (PTI_STD(I)/=-99.99) .AND. (PM(I) .GE. 0.01))THEN
+!   write(*,*) I, PTI_SKEW(I)
+!
+!  1.2.0 first initialisation
+!  --------------------------
+!
+   ZXI       = 0.0        
+   ZPHI      = 0.0
+   ZNU       = 0.0
+!
+!  Wolock and McCabe (2000) linear regression equation between the mean
+!  topographic index computed with a 1000 meter DEM and a 100 meter DEM.
+!
+!
+!   ZTI_MOY=0.961*PTI_MOY(I)-1.957
+
+
+   IF (I_zti_moy .EQ. 1)THEN
+      ZTI_MOY=PTI_MOY(I) 
+      ZTI_MIN=PTI_MIN(I)      
+      ZTI_MAX=PTI_MAX(I)
+   ELSEIF (I_zti_moy .EQ. 2)THEN
+      ZTI_MOY=PTI_MOY(I)+ SHIFT_fsat_fwet !shift de la distribution d indice topo
+      ZTI_MIN=PTI_MIN(I)+ SHIFT_fsat_fwet
+      ZTI_MAX=PTI_MAX(I)+ SHIFT_fsat_fwet
+      !! non necessaire de modifier le skewness et la std: SKWENESS(X+a)=SKWNESS(X) et STD(X+a)=STD(X)
+   ENDIF
+
+
+!  Calculate topographic index pdf parameters 
+!
+
+   ZXI  = PTI_SKEW(I)*PTI_STD(I)/2. 
+   if (ZXI .NE. 0.0) then
+   ZPHI = (PTI_STD(I)/ZXI)**2
+   ZNU  = PTI_MOY(I)-ZPHI*ZXI
+
+   !vire deserts
+   if ((ZPHI .LT. 100.0) .AND. ((PWSAT(I)-PWWILT(I)) .GT. min_sechiba) &
+        & .AND. (PWSAT(I) .GT. min_sechiba) .AND. (sum_veget(I) .GT. 0.01)) then
+
+   ZD0 = (PWSAT(I)-PWWILT(I))*PD_TOP/PM(I)
+
+!  Initialise
+!
+   ZGYMAX = 0.0
+   ZGYMIN = 0.0
+   ZFTOT  = 0.0
+   ZYMIN  = 0.0
+   ZYMAX  = 0.0
+!
+!  variable changing yi ---> (ti-nu)/xi
+!
+   ZYMIN = (ZTI_MIN-ZNU)/ZXI
+   ZYMAX = (ZTI_MAX-ZNU)/ZXI
+!  
+!  Supress numerical artifact
+!
+   ZYMIN = MAX(0.0,ZYMIN)
+!
+!  Errors flags indicating a number of error condition in G and GSTAR
+!  (see gamma_inc.f for more detail)
+!
+   IFLG        =0
+   IFLGST      =0
+!
+!  Computation of F(0 --> ymin)
+!
+   CALL DGAM(ZPHI,ZYMIN,2.,ZG,ZGYMIN,IFLG,IFLGST)
+!      
+!  if the incomplete gamma function don't work, print why
+!
+   IF (IFLGST/=0) PRINT*,'MAILLE =',I,'FLGST= ',IFLGST,'PHI= ',ZPHI,'YMIN= ',ZYMIN      
+!
+!  Computation of F(0 --> ymax)
+!
+   CALL DGAM(ZPHI,ZYMAX,2.,ZG,ZGYMAX,IFLG,IFLGST)
+!      
+!  if the incomplete gamma function don't work, print why
+!
+   IF (IFLGST/=0) PRINT*,'MAILLE =',I,'FLGST= ',IFLGST,'PHI= ',ZPHI,'YMAX= ',ZYMAX 
+!
+!  FTOT = F(0 --> ymax) - F(0 --> ymin)
+!
+   ZFTOT=ZGYMAX-ZGYMIN   
+   if (ZFTOT .NE. 0.0) then
+!
+!  initialization of loop control variables
+!
+   JSI_MAX = 0
+!
+!  Define the new limits for the satured index loop
+!
+   JSI_MIN = 1
+   JSI_MAX = IPAS
+   ZPAS(I)    = (ZTI_MAX-ZTI_MIN)/(IPAS-1)
+!
+!  1.2.2 Calculate all topmodel arrays
+!  -----------------------------------
+!
+!  Satured index loop
+!
+   DO IND=JSI_MIN,JSI_MAX
+!
+!     initialize of loops variables
+!
+      ZXSAT_IND = 0.0 
+      ZYSAT     = 0.0
+      ZY0       = 0.0
+      ZDMOY     = 0.0
+      ZXMOY     = 0.0
+      ZFMED     = 0.0
+!
+!     Initialize of incomplete gamma function flags and variables
+!
+      IFLG   = 0
+      IFLGST = 0
+      ZGYSAT = 0.0
+      ZGY0   = 0.0
+!
+!     calculate xsat for all new index
+!
+      ZXSAT_IND=ZTI_MIN+(IND-1)*ZPAS(I)
+!
+!     Changing variable to compute incomplete gamma function 
+!
+      ZYSAT=(ZXSAT_IND-ZNU)/ZXI
+      ZY0  =((ZXSAT_IND-ZD0)-ZNU)/ZXI
+!      
+!     Calculate Y0 and ysat and assume ymin < y0 < ymax !
+
+      ZYSAT=MAX(ZYMIN,MIN(ZYSAT,ZYMAX))
+      ZY0  =MAX(ZYMIN,MIN(ZY0,ZYMAX))
+!
+!     call incomplete gamma function for xsat
+!
+      CALL DGAM(ZPHI,ZYSAT,2.,ZG,ZGYSAT,IFLG,IFLGST)
+!
+!     if the incomplete gamma function don't works, print why
+!
+      IF (IFLGST/=0) print*,'MAILLE= ',I,'FLGST= ',IFLGST,'PHI= ',ZPHI,'YSAT= ',ZYSAT
+!
+!     call incomplete gamma function for xsat
+!
+      CALL DGAM(ZPHI,ZY0,2.,ZG,ZGY0,IFLG,IFLGST)
+!
+!     if the incomplete gamma function don't works, print why
+!
+      IF (IFLGST/=0) print*,'MAILLE= ',I,'FLGST= ',IFLGST,'PHI= ',ZPHI,'Y0= ',ZY0
+!
+!     compute satured fraction as FSAT = F(0 --> ymax) - F(0 --> ysat)
+!
+      IF (I_zti_moy .EQ. 1)THEN
+          PTAB_FSAT(I,IND)=(ZGYMAX-ZGYSAT)/ZFTOT
+      ELSEIF (I_zti_moy .EQ. 2)THEN
+          PTAB_FWET(I,IND)=(ZGYMAX-ZGYSAT)/ZFTOT
+      ENDIF
+!
+!     Calculate FMED =  F(0 --> ysat) - F(0 --> y0)
+!
+      ZFMED=MAX(0.0,((ZGYSAT-ZGY0)/ZFTOT))
+!
+!     compute driest fraction as F0 = 1-Fsat-Fwet
+!
+      IF (I_zti_moy .EQ. 1)THEN
+          ZF0=MAX(0.0,(1.0-PTAB_FSAT(I,IND)-ZFMED))  
+      ELSEIF (I_zti_moy .EQ. 2)THEN
+          ZF0=MAX(0.0,(1.0-PTAB_FWET(I,IND)-ZFMED))  
+      ENDIF
+   
+!
+      IF (ZFMED/=0.0) THEN
+!
+!        Compute the new x mean, xmoy', over the wet fraction Fwet
+!
+         CALL gamma(ZPHI, ZGAM_PHI)
+         
+         ZXMOY = ZNU+ZXI*(ZPHI+(EXP(-ZY0)*(ZY0**(ZPHI/2))*(ZY0**(ZPHI/2))     &
+              -EXP(-ZYSAT)*(ZYSAT**(ZPHI/2))*(ZYSAT**(ZPHI/2)))/(ZFMED*ZGAM_PHI))
+ 
+!        supress numerical artifacs
+!
+            ZXMOY =MAX((ZXSAT_IND-ZD0),MIN(ZXSAT_IND,ZXMOY))
+!
+!        Calculate the mean normalysed deficit as Dbar/M = (1-fsat-f0)*(xsat-xmoy')+f0*D0/M
+!
+            ZDMOY = ZFMED*(ZXSAT_IND-ZXMOY)+ZF0*ZD0
+!
+      ENDIF
+!
+!     supress numerical artifacs
+! 
+      ZDMOY = MAX(0.0,MIN(ZDMOY,ZD0))
+!
+!     Solves Dbar = (Wsat-WT)*d_top with Dbar/M (=ZDMOY) = (Wsat-WT)*d_top/M
+!
+      !modifie le calcul de PTAB_WTOP du au fait que le deficit est calcule par rapport a wfc et non par rapport a wsat
+
+      IF (I_zti_moy .EQ. 1)THEN
+          PTAB_WTOP(I,IND) = PWSAT(I)-(PM(I)*ZDMOY/PD_TOP)    
+!pss: should not minus PWWILT, otherwise not consistent with hydro_subgrid.f90
+!          PTAB_WTOP(I,IND) = PTAB_WTOP(I,IND) - PWWILT(I)
+      ELSEIF (I_zti_moy .EQ. 2)THEN
+         !ne modifie que une des deux fonctions (c.a.d PTAB_FSAT/PTAB_FWET et pas PTAB_WTOP)  
+         !PTAB_WTOP_WET(I,IND) = PWSAT(I)-(PM(I)*ZDMOY/PD_TOP(I))   
+         !PTAB_WTOP_WET(I,IND) = PTAB_WTOP_WET(I,IND) - PWWILT(I)
+         PTAB_WTOP_WET(I,IND) = PTAB_WTOP(I,IND)
+      ENDIF
+
+      !suprime eventuels pbs 
+      IF (I_zti_moy .EQ. 1)THEN     
+          IF ( PTAB_WTOP(I,IND) <= 0.0 ) PTAB_FSAT(I,IND) = 0.0
+!pss: normally not need to decide the over-saturation as zero saturated fraction
+!          IF ( PTAB_WTOP(I,IND) >= PWSAT(I) ) PTAB_FSAT(I,IND) = 0.0
+      ELSEIF (I_zti_moy .EQ. 2)THEN
+          IF ( PTAB_WTOP_WET(I,IND) <= 0.0 ) PTAB_FWET(I,IND) = 0.0
+!pss: normally not need to decide the over-saturation as zero saturated fraction
+!          IF ( PTAB_WTOP_WET(I,IND) >= PWSAT(I) ) PTAB_FWET(I,IND) = 0.0
+      ENDIF
+
+
+!
+    ENDDO
+
+ else !if (ZFTOT .NE. 0.0) then 
+
+     IF (I_zti_moy .EQ. 1)THEN
+     
+         PTAB_WTOP(I,:) = 0.0
+         PTAB_FSAT(I,:) = 0.0    
+     
+
+      ELSEIF (I_zti_moy .EQ. 2)THEN
+        
+          PTAB_WTOP_WET(I,:) = 0.0
+          PTAB_FWET(I,:) = 0.0    
+    
+
+      ENDIF
+       
+   endif !if (ZFTOT .NE. 0.0) then
+
+
+else ! if ((ZPHI .LT. 100.0) .AND. ((PWSAT(I)-PWWILT(I)) .GT. min_sechiba) .AND. (PWSAT(I) .GT. min_sechiba) .AND. (sum_veget(I) .GT. 0.02))
+   
+    IF (I_zti_moy .EQ. 1)THEN
+        
+        PTAB_WTOP(I,:) = 0.0
+        PTAB_FSAT(I,:) = 0.0    
+        
+        
+    ELSEIF (I_zti_moy .EQ. 2)THEN
+        
+        PTAB_WTOP_WET(I,:) = 0.0
+        PTAB_FWET(I,:) = 0.0    
+        
+        
+    ENDIF
+
+   !fin de la boucle if sur la condition ZPHI > 100.0
+endif ! if ((ZPHI .LT. 100.0) .AND....
+
+else
+
+    IF (I_zti_moy .EQ. 1)THEN
+        
+        PTAB_WTOP(I,:) = 0.0
+        PTAB_FSAT(I,:) = 0.0    
+        
+        
+    ELSEIF (I_zti_moy .EQ. 2)THEN
+        
+        PTAB_WTOP_WET(I,:) = 0.0
+        PTAB_FWET(I,:) = 0.0    
+        
+        
+    ENDIF
+
+
+
+
+ endif  !if (ZXI .NE. 0.0)
+
+    ELSE
+
+
+        IF (I_zti_moy .EQ. 1)THEN
+            
+            PTAB_WTOP(I,:) = 0.0
+            PTAB_FSAT(I,:) = 0.0    
+            
+            
+        ELSEIF (I_zti_moy .EQ. 2)THEN
+        
+            PTAB_WTOP_WET(I,:) = 0.0
+            PTAB_FWET(I,:) = 0.0    
+            
+            
+        ENDIF
+
+
+
+     ENDIF !IF((PTI_SKEW(I)/=-99.99) .AND. (PTI_STD(I)/=-99.99) .AND. (PM(I).GE. 0.01))
+!
+  ENDDO
+
+
+ENDDO
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE init_top_main 
+!
+!*******************************************
+!*           FUNCTION  GAMMA(X)            *
+!* --------------------------------------- *
+!* Returns the value of Gamma(x) in double *
+!* precision as EXP(LN(GAMMA(X))) for X>0. *
+!*******************************************
+!!!  real*8 Function gamma(xx)
+SUBROUTINE gamma(xx,gamma_re)
+  IMPLICIT NONE
+  REAL(r_std), INTENT(IN)   :: xx
+  REAL(r_std), INTENT(OUT)   :: gamma_re 
+  REAL cof(6),stp,half,one,fpf,x,tmp,ser
+  INTEGER j
+  DATA cof,stp /76.18009173d0,-86.50532033d0,24.01409822d0,  &
+       -1.231739516d0,0.120858003d-2,-0.536382d-5,2.50662827465d0/
+  DATA half,one,fpf /0.5d0,1.0d0,5.5d0/
+  x=xx-one
+!  PRINT*, 'x',x
+  tmp=x+fpf
+!  PRINT*, 'tmp', tmp
+  tmp=(x+half)*DLOG(tmp)-tmp
+!  PRINT*, 'tmp', tmp
+  ser=one
+  do j=1,6
+    x=x+one
+    ser=ser+cof(j)/x
+  end do
+!  PRINT*, 'ser', ser
+  gamma_re = DEXP(tmp+DLOG(stp*ser))
+!  return
+END SUBROUTINE gamma
+
+END MODULE init_top
+!
Index: /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_sticslai/Besoins_en_froid.f90
===================================================================
--- /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_sticslai/Besoins_en_froid.f90	(revision 6940)
+++ /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_sticslai/Besoins_en_froid.f90	(revision 6940)
@@ -0,0 +1,313 @@
+!> Module of vernalisation or chilling requirements
+!> - Stics book paragraphe 2.3.4, page 33-36
+!>
+!! Winter crops and perennial crops in temperate climate zones have vernalisation or chilling requirements.  The formalisations classically applied and used
+!! in STICS differ for herbaceous plants (vernalisation) and woody plants (dormancy).  For herbaceous plants, the resting state is considered not to be total,
+!! and the "vernalisation" formalisation which applies to herbaceous plants allows a partial accumulation of development units during winter rest.
+!! For woody plants the "dormancy" formalisations are much severe, and development units are only active when all chilling requirements have been met.
+!! Consequently, non-compliance with vernalisation requirements slows (rfvi <1 for herbaceous plants) or stops (rfvi = 0 for ligneous plants) the development of crops.
+!! For woody plants the post-dormancy period is characterized by the phasic course between dormancy break (ifindorm) and budding (ILEV), i.e. stdordebour.
+!>  - Vernalisation (achieved by function "Vernalisation" in this module)
+!!   Vernalisation requirements are defined by the genotype-dependent number of vernalising days (jvc) and the vernalising value of a given day (jvi) depends on
+!!   crop temperature.  Vernalising days are counted from germination (IGER) for annual crops because an active metabolism is required to initiate the process,
+!!   or from the julvernal day for perennial crops.  A minimum number of vernalising days, jvcmini is required. The progress in crop vernalisation, rfvi,
+!!   gradually increases until it reaches the value of 1.
+!!   tfroid (optimum vernalisation temperature) and ampfroid (thermal semi-amplitude of the vernalising effect) are parameters which provide the range of
+!!   vernalising activity of temperatures. ampfroid indicates the sensitivity of the species to vernalisation: if it is low, the range of vernalising temperatures
+!!   is narrow and a long period will be necessary to meet the requirements; if it is high, the temperature range is broader and results in more rapid vernalisation.
+!>  - Dormancy (achieved by functions "Dormancy_Richardson" and "Dormancy_Bidabe" in this module)
+!!   This module deals with the perennial dormancy and not with the dormancy break of annual crop grains such as wheat, barley or pea that can lead to germination
+!!   of the grain on the plants before harvest.
+!!   The aim is to calculate the day of break of dormancy (IFINDORM), which makes it possible to change the rfvi variable from 0 to 1, bearing in mind that it is
+!!   always possible to impose this date and ignore the following dormancy calculations. Two options are available to calculate the break of dormancy, relying on
+!!   well known formulae used for fruit trees for both vegetative or reproductive buds, and minimal and maximal values of the air temperature (tmin and tmax).
+!>      - The first dormancy calculation included in STICS (see function "Dormancy_Richardson") is the one by Richardson et al. (1974), developed for peach trees.
+!!       It is based on accumulated chilling hourly units (cuh) effective to ensure break of dormancy. The relationship between cuh and hourly temperature
+!!       is a "stepped" function.
+!!       In order to be able to use bibliographic references to chilling requirements, we reconstitute hourly temperatures in accordance with Richardson's proposals
+!!       (Richardson et al., 1974): min at 0 hour, tmax at 12 hours and linear interpolation between the two. The active sum of cuh starts in the autumn as soon
+!!       as the cuh are positive, defining idebdorm. The instability which may be generated by alternating positive and negative cuh has no effect on the final
+!!       result for dormancy break.
+!>      - The second dormancy calculation (see function "Dormancy_Bidabe") is derived from the formulation proposed by Bidabe in 1965 to calculate dormancy and
+!!       post-dormancy durations for apple trees, based on the Q10 notion which corresponds to exponential type responses to temperature.
+!!       In STICS, we just use what concerns the dormancy period, since the post-dormancy period (i.e. from IFINDORM to ILEV)
+!!       is accounted for by the positive responses to temperature. The daily responses are accumulated (cu) until the current day (I) from a starting date (idebdorm)
+!!       generally taken to be during the autumn or the summer (Garcia de Cortazar, 2006). It has little effect on the calculation. The genetic-dependent parameter
+!!       for the amount of chilling requirement is jvc.
+!*-----------------------------------------------------------------------------------------------------------------------------------------------------------* c!!
+module Besoins_en_froid
+
+USE Stics
+
+IMPLICIT NONE
+PRIVATE
+PUBLIC Vernalisation
+
+contains
+
+
+!> *************************************************** !
+!! * Calcul des besoins en froid (sortie de develop) * !
+!< *************************************************** !
+
+!> I comment the subroutine broid----xcwu
+
+
+!subroutine bfroid(tdev,P_codebfroid,caljvc,P_jvc,P_jvcmini,rfvi,etatvernal,P_codeperenne,P_culturean,P_codeinitprec,maxwth, &
+!!                  nbjanrec,nrecbutoir,P_tfroid,P_ampfroid,jjul,P_codedormance,thor,cu_min,cu_veille,cu,ndebdorm,n,P_q10,tmin,tmax)
+!! DR 20/07/2012 on a plus besoin de jjul
+!                  nbjanrec,nrecbutoir,P_tfroid,P_ampfroid,P_codedormance, & 
+!                  !   thor,cu_min,cu_veille,cu,ndebdorm,n,P_q10,tmin,tmax)
+!                  !-- apparemment, en trop, inutile ,numcult)
+!
+!implicit none
+!
+!!: les ARGUMENTS
+!  real,     intent(IN)     :: tdev  
+!  integer,  intent(IN)     :: P_codebfroid  !> // PARAMETER // option of calculation of chilling requirements // code 1/2 // PARPLT // 0 
+!  real,     intent(INOUT)  :: caljvc  
+!  real,     intent(IN)     :: P_jvc  !> // PARAMETER // Number of vernalizing days // day // PARPLT // 1 
+!  real,     intent(IN)     :: P_jvcmini  !> // PARAMETER // Minimum number of vernalising days  // day // PARPLT // 1 
+!  real,     intent(OUT)    :: rfvi   !> // OUTPUT // Slowing effect of the vernalization on plant development // 0-1
+!  logical,  intent(INOUT)  :: etatvernal  
+!  integer,  intent(IN)     :: P_codeperenne  !> // PARAMETER // option defining the annual (1) or perenial (2) character of the plant // code 1/2 // PARPLT // 0 
+!  integer,  intent(IN)     :: P_culturean  !> // PARAMETER // crop status 1 = over 1 calendar year ,other than 1  = on two calendar years (winter crop in northern hemisphere) // code 0/1 // P_USM/USMXML // 0 
+!  integer,  intent(IN)     :: P_codeinitprec  !> // PARAMETER // reinitializing initial status in case of chaining simulations : yes (1), no (2) // code 1/2 // PARAM // 0 
+!  integer,  intent(INOUT)  :: maxwth  
+!  integer,  intent(IN)     :: nbjanrec  
+!  integer,  intent(OUT)    :: nrecbutoir  
+!  real,     intent(IN)     :: P_tfroid  !> // PARAMETER // optimal temperature for vernalisation // degree C // PARPLT // 1
+!  real,     intent(IN)     :: P_ampfroid  !> // PARAMETER // semi thermal amplitude thermique for vernalising effect // degree C // PARPLT // 1
+!! DR 20/07/2012 on a plus besoin de jjul
+!!  integer,  intent(IN)     :: jjul
+!  integer,  intent(IN)     :: P_codedormance  !> // PARAMETER // option of calculation of dormancy and chilling requirement // code 1/2 // PARPLT // 0 
+!  real,     intent(IN)     :: thor(24)  
+!  real,     intent(IN)     :: cu_min  
+!  real,     intent(IN)     :: cu_veille  
+!  real,     intent(INOUT)  :: cu  
+!  integer,  intent(INOUT)  :: ndebdorm  
+!  integer,  intent(IN)     :: n  
+!  real,     intent(IN)     :: P_q10  !> // PARAMETER // P_Q10 used for the dormancy break calculation  // SD // PARPLT // 1 
+!  real,     intent(IN)     :: tmin   !> // OUTPUT // Minimum active temperature of air // degree C
+!  real,     intent(IN)     :: tmax   !> // OUTPUT // Maximum active temperature of air // degree C
+!  !--integer, intent(IN) :: numcult
+!
+!
+!  !: Cas des cultures vernalisantes NB le 13/3
+!  if (P_codebfroid == 2) then
+!    call Vernalisation(tdev,P_jvc,P_jvcmini,P_codeperenne,P_culturean,       &  ! IN
+!                       P_codeinitprec,nbjanrec,P_tfroid,P_ampfroid,n, &  ! IN   !!DR 20/07/2012 pas besoin de jjul
+!                       rfvi,nrecbutoir,maxwth,caljvc,etatvernal)        ! OUT & INOUT
+!  endif
+!
+!  !: Cas des cultures dormantes NB le 13/3
+!  !- calcul des Chill Units (Richardson, 1974)
+!  ! dr et igc 28/08/2012 test s'applique seulement à Richardson
+!  !if (P_codebfroid == 3 .and. P_codedormance <= 2) then
+!  if (P_codebfroid == 3 .and. P_codedormance == 2) then
+!    call Dormancy_Richardson(thor,n,cu_min,cu_veille,ndebdorm,cu)
+!  endif
+!
+!  !: calcul des besoins en froid selon Bidabe
+!  if (P_codebfroid == 3 .and. P_codedormance == 3) then
+!    call Dormancy_Bidabe(n,ndebdorm,P_q10,tmin,tmax,cu_veille,cu)
+!  endif
+!
+!return
+!end subroutine bfroid
+
+
+
+
+
+!DR et IGC 28/08/2012 on a renommé Stics_Bfroid2 Vernalisation
+!DR 20/07/2012 pas besoin de jjul
+!subroutine Vernalisation(tdev,P_jvc,P_jvcmini,P_codeperenne,P_culturean,P_codeinitprec,nbjanrec,P_tfroid,P_ampfroid,jjul,n, & !IN
+
+subroutine Vernalisation(tdev,            &     ! IN
+                         !P_jvc,
+                         !P_jvcmini,
+                         !P_codeperenne,
+                         !P_culturean,
+                         !P_codeinitprec,
+                         !nbjanrec,
+                         !P_tfroid,
+                         !P_ampfroid,
+                         !n,               & !IN
+                         rfvi,            &     ! OUT
+                         !nrecbutoir,
+                         !maxwth,
+                         caljvc,          &     ! INOUT
+                         etatvernal)            ! OUT
+
+!USE Messages
+
+!: ARGUMENTS
+!  0.1  INPUT
+   real,    intent(IN)    :: tdev  
+!  real,    intent(IN)    :: P_jvc  !> // PARAMETER // Number of vernalizing days // day // PARPLT // 1 
+!  real,    intent(IN)    :: P_jvcmini  !> // PARAMETER // Minimum number of vernalising days  // day // PARPLT // 1 
+!  integer, intent(IN)    :: P_codeperenne  !> // PARAMETER // option defining the annual (1) or perenial (2) character of the plant // code 1/2 // PARPLT // 0 
+!  integer, intent(IN)    :: P_culturean  !> // PARAMETER // crop status 1 = over 1 calendar year ,other than 1  = on two calendar years (winter crop in northern hemisphere) // code 0/1 //  
+!  integer, intent(IN)    :: P_codeinitprec  !> // PARAMETER // reinitializing initial status in case of chaining simulations : yes (1), no (2) // code 1/2 // PARAM // 0 
+!  integer, intent(IN)    :: nbjanrec  
+!  real,    intent(IN)    :: P_tfroid  !> // PARAMETER // optimal temperature for vernalisation // degree C // PARPLT // 1
+!  real,    intent(IN)    :: P_ampfroid  !> // PARAMETER // semi thermal amplitude thermique for vernalising effect // degree C // PARPLT // 1
+!!  integer, intent(IN)    :: jjul
+!  integer, intent(IN)    :: n  
+
+
+!  0.2 INOUT
+!  integer, intent(INOUT) :: maxwth  
+   real,    intent(INOUT) :: caljvc      
+   logical, intent(INOUT) :: etatvernal      
+
+!  0.3 OUTPUT
+!  integer, intent(OUT)   :: nrecbutoir  
+   real,    intent(OUT)   :: rfvi   !> // OUTPUT // Slowing effect of the vernalization on plant development // 0-1
+
+
+!  0.4 VARIABLES LOCALES
+  real :: jvi  
+
+
+  if (caljvc >= P_jvc) then
+    rfvi = 1.0
+    etatvernal = .TRUE.
+    caljvc  =  0.0
+    !if (P_codeperenne == 2 .and. P_culturean /= 1 .and. P_codeinitprec == 2) then
+    ! DR!   !!!!! 19/02/08 on fait un test pour la prairie ca merde!!!!!!!
+    ! maxwth  =  n
+    ! dr! 19/02/08 test
+    !  if (nbjanrec == 366)then
+    !    maxwth = 366
+    !  else
+    !    maxwth = 365
+    !  endif
+    !  nrecbutoir  =  maxwth
+    !endif
+  else
+    jvi = 1 - ((P_tfroid - tdev) / P_ampfroid)**2
+    jvi = amax1(jvi,0.)
+    caljvc = caljvc + jvi
+    if (caljvc >= P_jvc) then
+      rfvi = 1
+    else
+      rfvi = (caljvc -  P_jvcmini) / (P_jvc - P_jvcmini)
+      rfvi = amax1(rfvi,0.0)
+    endif
+    !: PB - 27/12/2004
+    !- si l'on est pendant la vernalisation et que l'on enchaine les années,
+    !- alors on repousse la date d'enchainement jusqu'à la fin de la vernalisation.
+    !if (n == maxwth) then
+    !  if (P_codeperenne == 2 .and. P_codeinitprec == 2) then
+    !    maxwth  =  maxwth + 1
+    !    nrecbutoir  =  maxwth
+    !    call EnvoyerMsgHistorique(431)
+    !  endif
+    !endif
+  endif
+  
+
+return
+end subroutine Vernalisation
+
+
+
+!======================================================================================!
+!======================================================================================!
+!======================================================================================!
+
+
+!!DR et IGC 28/08/2012 on a renommé Stics_Bfroid3_Dorm12 Dormancy_Richardson
+!subroutine Dormancy_Richardson(thor,n,cu_min,cu_veille,ndebdorm,cu)
+!
+!!: ARGUMENTS
+!! IN
+!  real,    intent(IN)    :: thor(24)  
+!  integer, intent(IN)    :: n  
+!  real,    intent(IN)    :: cu_min  
+!  real,    intent(IN)    :: cu_veille  
+!! INOUT
+!  integer, intent(INOUT) :: ndebdorm  
+!  real,    intent(INOUT) :: cu  
+!
+!!: VARIABLES LOCALES
+!  real    :: cuj  !>  
+!  real    :: cuh  
+!  integer :: ih  
+!
+!!: thor en argument
+!!-- ** 1/ reconstitution des températures horaires
+!!--    do ih = 1,12
+!!--      thor(ih) = tmin(n)+ih*(tmax(n)-tmin(n))/12.0
+!!--    end do
+!!--    do ih = 13,24
+!!--      thor(ih) = tmax(n)-(ih-12)*(tmax(n)-tmin(n+1))/12.0
+!!--    end do
+!
+!    !: Calcul des C(hill) U(nits)
+!    cuj = 0.0
+!    cuh = 0.0
+!    do ih = 1,24
+!      if (thor(ih) <= 1.4) cuh = 0.0
+!      if (thor(ih) > 1.4 .and. thor(ih) <= 2.4)  cuh = 0.5
+!      if (thor(ih) > 2.4 .and. thor(ih) <= 9.1)  cuh = 1.0
+!      if (thor(ih) > 9.1 .and. thor(ih) <= 12.4) cuh = 0.5
+!      if (thor(ih) > 12.4 .and. thor(ih) <= 15.9) cuh = 0.0
+!      if (thor(ih) > 15.9 .and. thor(ih) <= 17.5) cuh = -0.5
+!      if (thor(ih) > 17.5) cuh = -1
+!      ! Cumul horaire
+!      cuj = cuj+cuh
+!    end do
+!
+!    ! Cumul journalier
+!    cu = cu_veille + cuj
+!
+!    !: Rectification erreur dans l'entrée en dormance
+!    !- si températures faibles occasionnelles
+!    if (cu < 0) ndebdorm = 0
+!
+!    !: Détermination de l'entrée en dormance
+!    if (cu > cu_min .and. ndebdorm == 0) then
+!      ndebdorm = n
+!      cu = 0.
+!    endif
+!
+!return
+!end subroutine Dormancy_Richardson
+!
+!
+!!======================================================================================!
+!!======================================================================================!
+!!======================================================================================!
+!
+!!DR et IGC 28/08/2012 on a renommé Stics_Bfroid3_Dorm3 Dormancy_Bidabe
+!subroutine Dormancy_Bidabe(n,ndebdorm,P_q10,tmin,tmax,cu_veille,cu)
+!
+!!: ARGUMENTS
+!! IN
+!  integer,  intent(IN)    :: n  
+!  integer,  intent(IN)    :: ndebdorm  
+!  real,     intent(IN)    :: P_q10  !> // PARAMETER // P_Q10 used for the dormancy break calculation  // SD // PARPLT // 1 
+!  real,     intent(IN)    :: tmin   !> // OUTPUT // Minimum active temperature of air // degree C
+!  real,     intent(IN)    :: tmax   !> // OUTPUT // Maximum active temperature of air // degree C
+!  real,     intent(IN)    :: cu_veille  
+!
+!! INOUT
+!  real,     intent(INOUT) :: cu  
+!
+!
+!! ** début du cumul imposé à ndebdorm (cd initial)
+!    if (n < ndebdorm) then
+!      cu = 0.
+!    else
+!      cu = cu_veille + P_q10**(-tmin/10.) + P_q10**(-tmax/10.)
+!    endif
+!
+!return
+!end subroutine Dormancy_Bidabe
+!
+
+
+end module Besoins_en_froid
Index: /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_sticslai/CalculNombreDeFeuilles.f90
===================================================================
--- /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_sticslai/CalculNombreDeFeuilles.f90	(revision 6940)
+++ /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_sticslai/CalculNombreDeFeuilles.f90	(revision 6940)
@@ -0,0 +1,37 @@
+! ************************************* c
+! *  calcul du nombre de feuilles     * c
+! *  version 5.0   29/06/01           * c
+! ************************************* c
+! ****************************************************************
+!> Calculation of the number of leaves (nbfeuille) is mainly indicative.
+!> - Stics book paragraphe 3.1.5, page 48
+!!
+!> Its only active role is to define the duration of the plantlet phase when calculating
+!! frost risks. Indeed the plantlet stage is calculated as a leaf-number stage (2 or 3). nbfeuille is calculated up to the ILAX stage from the phyllotherm (phyllotherme)
+!! (the thermal period separating the emission of two successive leaves) expressed in crop degree.days as  for the phasic development.
+! *-----------------------------------------------------------------------------------------------------------------------------------------------------------* c
+subroutine CalculNombreDeFeuilles(nlax,udev,somfeuille,nbfeuille)
+   
+  USE Stics
+
+      
+  ! ARGUMENTS (IN)
+  !real,    intent(IN)    :: P_phyllotherme  !> // PARAMETER // thermal duration between the apparition of two successive leaves on the main stem // degree C day // PARPLT // 1
+  integer, intent(IN)    :: nlax  
+  real,    intent(IN)    :: udev  
+  
+  ! ARGUMENTS (INOUT)
+  real,    intent(INOUT) :: somfeuille  
+  integer, intent(INOUT) :: nbfeuille   !> // OUTPUT // Number of leaves on main stem // SD
+         
+    if (P_phyllotherme <= 0 .or. nlax > 0) return
+    
+    somfeuille = somfeuille + udev
+          
+    if (somfeuille > P_phyllotherme) then
+      nbfeuille = nbfeuille + 1
+      somfeuille = somfeuille - P_phyllotherme
+    endif
+      
+return
+end subroutine CalculNombreDeFeuilles
Index: /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_sticslai/Divers_develop.f90
===================================================================
--- /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_sticslai/Divers_develop.f90	(revision 6940)
+++ /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_sticslai/Divers_develop.f90	(revision 6940)
@@ -0,0 +1,153 @@
+
+
+module Divers_develop
+
+USE Stics
+
+
+IMPLICIT NONE
+PRIVATE
+PUBLIC calcul_UDev, cRFPI
+
+
+contains
+!======================================================================================!
+!======================================================================================!
+!======================================================================================!
+
+!> calculate the effects of temperature on UDev_cult (in unit of degree days), UDev_cult is something like the temperature of crop, but different with Tcult
+!> for more detailed information please see eq. 2.11 in page 29 in the STICS documentation -- XCWU 
+
+real function calcul_UDev(temp)
+  
+  real, intent(IN) :: temp  !> I don't know what is the temp? From the documentation , the temp should be the Tcult, but not the air temperature.
+  !real, intent(IN) :: P_tdmax  !> // PARAMETER // Maximum threshold temperature for development // degree C // PARPLT // 1
+  !real, intent(IN) :: P_tdmin  !> // PARAMETER // Minimum threshold temperature for development // degree C // PARPLT // 1
+  !real, intent(IN) :: P_tcxstop  !> // PARAMETER // threshold temperature beyond which the foliar growth stops (phasic growth stop) // degree C // PARPLT // 1
+
+  real :: udev ! pour alléger l'écriture, utilisation variable temporaire udev  
+
+    udev = max(0.,temp - P_tdmin)
+    if (P_tcxstop >= 100.0) then       !> the threshold temperature seems strange here but could be defined in the running definition file
+      if (temp > P_tdmax) udev = P_tdmax - P_tdmin
+    else   ! (P_tcxstop < 100)
+      if (temp > P_tdmax) then
+        udev = (P_tdmax - P_tdmin) / (-P_tcxstop + P_tdmax) * (temp - P_tcxstop)
+        udev = max(0.,udev)
+      endif
+    endif
+
+    calcul_UDev = udev ! on affecte la valeur de retour
+
+return
+end function calcul_UDev
+
+!======================================================================================!
+!======================================================================================!
+!======================================================================================!
+!> calculating the hourly temperatures
+!function calcul_TemperaturesHoraires(tmin, tmin_demain, tmax)
+!
+!  real, intent(IN)               :: tmin            !> arg. Température minimum  	  // OUTPUT // Minimum active temperature of air // degree C
+!  real, intent(IN)               :: tmin_demain     !> arg. Température minimum du lendemain  // Minimum temperature of the following day---Xiuchen Wu
+!  real, intent(IN)               :: tmax            !> arg. Température maximum  	  // OUTPUT // Maximum active temperature of air // degree C
+!
+!  real, dimension(24)            :: calcul_TemperaturesHoraires ! variable de retour  
+!
+!  integer :: ih ! locale  
+!
+!  do ih = 1,12
+!    calcul_TemperaturesHoraires(ih) = tmin + (ih * (tmax - tmin)/12.0)
+!  end do
+!
+!  do ih = 13,24
+!    calcul_TemperaturesHoraires(ih) = tmax - ((ih-12) * (tmax - tmin_demain)/12.0)
+!  end do
+!
+!return
+!end
+
+!======================================================================================!
+!======================================================================================!
+!======================================================================================!
+!> calculating the GDH, it seems a variable representing the accumulated active temperature for developement--XCW 
+!real function calcul_GDH(thor,P_tdmin,P_tdmax)
+!
+!  real, intent(IN), dimension(24) :: thor  ! arg. Temperatures Horaires sur 24 heures  
+!  real, intent(IN)                :: P_tdmin ! arg. Température de développement minimum 	  // PARAMETER // Minimum threshold temperature for development // degree C // PARPLT // 1
+!  real, intent(IN)                :: P_tdmax ! arg. Température de développement maximum 	  // PARAMETER // Maximum threshold temperature for development // degree C // PARPLT // 1
+!
+!  integer :: ih       ! locale  
+!  real :: udh         ! locale  
+!
+!    calcul_GDH = 0.
+!    do ih = 1,24
+!      udh = thor(ih) - P_tdmin
+!      if (thor(ih) < P_tdmin) udh = 0.0
+!      if (thor(ih) > P_tdmax) udh = P_tdmax - P_tdmin
+!      calcul_GDH = calcul_GDH + udh
+!    end do
+!
+!return
+!end
+
+
+!======================================================================================!
+!> slowly effect of the photoperiod on plant development
+real function cRFPI(phoi)
+
+  !real, intent(IN) :: P_sensiphot  !> // PARAMETER //  photoperiod sensitivity (1=insensitive) // SD // PARPLT // 1 
+  !real, intent(IN) :: P_phosat  !> // PARAMETER // saturating photoperiod // hours // PARPLT // 1 
+  !real, intent(IN) :: P_phobase  !> // PARAMETER // Base photoperiod  // hours // PARPLT // 1 
+  real, intent(IN) :: phoi   !> // OUTPUT // Photoperiod // hours
+
+    cRFPI = (1.0 - P_sensiphot) / (P_phosat - P_phobase) * (phoi - P_phosat) + 1.0
+    cRFPI = min(cRFPI,1.0)
+    cRFPI = max(cRFPI,P_sensiphot)
+     
+!    ! there may be problematic 
+!    cRFPI = max(cRFPI, 0.5)
+!    cRFPI = min(cRFPI, 1.0)
+return
+end function cRFPI
+
+!======================================================================================!
+! fonction de calcul de l'humidité correspondant à un potentiel du sol
+! utile pour la germination
+! NB 15/02 2007
+
+! calculate the moisture corresponding to a ground potential useful for germination
+
+!real function humpotsol(P_psihucc,P_psihumin,humin,hucc,dacouche,psiref,P_codefente)
+!
+!!: ARGUMENTS
+!  real,    intent(IN) :: P_psihucc  !> // PARAMETER // soil potential corresponding to field capacity  // Mpa // PARAM // 1 
+!  real,    intent(IN) :: P_psihumin  !> // PARAMETER // soil potential corresponding to wilting point // Mpa // PARAM // 1 
+!  real,    intent(IN) :: hucc  
+!  real,    intent(IN) :: humin  
+!  real,    intent(IN) :: dacouche  
+!  real,    intent(IN) :: psiref  
+!  integer, intent(IN) :: P_codefente  !> // PARAMETER // option allowing an additional water compartment for the swelling soils: yes (1), no (0) // code 0/1 // PARSOL // 0 
+!
+!!: Variables locales
+!  real :: bpsisol  
+!  real :: psisols  
+!  real :: wsat  
+!
+!  ! Calcul des paramètres de la courbe de rétention
+!    if (P_codefente == 1) then
+!      wsat = ((1.5 * hucc) - (0.5 * humin)) / 10.
+!    else
+!      wsat = 1. - (dacouche / 2.66)
+!    endif
+!
+!    bpsisol = log(P_psihucc / P_psihumin) / log(humin / hucc)
+!    psisols = P_psihumin * ((humin / (wsat *10 ))**bpsisol)
+!
+!  ! Calcul de l'humidité
+!    humpotsol = wsat * 10. * ((psiref / psisols)**(-1/bpsisol))
+!
+!return
+!end function humpotsol
+ 
+ end module Divers_develop
Index: /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_sticslai/F_humirac.f90
===================================================================
--- /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_sticslai/F_humirac.f90	(revision 6940)
+++ /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_sticslai/F_humirac.f90	(revision 6940)
@@ -0,0 +1,65 @@
+! *----------------------------------------------------------------* c
+! *   introduction d'une fonction continue entre pf4.2 et CC pour  * c
+! *   contraindre la germination et la levée                       * c
+! *----------------------------------------------------------------* c
+!> Introduction of a continuous function between pf4.2 and CC to Constrain germination and emergence
+!> calculate the effects of soil moisture in the seedbed on germination and this effect can be estimated by using the parameter of F_humirac as shown below--Xiuchen Wu
+
+module Divers_water
+
+  USE Stics
+
+  IMPLICIT NONE
+  PRIVATE
+  PUBLIC F_humirac
+ 
+  contains
+ 
+  real function F_humirac(h)
+  
+    IMPLICIT NONE
+  
+    real, intent(IN) :: h  
+    !real, intent(IN) :: hmin  
+    !real, intent(IN) :: hmax      !> // OUTPUT // Maximum height of water table between drains // cm
+    !real, intent(IN) :: P_sensrsec  !> // PARAMETER // root sensitivity to drought (1=insensitive) // SD // PARPLT // 1 
+    
+    !real :: x  
+  
+        
+        if (h > 0) then
+           F_humirac = P_sensrsec + (1. - P_sensrsec) * h
+        else
+           F_humirac = 0
+        endif
+  
+  
+  
+        if (F_humirac > 1.)  F_humirac = 1.
+        if (F_humirac < 0.)  F_humirac = 0.
+  
+       ! if (hmax /= hmin) then  
+       !   !: 10/06/03 - modif de fonction humirac avant pfp pour 
+       !   !-            aboutir à une absorption nulle pour h = 0
+       !   if (h > hmin) then
+       !     x = (h - hmin) / (hmax - hmin)
+       !     F_humirac = P_sensrsec + (1. - P_sensrsec) * x
+       !   else
+       !     F_humirac = P_sensrsec / hmin * h
+       !   endif
+       ! else
+       !   !: NB - 10/06/03
+       !   ! --if (h < hmin) humirac = P_sensrsec
+       !   if (h >= hmin) then
+       !     F_humirac = 1.0
+       !   else
+       !     F_humirac = P_sensrsec / hmin * h
+       !   endif
+       ! endif
+  
+       ! if (F_humirac > 1.)  F_humirac = 1.
+       ! if (F_humirac < 0.)  F_humirac = 0.
+  
+  return
+  end function F_humirac
+end module Divers_water
Index: /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_sticslai/Stics.f90
===================================================================
--- /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_sticslai/Stics.f90	(revision 6940)
+++ /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_sticslai/Stics.f90	(revision 6940)
@@ -0,0 +1,917 @@
+!> Module Stics
+!> - Description : Stics main module. 
+!! This module contains the main subroutine of LAIdev for calculating the LAI of crops
+!! This module is built by XCW. // 06/06/2013
+!>
+
+module Stics
+
+    USE ioipsl      ! USE the tools of ioipsl
+    USE grid        ! USE the module regarding the grid
+
+ 
+    IMPLICIT NONE 
+    PUBLIC driver_stics
+
+    !variable (parameters) declaration
+    INTEGER(i_std), PARAMETER :: crop_nbjmax = 300  !!Maximum days of a crop cycle simulation
+
+       CHARACTER(len=3)  :: P_codeplante
+       CHARACTER(len=3)  :: P_stade0
+       INTEGER(i_std)  :: P_iplt0
+       INTEGER(i_std)  :: P_iwater 
+       CHARACTER(len=7)  :: P_codesimul
+       INTEGER(i_std)  :: P_codelaitr
+       REAL(r_std)  :: P_slamax
+       REAL(r_std)  :: P_slamin
+       INTEGER(i_std)  :: P_codeperenne    !! annual crop (1) or perennial crop (2)
+       INTEGER(i_std)  :: P_codcueille     !! harvest option: cutting (1) or picking (2)
+       INTEGER(i_std)  :: P_codegdh        !! hourly (1) or daily (2) calculation of development unit 
+       INTEGER(i_std)  :: P_codetemp       !! 
+       INTEGER(i_std)  :: P_coderetflo
+       INTEGER(i_std)  :: P_codeinnact
+       INTEGER(i_std)  :: P_codeh2oact
+       REAL(r_std)  :: P_stressdev
+       REAL(r_std)  :: P_innlai
+       REAL(r_std)  :: P_innsenes
+       INTEGER(i_std)  :: P_codebfroid
+       INTEGER(i_std)  :: P_codephot
+       INTEGER(i_std)  :: P_codedormance
+       INTEGER(i_std)  :: P_codefauche     !! option of cut modes for forage crops: yes (1) no (2)
+       INTEGER(i_std)  :: P_codetempfauche !! option of the reference temperature to compute cutting sum of temperatures : upvt (1) udevair (2)
+       INTEGER(i_std)  :: P_codlainet
+       INTEGER(i_std)  :: P_codeindetermin
+       INTEGER(i_std)  :: P_codeinitprec
+       INTEGER(i_std)  :: P_culturean 
+       REAL(r_std)  :: P_jvc
+       REAL(r_std)  :: P_tfroid
+       REAL(r_std)  :: P_ampfroid 
+       REAL(r_std)  :: P_jvcmini
+       REAL(r_std)  :: P_tgmin
+       REAL(r_std)  :: P_stpltger
+       REAL(r_std)  :: P_profsem
+       REAL(r_std)  :: P_propjgermin        !! minimal proportion of the duration P_nbjgerlim when the temperature is higher than the temperature threshold P_Tdmax 
+       REAL(r_std)  :: P_tdmax
+       INTEGER(i_std)  :: P_nbjgerlim              !! Threshold number of day after grain imbibition without germination lack // days
+       REAL(r_std)  :: P_densitesem
+       REAL(r_std)  :: P_vigueurbat                !!  indicator of plant vigor allowing to emerge through the crust  // between 0 and 1 //
+       INTEGER(i_std)  :: P_codepluiepoquet              !!  option to replace rainfall by irrigation at poquet depth in the case of poquet sowing // code 1/2
+       INTEGER(i_std)  :: P_codehypo
+       REAL(r_std)  :: P_elmax
+       REAL(r_std)  :: P_belong
+       REAL(r_std)  :: P_celong
+       INTEGER(i_std)  :: P_nlevlim1             !! number of days after germination decreasing the emerged plants if emergence has not occur // days 
+       INTEGER(i_std)  :: P_nlevlim2             !! number of days after germination after which the emerged plants are null // days 
+       INTEGER(i_std)  :: P_codrecolte           !! harvest mode : all the plant (1) or just the fruits (2)
+       INTEGER(i_std)  :: P_variete              !! variety number in the technical file // SD
+       INTEGER(i_std)  :: P_codegermin           !! option of simulation of a germination phase or a delay at the beginning of the crop (1) or  direct starting (2)
+
+       INTEGER(i_std)  :: codeulaivernal
+       REAL(r_std)  :: P_swfacmin
+      
+       ! STICS:: LAI CALCULATION
+       REAL(r_std)  :: P_laiplantule
+       REAL(r_std)  :: P_vlaimax
+       REAL(r_std)  :: P_stlevamf
+       REAL(r_std)  :: P_stamflax
+       REAL(r_std)  :: P_udlaimax
+       REAL(r_std)  :: P_laicomp
+       REAL(r_std)  :: P_adens                   !! Interplant competition parameter 
+       REAL(r_std)  :: P_bdens
+       REAL(r_std)  :: P_tcxstop
+       REAL(r_std)  :: P_tcmax
+       REAL(r_std)  :: P_tcmin
+       REAL(r_std)  :: P_dlaimax
+       REAL(r_std)  :: P_dlaimin
+       REAL(r_std)  :: P_pentlaimax
+       REAL(r_std)  :: P_tigefeuil               !! stem (structural part)/leaf proportion // SD  
+
+       REAL(r_std)  :: P_stlaxsen
+       REAL(r_std)  :: P_stsenlan                   !! Interplant competition parameter 
+       REAL(r_std)  :: P_stlevdrp
+       REAL(r_std)  :: P_stflodrp
+       REAL(r_std)  :: P_stdrpmat
+       REAL(r_std)  :: P_stdrpdes
+       REAL(r_std)  :: P_phyllotherme
+       REAL(r_std)  :: P_lai0
+       REAL(r_std)  :: P_tustressmin
+
+       ! STICS:: LAI SENESCENCE  
+       INTEGER(i_std)  :: P_nbfgellev
+       INTEGER(i_std)  :: P_maxgs
+       REAL(r_std)  :: P_ratiodurvieI
+       REAL(r_std)  :: P_durvieF
+       REAL(r_std)  :: P_ratiosen
+       REAL(r_std)  :: P_tdmin
+!       ! Xuhui 140321
+!       INTEGER(i_std),SAVE :: doyhistst
+!       INTEGER(i_std),SAVE :: hist_sencour
+!       INTEGER(i_std),SAVE :: hist_latest
+!       REAL(r_std), DIMENSION(crop_nbjmax,5), SAVE :: histgrowth
+       ! 5 variables are dltai dltams tdevelop ulai durvie
+       ! intial these variables to zeros at Stics_init
+       ! end 140321
+      
+       ! STICS:: F_humerac
+
+       REAL(r_std)  :: P_sensrsec
+      
+       ! STICS:: GEL
+       INTEGER(i_std)  :: P_codgellev
+       INTEGER(i_std)  :: P_codgeljuv
+       INTEGER(i_std)  :: P_codgelveg
+       REAL(r_std)  :: P_tletale
+       REAL(r_std)  :: P_tdebgel
+       REAL(r_std)  :: P_tgellev10
+       REAL(r_std)  :: P_tgellev90
+       REAL(r_std)  :: P_tgeljuv10
+       REAL(r_std)  :: P_tgeljuv90
+       REAL(r_std)  :: P_tgelveg10
+       REAL(r_std)  :: P_tgelveg90
+       ! STICS:: Photoperiod
+       REAL(r_std)  :: P_sensiphot
+       REAL(r_std)  :: P_phosat
+       REAL(r_std)  :: P_phobase
+
+       INTEGER(i_std) :: P_codesla
+
+
+contains
+
+    subroutine driver_stics(n,                               &  ! IN
+                            in_cycle,                       &  ! INout  
+                            f_crop_recycle,                 &  ! INOUT
+                            f_sen_lai,                       &  ! INout  
+                            t2m_daily,                       &  ! IN  
+                            t2m_min_daily,                       &  ! IN  
+                            gdh_daily,                       &  ! IN
+                            phoi,                            &  ! IN
+                            onarretesomcourdrp,              &  ! IN                          
+                            stempdiag_cm_daily,              &  ! IN
+                            shumdiag_cm_day,                 &  ! IN
+!                            nlevobs,                         &  ! IN
+!                            namfobs,                         &  ! IN
+!                            nfloobs,                         &  ! IN
+!                            nlanobs,                         &  ! IN
+!                            nlaxobs,                         &  ! IN
+!                            nmatobs,                         &  ! IN
+!                            nrecobs,                         &  ! IN
+!                            nsenobs,                         &  ! IN
+!                            ndrpobs,                         &  ! IN
+                            dltams,                          &  ! IN
+                            eop,                             &  ! IN
+                            masec,                           &  ! IN
+                            masecveg,                        &  ! IN
+                            nsendltams,                      &  ! INOUT
+                            nsendltai,                       &
+                            nsenpfeuilverte,                 &
+                            nsendurvie,                      &
+                            nsenndurvie,                     &
+                            densiteequiv,                    &
+                            nplt,                            &
+                            tursla,                          &
+                            sla,                             &
+                            pfeuilverte,                     &
+                            bsenlai,                         &
+                            zrac,                            &
+                            nrec,                            &
+                            nlan,                            &
+                            tcult,                           &
+                            udevair,                         &
+                            udevcult,                        &
+                            ndrp,                            &
+                            rfvi,                            &
+                            nlev,                            &
+                            nger,                            &
+                            etatvernal,                      &
+                            caljvc,                          &
+                            rfpi,                            &
+                            upvt,                            &
+                            utp,                             &
+                            somcour,                         &
+                            somcourdrp,                      &
+                            somcourutp,                      &
+                            tdevelop,                        &
+                            somtemp,                         &
+                            somcourfauche,                   &
+                            stpltger,                        &
+                            R_stamflax,                      &
+                            R_stlaxsen,                      &
+                            R_stsenlan,                      &
+                            stlevflo,                        &
+                            nflo,                            &
+                            R_stlevdrp,                      &
+                            R_stflodrp,                      &
+                            R_stdrpmat,                      &
+                            nmat,                            &
+                            nlax,                            &
+                            nrecbutoir,                      &
+                            group,                           &
+                            ndebdes,                         &
+                            R_stdrpdes,                      &
+                            densite,                         &
+                            densitelev,                      &
+                            coeflev,                         &
+                            densiteger,                      &
+                            somelong,                        &
+                            somger,                          &
+                            humectation,                     &
+                            nbjhumec,                        &
+                            somtemphumec,                    &
+                            stpltlev,                        &
+                            namf,                            &
+                            stmatrec,                        &
+                            tustress,                        &
+                            slai,                             &
+                            somfeuille,                      &
+                            pdlai,                           &
+                            nbfeuille,                       &
+                            reajust,                         &
+                            ulai,                            &
+                            pdulai,                          &
+                            efdensite,                       &
+                            tempeff,                         &
+                            nstopfeuille,                    &
+                            deltai,                          &
+                            vmax,                            &
+                            nsen,                            &
+                            laisen,                          &
+                            dltaisenat,                      &
+                            nsencour,                        &
+                            dltamsen,                        &
+                            dltaisen,                        &
+                            fgellev,                         &
+                            gelee,                           &
+                            fstressgel,                      &
+                            pdlaisen,                        &
+                            R_stlevamf,                      &
+                            dernier_n,                       &
+                            durvieI,                         &
+                            durvie,                          &
+                            ndebsen,                         &
+                            somsenreste,                     &
+                            shumrel,                          &
+                            humrel,                          &
+                            swfac,                           &
+                            turfac,                          &
+                            senfac,                           & ! INOUT
+                            mafeuiljaune,                     &
+                            msneojaune,                       &
+                            gslen,                            &
+                            drylen,                            &
+                            vswc,                             &
+                            !! parameters      
+                            TP_codeplante,                     &           
+                            TP_stade0,                         &
+                            TP_iplt0,                          &
+                            TP_iwater,                         &
+                            TP_codesimul,                      &
+                            TP_codelaitr,&
+                            TP_slamax,&
+                            TP_slamin,&
+                            TP_codeperenne,&
+                            TP_codcueille,&
+                            TP_codegdh,&
+                            TP_codetemp,&
+                            TP_coderetflo,&
+                            TP_codeinnact,&
+                            TP_codeh2oact,&
+                            TP_stressdev,&
+                            TP_innlai,&
+                            TP_innsenes,&
+                            TP_codebfroid,&
+                            TP_codephot,&
+                            TP_codedormance,&
+                            TP_codefauche,&
+                            TP_codetempfauche,&
+                            TP_codlainet,&
+                            TP_codeindetermin,&
+                            TP_codeinitprec,&
+                            TP_culturean,&
+                            TP_jvc,&
+                            TP_tfroid,&
+                            TP_ampfroid,&
+                            TP_jvcmini,&
+                            TP_tgmin,&                                  
+                            TP_stpltger,&
+                            TP_profsem,&
+                            TP_propjgermin,&
+                            TP_tdmax,&
+                            TP_nbjgerlim,&
+                            TP_densitesem,&
+                            TP_vigueurbat,&
+                            TP_codepluiepoquet,&
+                            TP_codehypo,&
+                            TP_elmax,&
+                            TP_belong,&
+                            TP_celong,&
+                            TP_nlevlim1,& 
+                            TP_nlevlim2,&
+                            TP_codrecolte,&
+                            TP_variete,&
+                            TP_codegermin,&
+                            T_codeulaivernal,&
+                            TP_swfacmin,&
+                            TP_laiplantule,& 
+                            TP_vlaimax,&
+                            TP_stlevamf,&
+                            TP_stamflax,&
+                            TP_udlaimax,&     
+                            TP_laicomp,&
+                            TP_adens,&
+                            TP_bdens,&
+                            TP_tcxstop,&
+                            TP_tcmax,&
+                            TP_tcmin,&
+                            TP_dlaimax,&
+                            TP_dlaimin,&
+                            TP_pentlaimax,&
+                            TP_tigefeuil,&
+                            TP_stlaxsen,&
+                            TP_stsenlan,&
+                            TP_stlevdrp,&
+                            TP_stflodrp,&
+                            TP_stdrpmat,&
+                            TP_stdrpdes,&
+                            TP_phyllotherme,&
+                            TP_lai0,&
+                            TP_tustressmin,&
+                            ! STICS:: SENESCENCE
+                            TP_nbfgellev,&
+                            TP_maxgs,&
+                            TP_ratiodurvieI,&
+                            TP_durvieF,&
+                            TP_ratiosen,&
+                            TP_tdmin,&
+                            ! STICS:: F_Humarec
+                            TP_sensrsec,&
+                            ! STICS:: GEL
+                            TP_codgellev,&
+                            TP_codgeljuv,&
+                            TP_codgelveg,&
+                            TP_tletale,&
+                            TP_tdebgel,&
+                            TP_tgellev10,&
+                            TP_tgellev90,&
+                            TP_tgeljuv10,&
+                            TP_tgeljuv90,&
+                            TP_tgelveg10,&
+                            TP_tgelveg90,&
+                            ! STICS:: Photoperiod
+                            TP_sensiphot,&
+                            TP_phosat,&
+                            TP_phobase,&
+                            histgrowth,&
+                            hist_sencour, &
+                            hist_latest, &
+                            doyhistst, &
+                            nbox, boxulai, boxndays, boxlai, boxlairem,boxtdev, boxbiom, boxbiomrem, boxdurage, boxsomsenbase, &
+                            codesla)
+
+
+       implicit none
+
+       ! DECLARATION
+       
+       ! 0.1 input
+       ! These variables should be transmitted from ORCHIDEE or initialized only once 
+
+       
+       integer(i_std), intent(IN)                           :: n    ! simulation date  // julian day 
+       logical, intent(inout)                                  :: in_cycle
+       logical, intent(inout)                                  :: f_crop_recycle
+       logical, intent(inout)                                  :: f_sen_lai
+       real(r_std),    intent(IN)                           :: t2m_daily  !> / Mean air temperature of the day // degree C
+       real(r_std),    intent(IN)                           :: t2m_min_daily  !> / minimum air temperature of the day // degree C
+       real(r_std),    intent(IN)                           :: gdh_daily  !> // daily gdh calculated according to halfhourly temperature // transmitted from stomate.f90 gdh_daily
+       real(r_std),    intent(IN)                           :: phoi   !> // OUTPUT // Photoperiod // hours
+       logical, intent(IN)                           :: onarretesomcourdrp 
+       real(r_std),    intent(IN), dimension(3)             :: stempdiag_cm_daily !> / soil temperature at 1 cm resolution for the sowing depth and neighbour layers // Degree C 
+       real(r_std),    intent(IN), dimension(3)             :: shumdiag_cm_day     !> /soil moisture at 1 cm resolution for the sowing depth and neighbour layers // unit m3 m-3 with values ranging 0-1
+!!!!! local variable
+       integer(i_std)            :: nlevobs    ! the following variables ended with obs are only used for forcing simulation.  
+       integer(i_std)            :: namfobs    ! the initial value should be always 999
+       integer(i_std)            :: nfloobs  
+       integer(i_std)            :: nlanobs  
+       integer(i_std)            :: nlaxobs  
+       integer(i_std)            :: nmatobs  
+       integer(i_std)            :: nrecobs  
+       integer(i_std)            :: nsenobs  
+       integer(i_std)            :: ndrpobs  
+!!!!! local variable
+       real(r_std),    intent(IN)                           :: dltams     ! biomass growth rate  // t ha-1 day-1
+       real(r_std),    intent(IN)                           :: eop        ! potential evaportranspiration //  mm 
+       real(r_std),    intent(INOUT)                        :: masec        ! aboveground biomass   // t ha-1
+       real(r_std),    intent(IN)                           :: masecveg     ! vegetative dry matter // t ha-1
+       real(r_std),    intent(IN)                           :: vswc    ! volumetric soil water content
+
+       ! 0.1 input--parameters
+
+       CHARACTER(len=3), INTENT(IN) :: TP_codeplante
+       CHARACTER(len=3), INTENT(IN) :: TP_stade0
+       INTEGER(i_std), INTENT(IN) :: TP_iplt0
+       INTEGER(i_std), INTENT(IN) :: TP_iwater 
+       CHARACTER(len=7), INTENT(IN) :: TP_codesimul
+       INTEGER(i_std), INTENT(IN) :: TP_codelaitr
+       REAL(r_std), INTENT(IN) :: TP_slamax
+       REAL(r_std), INTENT(IN) :: TP_slamin
+       INTEGER(i_std), INTENT(IN) :: TP_codeperenne    !! annual crop (1) or perennial crop (2)
+       INTEGER(i_std), INTENT(IN) :: TP_codcueille     !! harvest option: cutting (1) or picking (2)
+       INTEGER(i_std), INTENT(IN) :: TP_codegdh        !! hourly (1) or daily (2) calculation of development unit 
+       INTEGER(i_std), INTENT(IN) :: TP_codetemp       !! 
+       INTEGER(i_std), INTENT(IN) :: TP_coderetflo
+       INTEGER(i_std), INTENT(IN) :: TP_codeinnact
+       INTEGER(i_std), INTENT(IN) :: TP_codeh2oact
+       REAL(r_std), INTENT(IN) :: TP_stressdev
+       REAL(r_std), INTENT(IN) :: TP_innlai
+       REAL(r_std), INTENT(IN) :: TP_innsenes
+       INTEGER(i_std), INTENT(IN) :: TP_codebfroid
+       INTEGER(i_std), INTENT(IN) :: TP_codephot
+       INTEGER(i_std), INTENT(IN) :: TP_codedormance
+       INTEGER(i_std), INTENT(IN) :: TP_codefauche     !! option of cut modes for forage crops: yes (1), no (2)
+       INTEGER(i_std), INTENT(IN) :: TP_codetempfauche !! option of the reference temperature to compute cutting sum of temperatures : upvt (1), udevair (2)
+       INTEGER(i_std), INTENT(IN) :: TP_codlainet
+       INTEGER(i_std), INTENT(IN) :: TP_codeindetermin
+       INTEGER(i_std), INTENT(IN) :: TP_codeinitprec
+       INTEGER(i_std), INTENT(IN) :: TP_culturean 
+       REAL(r_std), INTENT(IN) :: TP_jvc
+       REAL(r_std), INTENT(IN) :: TP_tfroid
+       REAL(r_std), INTENT(IN) :: TP_ampfroid 
+       REAL(r_std), INTENT(IN) :: TP_jvcmini
+       REAL(r_std), INTENT(IN) :: TP_tgmin
+       REAL(r_std), INTENT(IN) :: TP_stpltger
+       REAL(r_std), INTENT(IN) :: TP_profsem
+       REAL(r_std), INTENT(IN) :: TP_propjgermin              !! minimal proportion of the duration TP_nbjgerlim when the temperature is higher than the temperature threshold TP_Tdmax 
+       REAL(r_std), INTENT(IN) :: TP_tdmax
+       INTEGER(i_std), INTENT(IN) :: TP_nbjgerlim              !! Threshold number of day after grain imbibition without germination lack // days
+       REAL(r_std), INTENT(IN) :: TP_densitesem
+       REAL(r_std), INTENT(IN) :: TP_vigueurbat                !!  indicator of plant vigor allowing to emerge through the crust  // between 0 and 1 //
+       INTEGER(i_std), INTENT(IN) :: TP_codepluiepoquet              !!  option to replace rainfall by irrigation at poquet depth in the case of poquet sowing // code 1/2
+       INTEGER(i_std), INTENT(IN) :: TP_codehypo
+       REAL(r_std), INTENT(IN) :: TP_elmax
+       REAL(r_std), INTENT(IN) :: TP_belong
+       REAL(r_std), INTENT(IN) :: TP_celong
+       INTEGER(i_std), INTENT(IN) :: TP_nlevlim1             !! number of days after germination decreasing the emerged plants if emergence has not occur // days 
+       INTEGER(i_std), INTENT(IN) :: TP_nlevlim2             !! number of days after germination after which the emerged plants are null // days 
+       INTEGER(i_std), INTENT(IN) :: TP_codrecolte           !! harvest mode : all the plant (1) or just the fruits (2)
+       INTEGER(i_std), INTENT(IN) :: TP_variete              !! variety number in the technical file // SD
+       INTEGER(i_std), INTENT(IN) :: TP_codegermin           !! option of simulation of a germination phase or a delay at the beginning of the crop (1) or  direct starting (2)
+
+       INTEGER(i_std), INTENT(IN) :: T_codeulaivernal
+       REAL(r_std), INTENT(IN)    :: TP_swfacmin
+
+
+       ! STICS:: LAI CALCULATION
+       REAL(r_std), INTENT(IN) :: TP_laiplantule
+       REAL(r_std), INTENT(IN) :: TP_vlaimax
+       REAL(r_std), INTENT(IN) :: TP_stlevamf
+       REAL(r_std), INTENT(IN) :: TP_stamflax
+       REAL(r_std), INTENT(IN) :: TP_udlaimax
+       REAL(r_std), INTENT(IN) :: TP_laicomp
+       REAL(r_std), INTENT(IN) :: TP_adens                   !! Interplant competition parameter 
+       REAL(r_std), INTENT(IN) :: TP_bdens
+       REAL(r_std), INTENT(IN) :: TP_tcxstop
+       REAL(r_std), INTENT(IN) :: TP_tcmax
+       REAL(r_std), INTENT(IN) :: TP_tcmin
+       REAL(r_std), INTENT(IN) :: TP_dlaimax
+       REAL(r_std), INTENT(IN) :: TP_dlaimin
+       REAL(r_std), INTENT(IN) :: TP_pentlaimax
+       REAL(r_std), INTENT(IN) :: TP_tigefeuil               !! stem (structural part)/leaf proportion // SD  
+
+       REAL(r_std), INTENT(IN) :: TP_stlaxsen
+       REAL(r_std), INTENT(IN) :: TP_stsenlan
+       REAL(r_std), INTENT(IN) :: TP_stlevdrp
+       REAL(r_std), INTENT(IN) :: TP_stflodrp
+       REAL(r_std), INTENT(IN) :: TP_stdrpmat
+       REAL(r_std), INTENT(IN) :: TP_stdrpdes
+       REAL(r_std), INTENT(IN) :: TP_phyllotherme  
+       REAL(r_std), INTENT(IN) :: TP_lai0
+       REAL(r_std), INTENT(IN) :: TP_tustressmin  
+       
+       ! STICS:: LAI SENESCENCE  
+       INTEGER(i_std), INTENT(IN) :: TP_nbfgellev
+       INTEGER(i_std), INTENT(IN) :: TP_maxgs
+       REAL(r_std), INTENT(IN) :: TP_ratiodurvieI
+       REAL(r_std), INTENT(IN) :: TP_durvieF
+       REAL(r_std), INTENT(IN) :: TP_ratiosen
+       REAL(r_std), INTENT(IN) :: TP_tdmin
+       ! STICS:: F_Humarec
+       
+       REAL(r_std), INTENT(IN) :: TP_sensrsec
+       
+       ! STICS:: GEL
+       INTEGER(i_std), INTENT(IN) :: TP_codgellev
+       INTEGER(i_std), INTENT(IN) :: TP_codgeljuv
+       INTEGER(i_std), INTENT(IN) :: TP_codgelveg
+       REAL(r_std), INTENT(IN) :: TP_tletale
+       REAL(r_std), INTENT(IN) :: TP_tdebgel
+       REAL(r_std), INTENT(IN) :: TP_tgellev10
+       REAL(r_std), INTENT(IN) :: TP_tgellev90
+       REAL(r_std), INTENT(IN) :: TP_tgeljuv10
+       REAL(r_std), INTENT(IN) :: TP_tgeljuv90
+       REAL(r_std), INTENT(IN) :: TP_tgelveg10
+       REAL(r_std), INTENT(IN) :: TP_tgelveg90
+  
+       ! STICS:: Photoperiod
+
+       REAL(r_std), INTENT(IN) :: TP_sensiphot
+       REAL(r_std), INTENT(IN) :: TP_phosat
+       REAL(r_std), INTENT(IN) :: TP_phobase
+       INTEGER(i_std), INTENT(IN) :: codesla
+       REAL(r_std), INTENT(IN) :: humrel
+       ! 0.2 inout
+       ! these variables should ba all saved in Stomate.f90 for historical interaction
+
+       ! these variables are for laidev specifically
+       real, intent(INOUT)        :: nsendltams
+       real, intent(INOUT)        :: nsendltai
+       real, intent(INOUT)        :: nsenpfeuilverte
+       real, intent(INOUT)        :: nsendurvie
+       real, intent(INOUT)        :: nsenndurvie
+       real, intent(INOUT)        :: densiteequiv
+       integer, intent(INOUT)        :: nplt
+       real, intent(INOUT)        :: tursla
+       real, intent(INOUT)        :: sla
+       real, intent(INOUT)        :: pfeuilverte
+       real, intent(INOUT)        :: bsenlai
+       
+       ! variables are involved in DEVELOPMENT
+
+       real,    intent(INOUT)        :: zrac
+       integer, intent(INOUT)        :: nrec
+       integer, intent(INOUT)        :: nlan
+       real,    intent(INOUT)        :: tcult
+       real,    intent(INOUT)        :: udevair
+       real,    intent(INOUT)        :: udevcult
+       integer,    intent(INOUT)        :: ndrp
+       real,    intent(INOUT)        :: rfvi
+       integer,    intent(INOUT)        :: nlev
+       integer,    intent(INOUT)        :: nger
+       logical,    intent(INOUT)        :: etatvernal
+       real,    intent(INOUT)        :: caljvc
+       real,    intent(INOUT)        :: rfpi
+       real,    intent(INOUT)        :: upvt
+       real,    intent(INOUT)        :: utp
+       real,    intent(INOUT)        :: somcour
+       real,    intent(INOUT)        :: somcourdrp
+       real,    intent(INOUT)        :: somcourutp
+       real,    intent(INOUT)        :: tdevelop
+       real,    intent(INOUT)        :: somtemp
+       real,    intent(INOUT)        :: somcourfauche
+       real,    intent(INOUT)        :: stpltger
+       real,    intent(INOUT)        :: R_stamflax
+       real,    intent(INOUT)        :: R_stlaxsen
+       real,    intent(INOUT)        :: R_stsenlan
+       real,    intent(INOUT)        :: stlevflo
+       integer,    intent(INOUT)        :: nflo
+       real,    intent(INOUT)        :: R_stlevdrp
+       real,    intent(INOUT)        :: R_stflodrp
+       real,    intent(INOUT)        :: R_stdrpmat
+       integer,    intent(INOUT)        :: nmat
+       integer,    intent(INOUT)        :: nlax
+       integer,    intent(INOUT)        :: nrecbutoir
+       real,    intent(INOUT)        :: group
+       integer,    intent(INOUT)        :: ndebdes
+       real,    intent(INOUT)        :: R_stdrpdes
+       real,    intent(INOUT)        :: densite
+       real,    intent(INOUT)        :: densitelev
+       real,    intent(INOUT)        :: coeflev
+       real,    intent(INOUT)        :: densiteger
+       real,    intent(INOUT)        :: somelong
+       real,    intent(INOUT)        :: somger
+       logical,    intent(INOUT)        :: humectation
+       integer,    intent(INOUT)        :: nbjhumec
+       real,    intent(INOUT)        :: somtemphumec
+       real,    intent(INOUT)        :: stpltlev
+       integer,    intent(INOUT)        :: namf
+       real,    intent(INOUT)        :: stmatrec
+ 
+       ! these variables are involved in Lai_calculation
+        
+       real,    intent(INOUT)        :: tustress
+       real,    intent(INOUT)        :: slai
+       real,    intent(INOUT)        :: somfeuille
+       real,    intent(INOUT)        :: pdlai
+       integer,    intent(INOUT)        :: nbfeuille
+       real,    intent(INOUT)        :: reajust
+       real,    intent(INOUT)        :: ulai
+       real,    intent(INOUT)        :: pdulai
+       real,    intent(INOUT)        :: efdensite
+       real,    intent(INOUT)        :: tempeff
+       integer,    intent(INOUT)        :: nstopfeuille
+       real,    intent(INOUT)        :: deltai
+       real,    intent(INOUT)        :: vmax
+       integer,    intent(INOUT)        :: nsen
+       real,    intent(INOUT)        :: laisen
+       real,    intent(INOUT)        :: dltaisenat
+       ! Xuhui 140321
+       INTEGER(i_std), intent(INOUT) :: doyhistst
+       INTEGER(i_std), intent(INOUT) :: hist_sencour
+       INTEGER(i_std), intent(INOUT) :: hist_latest
+       REAL(r_std), DIMENSION(300,5), intent(INOUT) :: histgrowth
+       !end histgrowth
+
+       ! these variables are involved in the LAIsenescence
+
+       integer,    intent(INOUT)      :: nsencour
+       real,    intent(INOUT)      :: dltamsen
+       real,    intent(INOUT)      :: dltaisen
+       real,    intent(INOUT)      :: fgellev
+       logical,    intent(INOUT)      :: gelee
+       real,    intent(INOUT)      :: fstressgel
+       real,    intent(INOUT)      :: pdlaisen
+       real,    intent(INOUT)      :: R_stlevamf
+       integer,    intent(INOUT)      :: dernier_n
+       real,    intent(INOUT)      :: durvieI
+       real,    intent(INOUT)      :: durvie
+       integer,    intent(INOUT)      :: ndebsen
+       real,    intent(INOUT)      :: somsenreste
+
+       ! compartment senescence module
+!boxulai, boxndays, boxlai, boxlairem,boxtdev, boxbiom, boxbiomrem, boxdurage, boxsomsenbase
+       integer(i_std), intent(IN)                  :: nbox
+       real(r_std), dimension(nbox), intent(INOUT) :: boxulai
+       integer(i_std), dimension(nbox), intent(INOUT) :: boxndays
+       real(r_std), dimension(nbox), intent(INOUT) :: boxlai
+       real(r_std), dimension(nbox), intent(INOUT) :: boxlairem
+       real(r_std), dimension(nbox), intent(INOUT) :: boxtdev
+       real(r_std), dimension(nbox), intent(INOUT) :: boxbiom
+       real(r_std), dimension(nbox), intent(INOUT) :: boxbiomrem
+       real(r_std), dimension(nbox), intent(INOUT) :: boxdurage
+       real(r_std), dimension(nbox), intent(INOUT) :: boxsomsenbase
+       
+
+       ! these variables are involved in STRESS calculation
+       
+       real,    intent(INOUT)      :: shumrel
+       real,    intent(INOUT)      :: swfac
+       real,    intent(INOUT)      :: turfac
+       real,    intent(INOUT)      :: senfac
+
+       ! these variables are involved in CARBON ALLOCATION PROCESSES
+       real,    intent(INOUT)      :: mafeuiljaune      !  Dry matter of yellow leaves // t.ha-1
+       real,    intent(INOUT)      :: msneojaune        ! Newly-formed senescent dry matter  // t.ha-1
+       integer,    intent(INOUT)      :: gslen
+       integer,    intent(INOUT)      :: drylen
+
+       ! assignment 
+       nlevobs = 999
+       namfobs = 999
+       nfloobs = 999
+       nlanobs = 999
+       nlaxobs = 999
+       nmatobs = 999
+       nrecobs = 999
+       nsenobs = 999
+       ndrpobs = 999
+
+       P_codeplante = TP_codeplante
+       P_stade0 = TP_stade0
+       P_iplt0 = TP_iplt0
+       P_iwater = TP_iwater
+       P_codesimul = TP_codesimul
+       P_codelaitr = TP_codelaitr
+       P_slamax = TP_slamax
+       P_slamin = TP_slamin
+       P_codeperenne = TP_codeperenne
+       P_codcueille = TP_codcueille
+       P_codegdh = TP_codegdh
+       P_codetemp = TP_codetemp
+       P_coderetflo = TP_coderetflo
+       P_codeinnact = TP_codeinnact
+       P_codeh2oact = TP_codeh2oact
+       P_stressdev = TP_stressdev
+       P_innlai = TP_innlai
+       P_innsenes = TP_innsenes
+       P_codebfroid = TP_codebfroid
+       P_codephot = TP_codephot
+       P_codedormance = TP_codedormance
+       P_codefauche = TP_codefauche
+       P_codetempfauche = TP_codetempfauche
+       P_codlainet = TP_codlainet
+       P_codeindetermin = TP_codeindetermin
+       P_codeinitprec = TP_codeinitprec
+       P_culturean = TP_culturean
+       P_jvc = TP_jvc
+       P_tfroid = TP_tfroid
+       P_ampfroid = TP_ampfroid
+       P_jvcmini = TP_jvcmini
+       P_tgmin = TP_tgmin
+       P_stpltger = TP_stpltger
+       P_profsem = TP_profsem
+       P_propjgermin = TP_propjgermin
+       P_tdmax = TP_tdmax
+       P_nbjgerlim = TP_nbjgerlim
+       P_densitesem = TP_densitesem
+       P_vigueurbat = TP_vigueurbat
+       P_codepluiepoquet = TP_codepluiepoquet
+       P_codehypo = TP_codehypo
+       P_elmax = TP_elmax
+       P_belong = TP_belong
+       P_celong = TP_celong
+       P_nlevlim1 = TP_nlevlim1
+       P_nlevlim2 = TP_nlevlim2
+       P_codrecolte = TP_codrecolte
+       P_variete = TP_variete
+       P_codegermin = TP_codegermin
+       
+       codeulaivernal = T_codeulaivernal
+       P_swfacmin = TP_swfacmin
+
+
+       P_laiplantule = TP_laiplantule
+       P_vlaimax = TP_vlaimax
+       P_stlevamf = TP_stlevamf
+       P_stamflax = TP_stamflax
+       P_udlaimax = TP_udlaimax
+       P_laicomp = TP_laicomp
+       P_adens = TP_adens
+       P_bdens = TP_bdens
+       P_tcxstop = TP_tcxstop
+       P_tcmax = TP_tcmax
+       P_tcmin = TP_tcmin
+       P_dlaimax = TP_dlaimax
+       P_dlaimin = TP_dlaimin
+       P_pentlaimax = TP_pentlaimax
+       P_tigefeuil = TP_tigefeuil
+ 
+       P_stlaxsen = TP_stlaxsen
+       P_stsenlan = TP_stsenlan
+       P_stlevdrp = TP_stlevdrp
+       P_stflodrp = TP_stflodrp
+       P_stdrpmat = TP_stdrpmat
+       P_stdrpdes = TP_stdrpdes
+       P_phyllotherme = TP_phyllotherme
+       P_lai0 = TP_lai0
+       P_tustressmin = TP_tustressmin
+       ! STICS:: SENESCENCE
+       P_nbfgellev = TP_nbfgellev
+       P_maxgs = TP_maxgs
+       P_ratiodurvieI = TP_ratiodurvieI
+       P_durvieF = TP_durvieF
+       P_ratiosen = TP_ratiosen
+       P_tdmin = TP_tdmin
+       ! STICS:: F_hemarec
+       P_sensrsec = TP_sensrsec
+       ! STICS::GEL
+       P_codgellev = TP_codgellev
+       P_codgeljuv = TP_codgeljuv
+       P_codgelveg = TP_codgelveg
+       P_tletale = TP_tletale
+       P_tdebgel = TP_tdebgel
+       P_tgellev10 = TP_tgellev10
+       P_tgellev90 = TP_tgellev90
+       P_tgeljuv10 = TP_tgeljuv10
+       P_tgeljuv90 = TP_tgeljuv90
+       P_tgelveg10 = TP_tgelveg10
+       P_tgelveg90 = TP_tgelveg90
+       ! STICS:: Photoperiod    
+       P_sensiphot = TP_sensiphot
+       P_phosat = TP_phosat
+       P_phobase = TP_phobase
+
+      P_codesla = codesla
+        
+!       if (.NOT. in_cycle) then
+!           doyhistst = 0
+!           hist_sencour = 0
+!           hist_latest = 0
+!           histgrowth(:,:) = 0.
+!       endif
+
+
+       call laidev(n,                               &  ! IN
+                   in_cycle,                        &  ! inout
+                   f_crop_recycle,                  &  ! INOUT
+                   f_sen_lai,                        &  ! inout
+                   t2m_daily,                       &  ! IN  
+                   t2m_min_daily,                       &  ! IN  
+                   gdh_daily,                       &  ! IN
+                   phoi,                            &  ! IN
+                   onarretesomcourdrp,              &  ! IN                          
+                   stempdiag_cm_daily,              &  ! IN
+                   shumdiag_cm_day,                 &  ! IN
+                   nlevobs,                         &  ! IN
+                   namfobs,                         &  ! IN
+                   nfloobs,                         &  ! IN
+                   nlanobs,                         &  ! IN
+                   nlaxobs,                         &  ! IN
+                   nmatobs,                         &  ! IN
+                   nrecobs,                         &  ! IN
+                   nsenobs,                         &  ! IN
+                   ndrpobs,                         &  ! IN
+                   dltams,                          &  ! IN
+                   eop,                             &  ! IN
+                   masec,                           &  ! IN
+                   masecveg,                        &  ! IN
+                   nsendltams,                      &  ! INOUT
+                   nsendltai,                       &
+                   nsenpfeuilverte,                 &
+                   nsendurvie,                      &
+                   nsenndurvie,                     &
+                   densiteequiv,                    &
+                   nplt,                            &
+                   tursla,                          &
+                   sla,                             &
+                   pfeuilverte,                     &
+                   bsenlai,                         &
+                   zrac,                            &
+                   nrec,                            &
+                   nlan,                            &
+                   tcult,                           &
+                   udevair,                         &
+                   udevcult,                        &
+                   ndrp,                            &
+                   rfvi,                            &
+                   nlev,                            &
+                   nger,                            &
+                   etatvernal,                      &
+                   caljvc,                          &
+                   rfpi,                            &
+                   upvt,                            &
+                   utp,                             &
+                   somcour,                         &
+                   somcourdrp,                      &
+                   somcourutp,                      &
+                   tdevelop,                        &
+                   somtemp,                         &
+                   somcourfauche,                   &
+                   stpltger,                        &
+                   R_stamflax,                      &
+                   R_stlaxsen,                      &
+                   R_stsenlan,                      &
+                   stlevflo,                        &
+                   nflo,                            &
+                   R_stlevdrp,                      &
+                   R_stflodrp,                      &
+                   R_stdrpmat,                      &
+                   nmat,                            &
+                   nlax,                            &
+                   nrecbutoir,                      &
+                   group,                           &
+                   ndebdes,                         &
+                   R_stdrpdes,                      &
+                   densite,                         &
+                   densitelev,                      &
+                   coeflev,                         &
+                   densiteger,                      &
+                   somelong,                        &
+                   somger,                          &
+                   humectation,                     &
+                   nbjhumec,                        &
+                   somtemphumec,                    &
+                   stpltlev,                        &
+                   namf,                            &
+                   stmatrec,                        &
+                   tustress,                        &
+                   slai,                             &
+                   somfeuille,                      &
+                   pdlai,                           &
+                   nbfeuille,                       &
+                   reajust,                         &
+                   ulai,                            &
+                   pdulai,                          &
+                   efdensite,                       &
+                   tempeff,                         &
+                   nstopfeuille,                    &
+                   deltai,                          &
+                   vmax,                            &
+                   nsen,                            &
+                   laisen,                          &
+                   dltaisenat,                      &
+                   nsencour,                        &
+                   dltamsen,                        &
+                   dltaisen,                        &
+                   fgellev,                         &
+                   gelee,                           &
+                   fstressgel,                      &
+                   pdlaisen,                        &
+                   R_stlevamf,                      &
+                   dernier_n,                       &
+                   durvieI,                         &
+                   durvie,                          &
+                   ndebsen,                         &
+                   somsenreste,                     &
+                   shumrel,                          &
+                   humrel,                          &
+                   swfac,                           &
+                   turfac,                          &
+                   senfac,                          &
+                   mafeuiljaune,                    &
+                   msneojaune,                      &
+                   gslen,                           &
+                   drylen,                           &
+                   vswc, &
+                   histgrowth, &
+                   hist_sencour, &
+                   hist_latest, &
+                   doyhistst, &
+                   nbox, boxulai, boxndays, boxlai, boxlairem,boxtdev, &
+                   boxbiom, boxbiomrem,boxdurage, boxsomsenbase)
+
+    
+    end subroutine driver_stics
+
+end module Stics
+ 
+ 
Index: /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_sticslai/Stics_Calcul_LAI.f90
===================================================================
--- /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_sticslai/Stics_Calcul_LAI.f90	(revision 6940)
+++ /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_sticslai/Stics_Calcul_LAI.f90	(revision 6940)
@@ -0,0 +1,724 @@
+!    *****************************
+!     calcul de l'indice foliaire
+!           N.Brisson, R. Roche
+!    *****************************
+! *-----------------------------------------------------------------------------------------------------------------------------------------------------------* c!
+!> calculation of the LAI
+!> - Stics book paragraphe 3.1.1, page 40-44
+!>
+!! In STICS, leaf area growth is driven by phasic development, temperature and stresses. An empirical plant density-dependent function represents inter-plant
+!! competition. For indeterminate plants, trophic competition is taken into account through a trophic stress index, while for determinate plants a maximal
+!! expansion rate threshold is calculated to avoid unrealistic leaf expansion.
+!! The calculation of leaf growth rate (deltai in m2m-2 d-1) is broken down: a first calculation of the LAI growth rate (in m2 plant-1 degree-day-1) describes
+!! a logistic curve, related to the ILEV, IAMF and ILAX phenological stages. This value is then multiplied by the effective crop temperature, the plant density
+!! combined with a density factor, supposed to stand for inter-plant competition, that is characteristic for the variety, and the water and nitrogen stress indices.
+!!
+!! The phasic development function is comparable to that of the model PUTU (Singels and Jagger, 1991), i.e. a logistic function with dlaimaxbrut as asymptote
+!! and pentlaimax as the slope at the inflection point. It is driven by a normalized leaf development unit (ULAI) equal to 1 at ILEV and 3 at ILAX.
+!! At the end of the juvenile stage (IAMF), it is equal to vlaimax when the inflection of the dynamics (point of maximal rate) also occurs.
+!! Between the stages ILEV, IAMF and ILAX, the model performs linear interpolation based on development units (upvt) which include all the environmental effects
+!! on phasic development. As the ILAX stage approaches, it is possible to introduce a gradual decline in growth rate using the udlaimax parameter
+!!- the ULAI value beyond which there is a decline in the leaf growth rate. If udlaimax=3 it has no effect and the leaf stops growing at once at ILAX.
+!!
+!! The thermal function relies on crop temperature and cardinal temperatures (tcmin and tcmax) which differ from the ones used for the phasic development.
+!! The extreme threshold tcxstop is the same as for development.
+!!
+!! The density function is active solely after a given LAI threshold occurs (laicomp parameter) if the plant density (densite in plant m-2 possibly decreased
+!! by early frost) is greater than the bdens threshold, below which plant leaf area is assumed independent of density.  Beyond this density value, leaf area
+!! per plant decreases exponentially.  The adens parameter represents the ability of a plant to withstand increasing densities.  It depends on the species
+!! and may depend on the variety.  For branching or tillering plants, adens represents the plants branching or tillering ability (e. g. wheat or pea).
+!! For single-stem plants, adens represents competition between plant leaves within a given stand (e.g. maize or sunflower).
+!!
+!! Water and nitrogen affect leaf growth as limiting factors, i.e. stress indices whose values vary between 0 and 1. Water (turfac) and nitrogen deficits (innlai)
+!! are assumed to interact, justifying the use of the more severe of the two stresses. Meanwhile at the whole plant level the water-logging stress index is assumed
+!! to act independently
+!!
+!!
+!!
+!> -    Features of determinate crops
+!!   Failure to account for trophic aspects in the calculation of leaf growth may cause problems when the radiation intercepted by the crop is insufficient to
+!!   ensure leaf expansion (e.g. for crops under a tree canopy or crops growing in winter).  Consequently, from the IAMF stage, we have introduced a trophic effect
+!!  to calculate the definitive LAI growth rate in the form of a maximum threshold for leaf expansion (deltaimaxi in m2m-2d-1) using the notion of the maximum
+!!   leaf expansion allowed per unit of biomass accumulated in the plant (sbvmax in cm2 g-1) and the daily biomass accumulation (dltams in t.ha-1day-1 possibly
+!!   complemented by remobilized reserve remobilj). sbvmax is calculated using the slamax and tigefeuil parameters.
+!!
+!> -    Features of indeterminate crops
+!!   It has been possible to test the robustness of the above formalisation on a variety of crops, including crops where there is an overlap between the
+!!   vegetative phase and the reproductive phase (soybean and flax for example).  However, when trophic competition between leaves and fruits is a driving force
+!!   for the production and management of the crop (for example tomato, sugarbeet), this formalisation is unsuitable.  We therefore calculate the deltai variable
+!!   so as to take trophic monitoring into consideration in the case of crops described as indeterminate, by introducing a trophic stress index (splai).
+!!   As a consequence, the LAI can decrease markedly during the theoretical growth phase if the crop is experiencing severe stresses during the harvested
+!!   organs filling phase.
+! *-----------------------------------------------------------------------------------------------------------------------------------------------------------* c
+
+
+
+subroutine calai_(turfac,                                                                     & ! IN
+                  udevair,udevcult,n,                                                         & ! IN
+                  nplt,nlev,namf,nlax,ndrp,nrec,upvt,upvtutil,somcour,somcourutp,             & ! IN
+                  densite,tcult,                                                              & ! IN
+                  fstressgel,dltamsen,sla,                                                    & ! IN
+                  dltams, densiteequiv, bsenlai,                                              & ! IN
+                  pdlaisen, lai, pdlai, pdulai, somfeuille, nbfeuille, nsen, nlan,            & ! INOUT
+                  reajust,  ulai, vmax,                                                       & ! INOUT
+                  dltaisenat, laisen, dltaisen, R_stsenlan,                                   & ! INOUT
+                  tustress, efdensite, nstopfeuille, deltai, R_stlaxsen, tempeff, &
+                  histgrowth, hist_sencour, hist_latest, doyhistst) !, &
+!                  nbox, boxulai, boxndays, boxlai, boxlairem,boxtdev, &
+!                  boxbiom,boxbiomrem, boxdurage, boxsomsenbase)
+
+USE Stics
+USE Besoins_en_froid
+implicit none
+
+! 0 DECLARATION
+
+! 0.1 INPUTS
+
+!integer, intent(IN)    :: nbjmax !> la taille des tableaux journaliers  
+!integer, intent(IN)    :: P_codeinnact  !> // PARAMETER // code activating  nitrogen stress effect on the crop: yes (1), no (2) // code 1/2 // PARAM // 0 
+!integer, intent(IN)    :: P_codeh2oact  !> // PARAMETER // code to activate  water stress effect on the crop: yes (1), no (2) // code 1/2 // PARAM // 0 
+!integer, intent(IN)    :: P_codehypo  !> // PARAMETER // option of simulation of a  phase of hypocotyl growth (1) or planting of plantlets (2) // code 1/2 // PARPLT // 0 
+!integer, intent(IN)    :: P_codegermin  !> // PARAMETER // option of simulation of a germination phase or a delay at the beginning of the crop (1) or  direct starting (2) // code 1/2 // PARPLT // 0 
+!integer, intent(IN)    :: P_codcueille  !> // PARAMETER // way how to harvest // code 1/2 // PARTEC // 0 
+!integer, intent(IN)    :: P_codlainet  !> // PARAMETER // option of calculation of the LAI (1 : direct LAInet; 2 : LAInet = gross LAI - senescent LAI) // code 1/2 // PARPLT // 0
+!integer, intent(IN)    :: codeulaivernal  !>// the value is either 0 (there is not a vernalization) or 1 (there is an effect of vernalization).
+!integer, intent(IN)    :: P_codeindetermin  !> // PARAMETER // option of  simulation of the leaf growth and fruit growth : indeterminate (2) or determinate (1) // code 1/2 // PARPLT // 0 
+!integer, intent(IN)    :: P_codeinitprec  !> // PARAMETER // reinitializing initial status in case of chaining simulations : yes (1), no (2) // code 1/2 // PARAM // 0 
+!integer, intent(IN)    :: P_codeperenne  !> // PARAMETER // option defining the annual (1) or perenial (2) character of the plant // code 1/2 // PARPLT // 0 
+!integer, intent(IN)    :: P_codetemp  !> // PARAMETER // option calculation mode of heat time for the plant : with air temperature (1)  or crop temperature (2) // code 1/2 // PARPLT // 0 
+real,    intent(IN)    :: turfac   !> // OUTPUT // Index of turgescence water stress  // 0-1
+!real,    intent(IN)    :: innlai   !> // OUTPUT // Index of nitrogen stress active on leaf growth // P_innmin à 1
+!real,    intent(IN)    :: P_laiplantule  !> // PARAMETER // Plantlet Leaf index at the plantation // m2 leaf  m-2 soil // PARPLT // 1 
+!real,    intent(IN)    :: P_phyllotherme  !> // PARAMETER // thermal duration between the apparition of two successive leaves on the main stem // degree C day // PARPLT // 1
+real,    intent(IN)    :: udevair   !> // OUTPUT // Effective temperature for the development, computed with TAIR // degree.days
+real,    intent(IN)    :: udevcult   !> // OUTPUT // Effective temperature for the development, computed with TCULT // degree.days
+!real,    intent(IN)    :: P_dlaimaxbrut  !> // PARAMETER // Maximum rate of the setting up of LAI // m2 leaf plant-1 degree d-1 // PARPLT // 1 
+!real,    intent(IN)    :: P_udlaimax  !> // PARAMETER // ulai from which the rate of leaf growth decreases  // SD // PARPLT // 1 
+integer, intent(IN)    :: n  
+!integer, intent(IN)    :: numcult  
+integer, intent(IN)    :: nplt  
+integer, intent(IN)    :: nlev  
+integer, intent(IN)    :: namf  
+integer, intent(IN)    :: nlax  
+integer, intent(IN)    :: ndrp  
+integer, intent(IN)    :: nrec  
+real,    intent(IN)    :: upvt   !> // OUTPUT // Daily development unit  // degree.days (calculated in stics_diverse.f90)
+real,    intent(IN)    :: upvtutil  ! (calculated in stics_develop.f90)
+!real,    intent(IN)    :: P_vlaimax  !> // PARAMETER // ULAI  at inflection point of the function DELTAI=f(ULAI) // SD // PARPLT // 1
+!real,    intent(IN)    :: P_laicomp  !> // PARAMETER // LAI from which starts competition inbetween plants // m2 m-2 // PARPLT // 1 
+real,    intent(IN)    :: somcour   !> // OUTPUT // Cumulated units of development between two stages // degree.days
+real,    intent(IN)    :: somcourutp  
+!real,    intent(IN)    :: P_stlevamf  !> // PARAMETER // Sum of development units between the stages LEV and AMF // degree.days // PARPLT // 1 
+!real,    intent(IN)    :: P_stamflax  !> // PARAMETER // Sum of development units between the stages AMF and LAX // degree.days // PARPLT // 1 
+real,    intent(IN)    :: densite   !> // OUTPUT // Actual sowing density // plants.m-2
+!real,    intent(IN)    :: P_adens  !> // PARAMETER // Interplant competition parameter // SD // PARPLT // 1 
+!real,    intent(IN)    :: P_bdens  !> // PARAMETER // minimal density from which interplant competition starts // plants m-2 // PARPLT // 1 
+!real,    intent(IN)    :: P_tcxstop  !> // PARAMETER // threshold temperature beyond which the foliar growth stops // degree C // PARPLT // 1
+real,    intent(IN)    :: tcult   !> // OUTPUT // Crop surface temperature (daily average) // degree C
+!real,    intent(IN)    :: P_tcmin  !> // PARAMETER // Minimum temperature of growth // degree C // PARPLT // 1
+!real,    intent(IN)    :: P_tcmax  !> // PARAMETER // Maximum temperature of growth // degree C // PARPLT // 1
+!real,    intent(IN)    :: P_pentlaimax  !> // PARAMETER // parameter of the logistic curve of LAI growth  // SD // PARPLT // 1 
+!real,    intent(IN)    :: P_dlaimin  !> // PARAMETER // accelerating parameter for the lai growth rate // SD // PARAMV6/PLT // 1 
+!real,    intent(IN)    :: exolai   !> // OUTPUT // Index for excess water active on growth in biomass // 0-1   ! at this moment, we do not consider the effects of water logging on LAI
+!real,    intent(IN)    :: P_splaimin  !> // PARAMETER // Minimal value of ratio sources/sinks for the leaf growth  // between 0 and 1 // PARPLT // 1 
+!real,    intent(IN)    :: P_splaimax  !> // PARAMETER // maximal sources/sinks value allowing the trophic stress calculation for leaf growing // SD // PARPLT // 1 
+!real,    intent(IN)    :: P_slamin  !> // PARAMETER // minimal SLA of green leaves // cm2 g-1 // PARPLT // 1 
+!real,    intent(IN)    :: P_slamax  !> // PARAMETER // maximal SLA of green leaves // cm2 g-1 // PARPLT // 1 
+!real,    intent(IN)    :: P_tigefeuil  !> // PARAMETER // stem (structural part)/leaf proportion // SD // PARPLT // 1 
+!real,    intent(IN)    :: P_tustressmin  !> // PARAMETER //  threshold stress (min(turfac,inns)) under which there is an effect on the LAI (supplementary senescence by ratio at the natural senescence) 
+real,    intent(IN)    :: fstressgel   !> // OUTPUT // Frost index on the LAI // 0-1
+real,    intent(IN)    :: dltamsen   !> // OUTPUT // Senescence rate // t ha-1 j-1
+real,    intent(IN)    :: sla   !> // OUTPUT // Specific surface area // cm2 g-1
+real,    intent(IN)    :: dltams                ! (n-1)    // OUTPUT // Growth rate of the plant  // t ha-1.j-1
+real,    intent(IN)    :: densiteequiv  !densite equivalente calculée chaque jour
+real,    intent(IN)    :: bsenlai      ! lai value at date nsen, when the sen begin 
+
+! 0.2 INOUT
+
+real,    intent(INOUT) :: pdlaisen          ! senescence leaf area index of the previous day // Leaf area index (table) // m2 leafs  m-2 soil// 
+real,    intent(INOUT) :: lai            ! (n), (n-1), (nsen), (nlan)    // OUTPUT // Leaf area index (table) // m2 leafs  m-2 soil// in this version, there is no time dimension
+real,    intent(INOUT) :: pdlai          ! leaf area index of the previous day // Leaf area index (table) // m2 leafs  m-2 soil// 
+real,    intent(INOUT) :: pdulai          ! leaf area index of the previous day // Leaf area index (table) // m2 leafs  m-2 soil// 
+real,    intent(INOUT) :: somfeuille  
+integer, intent(INOUT) :: nbfeuille   !> // OUTPUT // Number of leaves on main stem // SD
+integer, intent(INOUT) :: nsen  
+integer, intent(INOUT) :: nlan  
+!real,    intent(INOUT) :: P_dlaimax  !> // PARAMETER // Maximum rate of the setting up of LAI // m2 leaf plant-1 degree d-1 // PARPLT // 1 
+real,    intent(INOUT) :: reajust  
+real,    intent(INOUT) :: ulai         !> // Daily relative development unit for LAI // 0-3
+real,    intent(INOUT) :: vmax  
+real,    intent(INOUT) :: dltaisenat  
+real,    intent(INOUT) :: laisen        ! (n), (n-1)    // OUTPUT // Leaf area index of senescent leaves // m2 leafs  m-2 soil
+real,    intent(INOUT) :: dltaisen   !> // OUTPUT // Daily increase of the senescent leaf index // m2.m-2 sol.j-1
+real,    intent(INOUT) :: R_stsenlan  !> // PARAMETER // Sum of development units between the stages SEN et LAN // degree.days // PARPLT // 1 
+
+  real, dimension(300,5), intent(INOUT) :: histgrowth
+  integer, intent(INOUT)                :: hist_sencour
+  integer, intent(INOUT)                :: hist_latest
+  integer, intent(INOUT)                :: doyhistst
+
+! 0.3 OUT
+
+real,    intent(OUT)   :: tustress   !> // OUTPUT // Stress index active on leaf growth (= minimum(turfac,innlai))  // 0-1
+real,    intent(OUT)   :: efdensite  
+integer, intent(OUT)   :: nstopfeuille  
+real,    intent(OUT)   :: deltai                ! (n)    --(0:nbjmax)    // OUTPUT // Daily increase of the green leaf index // m2 leafs.m-2 soil
+!real,    intent(OUT)   :: splai   !> // OUTPUT // Pool/sink ratio applied to leaves // 0-1
+!real,    intent(OUT)   :: fpv   !> // OUTPUT // Sink strength of developing leaves // g.j-1.m-2
+real,    intent(OUT)   :: R_stlaxsen  !> // PARAMETER // Sum of development units between the stages LAX and SEN // degree.days // PARPLT // 1 
+real,    intent(OUT)   :: tempeff   !> // OUTPUT // Efficient temperature for growth // degree C
+
+! 0.4 LOCAL VARIABLES
+real :: deltaimaxi  
+real :: sbvmin  
+real :: sbvmax 
+
+real :: tdevelop 
+!integer :: ii
+
+!: 0. Assignments of the historical variables
+!---------------------------------------------------------------
+    
+    ! assignment of the historical variables
+    pdlai = lai
+    pdulai = ulai
+    pdlaisen = laisen
+
+
+!: 1. CALCULATION THE STRESS FACTOR (no problem)
+!--------------------------------------
+
+    if (P_codeinnact == 1 .and. P_codeh2oact == 1) then
+      tustress = min(turfac,P_innlai)
+    endif
+    if (P_codeinnact == 2 .and. P_codeh2oact == 1) then
+      tustress = min(turfac,1.0)
+    endif
+    if (P_codeinnact == 1 .and. P_codeh2oact == 2) then
+      tustress = min(1.0,P_innlai)
+    endif
+    if (P_codeinnact == 2 .and. P_codeh2oact == 2) then
+      tustress = 1.
+    endif
+
+!print *, 'wu: in calai process the tustress is', tustress
+
+!: 2. INITIALIZATIONS OF SOME VARIABLES BEFORE EMERGENCE (done)
+!-------------------------------------------------
+
+!: Dans le cas des cultures annuelles (P_codeperenne=1), trois cas:
+!
+!- a) pour les cultures qui se plantent (P_codehypo=2) et admettent un
+!-    temps de latence avant le demarrage de la croissance (P_codegermin=1):
+!-    initialisation du lai a P_laiplantule a partir de la plantation;
+!-    et calcul de QNPlante par courbe de dilution
+!-
+!- b) pour les cultures qui se sement (P_codehypo=1):
+!-    initialisation du lai a 0 a partir du semis
+!-
+!- c) pour les cultures qui se plantent (P_codehypo=2) et demarrent directement (P_codegermin=2):
+!-    initialisation du lai a P_laiplantule a partir de la levee qui est aussi la plantation
+!-------------------------------------------------
+! in the case of annual crop, 3 cases:
+! 
+! a) for crops that are planted (P_codehypo = 2) and admit a latency before startup growth (P_codegermin = 1):
+!    initialization lai P_laiplantule from planting; and calculating by dilution curve QNPlante
+!
+! b) for crops that are sowed  (P_codehypo = 1): initialization lai 0 from sowing
+!
+! c) for crops that are planted (P_codehypo = 2) and been booted directly (P_codegermin = 2):
+!    initialization lai P_laiplantule from the levee
+!------------------------------------------------
+
+
+!    print *, 'dltams before calculate the lai is', dltams
+!    print *, 'in calai the nsen is,', nsen
+
+    if (nlev == 0) then
+
+      if (P_codeperenne == 1 .and. n >= nplt) then  !- NPLT étant non nul dès le depart de la simulation, on test n>=nplt
+        if (P_codehypo == 2 .and. P_codegermin == 1) then ! a)
+          !lai(n) = P_laiplantule
+          lai = P_laiplantule
+          return
+        else ! b)
+          lai = 0.
+          !lai(n) = 0.
+          return
+        endif
+      else
+        !lai(n) = 0.0
+        lai = 0.0
+        return
+        !: TODO - le somfeuille=0 après le return est inutile, il n'est jamais exécuté. BUG ?
+        somfeuille = 0.
+      endif
+    endif
+
+    ! le jour de la levée, si plantation par plantule, on force le lai du jour précédent
+    if (n == nlev .and. P_codehypo == 2 .and. namf == 0) then
+      !lai(n-1) = P_laiplantule
+      pdlai = P_laiplantule   ! // pdlai lai of previous day
+    endif
+
+    !: à la récolte (nrec+1)
+    !: 
+    if (nrec > 0 .and. n > nrec) then
+      ! En cas de moisson, on enlève les feuilles.
+      if (P_codcueille == 1) then ! havest the whole plant (1) or only the fruit (2)
+        !lai(n) = 0.
+        lai = 0.
+        somfeuille = 0.
+        return
+      endif
+    endif
+
+    !: Calcul du nombre de feuilles
+    !: calculation of number of leaves
+    if (P_codetemp == 2) then ! p_codetemp == 2 indicate that we use the crop temperature
+      call CalculNombreDeFeuilles(nlax,udevcult,somfeuille,nbfeuille)
+    else
+      call CalculNombreDeFeuilles(nlax,udevair,somfeuille,nbfeuille)
+    endif
+
+!    print *, 'wu: in calai process the nlev, ndrp, nlax, nsen are', nlev, ndrp, nlax, nsen
+!    print *, 'wu: in calai process the nbfeuille is', nbfeuille
+
+    !: si option LAI brut+ sénescence
+    !if (P_codlainet == 2) P_dlaimax = P_dlaimaxbrut
+
+    !: 2a) calcul de reajust : distance de développement pour réajuster
+    !-     les parcours observés
+
+    ! reinitialization of the sum of upvt
+    if (n == nlev) reajust = 0.0
+    if (n == namf) reajust = 0.0
+    if (n == nlax) reajust = 0.0
+    if (n == nsen) reajust = 0.0
+    if (n == nlan) reajust = 0.0
+
+    reajust = reajust + upvt - upvtutil 
+   
+!    print *, 'wu: in calai process the reajust is', reajust
+    
+
+    !: 2b) lai de départ non nul pour les cultures qui se plantent
+    !--      if (n == nlev .and. P_codehypo == 2 .and. namf == 0) then
+    !--        lai(n-1) = P_laiplantule
+    !--!: NB - le 21/04 - sbv remplacé par slavert
+    !--        ms(n-1) = lai(n-1)/P_slamin*100.0
+    !--!: NB - ajout de P_QNplante0 - le 21/04
+    !--        QNplante = (P_adilmax * ms(n-1) * 10) + P_QNplante0
+    !--        QNplantetot = QNplante
+    !--        inns =  1.0
+    !--        inn  =  1.0
+    !--        innlai  =  1.0
+    !--      endif
+
+
+!: 3. CALCUL DE ULAI
+!-------------------
+    !: 3a) calcul de ulai entre lev et amf
+    !- domi - 29/03 la vernalisation ne joue pas sur ulai si codeulaivernal = 1
+    if (nlev > 0 .and. namf == 0) then
+      if (codeulaivernal == 1) then
+        !ulai(n) = 1 + (P_vlaimax - 1) * (somcour + reajust) / (P_stlevamf + reajust)
+        ulai = 1 + (P_vlaimax - 1) * (somcour + reajust) / (P_stlevamf + reajust)
+      else
+        if (somcourutp <= P_stlevamf) then
+!          print *, 'in lai the somcourutp is,', somcourutp
+          !ulai(n) = 1 + (P_vlaimax - 1) * (somcourutp + reajust) / (P_stlevamf + reajust)
+          ulai = 1 + (P_vlaimax - 1) * (somcourutp + reajust) / (P_stlevamf + reajust)
+        else
+          !ulai(n) = ulai(n-1)
+          ulai = pdulai
+        endif
+      endif
+    endif
+  
+
+!    print *, 'wu: in calai process the ulai is', ulai
+
+    !: 3b) calcul de ulai entre amf et lax
+   
+    if (namf > 0 .and. nlax == 0) then
+      
+      if (codeulaivernal == 1) then
+        !ulai(n) = P_vlaimax + (3 - P_vlaimax) * (somcour + reajust) / (P_stamflax + reajust)
+        ulai = P_vlaimax + (3 - P_vlaimax) * (somcour + reajust) / (P_stamflax + reajust)
+      else
+        if (somcourutp <= P_stamflax) then
+          !ulai(n) = P_vlaimax + (3 - P_vlaimax) * (somcourutp + reajust) / (P_stamflax + reajust)
+          ulai = P_vlaimax + (3 - P_vlaimax) * (somcourutp + reajust) / (P_stamflax + reajust)         
+ 
+        else
+          !ulai(n) = ulai(n-1)
+          ulai = pdulai
+
+        endif
+      endif
+
+    endif
+
+!    print *, 'wu: in calai process the ulai is', ulai
+
+    !: 3c) ulai maximal atteint à drp pour les indéterminées
+    if (P_codeindetermin == 2 .and. ndrp > 0) then
+      !ulai(n) = P_udlaimax
+      ulai = P_udlaimax
+    else
+      if (nlax > 0) ulai = P_udlaimax     !ulai(n) = P_udlaimax
+    endif
+
+   
+
+!: 4. CALCUL du DELTAI BRUT
+!--------------------------
+
+    !: 4a) calcul du facteur densité efdensite actif à partir de P_laicomp
+    !- calcul de l'effet densité sur la mise en place du LAI pour les stics-plante
+
+    !: calculation of the effective density, to address the density effects on LAI development
+
+    efdensite = 1.
+    !if (ulai(n) > 1.) then
+    if (ulai > 1.) then 
+      !if (lai(n-1) < P_laicomp) then
+      if (pdlai < P_laicomp) then
+        efdensite = 1.
+      else
+        if (densite == 0) then
+          efdensite = 0.0
+        else
+          ! domi - 02/07/2002 - pb si gel total densite  = 0 et pb de log(0)
+          ! efdensite = min(1.0,(exp(P_adens * (log(densite / P_bdens)))))
+          ! DR 12/09/2012 on prend la densite equivalente pour calculer l'effet densite et uniquement pour ca !
+          efdensite = min(1.0,(exp(P_adens * (log(densiteequiv / P_bdens)))))
+        endif
+      endif
+    else
+      ! domi - 02/07/2002 - pb si gel total densite  = 0 et pb de log(0)
+      if (densite == 0) then
+        efdensite = 0.0
+      else
+        !efdensite = min(1.0,(exp(P_adens * log(densite / P_bdens))))
+        !DR 12/09/2012 on prend la densite equivalente pour calculer l'effet densite et uniquement pour ca !
+        efdensite = min(1.0,(exp(P_adens * log(densiteequiv / P_bdens))))
+      endif
+    endif
+
+    !if (ulai(n) == 1.0) efdensite = 1
+    if (ulai == 1.0) efdensite = 1.
+
+!    print *, 'wu: in calai process the efdensite is', efdensite
+
+    ! ** 4b) température efficace de croissance: limitation par P_tcmax
+    ! NB le 13/06/06
+    ! introduction d'une température maximale d'arrêt de croissance
+    ! foliaire P_Tcxstop à l'occasion étude Françoise sur fourrages méditerranéens
+    !      P_tcxstop = 30.0
+
+    !: addressing the effective temperature
+
+
+    if (P_tcxstop >= 100.0) then
+      if (tcult > P_tcmax) then
+        tempeff = max(0.,(P_tcmax - P_tcmin))
+      else
+        tempeff = max(0.,(tcult - P_tcmin))
+      endif
+    else
+      if (tcult > P_tcmax) then
+        tempeff = (P_tcmax - P_tcmin) / (-P_tcxstop + P_tcmax) * (tcult - P_tcxstop)
+        tempeff = max(0.,tempeff)
+      else
+        tempeff = max(0.,(tcult - P_tcmin))
+      endif
+    endif
+
+!    print *, 'wu: in calai process the tempeff is', tempeff
+
+    !: 4c) calcul du deltai
+    !- quelle que soit l'option LAI choisie, LAI net ou LAI brut :
+    !-  * la croissance s'arrête à LAX pour les déterminées
+    !-  * la croissance s'arrête à SEN pour les indéterminées
+    if (P_codeindetermin == 1) nstopfeuille = nlax
+    if (P_codeindetermin == 2) nstopfeuille = nsen
+
+    if (P_codlainet == 2) nstopfeuille = nlax
+    if (P_codlainet == 3) nstopfeuille = nlax
+
+!    print *, 'wu: in calai process the nstopfeuille is', nstopfeuille 
+!    print *, 'wu: in calai process the densite is', densite
+    if ( nstopfeuille .eq. 0 ) then
+ 
+!    print *, 'wu: in calai process, do we go in? if so the ulai is', ulai
+
+      !: modif le 23/07/01
+      !- entre ulai = 1 et ulai = P_udlaimax, la vitesse est croissante
+      !- NB - le 13/12
+
+      !if (ulai(n) <= P_udlaimax .or. P_udlaimax == 3.0) then
+      if (ulai <= P_udlaimax .or. P_udlaimax == 3.0) then
+
+        ! DR 07/03/08 integration des modifs du 28/02/07 P_dlaimax n'etait actif
+        ! et introduction de P_codedlaimin
+        ! NB et FR le 28/02/07
+        ! introduction d'une ordonnée à l'origine pour la croissance des feuilles
+        ! DR on vire le P_codedlaimin et on met P_dlaimin dans le fichier plante
+  
+        deltai = P_dlaimax * efdensite * densite &
+                  * (P_dlaimin + (1.0 - P_dlaimin) / (1 + exp(P_pentlaimax * (P_vlaimax - ulai))))
+        vmax = deltai
+      else
+        !: entre P_udlaimax = 1 et ulai = 3(lax), la vitesse est décroissante
+        !- sauf pour les indéterminées
+        ! DR 24/01/2011 on a un pb dans l'equation la puissance multiplie tout (eq 3.2 bouquin)
+
+        !deltai = vmax * (1 - (ulai(n) - P_udlaimax) / (3.0 - P_udlaimax))**2
+        deltai = vmax * (1 - (ulai - P_udlaimax) / (3.0 - P_udlaimax))**2
+
+      endif
+
+
+
+
+      !: NB - le 28/05 - on lève toujours
+      !- 10/01 - ajout d'un test sur l'enchainement des perennes
+      ! TODO: voir si on pourrait remplacer ce test par un booléen qui dirait si la plante a levé ou pas. ex: *if (isLevee) then*
+
+      !if (n > nlev .or. (P_codeperenne == 2 .and. P_codeinitprec == 2 .and. numcult > 1)) then
+      if (nlev > 0 .or. (P_codeperenne == 2 .and. P_codeinitprec == 2)) then
+
+        !: NB le 07/06 introduction de exolai
+        !: At this moment, we do not consider the limiting effects of exolai--xcwu
+ 
+        deltai = deltai * tempeff * tustress * exolai
+
+      endif
+
+      !: la croissance foliaire des plantes indéterminées dépend
+      !- du rapport source/puits des organes végétatifs
+
+      ! At this moment, we do not consider the perennial crop or indeterminant crops---xcw
+
+      !if (P_codeindetermin == 2) then
+
+      !  splai = (sourcepuits - P_splaimin) / (P_splaimax - P_splaimin)
+
+      !  splai = max(splai,0.0)
+      !  splai = min(splai,1.0)
+
+      !  ! NB le 21/04 recalcul d'un sbv approprié
+      !  sbvmin = P_slamin / (1.0 + P_tigefeuil)
+      !  fpv = deltai * splai * 1e4 / sbvmin
+      !  deltai  =  deltai*splai
+
+      !else
+      
+      if (P_codeindetermin == 1) then       ! determinant crop case
+  
+        !: limitation si le rayonnement est vraiment insuffisant
+        !- après AMF (cas des cultures associées)
+        !- NB le 21/04 recalcul d'un sbv approprié
+        !- NB le 15/05/02 calcul de fpv pour les pérennes
+
+        sbvmin = P_slamin / (1.0 + P_tigefeuil)
+        !fpv = deltai * 1e4 / sbvmin
+        sbvmax = P_slamax / (1.0 + P_tigefeuil)
+
+        !: ajout des remobilisations possible pour faire redémarrer le
+        !- lai en cas de couvert complètement sec
+        !- NB le 13/06/06
+        !- NB le 27/06/06 attention delatremobil était déjà compté dans dltams
+        
+        ! at this moment, we do not consider the remobilization,
+        ! we adjust the process
+        ! original process as following:
+        ! deltaimaxi = (dltams + remobilj) * sbvmax / 100.
+        ! adjusted processes as following:
+
+        deltaimaxi = dltams * sbvmax / 100. ! unit in m2 m-2
+    
+!        print *, 'in calai the dltams and sbvmax and deltaimaxi is:', dltams, sbvmax, deltaimaxi
+!        print *, 'in calai the dltams and sbvmin and deltaimini is:', dltams * sbvmin / 100.    
+        if (namf > 0) then
+          deltai = min(deltai,deltaimaxi)
+          !deltai = deltai   ! test
+        endif
+      endif
+      ! fin nstopfeuille = 0
+    else
+      deltai = 0.0
+    endif
+
+
+!    print *, 'xuhui: n ', n
+!    print *, 'xuhui: nlev ', nlev
+! xuhui: record the historical growth of lai for calculation of senescence
+    if (P_codlainet==2) then 
+        if (nlev > 0) then ! leaf growth have initiated
+            if (doyhistst == 0 .and. hist_sencour == 0) then ! history has not been intialized
+                doyhistst = n
+                hist_sencour = 1
+                hist_latest = 1
+!                print *, 'xuhui: histgrowth initiated'
+            else  ! history already initialized
+                hist_latest = hist_latest + 1
+!                print *, 'xuhui: histlatest: ',hist_latest
+            endif
+    !        histgrowth(hist_latest,6) = n
+            histgrowth(hist_latest,1) = deltai
+            if (hist_latest>1) then
+                histgrowth(hist_latest-1,2) = dltams  !! dltams in this routin is from yesterday
+            endif
+            if (P_codetemp == 2) then
+                tdevelop = 2.0 ** (udevcult / 10.)
+            else
+                tdevelop = 2.0 ** (udevair / 10.)
+            endif
+            ! according to STICS book, tdevelop should be 2.0 **
+            ! (udevcult*(stressdev*min(turfac, innlai) + 1 - stressdev)/10.)
+            ! however, the code of v6.0 did not have this process, considering
+            ! adding it into the calculation
+            histgrowth(hist_latest,3) = tdevelop
+            histgrowth(hist_latest,4) = ulai
+            ! histgrowth(:,5) is durvie, added in the senescence subroutine
+!            print *, 'xuhui: histgrowth in ',hist_latest, ': ', histgrowth(hist_latest,:)
+        endif
+    elseif (P_codlainet==3) then
+!        if (ulai < 1 .or. ulai > 3) then
+!            write(*,*) 'xuhui: ulai: ', ulai, ', likely a bug'
+!        else 
+!            ii = nbox
+!            do while (ulai < ulaibox(ii))
+!                ii = ii - 1
+!            enddo
+!            if (ii < 1) then
+!                write(*,*) 'xuhui: bug: ii<1'
+!                ii = 1
+!            endif 
+!            boxndays(ii) = boxndays(ii) + 1
+!            boxlai(ii) = boxlai(ii) + deltai
+!            boxlairem(ii) = boxlairem(ii) + deltai
+!            boxbiom(ii) = boxbiom(ii) + dltams
+!            boxbiomrem(ii) = boxbiomrem(ii) + dltams
+!            if (P_codetemp == 2) then
+!                tdevelop = 2.0 ** (udevcult / 10.)
+!            else
+!                tdevelop = 2.0 ** (udevair / 10.)
+!            endif
+!            boxtdev(ii) = boxtdev(ii) + tdevelop
+!        endif
+    endif
+! end xuhui
+
+!: 5. PHASE DE PLATEAU  (si option lainet et culture determinée)
+!---------------------------------------------------------------
+
+    if (P_codlainet == 1 .and. P_codeindetermin == 1) then
+      if (nlax > 0 .and. nsen == 0) deltai = 0.0
+    endif
+
+!: 6. Calcul de la senescence rapide par ajustement a la récolte
+!- entre sen et lan  pour les options 1 et 2
+!: calculation the lai according to two options
+!---------------------------------------------------------------
+
+    if (P_codlainet <= 1) then ! the P_codlainet is either 1 or 2, so here it is the direct calculation of LAI
+
+          !lai(n) =  lai(n-1) + deltai - dltaisenat  ! the calculation of dltaisenat is shown below
+          lai = pdlai + deltai - dltaisenat
+    
+
+          !if (n == nsen) lai(n) = lai(n-1)
+          if (n == nsen) lai = pdlai    ! in this date, the senescence is 0
+  
+          if (nsen > 0 .and. nlan == 0.) then
+
+            !lai(n) = lai(nsen) * (1 - ((somcour+reajust) / (R_stsenlan+reajust)))  ! 
+            lai = bsenlai * (1 - ((somcour+reajust) / (R_stsenlan+reajust + 80.0)))     ! there is decreasing lai, 80 is an offset
+            
+  
+            !dltaisenat = lai(n-1) - lai(n)
+            dltaisenat = pdlai - lai
+            !if (lai(n) <= 0.0 .and. nlan == 0)  nlan = n
+            if (lai <= 0.0 .and. nlan == 0) nlan = n
+            !if (n == nlan) lai(nlan) = 0.0
+            if (n == nlan) lai = 0.0    ! if n == nlan, lai(nlan) is the same as lai(n) , so lai = 0.0
+
+          endif
+     else
+          !: option LAI brut la sénescence (dltaisen) est calculé dans le spg senescen
+          !lai(n) = lai(n-1) + deltai - dltaisen  ! we do not consider the net calculation, so...
+          lai = pdlai + deltai - dltaisen
+     endif
+
+    !if (lai(n) < 0.) then
+    if (lai < 0.0) then
+      !lai(n) = 0.
+      lai = 0.0
+
+      ! DR 06/09/06 y'a un soucis car alors laisen ne prend pas en compte la derniere valeur de lai
+      !--dltaisen = 0.0
+    endif
+
+    ! NB - le 22/04 - à cause précisison dans les soustractions
+    !if (lai(n) <= 1e-4 .and. nstopfeuille > 0) then
+    !  lai(n) = 0.
+    !endif
+
+    if (lai <= 1e-4 .and. nstopfeuille > 0) then
+       lai = 0.0
+    endif
+
+!: 7. senescence foliaire due à des stress  pour l'option LAInet
+!: Addressing the senescence of lai, see senescen.f90 
+!---------------------------------------------------------------
+
+    !if (P_codlainet == 1 .and. lai(n) > 0.0) then
+    if (P_codlainet == 1 .and. lai > 0.0) then
+   
+      if (tustress < P_tustressmin .or. tcult < P_tcmin .or. fstressgel < 1.0) then    ! there seems to be an additional part of senescence for LAI, representing by dltamsen/100*sla
+        ! bug dans l'opération NB le 08/05
+
+        dltaisen = dltamsen * sla * 100.   ! unit in m2 m-2
+        
+
+        ! how can we calculate the sla, it is calculated in biomass allocation processes; ---repartir.f90
+        ! the calculation of sla is determined by the tursla. 
+
+        !lai(n) = lai(n) - dltaisen
+        lai = lai - dltaisen
+        dltaisen = dltaisen + dltaisenat
+        lai = max(lai, 0.0)
+  
+      else
+        dltaisen = dltaisenat
+      endif
+    endif
+
+    !laisen(n) = laisen(n-1) + dltaisen
+    laisen = pdlaisen + dltaisen 
+
+
+    !: NB le 22/04: calcul du stade lan pour P_codlainet = 2
+    !if (lai(n) <= 0 .and. nlan == 0 .and. nlax > 0) then
+    if (lai <= 0.0 .and. nlan == 0 .and. nlax > 0) then
+      if (nsen == 0) then
+        nsen = n
+        R_stlaxsen = somcour
+
+      endif
+      nlan = n
+      R_stsenlan = somcour
+      !lai(n) = 0.0      ! 07/06
+      lai = 0.0
+      dltaisen = 0.0
+      dltaisenat = 0.0 ! NB le 11/06
+    endif
+   
+
+return
+end subroutine calai_
Index: /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_sticslai/Stics_Develop.f90
===================================================================
--- /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_sticslai/Stics_Develop.f90	(revision 6940)
+++ /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_sticslai/Stics_Develop.f90	(revision 6940)
@@ -0,0 +1,1096 @@
+!> Routine develop2
+!>
+!! Description :
+!< (routine qui prend des arguments simples)
+
+! DR 23/07/2012 latitude est pas itilisé car on passe la photoperiode qui est suffisante
+!subroutine develop2(phoi,tmax,tmin,tmin_demain,trr,P_codeh2oact,P_codeinitprec,P_codeinnact,codeulaivernal,P_psihucc, &
+!                    P_psihumin, P_codcueille,P_codefauche,P_densitesem,P_profsem,P_variete,P_ampfroid,P_belong,P_celong,         &
+!                    P_codebfroid,P_codedormance,P_codegdh, P_codegdhdeb,P_codegermin,P_codehypo,P_codeperenne,P_codephot,        &
+!                    P_codeplante,P_coderetflo,P_codetemp,coeflev,cu_min,cu_veille, densite,densiteger,densitelev,P_elmax,        &
+!                    innlai,P_julvernal,P_jvc,P_jvcmini,P_nbjgerlim,ndrpobs,P_nlevlim1,P_nlevlim2,nlevobs,nplt,onarretesomcourdrp,&
+!                    P_phobase,P_phosat,P_potgermi,P_propjgermin,P_q10,P_sensiphot,P_sensrsec,somelong,somger,P_stdordebour,      &
+!                    P_stpltger,P_stressdev,P_tcxstop,P_tdmax,P_tdmaxdeb,P_tdmin,P_tdmindeb,P_tfroid,P_tgmin,turfac,P_vigueurbat, &
+!                    P_codefente,P_mulchbat,P_pluiebat,P_culturean,nbCouches,dacouche,hucc,humin,hur,jjul,n,nbjanrec,nbjsemis,    &
+!                    numcult,tairveille,tcult,tsol,xmlch1,P_codepluiepoquet,P_codetempfauche,humectation,nbjhumec,pluiesemis,     &
+!                    somtemphumec,P_codeindetermin,P_codelaitr,P_codlainet,P_dureefruit,namfobs,P_nbcueille,nfloobs,     &
+!                    nlanobs, nlaxobs,nmatobs,nrecobs,nsenobs,P_stdrpnou,upobs,P_codemontaison,sioncoupe,                         &
+!                    caljvc,cu,demande,etatvernal,hauteur,mafrais,mafraisfeuille,mafraisrec,mafraisres,mafraistige,masec,namf,    &
+!                    ndebdorm,ndrp,nfindorm,nflo,nger,nlan,nlev,nrec,nrecbutoir,pdsfruitfrais,rfpi,rfvi,somcour,somcourdrp,       &
+!                    somcourfauche,somcourutp,somtemp,stpltlev,tdevelop,udevair,udevcult,upvt,utp,zrac,maxwth,group,ndebdes,      &
+!                    nfruit,nlax,nmat,nnou,nsen,R_stamflax,R_stdrpdes,R_stdrpmat,stdrpsen,R_stflodrp,R_stlaxsen,R_stlevamf,       &
+!                    R_stlevdrp,stlevflo,stmatrec,R_stsenlan,upvtutil, P_codrecolte,h2orec,P_sucrerec,P_CNgrainrec,P_huilerec,    &
+!                    sucre,huile,teaugrain,P_h2ofrvert,P_codeaumin, P_h2ograinmin,P_h2ograinmax,P_deshydbase,   &
+!                    CNgrain,P_cadencerec, jdepuisrec,pdsfruit,nbrecolte,nrecint,rdtint,teauint,nbfrint,onestan2,somcourmont,     &
+!                    nmontaison,stpltger)
+
+! Here, we modify the develop2 processes. 
+
+subroutine develop2(n, in_cycle, nplt, tair,  gdh_daily, turfac,  phoi, onarretesomcourdrp,  stempdiag_cm_daily, shumdiag_cm_day, lai,            &  !> INPUTS
+                    nlevobs, namfobs, nfloobs, nlanobs, nlaxobs, nmatobs, nrecobs, nsenobs, ndrpobs,  nrecbutoir,                                            &  !> INPUTS
+                    masec, namf,  ndrp, nflo, nger, nlan, nlev, nrec, etatvernal, caljvc,                                                                 &  !> INOUT
+                    upvt, utp, somcour, somcourdrp, somcourfauche, somcourutp, somtemp, zrac,                                                      &  !> INOUT
+                    coeflev, somelong, somger, humectation, nbjhumec, somtemphumec, densite, densitelev, nlax, nmat, nsen, stlevflo, ndebdes,      &  !> INOUT 
+                    R_stlevamf, R_stamflax, R_stsenlan, R_stlaxsen, R_stlevdrp, R_stflodrp, R_stdrpmat, R_stdrpdes, densiteger,                    &  !> INOUT
+                    udevair, udevcult,                                                                                               &  !> INOUT                
+                    rfvi, rfpi, tdevelop, stpltger, upvtutil, stmatrec, group, tcult, stpltlev,                                      &   !>INOUT
+                    f_crop_recycle, gslen, drylen)   
+
+
+USE Divers_develop
+USE Besoins_en_froid
+USE Stics
+USE constantes
+!USE Messages
+
+implicit none 
+
+!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+! declaration of variables
+
+! 0.1 input 
+ 
+   
+  integer, intent(IN)                           :: n
+  logical, intent(inout)                           :: in_cycle
+  integer, intent(IN)                           :: nplt  
+  real,    intent(IN)                           :: tair !> / Mean air temperature of the day // degree C
+  real,    intent(IN)                           :: gdh_daily  !> // daily gdh calculated according to halfhourly temperature // transmitted from stomate.f90 gdh_daily
+  real,    intent(IN)                           :: turfac
+  real,    intent(IN)                           :: phoi   !> // OUTPUT // Photoperiod // hours
+  logical, intent(IN)                           :: onarretesomcourdrp 
+  real,    intent(IN), dimension(3)             :: stempdiag_cm_daily !> / soil temperature at 1 cm resolution for the sowing depth and neighbour layers // Degree C 
+  real,    intent(IN), dimension(3)             :: shumdiag_cm_day     !> /soil moisture at 1 cm resolution for the sowing depth and neighbour layers // unit m3 m-3 with values ranging 0-1
+  real,    intent(IN)                           :: lai   !> leaf area index
+  integer, intent(IN)                           :: nlevobs 
+  integer, intent(IN)                           :: namfobs  
+  integer, intent(IN)                           :: nfloobs  
+  integer, intent(IN)                           :: nlanobs  
+  integer, intent(IN)                           :: nlaxobs  
+  integer, intent(IN)                           :: nmatobs  
+  integer, intent(IN)                           :: nrecobs  
+  integer, intent(IN)                           :: nsenobs  
+  integer, intent(IN)                           :: ndrpobs  
+  integer, intent(IN)                        :: nrecbutoir    !// the harvest date imposed, actually, if we simulate the harvest automatically, we do not use it. So, we initialize it as 999.  
+
+! 0.2 inout
+
+  real,    intent(INOUT)                        :: masec 
+
+  integer, intent(INOUT)                        :: namf  
+  integer, intent(INOUT)                        :: ndrp  
+  integer, intent(INOUT)                        :: nflo  
+  integer, intent(INOUT)                        :: nger  
+  integer, intent(INOUT)                        :: nlan  
+  integer, intent(INOUT)                        :: nlev  
+  integer, intent(INOUT)                        :: nrec  
+  logical, intent(INOUT)                        :: etatvernal
+  real,    intent(INOUT)                        :: caljvc 
+  real,    intent(INOUT)                        :: upvt   !> // OUTPUT // Daily development unit  // degree.days
+  real,    intent(INOUT)                        :: utp 
+  real,    intent(INOUT)                        :: somcour   !> // OUTPUT // Cumulated units of development between two stages // degree.days
+  real,    intent(INOUT)                        :: somcourdrp 
+  real,    intent(INOUT)                        :: somcourfauche  
+  real,    intent(INOUT)                        :: somcourutp  
+  real,    intent(INOUT)                        :: somtemp   !> // OUTPUT // Sum of temperatures // degree C.j
+  real,    intent(INOUT)                        :: zrac   !> // OUTPUT // Depth reached by root system // cm
+  real,    intent(INOUT)                        :: coeflev 
+  real,    intent(INOUT)                        :: somelong 
+  real,    intent(INOUT)                        :: somger  
+  logical, intent(INOUT)                        :: humectation  
+  integer, intent(INOUT)                        :: nbjhumec  
+  real,    intent(INOUT)                        :: somtemphumec  
+  real,    intent(INOUT)                        :: densite   !>  actual sowing density // plants m-2
+  real,    intent(INOUT)                        :: densitelev  
+  integer, intent(INOUT)                        :: nlax  
+  integer, intent(INOUT)                        :: nmat  
+  integer, intent(INOUT)                        :: nsen  
+  real,    intent(INOUT)                        :: stlevflo  
+  integer, intent(INOUT)                        :: ndebdes 
+  real,    intent(INOUT)                        :: R_stlevamf
+  real,    intent(INOUT)                        :: R_stamflax
+  real,    intent(INOUT)                        :: R_stsenlan
+  real,    intent(INOUT)                        :: R_stlaxsen
+  real,    intent(INOUT)                        :: R_stlevdrp
+  real,    intent(INOUT)                        :: R_stflodrp
+  real,    intent(INOUT)                        :: R_stdrpmat
+  real,    intent(INOUT)                        :: R_stdrpdes
+  real,    intent(INOUT)                        :: densiteger  
+  real,    intent(INOUT)                        :: udevair   !> // OUTPUT // Effective temperature for the development, computed with TAIR // degree.days
+  real,    intent(INOUT)                        :: udevcult   !> // OUTPUT // Effective temperature for the development, computed with TCULT // degree.days
+
+  logical, intent(inout)                           :: f_crop_recycle   ! > in levee subroutine, we judge whether or not the crop emerges, if not, the in_cycle shoule be false, and crop recycle
+  integer, intent(INOUT)                        :: gslen 
+  integer, intent(INOUT)                        :: drylen 
+
+
+
+
+! 0.3 out
+
+  ! DEVELOP
+
+  real,    intent(OUT)                          :: rfvi   !> // OUTPUT // Slowing effect of the vernalization on plant development // 0-1
+  real,    intent(OUT)                          :: rfpi   !> // OUTPUT // Slowing effect of the photoperiod on plant development  // 0-1
+  real,    intent(OUT)                          :: tdevelop 
+  real,    intent(OUT)                          :: stpltger
+  real,    intent(OUT)                          :: upvtutil 
+  real,    intent(OUT)                          :: stmatrec
+  real,    intent(OUT)                          :: group 
+  real,    intent(OUT)                          :: tcult   !> / Mean crop temperature of the day // degree C
+  real,    intent(OUT)                          :: stpltlev
+
+! 0.4 local Variables
+  real :: tdev  
+
+
+
+
+!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+!  1. CONDITIONAL STATEMENT AND INITIALIZATION
+
+!: Pour les annuelles => pas de développement avant le semis
+!- DR - 03/05/06
+!- dans le cas de repousse du semis par decisionsemis on ne commence pas les cumul d'unite
+
+  
+  if (P_codeperenne == 1 .and. ((n /= nplt) .and. (in_cycle == .FALSE.))) then
+     return
+  else
+ 
+     in_cycle = .TRUE. ! enter the cycle
+     
+     !! FIRST STEP: WE ACCOUNT THE GROWING LENGTH
+     
+     gslen = gslen + 1 
+
+
+!:    On remet à zéro les masses sèches, masses fraiches, masses des fruits, la hauteur de la plante, les variables de fixation (et le zrac ?)
+!:    Marie et Domi - 10/10/03 - bug signalé par Emmanuelle Sauboua
+!-    N'était jamais testé dans 'recolte'
+
+!    comments:
+!    reinitialization of some variables, which are related to harvest 
+!    P_codcueille: way how to harvest
+!    1.  We do not use the process of stics to address biomass production;
+!    2.  we also do not consider the root dynamics at this moment
+
+
+     if (P_codeperenne == 1 .and. P_codcueille == 1) then     ! P_codcueille: way how to harvest, 1, whole plant, 2, only fruits
+       if (n == nrec+1) then
+          masec             = 0.
+          zrac              = 0.
+          !mafrais(:)        = 0.
+          !pdsfruitfrais(:)  = 0.
+          !hauteur(:)        = 0. ! DR - 22/10/03
+          !demande(:)        = 0. ! PB - 03/05/2004 - remise à zéro des variables de fixation
+          !!: DR - 13/01/06 - remise à zero sinon mafrais ne revient pas nul
+          !mafraisfeuille(:) = 0.
+          !mafraistige(:)    = 0.
+          !mafraisres(:)     = 0.
+          !mafraisrec(:)     = 0.
+       endif
+!:    Pour les cultures annuelles (P_codeperenne=1) moissonnées (P_codcueille=1) : pas de développement après la récolte.
+       if (n > nrec .and. nlan > 0 .and. nrec > 0) return ! exit this subroutine
+     endif
+
+!:    PB - 11/03/2005 - On remet pdsfruitfrais à zéro après la récolte.
+!:    PB - 07/08/2009 - Attention, qd n=1 et nrec=0, cette condition peut être vraie alors qu'on est pas après la récolte.
+!                       TODO: Ajouter un test sur nrec est nul ?
+     !if (P_codeperenne == 2 .and. P_codcueille == 2 .and. n == (nrec+1) .and. P_codeinitprec == 2) then
+     !  pdsfruitfrais(:) = 0.
+     !endif
+
+!    TODO : GERER LE CAS DES CULTURES ANNUELLES  A RECOLTES MULTIPLES
+
+
+
+!2   . CALCULATION OF  EFFECT TEMPERATURE (calcul udevair/udevcult)
+!    -------------------------------------------
+
+     !: daily temperature
+     !- NB - 07/07/06: Application du seuil thermique négatif P_TCXSTOP au développement
+     
+     tcult = tair  ! here, we do not use the crop temperature, later if we use the tcult, this sentence shoul dbe commented.
+
+
+     if (P_codegdh == 1) then  !
+       udevair = calcul_UDev(tair)
+       udevcult = calcul_UDev(tcult) 
+     endif
+
+!     print *, 'udevair and udevcult in develop is', udevair, udevcult
+     
+     !: hourly temperature
+     if (P_codegdh == 2) then
+
+       !: Pour l'instant que températures air autorisées
+       if (P_codetemp == 2) then
+         !call EnvoyerMsgHistorique(49)
+         stop
+       endif
+
+       !: 1) Reconstitution des températures horaires.
+       !-    Pour l'instant on n'autorise uniquement le cas par températures air.
+       !thor = calcul_TemperaturesHoraires(tmin,tmin_demain,tmax)
+
+       !: 2) calculation gdh 
+       !     using hourly temperature, only available for air temperature.
+       !     see stomate.f90
+       
+       udevair = gdh_daily  ! the GDH calculated according to halfhourly temperature is implemented in stomate.f90
+       !udevair = calcul_GDH(thor,P_tdmin,P_tdmax)
+       udevcult = udevair
+      
+     endif
+
+
+
+     ! NB - le 01/09/06:
+     ! effet retard du stress hydrique en phase végétative appliqué directement
+     ! sur les udevair (ou udevcult) de façon à ce qu'il agisse sur le développement
+     ! P_phénologique et également sur la durée de vie.
+     ! modif pour Sophie pour permettre action de P_stressdev pendant tout le cycle et
+     ! en n'utilisant qu'un seul des deux stress
+     ! DR et ML et La Soso - 15/08/07 - y'avait un bug introduit par sophie et on sait
+     ! pas qui. On passait la tout le temps meme quand P_coderetflo=2
+     !       if (P_coderetflo == 1.and.P_codeinnact == 1 .or. P_codeh2oact == 1)
+
+     ! considering the water and/or nitrogen limiting effects--xcw
+     ! at this moment, we do not consider the Nitrogen processes, nitrogen limitation factor innlai is seted as parameter with a value of 1
+     ! the calculation of turfac is done in stress subroutine
+
+     if (P_coderetflo == 1 .and. (P_codeinnact == 1 .or. P_codeh2oact == 1)) then
+       if (P_codeplante == 'qui' .or. ndrp == 0) then
+         if (P_codetemp == 2) then
+           udevcult = udevcult * (P_stressdev * min(turfac,P_innlai) + 1 - P_stressdev)  
+         else
+           udevair = udevair * (P_stressdev * min(turfac,P_innlai) + 1 - P_stressdev)
+         endif
+       endif
+     endif
+
+
+
+!    3. EFFECTS OF VERNALIZATION (calcul de rfvi)
+!    ---------------------------------
+     if (P_codebfroid == 1) rfvi = 1.0
+
+     !: Calcul de l'effet vernalisation a partir de la germination
+     !- ou en cours de culture après la date P_julvernal
+     !- calculs données intermédiaires
+     if (P_codebfroid == 2) then
+       !: set the optional temperature for tdev
+       if (P_codetemp == 2) then
+         tdev = tcult
+       else
+         tdev = tair
+       endif
+      
+     ! calculation of rfvi, actually, we only use the subroutine vernalization to calculate the rfvi
+     ! Considering vernalization when germination
+
+       call Stics_Develop_bfroid2(nger,                &  
+                                  tdev,                &  
+                                  rfvi,                &  
+                                  etatvernal,          &  
+                                  caljvc)                 
+
+      ! call Stics_Develop_bfroid2(jjul,n,P_tfroid,P_ampfroid,P_julvernal,P_jvc,P_jvcmini,P_codeperenne,  &
+      !                            nger,namf,numcult,nbjsemis,tdev,P_codemontaison,P_culturean,   &
+      !                            P_codeinitprec,nbjanrec,                                     &
+      !                            nrecbutoir,rfvi,maxwth,etatvernal,caljvc,onestan2)
+     endif
+!     print *, 'in develop the rfvi is,', rfvi
+
+ 
+ !    COMMENTS: P_codebfroid == 3 is only effective for perennial crops;
+ !    at this moment, we do not address such crops-----xcwu
+
+ !    if (P_codebfroid == 3) then
+ !      call Stics_Develop_bfroid3(P_codedormance,cu_min,cu_veille,n,P_jvc,P_q10,tmin,tmax,thor, &
+ !                                 etatvernal,cu,rfvi,ndebdorm,nfindorm,nlev)
+ !    endif
+
+
+!    4. EFFECTS OF PHOTOPERIOD (calcul of rfpi)
+!    -----------------------------
+     if (P_codephot == 1) then
+       !numdate = MOD(jjul,nbjsemis+1)
+       !numdate = jjul
+       !if (jjul > nbjsemis) numdate = jjul - nbjsemis
+
+       !call photpd(P_latitude,numdate,daylen,phoi)
+
+       !if (ndrp /= 0 .or. n > ndrpobs) then
+       if (ndrp /= 0) then
+         rfpi = 1.0
+       else if (P_codebfroid /= 3 .and. (nlev == 0 .or. n < nlev)) then ! pour les ligneux, photopériode active à partir de la fin de dormance
+         rfpi = 1.0
+       !else if (P_codebfroid == 3 .and. nfindorm == 0) then
+       !  rfpi = 1.0
+       else
+         ! TODO: on remplace l'appel à photpd par ses résultats. photpd n'est appelé qu'une fois par pas de temps
+         rfpi = cRFPI(phoi)
+       endif
+     else
+       rfpi = 1.0
+     endif
+     
+!     print *, 'in develop the rfpi is,', rfpi
+
+!    5. UNIT OF DEVELOPPEMENT (calcul de upvt)
+!    ---------------------------------------------------
+     if (P_codetemp == 2) then
+       ! DR 17/08/06 si on est sur une perenne et qu'une dormance a deja ete faite
+       ! on ne fait plus jouer la vernalisation sur le calcul des stades
+       ! implicitement n'est utilisé que si on est en enchainement
+       
+       
+       ! the calculation of upvt is done
+       if (P_codedormance == 3 .and. nlev > 0) then
+         upvt = udevcult * rfpi
+       else
+         upvt = udevcult * rfpi * rfvi
+       endif
+
+       ! option codelaisansvernal la vernalisation ne joue pas sur la ulai
+       if (codeulaivernal == 0) utp = udevcult * rfpi
+     else
+       ! DR 17/08/06 si on est sur une perenne et qu'une dormance a deja ete faite
+       ! on ne fait plus jouer la vernalisation sur le calcul des stades
+       ! implicitement n'est utilisé que si on est en enchainement
+       ! NB le 21/08/07 bug
+       if (P_codebfroid == 3 .and. P_codedormance == 3 .and. nlev > 0) then
+         upvt = udevair * rfpi
+       else
+         upvt = udevair * rfpi * rfvi
+       endif
+
+       if (codeulaivernal == 0) utp = udevair * rfpi
+     endif
+
+
+     !: calculation of the cumulated units of development between two stages
+     somcour = somcour + upvt
+
+!     print *, 'somcour and upvt in development is', somcour, upvt
+
+     !: somcourdrp = cumul d'unité entre deux stades reproducteurs
+     !- à partir de la levee
+     if (nlev > 0) somcourdrp = somcourdrp + upvt
+
+     ! dr 13/01/06: dans le cas de la prairie on ne cumule plus d'upvt si on coupe apres amf
+     ! dr 17/11/05: si on coupe apres amf et avant drp on ne pourra plus faire d'epi
+     !              donc on arrete le developpement des stades reproducteurs
+     if (P_codefauche == 1 .and. onarretesomcourdrp) then   ! P_codefauche cut mode for forage crop, cut (1) or not (2)
+       if (namf /= 0 .and. (ndrp == 0 .or. nflo == 0)) then
+         somcourdrp = somcourdrp - upvt
+       endif
+     endif
+
+     if (codeulaivernal == 0) then
+       somcourutp = somcourutp + utp
+     endif
+
+
+     !: calcul d'une somme de températures même
+     !- pour les plantes vernalo-photo-sensibles
+     !- pour les calculs de sénescence et de nombre  de feuilles
+     !-
+     !- NB le 08/05 on remplace la somme des températures pour
+     !- la sénescence par un P_Q10 pour que le vieillissement soit effectif meme
+     !- en conditions froides
+     if (P_codetemp == 2) then
+       tdevelop = 2.0 ** (udevcult / 10.)
+     else
+       tdevelop = 2.0 ** (udevair / 10.)
+     endif
+
+     somtemp = somtemp + tdevelop
+     if (P_codetempfauche == 1) then
+       somcourfauche = somcourfauche + upvt
+     else
+       somcourfauche = somcourfauche + udevair
+     endif
+
+!     print *, 'somcour and tdevelop, somtemp in develop is:', somcour, tdevelop, somtemp
+
+
+!    6. CALCULATION OF THE STATUS
+!    -----------------
+!    
+
+!    This part is for perennial grassland----xcwu
+
+!!    DR et ML et SYL 16/06/09
+!!    calcul de la date de montaison et du jour d'entree en
+!!    vernalisation de la prairie perenne
+!     if (P_codemontaison == 1)then
+!!    ####
+!!    entrée en vernalisation des fourrages (pérenne)
+!!    NB le 07/03/08
+!       if (P_codebfroid == 2 .and. P_codeperenne == 2) then
+!         somcourmont = somcourmont + upvt
+!       ! PB - 03/08/2010 - je remplace jul par jjul qui correspond à n+P_iwater-1
+!         if (jjul+((onestan2-1)*nbjsemis) == P_julvernal) then
+!           somcourmont = 0.0
+!         endif
+!!    ** stade début montaison : après vernalisation
+!!    unique cycle reproducteur de l'année
+!         if (somcourmont >= R_stlevamf .and. jjul+((onestan2-1)*nbjsemis) > P_julvernal)then
+!           nmontaison = n
+!           namf = n
+!!    DR et ML et SYL 16/06/09 - on supprime nvernal qui ne sert à rien
+!!   --         nvernal=0
+!           somcourmont=0.0
+!           onestan2 = 1
+!         endif
+!
+!!    si la coupe intervient après le stade montaison alors on remet
+!!    le stade à 0
+!         if (sioncoupe) nmontaison=0
+!       endif
+!!    ####
+!     endif
+!!    DR et ML et SYL 16/06/09 FIN
+
+     !: 6.1 STATUS OF GERMINATION AND EMERGENCE
+     !: levee
+     !: in this subroutine, we know when the crop germinates and emerges. We allowed the winter wheat emerges in the following spring within a reasonable period.
+     !: However, if the crop can not emerge within this period, we stop the crop growth (in_cycle) and go into another cropping season (f_crop_recycle). 
+     
+!     write(*,*) 'Pstade0: ', P_stade0
+     if (TRIM(P_stade0) == 'snu') then
+       if (nlev == 0) &
+         call levee(n,stempdiag_cm_daily, shumdiag_cm_day, nlevobs,                                     & ! INPUTS
+                    densiteger,densite,coeflev,densitelev,zrac,                                        & ! INOUT
+                    somelong,somger,nlev,nger, humectation,nbjhumec,somtemphumec,somcour,              &
+                    in_cycle, f_crop_recycle, nplt)               ! INOUT
+     elseif (TRIM(P_stade0) == 'lev') then
+       if (nlev==0) then
+         nger = n
+         nlev = n
+!         nger = 0
+         coeflev = 1
+         densiteger = P_densitesem
+         densitelev = densiteger*coeflev
+         zrac = P_profsem
+         densite = densitelev
+       endif
+     else
+       write(*,*) 'Pstade0 ', P_stade0, ' not recognized'
+     endif
+
+!    DR 18/07/2012 je rajoute la germination
+       if (n == nger) then
+          stpltger = somcour   
+          ! on affecte le cumul de température entre le semis et la levée
+          ! DR 18/07/2012 pour la germination on affiche juste somcour sans le reinitialiser
+          !      somcour = 0.0        ! on remet à zéro le cumul de température courant.
+          !      if (P_codeperenne == 1) somcourdrp = 0.0 ! NB le 23/03 pour les pérenne début du décompte drp à la levée de dormance
+          !      if (P_codefauche == 2) somcourfauche = 0.0
+          !      if (codeulaivernal == 0) somcourutp = 0.0
+       endif
+
+
+     if (nlevobs == 999) then ! pas d'observation pour la levée
+       if (n  == nlev) then   ! si on est le jour de la levée
+         stpltlev = somcour ! on affecte le cumul de température entre le semis et la levée
+         somcour = 0.0        ! on remet à zéro le cumul de température courant.
+         if (P_codeperenne == 1) somcourdrp = 0.0 ! NB le 23/03 pour les pérenne début du décompte drp à la levée de dormance
+         if (P_codefauche == 2) somcourfauche = 0.0
+         if (codeulaivernal == 0) somcourutp = 0.0
+       endif
+     !else                       ! levée observée, this means that we used the forced LAI, but at this moment we do not use this option
+     !  if (n  == nlevobs) then  ! si on est le jour de la levée observée
+     !    nlev = nlevobs         ! on force nlev
+     !    if (nger <= 0) nger = nlev  ! si la germination n'a pas encore été affectée, on la force au jour de la levée
+     !    ! réajustement du parcours de dl
+     !    stpltlev = somcour       ! on affecte le cumul de température entre le semis et la levée
+     !    somcour = 0.0            ! on remet à zéro le cumul de température courant.'
+     !    if (P_codeperenne == 1) somcourdrp = 0.0 ! NB le 23/03 pour les pérenne début du décompte drp à la levée de dormance
+     !    if (P_codefauche == 2) somcourfauche = 0.0
+     !    if (codeulaivernal == 0) somcourutp = 0.0
+     !  endif
+     endif
+
+
+
+     ! 6.2  STATUS OF VEGETATIVE STAGES
+
+     !: stade amf
+     if (namfobs == 999) then
+       if (somcour >= R_stlevamf .and. namf == 0 .and. nlev > 0) then
+         namf = n
+         R_stlevamf = somcour
+         somcour = 0.0
+         if (codeulaivernal == 0) somcourutp = 0.0
+       endif
+     !else
+     !  if (n == namfobs) then
+     !    namf = namfobs
+     !    ! réajustement du parcours de dl
+     !    R_stlevamf = somcour
+     !    somcour=0.0
+     !    if (codeulaivernal == 0) somcourutp = 0.0
+     !    if (namf < nlev .or. nlev == 0) then
+     !      call EnvoyerMsgHistorique(46)
+     !      stop
+     !    endif
+     !  endif
+     endif
+
+     !: stade end of leaf onset
+     if (nlaxobs == 999) then
+       if (somcour >= R_stamflax .and. nlax == 0 .and. namf > 0) then
+         nlax = n
+         R_stamflax = somcour
+         somcour = 0.0
+         if (codeulaivernal == 0) somcourutp = 0.0
+       endif
+     !else
+     !  if (n == nlaxobs) then
+     !    nlax = nlaxobs
+     !    ! réajustement du parcours de dl
+     !    R_stamflax = somcour
+     !    somcour = 0.0
+     !    if (codeulaivernal == 0) somcourutp = 0.0
+     !    if (nlax < namf .or. namf == 0) then
+     !      call EnvoyerMsgHistorique(41)
+     !      stop
+     !    endif
+     !  endif
+     endif
+    
+
+     !: stade sen
+     !- uniquement si P_codlainet=1
+     if (P_codlainet == 1) then
+       if (nsenobs == 999) then
+         if (somcour >= R_stlaxsen .and. nsen == 0 .and. nlax > 0) then
+           nsen = n
+           R_stlaxsen = somcour
+           somcour = 0.0
+           if (codeulaivernal == 0) somcourutp = 0.0
+         endif
+       !else
+       !  if (n == nsenobs) then
+       !    ! réajustement du parcours de dl
+       !    stdrpsen = somcour
+       !    nsen = nsenobs
+       !    if (nsen < nlax .or. nlax == 0) then
+       !      call EnvoyerMsgHistorique(42)
+       !      stop
+       !    endif
+       !    somcour = 0.0
+       !    if (codeulaivernal == 0) somcourutp = 0.0
+       !  endif
+       endif
+     endif
+
+!:    version 4.0 suppression du stade fir
+
+
+     !: stade lan
+     !- NB - le 22/04 - si colainet=2 plus de stade lan
+     if (P_codelaitr == 1 .and. P_codlainet == 1 .or. P_codelaitr == 2) then
+       if (nlanobs == 999) then
+         if (somcour >= R_stsenlan .and. nlan == 0 .and. nsen > 0) then
+           nlan = n
+           R_stsenlan = somcour
+           somcour = 0.0
+           if (codeulaivernal == 0)somcourutp = 0.0
+         endif
+       !else
+       !  if (n == nlanobs) then
+       !    ! réajustement du parcours de dl
+       !    R_stsenlan = somcour
+       !    nlan = nlanobs
+       !    somcour = 0.0
+       !    if (codeulaivernal == 0) somcourutp = 0.0
+       !    if (nlan < nsen .or. nsen == 0) then
+       !      call EnvoyerMsgHistorique(43)
+       !      stop
+       !    endif
+       !  endif
+       endif
+     endif
+
+
+!:    STADES REPRODUCTEURS
+
+     !: stade flo
+     if (nfloobs == 999) then
+       if (somcourdrp >= stlevflo .and. nflo == 0) then
+         nflo = n
+         stlevflo = somcourdrp
+!-   -      somcourdrp = 0.0 ! domi 04/04/01  pb canne on supprime la remise à zero
+       endif
+     !else
+     !  if (n == nfloobs) then
+     !    nflo = nfloobs
+     !    ! réajustement du parcours de dl
+     !    stlevflo = somcourdrp
+     !    ! DR et ML 21/01/08 on teste le pb des sommes de temp foireuses
+!-   !-      somcourdrp = 0.0
+     !  endif
+     endif
+
+
+     !: stade drp
+     if (ndrpobs == 999) then
+       if (somcourdrp >= R_stlevdrp .and. ndrp == 0) then
+         ndrp = n
+!    NB le 29/3
+!         R_stlevdrp=somcourdrp
+!     domi 04/04/01 on fait un essai
+!    DR et ML 21/01/08:
+!    SUITE AUX PBS DE calcul des sommes de temp dans le bilan
+!    lorsque on force flo ou drp => 2 modifs on enleve la remise à zero de somcourdrp si
+!    flo est observe (je me demande bien pourquoi on faisait ca)
+!    et R_stflodrp =somcourdrp-stlevflo
+!-   -      R_stflodrp=somcourdrp
+         R_stflodrp = somcourdrp - stlevflo
+         somcourdrp = 0.0
+!-   -      if (ndrp  = = nflo .or. nflo == 0) then
+!-   -        call EnvoyerMsgHistorique(47)
+!-   -        stop
+!-   -      endif
+       endif
+     !else
+     !  if (n == ndrpobs) then
+     !    ndrp = ndrpobs
+     !    ! réajustement du parcours de dl
+     !    ! NB le 29/3
+     !    !--      R_stlevdrp = somcourdrp
+     !    ! domi 04/04/01  essai y'a un pb dans les sommes flo
+     !    !--      R_stflodrp = somcourdrp
+     !    !--      R_stflodrp = somcourdrp
+     !    R_stflodrp = somcourdrp-stlevflo
+     !    somcourdrp = 0.0
+     !    if (ndrp < nflo .or. nflo == 0) then
+     !      call EnvoyerMsgHistorique(47)
+     !      stop
+     !    endif
+     !  endif
+     endif
+
+!     !: stade fin de nouaison pour la mise en place des fruits
+!     if (P_codeindetermin == 2) then
+!       if (somcourdrp >= P_stdrpnou .and. nnou == 0 .and. ndrp > 0) nnou = n
+!     endif
+
+     !: stade mat
+     if (nmatobs == 999) then
+       if (P_codeindetermin == 1) then   ! determinate crop 
+         if (somcourdrp >= R_stdrpmat .and. nmat == 0 .and. ndrp > 0) then
+           nmat = n
+           R_stdrpmat = somcourdrp
+           ! grain drying start
+           drylen = drylen + 1
+!           print *, 'in develop, for nmat do we go here, drylen is', drylen
+         endif
+       !else
+       !  ! pour les indéterminées la maturité finale correspond à l'ensemble des P_nboite-1 vides
+       !  ! Nb le 01/05 si P_nbcueille = 1
+       !  ! si P_nbcueille = 2 : la maturité correspond au début de remplissage de la dernière boite
+       !  if (P_nbcueille == 1) then
+!-   - !           if (nbfruit == 0.0 .and. nmat == 0 .and.
+       !    ! 12/07/06  DR et IGC nous avons changé la condition de calcul de la date
+       !    ! de maturité. Avant il calculait celle-ci en fonction du nombre de grains.
+       !    ! Maintenant, on calcule en focntion de la durée de fruits.
+       !    if (somcourdrp > P_dureefruit .and. nmat == 0 .and. n > ndrp .and. ndrp > 0) then
+       !      nmat = n
+       !      R_stdrpmat = somcourdrp
+       !    endif
+       !  else
+       !    if (nfruit > 0.0 .and. nmat == 0 .and. n > ndrp .and. ndrp > 0) then
+       !      nmat = n
+       !      R_stdrpmat = somcourdrp
+       !    endif
+       !  endif
+       endif
+     !else
+     !  if (n == nmatobs) then
+     !    nmat = nmatobs
+     !    ! réajustement du parcours de dl
+     !    R_stdrpmat = somcourdrp
+     !    if (nmat < ndrp .or. ndrp == 0) then
+     !      call EnvoyerMsgHistorique(44,ndrp)
+     !      stop
+     !    endif
+     !  endif
+     endif
+    
+     if (drylen > 0) then 
+!        print *, 'in develop, the n and nmat is', n, nmat
+        if (n > nmat) then
+           drylen = drylen + 1
+!           print *, 'in develop, the drylen is increasing', drylen
+        endif
+     endif
+
+
+!     print *, 'in develop, the somcour and somcourdrp is:', somcour, somcourdrp
+
+
+     !: stade rec
+     if (nrecobs == 999) then !not forced
+       ! détemination de la date de récolte par la teneur en eau des grains à partir de la maturité
+!-   -     if (teaugrain == h2ograin .and. nrec == 0) then
+!-   -       nrec = n
+!-   -       stmatrec = somcourdrp-R_stdrpmat
+!-   -       group = gpreco
+!-   -       write(*,*) 'rec',n,somcour,stmatrec,upvt
+!-   -     endif
+
+       !: Récolte
+       !- PB - 18/01/2005 - pas de récolte qd culture fauchée.
+       if (P_codefauche /= 1) &   ! option of cut modes for forage crops: yes (1); and no (2)
+           call recolte(n,ndrp, gslen, drylen, lai,        &   ! INPUT 
+                        nmat, nrec,              &   ! INOUT
+                        stmatrec,group)       ! OUT
+
+     endif
+
+
+!:    Affectation des bonnes valeurs d'unités de développement
+!-    utilisées pour le calcul du LAI
+     upvtutil = upvt
+     !if (nlevobs /= 999 .and. n <= nlevobs) then
+     !  upvtutil = upobs
+     !endif
+
+     !if (namfobs /= 999 .and. n <= namfobs .and. n > nlev) then
+     !  upvtutil = upobs
+     !endif
+
+     !if (nlaxobs /= 999 .and. n <= nlaxobs .and. n > namf) then
+     !  upvtutil = upobs
+     !endif
+
+     !if (nsenobs /= 999 .and. n <= nsenobs .and. n > nlax) then
+     !  upvtutil = upobs
+     !endif
+
+     !if (nlanobs /= 999 .and. n <= nlanobs .and. n > nsen) then
+     !  upvtutil = upobs
+     !endif
+
+     if (nlevobs == 999 .and. nlev == 0) then
+       upvtutil = upvt
+     endif
+
+     if (namfobs == 999 .and. nlev > 0 .and. namf == 0) then
+       upvtutil = upvt
+     endif
+
+     if (nlaxobs == 999 .and. namf > 0 .and. nlax == 0) then
+       upvtutil = upvt
+     endif
+
+     if (nsenobs == 999 .and. nlax > 0 .and. nsen == 0) then
+       upvtutil = upvt
+     endif
+
+     if (nlanobs == 999 .and. nsen > 0 .and. nlan == 0) then
+       upvtutil = upvt
+     endif
+
+
+!    26/09/06 pour inaki on sort le test ici nrecbutoir ne sert qu'a declencher la recolte
+!    inaki teste et on voit
+!         if (n == nrecbutoir) then
+!           if (nrec == 0) then
+!             group = -1
+!             nrec = nrecbutoir
+!           endif
+!     endif
+
+!    ** Determination du groupe de precocite et effet de la date butoir
+!    DR 06/01/06 ajout du test sur P_culturean = 1 pour les perennes sur une portion de leur cycle
+     if (n >= nrecbutoir .and. (P_codeperenne /= 2 .or. P_codeinitprec /= 2 .or. P_culturean == 1)) then
+!    NB et IG le 23/09/06 suppression du test pour les cultures sur plusieurs années
+!         if (n == nrecbutoir) then
+       if (nrec == 0) then
+         group = -1
+         nrec = nrecbutoir
+       endif
+       if (nlev == 0) nlev = nrecbutoir
+       if (nlev > 0 .and. namf == 0) then
+         namf = nrecbutoir
+         R_stlevamf = somcour
+         somcour = 0.0
+       endif
+       if (namf > 0 .and. nlax == 0) then
+         nlax = nrecbutoir
+         R_stamflax = somcour
+         somcour = 0.0
+       endif
+       if (nlax > 0 .and. nsen == 0) then
+         nsen = nrecbutoir
+         R_stlaxsen = somcour
+         somcour = 0.0
+       endif
+       if (nsen > 0 .and. nlan == 0) then
+         nlan = nrecbutoir
+         R_stsenlan = somcour
+         somcour = 0.0
+       endif
+!    ** NB le 26/03   (floraison)
+       if (nflo == 0) then
+         nflo = nrecbutoir
+         stlevflo = somcourdrp
+         somcourdrp = 0.0
+       endif
+       if (ndrp == 0) then
+         ndrp = nrecbutoir
+         R_stlevdrp = somcourdrp
+         somcourdrp = 0.0
+       endif
+!    NB le 25/08/04 traitement debdes en cas de recolte butoir
+       if (ndebdes == 0) then
+         ndebdes = nrecbutoir
+         R_stdrpdes = somcourdrp
+       endif
+!
+       if (ndrp > 0 .and. nmat == 0) then
+         nmat = nrecbutoir
+!    NB le 25/08/04 réactivation ligne suivante
+         R_stdrpmat = somcourdrp
+       endif
+     endif
+
+endif
+return
+end subroutine develop2
+
+!======================================================================================!
+!======================================================================================!
+!======================================================================================!
+
+!> Routine de calcul des besoins en froid pour le P_codebfroid = 2
+!>
+!! Description : subroutine calculating the cold needed
+!<
+subroutine Stics_Develop_bfroid2(nger,                &  ! IN
+                                 tdev,                &  ! IN
+                                 rfvi,                &  ! OUT
+                                 etatvernal,          &  ! INOUT
+                                 caljvc)                 ! INOUT
+
+USE Besoins_en_froid
+USE Stics
+!USE Messages
+
+  implicit none
+
+!: ARGUMENTS
+
+
+! 0.1 INPUT
+  !integer, intent(IN)    :: jjul  
+  !integer, intent(IN)    :: n  
+  !real,    intent(IN)    :: P_tfroid  !> // PARAMETER // optimal temperature for vernalisation // degree C // PARPLT // 1
+  !real,    intent(IN)    :: P_ampfroid  !> // PARAMETER // semi thermal amplitude thermique for vernalising effect // degree C // PARPLT // 1
+  !real,    intent(IN)    :: P_julvernal  !> // PARAMETER // julian day (between 1 and 365) accounting for the beginning of vernalisation for perennial crops // julian day // PARPLT // 1 
+  !real,    intent(IN)    :: P_jvc  !> // PARAMETER // Number of vernalizing days // day // PARPLT // 1
+  !real,    intent(IN)    :: P_jvcmini  !> // PARAMETER // Minimum number of vernalising days  // day // PARPLT // 1 
+  !integer, intent(IN)    :: P_codeperenne  !> // PARAMETER // option defining the annual (1) or perenial (2) character of the plant // code 1/2 // PARPLT // 0 
+  integer, intent(IN)    :: nger  
+  !integer, intent(IN)    :: namf  
+  !integer, intent(IN)    :: numcult     ! number of years of simulation, number of crop seasons,   one-year crop, or two-year crop
+  !integer, intent(IN)    :: nbjsemis    ! days number in the sowing year, it is the ith day in the sowing year
+  real,    intent(IN)    :: tdev        ! temperature 
+  !integer, intent(IN)    :: P_codemontaison  !> // PARAMETER // code to stop the reserve limitation from the stem elongation // code 1/2 // PARAMV6 // 0 
+  !integer, intent(IN)    :: P_culturean  !> // PARAMETER // crop status 1 = over 1 calendar year ,other than 1  = on two calendar years (winter crop in northern hemisphere) // code 0/1 // 
+  !integer, intent(IN)    :: P_codeinitprec  !> // PARAMETER // reinitializing initial status in case of chaining simulations : yes (1), no (2) // code 1/2 // PARAM // 0 
+  !integer, intent(IN)    :: nbjanrec     ! days number in the harvest year, if the harvest year is different from the sowing year
+
+! 0.2  INOUT
+  !integer, intent(INOUT) :: maxwth   ! maximum days for the simulation, 365 or 366 which is determined by the leap or not. But here, we do not consider the leap year, so it is 365
+  logical, intent(INOUT) :: etatvernal  ! is it not sensitive to vernalization?  false: sensitive,  ture, non-sensitive 
+  real,    intent(INOUT) :: caljvc  
+  !integer, intent(INOUT) :: onestan2  
+
+! 0.3  OUT
+  !integer, intent(OUT)   :: nrecbutoir  
+  real,    intent(OUT)   :: rfvi   !> // OUTPUT // Slowing effect of the vernalization on plant development // 0-1
+
+
+
+!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>!
+!>
+!> this part is especially for perennial grass----xcwu
+! DR et ML et SYL 16/06/09
+! prise en cpte de la montaison pour les prairies
+!    if (P_codemontaison == 1) then   ! 
+!! ####
+!! SYL modif le 11/03/08
+!! NB le 07/03/08
+!      jul = jjul
+!      if (jul == nbjsemis) then
+!        onestan2 = 2
+!      endif
+!! DR et ML et SYL 16/06/09 Fin
+!    else
+!      jul = MOD(jjul,nbjsemis) ! jul = jjul modulo nbjsemis
+!    endif
+!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>!
+
+
+    !!: entrée en vernalisation des herbacées pérennes au jour P_julvernal
+    !if ( etatvernal .and. jul == P_julvernal .and. P_jvc > P_jvcmini .and. P_codeperenne == 2) then
+    !  etatvernal = .FALSE.
+    !endif
+
+    if (.not.etatvernal) then
+
+      !: On active P_julvernal pour les annuelles, qui joue lorqu'il se situe après la germination.
+      !- NB et ML - 25/02/04 : à tester sur RGI CIPAN
+      !- ML - 21/04/04 : on interdit de démarrer au stade 'dor' et d'avoir jul < P_julvernal pour les cultures perennes
+      if ( nger /= 0 ) then
+
+      ! This part is only for perennial grassland
+      !! DR et ML et SYL 16/06/09
+      !! prise en cpte de la montaison des prairies
+      !! ####
+      !  if (P_codemontaison == 1)then
+      !    numcult_ver = onestan2
+      !  else
+      !    numcult_ver = numcult
+      !  endif
+
+        !if (jul+((numcult_ver-1)*nbjsemis) >= P_julvernal) then
+        !--if (jul+((numcult-1)*nbjsemis) >= P_julvernal) then
+
+          !: ML - 28/05/04 : on interdit de démarrer au stade lev et
+          !- d'avoir jul > P_julvernal le jour de la levée (début de vernalisation) pour les cultures perennes
+         
+
+
+          ! for annual crop we calculate the vernalization---xcw
+          if (P_codeperenne == 1) then
+            call Vernalisation(tdev, rfvi, caljvc, etatvernal)
+          else
+            !if (n == namf .and. jul > P_julvernal .and. jul <= (P_julvernal+P_jvcmini)) then
+            !   call EnvoyerMsgHistorique(32)
+              stop    
+            ! endif
+            !if (n > namf) then
+            !DR 20/07/2012 pas besoin de jjul
+            !  call Vernalisation(tdev,P_jvc,P_jvcmini,P_codeperenne,P_culturean,P_codeinitprec,nbjanrec,P_tfroid,P_ampfroid,    &
+            !                      jjul,n, rfvi,nrecbutoir,maxwth,caljvc,etatvernal)
+            !                     n, rfvi,nrecbutoir,maxwth,caljvc,etatvernal)
+            !endif
+          endif
+        !else    ! < P_julvernal
+        !  if (P_codeperenne == 1) then
+        !    rfvi = 1.0
+        !  else
+        !    !call EnvoyerMsgHistorique(50)
+        !    stop
+        !  endif
+        !endif
+
+      else   ! not  germination yet
+        rfvi = 1.0
+      endif
+    else    ! not sensitive to vernalization
+      rfvi = 1.0
+    endif
+
+return
+end subroutine Stics_Develop_bfroid2
+
+!======================================================================================!
+!======================================================================================!
+!======================================================================================!
+
+
+!> Routine de calcul des besoins en froid pour le P_codebfroid = 3
+!> It is only effective for perennial crops, such as vineyard
+!! Description :
+!<
+!subroutine Stics_Develop_bfroid3(cu_min,cu_veille,n,tmin,tmax,thor, &
+!                                 etatvernal,cu,rfvi,ndebdorm,nfindorm,nlev)
+!
+!USE Besoins_en_froid
+!
+!implicit none
+!
+!!  integer, intent(IN)    :: P_codedormance  !> // PARAMETER // option of calculation of dormancy and chilling requirement // code 1/2 // PARPLT // 0 
+!  real,    intent(IN)    :: cu_min  
+!  real,    intent(IN)    :: cu_veille  
+!  integer, intent(IN)    :: n  
+!!  real,    intent(IN)    :: P_jvc  !> // PARAMETER // Number of vernalizing days // day // PARPLT // 1 
+!!  real,    intent(IN)    :: P_q10  !> // PARAMETER // P_Q10 used for the dormancy break calculation  // SD // PARPLT // 1 
+!  real,    intent(IN)    :: tmin   !> // OUTPUT // Minimum active temperature of air // degree C
+!  real,    intent(IN)    :: tmax   !> // OUTPUT // Maximum active temperature of air // degree C
+!  real,    intent(IN)    :: thor(24)  
+!
+!  logical, intent(INOUT) :: etatvernal  
+!  real,    intent(INOUT) :: cu  
+!  real,    intent(OUT)   :: rfvi   !> // OUTPUT // Slowing effect of the vernalization on plant development // 0-1
+!  integer, intent(INOUT) :: ndebdorm  
+!  integer, intent(INOUT) :: nfindorm  
+!  integer, intent(INOUT) :: nlev  
+!
+!
+!
+!    if (.not.etatvernal) then
+!      !: Calcul des cu (chill units ?)
+!      select case(P_codedormance)
+!        case(1,2)
+!          call Dormancy_Richardson(thor,n,cu_min,cu_veille,ndebdorm,cu)
+!        case(3)
+!          call Dormancy_Bidabe(n,ndebdorm,P_q10,tmin,tmax,cu_veille,cu)
+!      end select
+!
+!
+!      if (P_codedormance >= 2) then
+!
+!        !: Cas des calculs de Richardson ou Bidabe
+!        if (cu > P_jvc) then
+!          rfvi = 1.0
+!          !: 17/03/08 : maintenant on garde nfindorm0 si nfin s'est passe annee d'avant
+!          !--if (nfindorm == 0) nfindorm=n
+!          nfindorm = n
+!          etatvernal = .TRUE.
+!
+!          !: DR - 20/11/06 : On est un peu perplexe , on etait sur d'avoir testé tous les cas.
+!          !- Quand on arrive en fin de dormance, si on ne met pas nlev=0 on ne calcule plus les sommes
+!          !- d'action chaude de richardson. La date de levée a été stockée dans ilevs
+!          nlev = 0
+!        else
+!          rfvi = 0.0
+!        end if
+!
+!      else
+!
+!        !: Cas de forçage de la levée de dormance
+!        if (n < nfindorm) then
+!         rfvi = 0.0
+!        else
+!          rfvi = 1.0
+!          etatvernal = .TRUE.
+!        end if
+!
+!      end if
+!
+!    else
+!
+!      !: ML - le 18/10/05 : Cas de la dormance calculee avec Bidabe: on demarre la dormance à ndebdorm
+!      if (P_codedormance == 3 .and. n == ndebdorm) then
+!        etatvernal = .FALSE.
+!        rfvi = 0.0
+!      else
+!        rfvi = 1.0
+!      endif
+!
+!    endif
+!
+!
+!return
+!end subroutine Stics_Develop_bfroid3
Index: /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_sticslai/Stics_Lai_Developpement.f90
===================================================================
--- /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_sticslai/Stics_Lai_Developpement.f90	(revision 6940)
+++ /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_sticslai/Stics_Lai_Developpement.f90	(revision 6940)
@@ -0,0 +1,745 @@
+!*-----------------------------------------------------------------------------------------------------------------------------------------------------------* c!
+!> - Stics book paragraphe 3.1.1, page 40-44
+!> - In STICS, leaf area growth is driven by phasic development, temperature and stresses. An empirical plant density-dependent function represents inter-plant
+!! competition. For indeterminate plants, trophic competition is taken into account through a trophic stress index, while for determinate plants a maximal
+!! expansion rate threshold is calculated to avoid unrealistic leaf expansion.
+!! The calculation of leaf growth rate (deltai in m2m-2 d-1) is broken down: a first calculation of the LAI growth rate (in m2 plant-1 degree-day-1) describes
+!! a logistic curve, related to the ILEV, IAMF and ILAX phenological stages. This value is then multiplied by the effective crop temperature, the plant density
+!! combined with a density factor, supposed to stand for inter-plant competition, that is characteristic for the variety, and the water and nitrogen stress indices.
+!!
+!! At the end of the juvenile stage (IAMF), it is equal to vlaimax when the inflection of the dynamics (point of maximal rate) also occurs.
+!! Between the stages ILEV, IAMF and ILAX, the model performs linear interpolation based on development units (upvt) which include all the environmental effects
+!! on phasic development. As the ILAX stage approaches, it is possible to introduce a gradual decline in growth rate using the udlaimax parameter
+!! - the ULAI value beyond which there is a decline in the leaf growth rate. If udlaimax=3 it has no effect and the leaf stops growing at once at ILAX.
+!!
+!! The thermal function relies on crop temperature and cardinal temperatures (tcmin and tcmax) which differ from the ones used for the phasic development.
+!! The extreme threshold tcxstop is the same as for development.
+!!
+!! The density function is active solely after a given LAI threshold occurs (laicomp parameter) if the plant density (densite in plant m-2 possibly decreased
+!! by early frost) is greater than the bdens threshold, below which plant leaf area is assumed independent of density.  Beyond this density value, leaf area
+!! per plant decreases exponentially.  The adens parameter represents the ability of a plant to withstand increasing densities.  It depends on the species
+!! and may depend on the variety.  For branching or tillering plants, adens represents the plants branching or tillering ability (e. g. wheat or pea).
+!! For single-stem plants, adens represents competition between plant leaves within a given stand (e.g. maize or sunflower).
+!!
+!! Water and nitrogen affect leaf growth as limiting factors, i.e. stress indices whose values vary between 0 and 1. Water (turfac) and nitrogen deficits (innlai)
+!! are assumed to interact, justifying the use of the more severe of the two stresses. Meanwhile at the whole plant level the water-logging stress index is assumed
+!! to act independently
+!
+!
+!
+!> -	Features of determinate crops
+!!   Failure to account for trophic aspects in the calculation of leaf growth may cause problems when the radiation intercepted by the crop is insufficient to
+!!   ensure leaf expansion (e.g. for crops under a tree canopy or crops growing in winter).  Consequently, from the IAMF stage, we have introduced a trophic effect
+!!  to calculate the definitive LAI growth rate in the form of a maximum threshold for leaf expansion (deltaimaxi in m2m-2d-1) using the notion of the maximum
+!!   leaf expansion allowed per unit of biomass accumulated in the plant (sbvmax in cm2 g-1) and the daily biomass accumulation (dltams in t.ha-1day-1 possibly
+!!   complemented by remobilized reserve remobilj). sbvmax is calculated using the slamax and tigefeuil parameters.
+!!
+!> -	Features of indeterminate crops
+!!   It has been possible to test the robustness of the above formalisation on a variety of crops, including crops where there is an overlap between the
+!!   vegetative phase and the reproductive phase (soybean and flax for example).  However, when trophic competition between leaves and fruits is a driving force
+!!   for the production and management of the crop (for example tomato, sugarbeet), this formalisation is unsuitable.  We therefore calculate the deltai variable
+!!   so as to take trophic monitoring into consideration in the case of crops described as indeterminate, by introducing a trophic stress index (splai).
+!!   As a consequence, the LAI can decrease markedly during the theoretical growth phase if the crop is experiencing severe stresses during the harvested
+!!   organs filling phase.
+! *-----------------------------------------------------------------------------------------------------------------------------------------------------------* c
+!TODO: modify the structure into the same manner as ORCHIDEE
+
+! XCW 23/05/2013 modified
+! subroutine laidev(sc,p,pg,itk,t,soil,c,sta)
+
+ subroutine laidev(n,                               &  ! IN
+                   in_cycle,                        &  ! INout
+                   f_crop_recycle,                  &  ! INOUT
+                   f_sen_lai,                        &  ! INout
+                   tair,                            &  ! IN  
+                   t2m_min_daily,                            &  ! IN  
+                   gdh_daily,                       &  ! IN
+                   phoi,                            &  ! IN
+                   onarretesomcourdrp,              &  ! IN                          
+                   stempdiag_cm_daily,              &  ! IN
+                   shumdiag_cm_day,                 &  ! IN
+                   nlevobs,                         &  ! IN
+                   namfobs,                         &  ! IN
+                   nfloobs,                         &  ! IN
+                   nlanobs,                         &  ! IN
+                   nlaxobs,                         &  ! IN
+                   nmatobs,                         &  ! IN
+                   nrecobs,                         &  ! IN
+                   nsenobs,                         &  ! IN
+                   ndrpobs,                         &  ! IN
+                   dltams,                          &  ! IN
+                   eop,                             &  ! IN
+                   masec,                           &  ! IN
+                   masecveg,                        &  ! IN
+                   nsendltams,                      &  ! INOUT
+                   nsendltai,                       &  ! INOUT
+                   nsenpfeuilverte,                 &  ! INOU&
+                   nsendurvie,                      &  ! INOU&
+                   nsenndurvie,                     &  ! INOU&
+                   densiteequiv,                    &  ! INOU&
+                   nplt,                            &  ! INOU&
+                   tursla,                          &  ! INOU&
+                   sla,                             &  ! INOU&
+                   pfeuilverte,                     &  ! INOU&
+                   bsenlai,                         &  ! INOU&
+                   zrac,                            &  ! INOU&
+                   nrec,                            &  ! INOU&
+                   nlan,                            &  ! INOU&
+                   tcult,                           &  ! INOU&
+                   udevair,                         &  ! INOU&
+                   udevcult,                        &  ! INOU&
+                   ndrp,                            &  ! INOU&
+                   rfvi,                            &  ! INOU&
+                   nlev,                            &  ! INOU&
+                   nger,                            &  ! INOU&
+                   etatvernal,                      &  ! INOU&
+                   caljvc,                          &  ! INOU&
+                   rfpi,                            &  ! INOU&
+                   upvt,                            &  ! INOU&
+                   utp,                             &  ! INOU&
+                   somcour,                         &  ! INOU&
+                   somcourdrp,                      &  ! INOU&
+                   somcourutp,                      &  ! INOU&
+                   tdevelop,                        &  ! INOU&
+                   somtemp,                         &  ! INOU&
+                   somcourfauche,                   &  ! INOU&
+                   stpltger,                        &  ! INOU&
+                   R_stamflax,                      &  ! INOU&
+                   R_stlaxsen,                      &  ! INOU&
+                   R_stsenlan,                      &  ! INOU&
+                   stlevflo,                        &  ! INOU&
+                   nflo,                            &  ! INOU&
+                   R_stlevdrp,                      &  ! INOU&
+                   R_stflodrp,                      &  ! INOU&
+                   R_stdrpmat,                      &  ! INOU&
+                   nmat,                            &  ! INOU&
+                   nlax,                            &  ! INOU&
+                   nrecbutoir,                      &  ! INOU&
+                   group,                           &  ! INOU&
+                   ndebdes,                         &  ! INOU&
+                   R_stdrpdes,                      &  ! INOU&
+                   densite,                         &  ! INOU&
+                   densitelev,                      &  ! INOU&
+                   coeflev,                         &  ! INOU&
+                   densiteger,                      &  ! INOU&
+                   somelong,                        &  ! INOU&
+                   somger,                          &  ! INOU&
+                   humectation,                     &  ! INOU&
+                   nbjhumec,                        &  ! INOU&
+                   somtemphumec,                    &  ! INOU&
+                   stpltlev,                        &  ! INOU&
+                   namf,                            &  ! INOU&
+                   stmatrec,                        &  ! INOU&
+                   tustress,                        &  ! INOU&
+                   lai,                             &  ! INOU&
+                   somfeuille,                      &  ! INOU&
+                   pdlai,                           &  ! INOU&
+                   nbfeuille,                       &  ! INOU&
+                   reajust,                         &  ! INOU&
+                   ulai,                            &  ! INOU&
+                   pdulai,                          &  ! INOU&
+                   efdensite,                       &  ! INOU&
+                   tempeff,                         &  ! INOU&
+                   nstopfeuille,                    &  ! INOU&
+                   deltai,                          &  ! INOU&
+                   vmax,                            &  ! INOU&
+                   nsen,                            &  ! INOU&
+                   laisen,                          &  ! INOU&
+                   dltaisenat,                      &  ! INOU&
+                   nsencour,                        &  ! INOU&
+                   dltamsen,                        &  ! INOU&
+                   dltaisen,                        &  ! INOU&
+                   fgellev,                         &  ! INOU&
+                   gelee,                           &  ! INOU&
+                   fstressgel,                      &  ! INOU&
+                   pdlaisen,                        &  ! INOU&
+                   R_stlevamf,                      &  ! INOU&
+                   dernier_n,                       &  ! INOU&
+                   durvieI,                         &  ! INOU&
+                   durvie,                          &  ! INOU&
+                   ndebsen,                         &  ! INOU&
+                   somsenreste,                     &  ! INOU&
+                   shumrel,                          &  ! INOU&
+                   humrel,                          &  ! INOU&
+                   swfac,                           &  ! INOU&
+                   turfac,                          &  ! INOU&
+                   senfac,                          &  ! INOUT
+                   mafeuiljaune,                    &  ! INOUT
+                   msneojaune,                      &
+                   gslen,                           &
+                   drylen,                           &
+                   vswc, &
+                   histgrowth, &
+                   hist_sencour, &
+                   hist_latest, &
+                   doyhistst, &
+                   nbox, boxulai, boxndays, boxlai, boxlairem,boxtdev, &
+                   boxbiom,boxbiomrem, boxdurage, boxsomsenbase)           ! INOUT 
+
+
+  USE Stics 
+  USE Besoins_en_froid
+  USE netcdf
+  USE ioipsl
+
+  IMPLICIT NONE
+
+ 
+  ! declaration of variables
+
+  ! 0.1 input 
+  
+  integer, intent(IN)                           :: n  
+  logical, intent(inout)                           :: in_cycle
+  logical, intent(inout)                           :: f_crop_recycle
+  
+  logical, intent(inout)                           :: f_sen_lai
+  real,    intent(IN)                           :: tair !> / Mean air temperature of the day // degree C
+  real,    intent(IN)                           :: t2m_min_daily !> / Minimum air temperature of the day // degree C
+  real,    intent(IN)                           :: gdh_daily  !> // daily gdh calculated according to halfhourly temperature // transmitted from stomate.f90 gdh_daily
+  real,    intent(IN)                           :: phoi   !> // OUTPUT // Photoperiod // hours
+  logical, intent(IN)                           :: onarretesomcourdrp 
+  real,    intent(IN), dimension(3)             :: stempdiag_cm_daily !> / soil temperature at 1 cm resolution for the sowing depth and neighbour layers // Degree C 
+  real,    intent(IN), dimension(3)             :: shumdiag_cm_day     !> /soil moisture at 1 cm resolution for the sowing depth and neighbour layers // unit m3 m-3 with values ranging 0-1
+  integer(i_std), intent(IN)                           :: nlevobs 
+  integer, intent(IN)                           :: namfobs  
+  integer, intent(IN)                           :: nfloobs  
+  integer, intent(IN)                           :: nlanobs  
+  integer, intent(IN)                           :: nlaxobs  
+  integer, intent(IN)                           :: nmatobs  
+  integer, intent(IN)                           :: nrecobs  
+  integer, intent(IN)                           :: nsenobs  
+  integer, intent(IN)                           :: ndrpobs  
+  real,    intent(IN)                           :: dltams     !> // growth rate of the plant // t ha-1 day-1 (difference of total biomass)
+  real,    intent(IN)                           :: eop        !> // potential evanpotranspiration 
+  real,    intent(INOUT)                        :: masec      !> // above ground drymatter // t ha-1
+  real,    intent(IN)                           :: masecveg   !> // vegetative dry matter  // t ha-1
+  real,    intent(IN)                           :: vswc   !> daily humrel data
+  real,    intent(IN)                           :: humrel
+
+! 0.2 inout
+ 
+  ! these variables are for laidev specifically
+  real, intent(INOUT)        :: nsendltams
+  real, intent(INOUT)        :: nsendltai
+  real, intent(INOUT)        :: nsenpfeuilverte
+  real, intent(INOUT)        :: nsendurvie
+  real, intent(INOUT)        :: nsenndurvie
+  real, intent(INOUT)        :: densiteequiv
+  integer, intent(INOUT)        :: nplt
+  real, intent(INOUT)        :: tursla
+  real, intent(INOUT)        :: sla
+  real, intent(INOUT)        :: pfeuilverte
+  real, intent(INOUT)        :: bsenlai
+  
+  ! variables are involved in DEVELOPMENT
+
+  real,    intent(INOUT)        :: zrac
+  integer, intent(INOUT)        :: nrec
+  integer, intent(INOUT)        :: nlan
+  real,    intent(INOUT)        :: tcult
+  real,    intent(INOUT)        :: udevair
+  real,    intent(INOUT)        :: udevcult
+  integer,    intent(INOUT)        :: ndrp
+  real,    intent(INOUT)        :: rfvi
+  integer,    intent(INOUT)        :: nlev
+  integer,    intent(INOUT)        :: nger
+  logical,    intent(INOUT)        :: etatvernal
+  real,    intent(INOUT)        :: caljvc
+  real,    intent(INOUT)        :: rfpi
+  real,    intent(INOUT)        :: upvt
+  real,    intent(INOUT)        :: utp
+  real,    intent(INOUT)        :: somcour
+  real,    intent(INOUT)        :: somcourdrp
+  real,    intent(INOUT)        :: somcourutp
+  real,    intent(INOUT)        :: tdevelop
+  real,    intent(INOUT)        :: somtemp
+  real,    intent(INOUT)        :: somcourfauche
+  real,    intent(INOUT)        :: stpltger
+  real,    intent(INOUT)        :: R_stamflax
+  real,    intent(INOUT)        :: R_stlaxsen
+  real,    intent(INOUT)        :: R_stsenlan
+  real,    intent(INOUT)        :: stlevflo
+  integer,    intent(INOUT)        :: nflo
+  real,    intent(INOUT)        :: R_stlevdrp
+  real,    intent(INOUT)        :: R_stflodrp
+  real,    intent(INOUT)        :: R_stdrpmat
+  integer,    intent(INOUT)        :: nmat
+  integer,    intent(INOUT)        :: nlax
+  integer,    intent(INOUT)        :: nrecbutoir
+  real,    intent(INOUT)        :: group
+  integer,    intent(INOUT)        :: ndebdes
+  real,    intent(INOUT)        :: R_stdrpdes
+  real,    intent(INOUT)        :: densite
+  real,    intent(INOUT)        :: densitelev
+  real,    intent(INOUT)        :: coeflev
+  real,    intent(INOUT)        :: densiteger
+  real,    intent(INOUT)        :: somelong
+  real,    intent(INOUT)        :: somger
+  logical,    intent(INOUT)        :: humectation
+  integer,    intent(INOUT)        :: nbjhumec
+  real,    intent(INOUT)        :: somtemphumec
+  real,    intent(INOUT)        :: stpltlev
+  integer,    intent(INOUT)        :: namf
+  real,    intent(INOUT)        :: stmatrec
+ 
+  ! these variables are involved in Lai_calculation
+   
+  real,    intent(INOUT)        :: tustress
+  real,    intent(INOUT)        :: lai
+  real,    intent(INOUT)        :: somfeuille
+  real,    intent(INOUT)        :: pdlai
+  integer,    intent(INOUT)        :: nbfeuille
+  real,    intent(INOUT)        :: reajust
+  real,    intent(INOUT)        :: ulai
+  real,    intent(INOUT)        :: pdulai
+  real,    intent(INOUT)        :: efdensite
+  real,    intent(INOUT)        :: tempeff
+  integer,    intent(INOUT)        :: nstopfeuille
+  real,    intent(INOUT)        :: deltai
+  real,    intent(INOUT)        :: vmax
+  integer,    intent(INOUT)        :: nsen
+  real,    intent(INOUT)        :: laisen
+  real,    intent(INOUT)        :: dltaisenat
+
+  ! these variables are involved in the LAIsenescence
+
+  integer,    intent(INOUT)      :: nsencour
+  real,    intent(INOUT)      :: dltamsen
+  real,    intent(INOUT)      :: dltaisen
+  real,    intent(INOUT)      :: fgellev
+  logical,    intent(INOUT)      :: gelee
+  real,    intent(INOUT)      :: fstressgel
+  real,    intent(INOUT)      :: pdlaisen
+  real,    intent(INOUT)      :: R_stlevamf
+  integer,    intent(INOUT)      :: dernier_n
+  real,    intent(INOUT)      :: durvieI
+  real,    intent(INOUT)      :: durvie
+  integer,    intent(INOUT)      :: ndebsen
+  real,    intent(INOUT)      :: somsenreste
+
+  real, dimension(300,5), intent(INOUT) :: histgrowth
+  integer, intent(INOUT)                :: hist_sencour
+  integer, intent(INOUT)                :: hist_latest
+  integer, intent(INOUT)                :: doyhistst
+
+! compartment senescence module
+!boxulai, boxndays, boxlai, boxlairem,boxtdev, boxbiom, boxbiomrem, boxdurage,
+!boxsomsenbase
+       integer(i_std), intent(IN)                  :: nbox
+       real(r_std), dimension(nbox), intent(INOUT) :: boxulai
+       integer(i_std), dimension(nbox), intent(INOUT) :: boxndays
+       real(r_std), dimension(nbox), intent(INOUT) :: boxlai
+       real(r_std), dimension(nbox), intent(INOUT) :: boxlairem
+       real(r_std), dimension(nbox), intent(INOUT) :: boxtdev
+       real(r_std), dimension(nbox), intent(INOUT) :: boxbiom
+       real(r_std), dimension(nbox), intent(INOUT) :: boxbiomrem
+       real(r_std), dimension(nbox), intent(INOUT) :: boxdurage
+       real(r_std), dimension(nbox), intent(INOUT) :: boxsomsenbase
+
+
+  ! these variables are involved in STRESS calculation
+  
+  real,    intent(INOUT)      :: shumrel
+  real,    intent(INOUT)      :: swfac
+  real,    intent(INOUT)      :: turfac
+  real,    intent(INOUT)      :: senfac
+
+  ! these variables are involved in CARBON ALLOCATION PROCESSES
+  
+  real,    intent(INOUT)      :: mafeuiljaune      !  Dry matter of yellow leaves // t.ha-1
+  real,    intent(INOUT)      :: msneojaune        ! Newly-formed senescent dry matter  // t.ha-1
+  integer,    intent(INOUT)      :: gslen
+  integer,    intent(INOUT)      :: drylen
+   
+
+! 0.4 local Variables
+  !real                          :: tdev  
+  real                          :: upvtutil
+  real                          :: tempdev
+
+ !  do i = 1, P_nbplantes   !possible multi species for intercropping.
+ !     on pourrait utiliser un pointeur pour raccourcir les écritures.
+ !     Ex : p = plante(i). Et au lieu de p(i), on aurait juste p.
+ !   
+ !     comments: adjustment of LAI, but it is only effective for the option of forcing LAI. 
+ !     there are two options for treating lai, 1. forced, 2. calculated.  ---xcwu	
+    
+ !     if (lge(P_codesimul,'feuille') .eqv. .TRUE.) then
+ !         call recalcullevee(n, nlev, nlevobs, nlaxobs, lai(1:n+1), &
+ !                            ! tauxcouv(1:n+1),
+ !                            & P_codelaitr &
+ !                            !,estDominante
+ !                            & )
+ !     endif
+
+
+    if (P_codeplante /= 'snu') then    ! 'snu' is bare soil.
+    !ens = AS   ! AS is a scalar, the value is 1. 
+
+
+    ! 1. In senescence process, we need the dltams and dltai at date of  nsencour (specific date). 
+    !    but we should know that the variable nsencour is calculated in the latter process in our laidev module.
+    !    So here , we can only use the data at the date of nsencour + 1 
+     
+         if (P_culturean /= 1 .AND. nsencour /= 0 .AND. nsencour > 365) then 
+   
+            if (n == nsencour - 365 + 1) then
+               nsendltams = dltams
+               nsendltai  = deltai
+               nsenpfeuilverte = pfeuilverte 
+               nsendurvie = durvie
+            endif
+      
+ 
+            ! We need the durvie of the following day after nsencour
+            if (n == nsencour- 365 + 2) then
+               nsenndurvie = durvie
+            endif
+         endif
+         
+         if (P_culturean == 1 .AND. nsencour /= 0) then 
+            if (n == nsencour + 1) then
+               nsendltams = dltams
+               nsendltai  = deltai
+               nsenpfeuilverte = pfeuilverte 
+               nsendurvie = durvie
+            endif
+ 
+            ! We need the durvie of the following day after nsencour
+            if (n == nsencour + 2) then
+               nsenndurvie = durvie
+            endif
+         endif
+
+    ! 2. DEVELOPMENT OF PLANTS   
+    !>>>> DEVELOPMENT PROCESSES<<<<<<<<<<<<<!
+    !>>>> MODIFIED 05/17/13<<<<<<<<<<<<<<<<<!
+         
+         ! SET THE NPLT
+         ! P_iwater //julian day of the beginning of the simulation // jour julien
+
+         nplt = P_iplt0 - P_iwater + 1  ! although nplt is changed each day, but it is actually a constance if the sowing date is determined.
+
+
+         call develop2(n, in_cycle, nplt, tair,  gdh_daily, turfac,  phoi, onarretesomcourdrp,  stempdiag_cm_daily, shumdiag_cm_day,lai,           &  !> INPUTS
+                       nlevobs, namfobs, nfloobs, nlanobs, nlaxobs, nmatobs, nrecobs, nsenobs, ndrpobs, nrecbutoir,                  &  !> INPUTS
+                       masec, namf,  ndrp, nflo, nger, nlan, nlev, nrec, etatvernal, caljvc,                                         &  !> INOUT
+                       upvt, utp, somcour, somcourdrp, somcourfauche, somcourutp, somtemp, zrac,                                                      &  !> INOUT
+                       coeflev, somelong, somger, humectation, nbjhumec, somtemphumec, densite, densitelev, nlax, nmat, nsen, stlevflo, ndebdes,      &  !> INOUT 
+                       R_stlevamf, R_stamflax, R_stsenlan, R_stlaxsen, R_stlevdrp, R_stflodrp, R_stdrpmat, R_stdrpdes, densiteger,                    &  !> INOUT
+                       udevair, udevcult, rfvi, rfpi, tdevelop, stpltger, upvtutil, stmatrec, group, tcult, stpltlev,                                 &
+                       f_crop_recycle, gslen, drylen)                                   !> OUT
+
+    
+       ! DR 12/09/2012 on pense que il y avait un pb sur le calcul de deltalai qui pour les CAS etait calculé à partir de la densite equivalente
+       ! cette densite equivalente ne doit etre utilisée que pour le calcul de efdensite (en cas de cas et pour la plante 2 ...)
+       ! si les 2 plantes sont arrivées à levee on recalcule la densite equivalente
+
+       ! comments: at this moment, we do not consider the intercropping system---xcwu
+       !
+       ! if(sc%P_nbplantes.gt.1 .and. i==2)then
+       !       if((p(1)%nlev>0 .and. p(2)%nlev>0) .and. (p(1)%nlev==sc%n.or.p(2)%nlev==sc%n))then
+              !TODO: commenté ou pas ça ?
+       !            if (p(1)%nplt > p(2)%nplt) then
+       !             call EnvoyerMsgHistorique('culture principale semée après culture associée')
+       !           endif
+       !    call F_densite_equiv(i,p(1)%densite,p(2)%densite,p(i)%estDominante,p(1)%P_bdens ,p(2)%P_bdens,&
+       !     p(1)%densiteequiv,p(2)%densiteequiv)
+       ! le jour de la levee la desnite de la plante 2 est celle qu'on vient de recalculer (densite equivalente)
+       !     p(2)%densitelev=p(2)%densite
+       ! endif
+       ! endif
+       ! si on a une seule plante on reaffecte la densite equivalente au cas ou il y aurait eu une modif sur la densite courante (gel ou autre )
+        
+ 
+       ! We consider that the crop system is homogenous and is without intercropping system, So the densiteequiv is equal to densite 
+   
+        densiteequiv = densite
+
+
+       ! on décompose les valeurs AOAS calculées dans develop en AO et AS
+       !  p(i)%rdtint(sc%AO,p(i)%nbrecolte-1) = p(i)%rdtint(sc%AOAS,p(i)%nbrecolte-1) * p(i)%surf(sc%AO)
+       !  p(i)%rdtint(sc%AS,p(i)%nbrecolte-1) = p(i)%rdtint(sc%AOAS,p(i)%nbrecolte-1) * p(i)%surf(sc%AS)
+
+       !  p(i)%nfruit(sc%AO,p(i)%P_nboite) = p(i)%nfruit(sc%AOAS,p(i)%P_nboite) * p(i)%surf(sc%AO)
+       !  p(i)%nfruit(sc%AS,p(i)%P_nboite) = p(i)%nfruit(sc%AOAS,p(i)%P_nboite) * p(i)%surf(sc%AS)
+
+       !  p(i)%pdsfruit(sc%AO,p(i)%P_nboite) = p(i)%pdsfruit(sc%AOAS,p(i)%P_nboite) * p(i)%surf(sc%AO)
+       !  p(i)%pdsfruit(sc%AS,p(i)%P_nboite) = p(i)%pdsfruit(sc%AOAS,p(i)%P_nboite) * p(i)%surf(sc%AS)
+
+       !#if DEBUG == 1
+       !        if (iand(sc%develop,4) >0) call develop_debug_read_output(1232,sc,p,itk,i)
+       !        if (iand(sc%develop,8) >0) call develop_debug_write_output(1233,sc,p,itk,i)
+       !        if (iand(sc%develop,16) >0) call develop_debug_test_output(1234,sc,p,itk,i)
+       !#endif
+
+       ! dr - 17/11/05: pb de recolte
+       ! dr et ml - 06/12/05 : c'etait idiot pour les perennes de forcer la recolte des 2 cultures en meme temps!!
+     
+
+       ! this part for the harvest of the cropping system,
+       ! at this moment, we do not consider the cropping system, so we comment them
+       !    if (itk(i)%P_coderecolteassoc == 1) then
+       !      if (p(i)%nrec /= 0 .and. ALL(p(:)%P_codeperenne == 1))then
+       !        p(:)%nrec = p(i)%nrec
+       !      endif
+       !    endif
+    
+    !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+    ! 3. Record the lai at nsen
+    !    After all of the processes relating to the calculation of daily LAI, we got the daily LAI.
+    !    Specially, we need record the lai value on the date when the sen stage begin.  
+       
+          if (nsen > 0 .and. nlan == 0 .and. f_sen_lai) then 
+                          
+             bsenlai = lai     ! bsenlai is the lai at the date when the sen starts
+           
+             f_sen_lai = .FALSE.  
+          endif
+
+    ! 4. CALCULATION OF LAI   
+    !>>>> MODIFIED 05/17/13<<<<<<<<<<<<<<<<<!
+
+        if (lge(P_codesimul,'feuille') .eqv. .FALSE.) then    ! If the LAI is not forced.
+          if (P_codelaitr == 1) then  ! if the calculation of LAI is true LAI instead of soil cover
+
+            
+            !do ens = sc%AS,sc%AO
+            !  if (surf > 0.) then  ! here we do not consider whether or not there are crop!
+            !    sc%ens = ens       ! we also do not need the intercropping system
+
+            ! Calcul the  LAI by calling calai subroutine
+
+            !call calai_(P_codeinnact,P_codeh2oact,P_codehypo,P_codegermin,P_codcueille,P_codlainet,codeulaivernal,      & !IN
+            !            P_codeindetermin,P_codeinitprec,P_codeperenne,P_codetemp,turfac,innlai,                         &
+            !            P_laiplantule,P_phyllotherme,udevair,udevcult,P_dlaimaxbrut,P_udlaimax,n,numcult,nbjmax,        &
+            !            nplt,nlev,namf,nlax,ndrp,nrec,upvt,upvtutil,P_vlaimax,P_laicomp,somcour,somcourutp,             &
+            !            P_stlevamf,P_stamflax,densite,P_adens,P_bdens,P_tcxstop,tcult,P_tcmin,P_tcmax,P_pentlaimax,     &
+            !            P_dlaimin,exolai,sourcepuits,P_splaimin,P_splaimax,P_slamin,P_slamax,P_tigefeuil,P_tustressmin, &
+            !            fstressgel,dltamsen,sla,remobilj,dltams,                                                        & !IN
+            !            tustress,efdensite,nstopfeuille,deltai,splai,fpv,P_stlaxsen,tempeff,                            & !OUT
+            !            lai,somfeuille,nbfeuille,nsen,nlan,P_dlaimax,reajust,ulai,vmax,dltaisenat,laisen,               & !INOUT
+            !            dltaisen,P_stsenlan,densiteequiv)
+
+            call calai_(turfac,                                                                     & ! IN
+                        udevair,udevcult,n,                                                         & ! IN
+                        nplt,nlev,namf,nlax,ndrp,nrec,upvt,upvtutil,somcour,somcourutp,             & ! IN
+                        densite,tcult,                                                              & ! IN
+                        fstressgel,dltamsen,sla,                                                    & ! IN
+                        dltams, densiteequiv, bsenlai,                                              & ! IN
+                        pdlaisen, lai, pdlai, pdulai, somfeuille, nbfeuille, nsen, nlan,            & ! INOUT
+                        reajust,  ulai, vmax,                                                       & ! INOUT
+                        dltaisenat, laisen, dltaisen, R_stsenlan,                                   & ! INOUT
+                        tustress, efdensite, nstopfeuille, deltai, R_stlaxsen, tempeff,             &
+                        histgrowth, hist_sencour, hist_latest, doyhistst)!,&
+!                        nbox, boxulai, boxndays, boxlai, boxlairem,boxtdev, &
+!                        boxbiom,boxbiomrem, boxdurage, boxsomsenbase)               ! OUT
+
+       
+            ! Rognage & Effeuillage, seulement si lai > 0
+            ! ATTENTION! on travaille sur masec(n-1) car à ce moment de la boucle journalière masec(n) n'a pas encore été calculé...
+            !     if (p(i)%lai(ens,sc%n) > 0.0) then
+            !       if (itk(i)%P_codrognage == 2) then
+            !         call rognage(itk(i)%P_codcalrogne,p(i)%hauteur(ens),p(i)%largeur,   & ! IN
+            !                      itk(i)%P_hautrogne,itk(i)%P_margerogne,itk(i)%P_largrogne, &
+            !                      p(i)%dfol,p(i)%P_hautbase,itk(i)%P_interrang,            &
+            !                      p(i)%sla(ens),p(i)%P_tigefeuil,itk(i)%P_biorognem,sc%n,  &
+            !           p(i)%nrogne,p(i)%CNplante(ens),         & DR 20/07/2012 on a plus besoin du Cnplante il est calculé apres
+            !                      p(i)%nrogne,                                             &
+            !                      p(i)%lairogne(ens),p(i)%biorogne(ens),                   & ! INOUT & OUT
+            !                      p(i)%lai(ens,sc%n),p(i)%masec(ens,sc%n-1),               &
+            !                      p(i)%varrapforme,p(i)%P_forme,p(i)%biorognecum(ens),     &
+            !                      p(i)%lairognecum(ens))
+
+            !       ! Cumuls AO/AS
+            !         !p(i)%lairogne(ens)
+            !         !p(i)%biorogne(ens)
+            !         p(i)%lai(sc%aoas,sc%n) = p(i)%lai(sc%as,sc%n) * p(i)%surf(sc%as)              &
+            !                                + p(i)%lai(sc%ao,sc%n) * p(i)%surf(sc%ao)
+            !         p(i)%masec(sc%aoas,sc%n-1) = p(i)%masec(sc%as,sc%n-1) * p(i)%surf(sc%as)      &
+            !                                    + p(i)%masec(sc%ao,sc%n-1) * p(i)%surf(sc%ao)
+            !         !p(i)%varrapforme
+            !         !p(i)%P_forme
+            !         !p(i)%biorognecum(ens)
+            !         !p(i)%lairognecum(ens)
+
+            !         ! NB le 23/05 recyclage de la biomasse rognée
+            !         ! PB - 08/08/2009 - Pas besoin d'apporter des résidus de rognage tous les jours.
+            !         !                   On conditionne l'apport en résidus, si il y a de la masse rognée.
+
+            !         if (sc%n == p(i)%nrogne .and. p(i)%biorogne(ens) > 0.) then
+            !           soil%itrav1 = 1
+            !           soil%itrav2 = 1
+            !           sc%ires = 2
+            !           Cfeupc  =  42.
+            !           CNrogne = Cfeupc / p(i)%CNplante(ens)
+            !          
+            !           !Bruno 06/2012 - ajout quantites de C et N tombees au sol apres rognage
+            !           Crogne=p(i)%biorogne(ens)*Cfeupc*10.
+            !           Nrogne=Crogne/CNrogne
+            !           p(i)%QCrogne = p(i)%QCrogne + Crogne
+            !           p(i)%QNrogne = p(i)%QNrogne + Nrogne
+
+
+            !          !EC 0!6/08/2012 Ajout du code ires des feuilles rognées
+            !          sc%ires = 2
+            !          call ResidusApportSurfaceSol(p(i)%biorogne(ens),Cfeupc,-1.e-10,sc%ires,pg%P_CNresmin(sc%ires),  & ! IN
+            !                 pg%P_CNresmax(sc%ires),1.,1.,pg%P_Qmulchdec(sc%ires),sc%nbCouchesSol,pg%nbResidus,   &
+            !                 itk(i)%nap,sc%airg(sc%n+1),CNrogne,sc%Cnondec(1:10),sc%Nnondec(1:10),                &
+            !                 sc%Cres(1:sc%nbCouchesSol,1:pg%nbResidus),sc%Nres(1:sc%nbCouchesSol,1:pg%nbResidus), &
+            !                 sc%QCapp,sc%QNapp,sc%QCresorg,sc%QNresorg)                                                 ! INOUT
+
+            !         Wr=0.
+            !         if (CNrogne > 0.) Wr=1./CNrogne
+            !         call ResiduParamDec(pg%P_awb(sc%ires),pg%P_bwb(sc%ires),pg%P_cwb(sc%ires),pg%P_CroCo(sc%ires),  &
+            !            pg%P_akres(sc%ires),pg%P_bkres(sc%ires),pg%P_ahres(sc%ires),pg%P_bhres(sc%ires),             &
+            !            sc%Wb(sc%ires),sc%kres(sc%ires),sc%hres(sc%ires),Wr)
+            !         endif
+
+            !       endif
+
+
+            !      Comments----xcwu
+            !      The removal of leaves seems only effective for indeterminate crops, so at this moment we do not consider this processes,
+            !      because we mainly focus on the determinate crops.
+            !      So, this process is commented. 
+
+            !       if (P_codeffeuil /= 1) then  ! if there is no thinning management! it seems to be only effective for indeterminate crops, such as grape etc
+            !         call effeuill(P_codcaleffeuil,P_laidebeff,deltai(ens,sc%n), &
+            !                       P_effeuil,sla(ens),n,neffeuil,  &
+            !                       P_laieffeuil, P_codetransrad,P_hautmax,P_khaut,     &
+            !                       dfol,P_largrogne,P_codhauteff,largeur,      &
+            !                       lai(ens,sc%n),masec(ens,sc%n-1),P_hautbase,        & ! INOUT
+            !                       varrapforme,bioeffcum(ens),laieffcum(ens))
+
+            !       ! Cumuls AO/AS
+            !         p(i)%lai(sc%aoas,sc%n) = p(i)%lai(sc%as,sc%n) * p(i)%surf(sc%as)              &
+            !                                  + p(i)%lai(sc%ao,sc%n) * p(i)%surf(sc%ao)
+            !         p(i)%masec(sc%aoas,sc%n-1) = p(i)%masec(sc%as,sc%n-1) * p(i)%surf(sc%as)      &
+            !                                      + p(i)%masec(sc%ao,sc%n-1) * p(i)%surf(sc%ao)
+
+            !       endif
+                endif
+              endif
+      !      end do
+      !     else
+      !      call TauxRecouvrement(sc,pg,p(i),itk(i))
+      !    endif
+      !  endif
+      !endif
+
+
+    !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+    ! 4. Senescence processes for LAI
+    !    This process is belong to GROWTH module in STICS
+    !    In this subroutine, we mainly calculate the senescenced lai and biomass
+    !    In detail, see senescence.f90 and the red book
+    
+         call senescen(nlev,n, lai, senfac,  &
+                       nbfeuille,t2m_min_daily, &
+                       densitelev,          &
+                       masecveg,         &
+                       nstopfeuille,somcour,nrec,      &
+                       ulai, &
+                       tdevelop,    &
+                       somtemp,nsenpfeuilverte,nsendltai,nsendurvie, nsendltams, nsenndurvie,          &    ! INPUTS
+                       pdlaisen, dernier_n,nsencour,dltaisen,dltamsen,fstressgel,fgellev,gelee,      & !INOUT
+                       densite,laisen,nlan,R_stsenlan,nsen,R_stlaxsen,namf,nlax,R_stlevamf,      &
+                       R_stamflax,durvie,     &
+                       ndebsen,somsenreste, mafeuiljaune, msneojaune,        &
+                       durvieI,deltai,dltams, &
+                       histgrowth, hist_sencour, hist_latest, doyhistst,  &
+                       nbox, boxulai, boxndays, boxlai, boxlairem,boxtdev, &
+                       boxbiom,boxbiomrem, boxdurage, boxsomsenbase)               ! OUT
+!)  ! OUTPUT
+    
+    ! >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+    ! 5. Calculation of sla ---xcw
+    !    In stics, the calculation of sla is in reptair.f90, The process reptair is belong to GROWTH in STICS
+    !    the reptair process is called after the senescence 
+    
+         ! calculation of tursla, the slowing effects of water stress on sla
+         ! turstress is calculated in Stics_Calcul_Lai.f90
+    
+         tursla = (tursla+tustress)/2.
+         IF (P_codesla==1) THEN
+             sla = min(tursla * P_slamax, P_slamin)
+             if ((lge(P_codesimul,'feuille') .eqv. .FALSE.).and.(sla > P_slamax  )) then
+                sla = P_slamax
+             endif
+             if (sla < P_slamin) sla = P_slamin
+         ELSEIF (P_codesla==2) THEN
+            if ((n <= nlev+1) .or. (nlev==0)) then ! before or start leafing
+               sla = P_slamax
+            else if ( ndrp == 0 ) then
+               tempdev = min(1. + (3. * somcourdrp / (P_stlevamf + P_stamflax)), 4.)
+               if (tursla>1) then
+                   tursla = 1
+               else if (tursla<0) then
+                   tursla = 0
+               endif
+               tursla = (1-tursla)/2 + 0.5 !tursla ~ [0.5 1]
+               sla = (P_slamax-P_slamin) * (exp(-1.5 * (tempdev - 1.))) * tursla + P_slamin
+            else if (ndrp >0 .and. nmat==0) then
+               sla = sla ! after ndrp, there is no imposed change of sla 
+            else
+               ! do nothing, keep the same sla until harvest
+            endif
+             
+         ELSE
+             WRITE(numout,*) 'codesla not recognized: ',P_codesla
+             stop
+         ENDIF
+
+    !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+    ! 6. Calculation of pfeuilverte
+    !    In stics, the calculation of pfeuilverte is in reptair.f90
+    !    the reptair process is called after the senescence 
+    !    masec == aboveground dry matter (t ha-1)
+    !    dltams == growth rate of plant (t ha-1 day-1)    
+    
+     
+         if (masec <= 0.0) then
+            pfeuilverte = 0.0
+         else
+            if (dltams > 0.) then
+               pfeuilverte = (deltai/P_slamax*1e2) / dltams
+               pfeuilverte = min(1.0,pfeuilverte)
+            else
+               pfeuilverte = 0.0
+            endif
+         endif
+
+    !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+    ! 8.  Calculation of the water stress on LAI, turfac
+          call stress(n,                  &  ! IN
+                      nrec,               &  
+                      lai,                & 
+                      eop,                &
+                      shumdiag_cm_day,    &  ! IN 
+                      vswc,               &  ! IN                    
+                      humrel,             &  ! IN
+                      shumrel,             &  ! OUT
+                      swfac,              &  ! INOUT)   ! calculate the turfac stress (water stress)
+                      turfac,             &
+                      senfac)                 
+
+    ! This part is for debugiing 
+
+   ! write(*,*) 'wu: DOY is',n
+   ! write(*,*) 'wu: nplt, nger, nlev, ndrp, nlax, nsen is ', nplt, nger, nlev, ndrp, nlax, nsen
+   ! write(*,*) 'wu: upvt is ', upvt
+   ! write(*,*) 'wu: somcour is ', somcour
+   !  
+   ! write(*,*) 'wu: udevair is ', udevair
+   ! write(*,*) 'wu: rfvi and rfpi is ', rfvi, rfpi
+   ! write(*,*) 'wu: efdensity and tempeff and nstopfeille is ', efdensite, tempeff,nstopfeuille
+   ! write(*,*) 'wu: dltai and dltaisen is ', deltai, dltaisen
+   ! write(*,*) 'wu: ulai and tustress  is ', ulai, tustress
+
+
+
+    endif
+return
+end
Index: /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_sticslai/Stics_Levee.f90
===================================================================
--- /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_sticslai/Stics_Levee.f90	(revision 6940)
+++ /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_sticslai/Stics_Levee.f90	(revision 6940)
@@ -0,0 +1,432 @@
+!! ****************************************************************
+!> Calculation of the emergence. Authors : C. Durr and G. Richard.
+!> - Programmation: N. Brisson.
+!> - last modification 20/02/07 : l'humectation de la graine se fait en fonction d'un potentiel : humecgraine en MPa.
+!> - Stics book paragraphe 2.2.2, page 21-27
+!!
+!> In STICS, the emergence phase is broken down into three subphases: seed imbibition, followed by germination and lastly, shoot elongation.
+!! The soil physical conditions influence not only the duration of emergence but also the number of emerged plants, in particular in dry conditions or when
+!! there is a surface crust.
+!> - Moistening :
+!!   Seed moistening can be regarded as a passive process starting at a species-dependent water potential prevailing in the seed bed (potgermi in MPa).
+!!   The relationship from Clapp and Hornberger (1978), parameterized by the characteristic soil water contents of field capacity and wilting point, was used
+!!   to convert potgermi into water content (in function "humpotsol", described in the module Divers_develop.f90). Once the seed is moistened, it has a limited
+!!   number of days of autotrophy  (nbjgrauto) due to its reserves. This number has a species-dependent component (nbjgerlim) but also a thermal one, since
+!!   it is thought that at low temperature (i.e the average soil temperature in the seed bed, from the beginning of moistening), respiration processes and
+!!   the consumption of reserves are slower (the minimum at high temperature is propjgermin x nbjgermin). When the temperature is lower than the
+!!   germination base temperature, tgmin, then the day number is maximal (nbjgerlim).
+!> - Germination :
+!!   Germination is achieved when the growing degree-days from planting in the seed bed (somger) reaches a given threshold (stpltger), with a condition as to
+!!   the dryness of the soil. Soil moisture in the seedbed influences germination through the "humirac" function (described in the module Divers.f90).
+!!   If the seedbed dries out, it may delay germination significantly. This does not impair grain viability as long as the grain has not already imbibed water.
+!!   If however the soil water content has been high enough to allow grain moistening, grain viability is reduced. To account for this effect, we relied on
+!!   Bradfords (1990, 2002) work showing that too long a time for germination after moistening reduces the germination rate if the number of days of
+!!   moistening (nbjhumec) is higher than a plant- and temperature-dependent threshold duration (nbjgrauto). It is assumed that germination occurs
+!!   (IGER being the germination day) but at a reduced plant density (ratio between density of germinated plants, densiteger, to sowing density, densitesem)
+!!   proportional to the thermal time deficit.
+!> - Subsoil plantlet growth :
+!!   Germination initiates the growth of the root and then of the shoot. The growth rate of the shoot is assumed to be a logistic function of soil degree-days
+!!   that may slow down with unsuitable soil moisture (humirac). Emergence occurs when elongation (elong) is greater than sowing depth (profsem).
+!> - Influence of soil crusting on emergence :
+!!   The density reduction law is specific to the crusting phenomenon but analogous to the other constraint law (water content and temperature-dependent)
+!!   with a minimum threshold corresponding to the vigueurbat parameter : if vigueurbat is greater than 0, which means that when the soil is crusted a
+!!   proportion of plants succeed in emerging, the crusting coeflev function is less effective than the water content and temperature-dependent coeflev function.
+!!   The combination of both relationships is made dynamically by calculating the daily derivatives of both laws: if the current day is a "battance=0" day
+!!   (battance is calculated in the module Stics_Battance.f90) the density reduction is done according to the crusting coeflev law.
+!>
+!! For woody plants which have perennial dormancy, ILEV stage corresponds to the budbreak stage (for this calculation hourly temperatures are reconstituted
+!! in the module Stics_Debour.f90).
+!------------------------------
+subroutine levee(n, tsol, hsol, nlevobs,                                                             & ! INPUTS
+                 densiteger,densite,coeflev,densitelev,zrac,                                        & ! INOUT
+                 somelong,somger,nlev,nger, humectation,nbjhumec,somtemphumec,somcour,              & ! INOUT
+                 in_cycle, f_crop_recycle, nplt)                ! INOUT
+
+USE Stics
+USE Besoins_en_froid
+USE Divers_water
+!USE Messages
+
+
+
+implicit none
+
+
+! 0.1 INPUT
+
+
+  integer, intent(IN) :: n
+  real,    intent(IN), dimension(3) :: tsol  !> // soil temperature with resolution of 1 cm, the dimension is 3, we consider the sowing depth and his upper and lower neighbours // degree C
+  real,    intent(IN), dimension(3) :: hsol  !> // soil moisture with resolution of 1 cm, the dimension is 3, we consider the sowing depth and his upper and lower neighbours // 
+  integer, intent(IN) :: nlevobs 
+  integer, intent(IN) :: nplt  
+  
+ 
+
+  !integer, intent(IN) :: P_codeperenne  !> // PARAMETER // option defining the annual (1) or perenial (2) character of the plant // code 1/2 // PARPLT // 0 
+  !integer, intent(IN) :: P_codebfroid  !> // PARAMETER // option of calculation of chilling requirements // code 1/2 // PARPLT // 0 
+  !integer, intent(IN) :: P_codegdhdeb  !> // PARAMETER // option of calculation of the bud break date in hourly or daily growing degrees  // code 1/2 // PARPLT // 0 
+  !integer, intent(IN) :: P_codetemp  !> // PARAMETER // option calculation mode of heat time for the plant : with air temperature (1)  or crop temperature (2) // code 1/2 // PARPLT // 0 
+  !integer, intent(IN) :: P_codegermin  !> // PARAMETER // option of simulation of a germination phase or a delay at the beginning of the crop (1) or  direct starting (2) // code 1/2 // PARPLT // 0 
+  !integer, intent(IN) :: P_codefente  !> // PARAMETER // option allowing an additional water compartment for the swelling soils: yes (1), no (0) // code 0/1 // PARSOL // 0 
+  !integer, intent(IN) :: P_codepluiepoquet  !> // PARAMETER // option to replace rainfall by irrigation at poquet depth in the case of poquet sowing // code 1/2 // PARAMV6 // 0 
+  !integer, intent(IN) :: P_codehypo  !> // PARAMETER // option of simulation of a  phase of hypocotyl growth (1) or planting of plantlets (2) // code 1/2 // PARPLT // 0 
+  !integer, intent(IN) :: P_nbjgerlim  !> // PARAMETER // Threshold number of day after grain imbibition without germination lack // days // PARPLT // 1 
+  !real,    intent(IN) :: tmin   !> // OUTPUT // Minimum active temperature of air // degree C
+  !real,    intent(IN) :: tmin_demain  
+  !real,    intent(IN) :: tmax   !> // OUTPUT // Maximum active temperature of air // degree C
+  !integer, intent(IN) :: n  
+  !integer, intent(IN) :: nrec  
+  !integer, intent(IN) :: P_nlevlim1  !> // PARAMETER // number of days after germination decreasing the emerged plants if emergence has not occur // days // PARPLT // 1 
+  !integer, intent(IN) :: P_nlevlim2  !> // PARAMETER // number of days after germination after which the emerged plants are null // days // PARPLT // 1 
+  !real,    intent(IN) :: P_tdmindeb  !> // PARAMETER // minimal thermal threshold for hourly calculation of phasic duration between dormancy and bud breaks // degree C // PARPLT // 1
+  !real,    intent(IN) :: P_tdmaxdeb  !> // PARAMETER // maximal thermal threshold for hourly calculation of phasic duration between dormancy and bud breaks // degree C // PARPLT // 1
+  !real,    intent(IN) :: rfvi   !> // OUTPUT // Slowing effect of the vernalization on plant development // 0-1
+  !real,    intent(IN) :: rfpi   !> // OUTPUT // Slowing effect of the photoperiod on plant development  // 0-1
+  !real,    intent(IN) :: P_profsem  !> // PARAMETER // Sowing depth // cm // PARTEC // 1 
+  !real,    intent(IN) :: P_stdordebour  !> // PARAMETER // phasic duration between the dormancy break and the bud break  // degree.days // PARPLT // 1 
+  !real,    intent(IN) :: P_tgmin  !> // PARAMETER // Minimum threshold temperature used in emergence stage // degree C // PARPLT // 1
+  !real,    intent(IN) :: P_stpltger  !> // PARAMETER // Sum of development allowing germination // degree.days // PARPLT // 1 
+  !real,    intent(IN) :: P_sensrsec  !> // PARAMETER // root sensitivity to drought (1=insensitive) // SD // PARPLT // 1 
+  !real,    intent(IN) :: P_psihucc  !> // PARAMETER // soil potential corresponding to field capacity  // Mpa // PARAM // 1 
+  !real,    intent(IN) :: P_psihumin  !> // PARAMETER // soil potential corresponding to wilting point // Mpa // PARAM // 1 
+  !real,    intent(IN) :: P_potgermi  !> // PARAMETER // humidity threshold from which seed humectation occurs, expressed in soil water potential  // Mpa // PARPLT // 1 
+  !real,    intent(IN) :: P_tdmax  !> // PARAMETER // Maximum threshold temperature for development // degree C // PARPLT // 1
+  !real,    intent(IN) :: P_propjgermin  !> // PARAMETER // minimal proportion of the duration P_nbjgerlim when the temperature is higher than the temperature threshold P_Tdmax  // % // PARPLT // 1 
+  !real,    intent(IN) :: P_densitesem  !> // PARAMETER // Sowing density  // plants.m-2 // PARTEC // 1 
+  !real,    intent(IN) :: pluiesemis  
+  !real,    intent(IN) :: P_pluiebat  !> // PARAMETER // minimal rain quantity for the crust occurrence // mm day-1 // PARSOL // 1 
+  !real,    intent(IN) :: P_mulchbat  !> // PARAMETER // mulch depth from which a crust occurs // cm // PARSOL // 1 
+  !real,    intent(IN) :: xmlch1   !> // OUTPUT // Thickness of mulch created by evaporation from the soil // cm
+  !real,    intent(IN) :: P_vigueurbat  !> // PARAMETER // indicator of plant vigor allowing to emerge through the crust  // between 0 and 1 // PARPLT // 1 
+  !real,    intent(IN) :: P_celong  !> // PARAMETER // parameter of the subsoil plantlet elongation curve // SD // PARPLT // 1 
+  !real,    intent(IN) :: P_belong  !> // PARAMETER // parameter of the curve of coleoptile elongation // degree.days -1 // PARPLT // 1 
+  !real,    intent(IN) :: P_elmax  !> // PARAMETER // Maximum elongation of the coleoptile in darkness condition // cm // PARPLT // 1 
+  !integer, intent(IN) :: nbCouches  
+  !real,    intent(IN) :: tsol(0:nbCouches)  
+  !real,    intent(IN) :: hur(nbCouches)  
+  !real,    intent(IN) :: humin(nbCouches)  
+  !real,    intent(IN) :: hucc(nbCouches)  
+  !real,    intent(IN) :: trr   !> // OUTPUT // Rainfall  // mm.day-1
+  !real,    intent(IN) :: dacouche(0:nbCouches)  
+
+
+
+  ! 0.2 INOUT
+ 
+  !real,    intent(INOUT) :: udevair   !> // OUTPUT // Effective temperature for the development, computed with TAIR // degree.days
+  !real,    intent(INOUT) :: udevcult   !> // OUTPUT // Effective temperature for the development, computed with TCULT // degree.days
+  !real,    intent(INOUT) :: upvt   !> // OUTPUT // Daily development unit  // degree.days
+  real,    intent(INOUT) :: densiteger  
+  real,    intent(INOUT) :: densite   !> // OUTPUT // Actual sowing density // plants.m-2
+  real,    intent(INOUT) :: coeflev  
+  real,    intent(INOUT) :: densitelev  
+  real,    intent(INOUT) :: zrac   !> // OUTPUT // Depth reached by root system // cm
+  real,    intent(INOUT) :: somelong  
+  real,    intent(INOUT) :: somger  
+  integer, intent(INOUT) :: nlev  
+  integer, intent(INOUT) :: nger  
+  logical, intent(INOUT) :: humectation  
+  integer, intent(INOUT) :: nbjhumec  
+  real,    intent(INOUT) :: somtemphumec  
+  real,    intent(INOUT) :: somcour   !> // OUTPUT // Cumulated units of development between two stages // degree.days
+  logical, intent(INOUT) :: in_cycle !> in this subroutine, we also judge whether or not we should stop the crop cycle due to no emergence, if the coeflev is becoming zero, then the in_cycle should be setted as FALSE, indicating exiting this cycle
+
+  logical, intent(INOUT) :: f_crop_recycle !> if the crop can not emerge, then the in_cycle should be setted as FALSE, indicating exiting this cycle, and recycle crop
+
+
+  ! 0.4 local variables
+
+  !integer :: i  !>  
+  !integer :: isem  !>  
+  !integer :: isembas  !>  
+  !integer :: isemhaut  
+  !! NB le 19/01/08
+  !real :: hn  !>  
+  !real :: hx  !>  
+  
+  real :: udevlev  
+  real :: temphumec  
+  real :: levbat  
+  real :: nbjgrauto  
+  integer :: icompte 
+  real :: elong  !>  
+  real :: humsol  !> 
+
+
+
+
+!: FUNCTIONS 
+  ! real :: humirac ! module Divers
+  ! real :: battance  
+  ! real :: humpotsol  
+
+
+
+! 25/04/2012 DR et IGC le retour ..., pb si on force la levee pour la vigne on passe dans le caluvle de la germination et on met une densité à 0
+! en gros il faut decomposer le test en 2 lignes
+!      if (P_codeperenne == 2 .and. P_codebfroid == 3 .and. nlevobs == 999) then
+
+! for perennial crop which are suffering P_codebroid
+      if (P_codeperenne == 2 .and. P_codebfroid == 3 ) then
+        !if(nlevobs == 999)then
+        !!: PB - 15/12/2008: Pour bien faire, je pense qu'on pourrait facilement déporter le calcul des udev et upvt pour debour dans develop.
+        !!- Ca allégerait l'écriture de levee et ça serait sans doute tout autant logique.
+        !  if (P_codegdhdeb == 2) call debour(P_codegdhdeb,P_codetemp,tmax,tmin,tmin_demain,P_tdmindeb,P_tdmaxdeb,rfvi,rfpi, &
+        !                                 upvt,udevair,udevcult)
+        !  somelong = somelong + upvt
+!       ! write(70,*) '2.',somelong,upvt
+        !  if (somelong > P_stdordebour) then
+        !    nlev = n
+        !    somelong = 0.
+        !  ! DR 05/08/08 si on est à  debourrement on initialise qnplante à  P_qnplante0 ,
+        !  ! apres essai y'a pb ca plante au bout de 12 ans à  voir avec nadine
+        !  !    qnplante(ipl,1,n-1) = P_qnplante0
+        !  endif
+        !  return
+        !else
+          return
+        !endif
+      endif
+
+!      print *, 'in levee, the tsoil is', tsol(:)
+
+      !: La germination
+      !- calcul de la germination màªme si nlev observé pour le démarrage de la vernalisation
+      !isem = int(P_profsem)
+      udevlev = tsol(2) - P_tgmin  ! there are 3 layers for tsol, the second layer means the sowing depth
+      if (udevlev <= 0.0) udevlev = 0.0
+
+!      write(*,*) 'nplt, udevlev, nger', nplt, udevlev, nger
+
+      !: Rajout domi - 15/09/97:
+      !- Test sur isem-1 et isem+1 pour qu'ils restent dans l'intervalle [1,200]
+      !- Calcul de la germination si P_codegermin = 1
+      !- domi - 14/12/00 - on passe la profondeur de sol de 200 à  1000
+      !- TODO: Remplacer le 1000 par nbCouches
+
+      !isembas = isem-1
+      !isemhaut = isem+1
+      !if (isembas < 1) isembas = 1
+      !if (isembas > 1000) isembas = 1000
+      !if (isemhaut < 1) isemhaut = 1
+      !if (isemhaut > 1000) isemhaut = 1000
+      if (P_codegermin == 1) then
+        !humsol = (hur(isem) + hur(isemhaut) + hur(isembas)) / 3
+        humsol = (hsol(2) + hsol(1) + hsol(3)) / 3.0 ! although the code is not elegant but it is clear
+
+        !hn = (humin(isem) + humin(isemhaut) + humin(isembas)) / 3
+        !hx = (hucc(isem) + hucc(isemhaut) + hucc(isembas)) / 3
+
+!        print *, 'tsol and humsol in levee is', tsol(2), humsol 
+
+        somger = somger + (udevlev * F_humirac(humsol))
+!        write(*,*) 'udevlev * F_humirac(humsol)', udevlev * F_humirac(humsol)
+!        write(*,*) 'somger ', somger
+
+        if (somger >= P_stpltger .and. nger == 0) then
+          nger = n
+          somelong = somger - P_stpltger
+          zrac = P_profsem
+        endif
+      
+!        print *, 'in levee, the somger and somlong is,', somger, somelong 
+   
+      ! NB le 18/08/07 : si levée observée et germination postérieure à  la levée alors forçage germination
+      
+      ! we do not use the forced emergence data  
+      
+        !if (nlevobs /= 999) then
+        !  if (nger > 0 .and. nlevobs < nger) then
+        !    nger = nlevobs
+        !  endif
+        !endif
+
+        !: NB le 11/04/05 introduction manques à  la germination
+        !- Sophie Lebonvallet
+        !- humectation de la graine
+        !- initialisation de humectation,nbjhumec
+
+
+        if (somger < P_stpltger .and. nger == 0) then
+          !whether or not the humidity is larger than the potential soil humidity 
+          !if (humsol >= humpotsol(P_psihucc,P_psihumin,hn,hx,dacouche(isem),P_potgermi,P_codefente)) then
+          if (humsol >= 1) then
+            if (.not. humectation ) humectation = .TRUE.
+          endif
+          if (humectation) then
+            nbjhumec = nbjhumec+1 ! accumulated days for humectation
+            somtemphumec = tsol(2) + somtemphumec
+            temphumec = somtemphumec / nbjhumec
+            ! on calcule le nombre de jours limite d'autotrophie de la graine en fonction de la température
+            nbjgrauto = (P_propjgermin - 1.0) / (P_tdmax - P_tgmin) * temphumec + 1 + (1.0 - P_propjgermin) * P_tgmin / &
+                        (P_tdmax - P_tgmin)
+            if (temphumec < P_tgmin) nbjgrauto = 1.0
+            if (temphumec > P_tdmax) nbjgrauto = P_propjgermin
+          else
+            somtemphumec = 0.
+            nbjgrauto = 1.0
+          endif
+          nbjgrauto = nbjgrauto*P_nbjgerlim
+          if (nbjhumec >= nbjgrauto) then
+            nger = n
+            densiteger = P_densitesem * somger / P_stpltger
+            ! ajout de test NB le 09/08/05
+            if (densiteger > P_densitesem) densiteger = P_densitesem
+          else
+            densiteger = P_densitesem
+          endif
+        endif
+        ! DR 06/02/07 on a pas acces à  la densité à  germination pour sophie
+        ! pour l'instant je l'affecte dans densite mais c'est à  voir avce nad
+        densite = densiteger
+      else
+        nger = n
+        zrac = P_profsem
+      endif
+
+
+       
+      ! introduction battance NB le 12/05/05
+      ! bug nrec > nrec (NB 19/01/08)
+      !levbat = battance(n,nplt,nrec,P_codeperenne,pluiesemis,trr,P_pluiebat,P_mulchbat,xmlch1,elong,P_profsem)
+      ! Nb le 19/01/08 : pas de battance avec le semis en poquet
+      !--if (P_vigueurbat == 1.0) levbat = 1.0
+
+
+      ! in this version, we do not consider the levbat effects on germination
+      if (P_vigueurbat == 1.0 .or. P_codepluiepoquet == 1) levbat = 1.0
+
+
+      !: élongation
+      !- NB - 17/08/07 : il faut pouvoir calculer la densité levée quel que soit
+      !-                 nlev obs ou cal
+     
+      if (nlevobs == 999) then
+        if (nger > 0 .and. nlev == 0) then
+          if (P_codehypo == 2) then
+            nlev = n
+          else
+            ! From the codes of this part, it calculates the average soil moisture in specific layers. It also calculates the Hn and Hx. 
+            ! but in this version, we just use the soil moisture at sowing depth to replace it. ---xcw
+   
+            !humsol = 0.
+            !hn = 0.
+            !hx = 0.
+            ! NB le 19/01/08 compteur pour moyenne correcte
+            !icompte = 0
+            !do i = isembas,max(int(zrac),isemhaut)
+            !  humsol = humsol + hur(i)
+            !  hn = hn + humin(i)
+            !  hx = hx + hucc(i)
+            !  icompte = icompte + 1
+            !end do
+            !humsol = humsol / icompte
+            
+            ! we just show that the humsol is same to the average soil moisture of the 3 layers around sowing depth
+            humsol = humsol
+            !hn = hn / icompte
+            !hx = hx / icompte
+
+            ! introduction battance NB le 12/05/05
+            somelong  =  somelong + (udevlev * levbat * F_humirac(humsol))
+            elong = P_elmax * (1 - exp(-(P_belong * somelong)**P_celong))
+  
+!            print *, 'in levee, the elong is,', elong
+!            write(*,*) 'elong,',elong
+       
+            if (elong >= P_profsem) nlev = n
+          endif
+        endif
+      endif
+      
+!      print *, 'in levee before calculating coeflev, P_nlevlim1 P_nlevlim2, levbat, coeflev are', P_nlevlim1, P_nlevlim2, levbat, coeflev
+
+      !: Diminution de la densité levée en fonction du délai germination-levée
+      !- paramàštres à  mettre dans *.plt 18/12/01
+      
+      ! FOR WINTER WHEAT, THE GROWING SEASON CAN COVER TWO YEAS, SO IN THE NEXT YEAR WE SHOULD NOT 
+      ! REPLACE THE COEFLEV AS 1.0. 
+      ! WE ALSO SET A CONDITION THAT IF THE COEFLEV IS NEGATIVE, WE SET IT AS 0.
+      
+
+      if ( nger > 0 ) then
+         if ( nger > nplt ) then !especially for crops covering two years, here in the current year the crop germinated     
+           if (((n - nger) < P_nlevlim1) .AND. ((n - nger) >= 0 )) then ! 
+             coeflev = 1.0
+           else
+             if ( P_nlevlim1 < P_nlevlim2 ) then
+               if ( levbat == 1. ) then
+                 if ( n - nger >= 0 ) then
+                    coeflev = coeflev + (1. / float((P_nlevlim1 - P_nlevlim2)))
+                 else  ! for winter wheat, it emerges in the following spring
+                    coeflev = coeflev + (1. / float((P_nlevlim1 - P_nlevlim2))) * 1.06  ! largely reduction of coeflev
+                 endif
+                 ! IF THE COEFLEV IS BECOMING NEGATIVE, WE SHOULD SET IT AS 0.
+                 if ( coeflev <= 0.0 ) then
+                    coeflev = 0.0
+                    in_cycle = .FALSE.
+                    f_crop_recycle = .TRUE.
+                 endif       
+               else
+                 coeflev = coeflev + (1. - P_vigueurbat) /float( (P_nlevlim1-P_nlevlim2))
+                 ! THE SAME AS ABOVE, IF THE COEFLEV IS BECOMING NEGATIVE, WE SHOULD SET IT AS ZERO
+                 if ( coeflev <= 0.0 ) then
+                    coeflev = 0.0
+                    in_cycle = .FALSE.
+                    f_crop_recycle = .TRUE.
+                 endif
+ 
+               endif
+             else
+               if ( levbat == 1. ) then
+                 coeflev = 0.0
+
+               !: ML 11/12/07 y'avait un bug: on ne peut pas avoir coeflev = P_vigueurbat apràšs P_nlevlim2
+               !- si à  la fois la battance et les conditions d'humidité et de température ont
+               !- freiné la levée
+               !--else
+               !--  coeflev = P_vigueurbat
+               endif
+             endif
+           endif
+         else  ! especially for crops covering two years, for one-year crop it will not occur. for spring germination, the effective densite should be largely reduced
+           coeflev = 1.0 + (1. / float((P_nlevlim1 - P_nlevlim2))) * ( (365-nplt-P_nlevlim1) + n*1.06 ) ! calculation of the coeflev until crop emerges in spring
+           if ( coeflev <= 0.0 ) then
+              coeflev = 0.0
+              in_cycle = .FALSE.
+              f_crop_recycle = .TRUE.
+           endif
+         endif
+      endif 
+
+!      print *, 'in levee the densiteger, coeflev is', densiteger, coeflev  
+   
+      
+      !: Réduction de densité
+      !- introduction de l'effet battance le 13/05/05
+      !- modif NB le 18/08/07
+      if (n == nlev .or. n == nlevobs) then
+        densitelev = densiteger * coeflev
+        densite = densitelev
+        if (densite <= 0.) then
+          !call EnvoyerMsgHistorique(400)
+          !: ML le 21/09/04 lorsque la densite de levee est nulle, on n arrete
+          !- pas la simulation (equivaut a un sol nu)
+          !--stop
+          !- domi 16/05/06 j'essaie de mettre la densite à zéro
+          densite = 0.0
+        endif
+
+      endif
+
+      !: 29/01/04 - bug pour affichage pheno dans bilan:
+      !- somcour etait mal affecte (NB et ML)
+      if (n >= nger .and. nger > 0) then
+        somcour = P_stpltger + somelong
+      else
+        somcour = somger
+      endif
+
+return
+end subroutine levee
Index: /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_sticslai/Stics_Recolte.f90
===================================================================
--- /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_sticslai/Stics_Recolte.f90	(revision 6940)
+++ /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_sticslai/Stics_Recolte.f90	(revision 6940)
@@ -0,0 +1,284 @@
+!-----------------------------------------------------------------------
+! modif le 27/06/01
+! NB le 01/05
+! détemination de la date de récolte
+! calcul de la date de récolte
+! plusieurs critères pour la récolte
+! 1- la maturité physiologique (P_codrecolte = 1)
+! 2- la teneur en eau          (P_codrecolte = 2)
+! 3- la teneur en sucre        (P_codrecolte = 3)
+! 4- la teneur en protéine     (P_codrecolte = 4)
+! 5- la teneur en huile        (P_codrecolte = 5)
+!-----------------------------------------------------------------------
+! addressing the harvest 
+
+
+ subroutine recolte(n,ndrp,gslen, drylen, lai,        & ! IN
+                    nmat, nrec,              & ! INOUT
+                    stmatrec,group)     ! OUT
+                    
+ USE Stics
+ USE constantes
+ !USE Messages
+
+implicit none
+
+! DECLARATION
+
+! 0.1 INPUT
+  integer, intent(IN)    :: n  
+  integer, intent(IN)    :: ndrp  
+  integer, intent(IN)    :: gslen 
+  
+
+  real,    intent(IN)    :: lai  !> // PARAMETER // minimal sugar rate at harvest // g sucre g-1 MF // PARTEC // 1 
+  
+
+  !integer, intent(IN)    :: P_codrecolte  !> // PARAMETER // harvest mode : all the plant (1) or just the fruits (2) // code 1/2 // PARTEC // 0 
+  !integer, intent(IN)    :: nmat  
+  !integer, intent(IN)    :: P_variete  !> // PARAMETER // variety number in the technical file // SD // PARTEC // 1 
+  !integer, intent(IN)    :: P_nbcueille  !> // PARAMETER // number of fruit harvestings // code 1/2 // PARTEC // 0 
+  !real,    intent(IN)    :: h2orec   !> // OUTPUT // Water content of harvested organs // %
+  !real,    intent(IN)    :: P_sucrerec  !> // PARAMETER // minimal sugar rate at harvest // g sucre g-1 MF // PARTEC // 1 
+  !real,    intent(IN)    :: P_CNgrainrec  !> // PARAMETER // minimal grain nitrogen content for harvest  // 0-1 // PARTEC // 1 
+  !real,    intent(IN)    :: P_huilerec  !> // PARAMETER // minimal oil content allowed for harvest // g huile g-1 MF // PARTEC // 1 
+  !real,    intent(IN)    :: sucre   !> // OUTPUT // Sugar content of fresh harvested organs // % (of fresh weight)
+  !real,    intent(IN)    :: huile   !> // OUTPUT // Oil content of fresh harvested organs // % (of fresh weight)
+  !real,    intent(IN)    :: teaugrain  
+  !real,    intent(IN)    :: P_h2ofrvert  !> // PARAMETER // water content of fruits before the beginning of hydrous evolution (DEBDESHYD) // g water g-1 MF // PARPLT // 1 
+  !integer, intent(IN)    :: P_codeaumin  !> // PARAMETER // harvest as a function of grain/fruit water content // code 1/2 // PARTEC // 0 
+  !real,    intent(IN)    :: P_h2ograinmin  !> // PARAMETER // minimal water content allowed at harvest // g eau g-1 MF // PARTEC // 1 
+  !real,    intent(IN)    :: P_deshydbase  !> // PARAMETER // phenological rate of evolution of fruit water content (>0 or <0) // g water.g MF-1.degree C-1 // PARPLT // 1
+  !real,    intent(IN)    :: somcourdrp  
+  !real,    intent(IN)    :: P_stdrpmat  !> // PARAMETER // Sum of development units between the stages DRP and MAT // degree.days // PARPLT // 1 
+  !real,    intent(IN)    :: P_h2ograinmax  !> // PARAMETER // maximal water content allowed at harvest // g water g-1 MF // PARTEC // 1 
+  !real,    intent(IN)    :: CNgrain   !> // OUTPUT // Nitrogen concentration of grains  // %
+  !integer, intent(IN)    :: P_cadencerec  !> // PARAMETER // number of days between two harvests // day // PARTEC // 1 
+
+! 0.2 INOUT
+  
+  integer, intent(INOUT)    :: nrec  
+  integer, intent(INOUT)    :: drylen 
+  integer, intent(INOUT)    :: nmat  
+
+  !integer, intent(INOUT) :: jdepuisrec  
+  !real,    intent(INOUT) :: pdsfruit   !> // OUTPUT // Weight of fruits in box 3 // g m-2
+  !real,    intent(INOUT) :: nfruit   !> // OUTPUT // Number of fruits in box 5 // nb fruits
+  !integer, intent(INOUT) :: nbrecolte  
+
+! 0.3 OUT
+
+  real,    intent(OUT)   :: stmatrec
+  real,    intent(OUT)   :: group  
+
+  !integer, intent(OUT)   :: nrecint  
+  !real,    intent(OUT)   :: rdtint  
+  !real,    intent(OUT)   :: teauint  
+  !real,    intent(OUT)   :: nbfrint  
+
+
+! 0.4 LOCAL VARIABLES 
+  !real :: huiledecis  !>  
+  !real :: sucredecis  !>  
+  !real :: teaudecis  
+
+
+    !: NB - le 27/08 - pas de passage avant ndrp
+    !: first, we check the growing season length, whether or not exceed the threshold, maxgs = 300.    
+    
+!    print *, 'in recolte, the lai is', lai
+    if ( gslen < P_maxgs ) then
+       if (ndrp == 0 .or. n == ndrp) return
+       
+       if ( lai > 0.) then ! when grain filling  starting and lai > 0
+          ! the first option, based on the physiological maturation
+          ! at first, we used this option, because we do not consider the nitrogen, water, sugar processes in the grain. 
+          if (P_codrecolte == 1) then
+            ! NB - le 08/05/02 - ajout du test nrec
+!            print *, 'in recolte, the drylen is ', drylen
+            if (drylen < matrec) then  ! drying process start only since mature
+               nrec = 0
+            else 
+               nrec = n
+               stmatrec = 0.
+               group = P_variete
+            endif
+          endif
+          if (P_codrecolte == 2) then
+            ! NB - le 08/05/02 - ajout du test nrec
+            if (drylen < matrec) then
+               nrec = 0
+            else
+               nrec = n
+               stmatrec = 0.
+               group = P_variete
+            endif
+          endif
+       else  ! ndrp != 0 and lai <= 0, that mean there is no lai aboveground, vegetation should stop here 
+          if (nmat == 0) then
+             nmat = n
+          else
+             ;
+          endif
+              
+          if (drylen <= 0) then
+             drylen = drylen + 1
+          else
+             drylen = drylen
+          endif
+          if (drylen < matrec) then
+             nrec = 0
+          else 
+             nrec = n
+             stmatrec = 0.
+             group = P_variete
+          endif
+!          print *,'in recolte, do we do here with lai <=0'
+!          print *, 'in recolte, the drylen is', drylen
+       endif
+    else ! when reaching the maxgs, we forced stop the crop growth
+       nmat = n
+       nrec = n
+       stmatrec = 0.
+       group = P_variete
+    endif
+
+
+    !!: on récolte lorsque la teneur en eau atteint un seuil
+    !!- ajout d'un test dans condition (teaugrain /= P_h2ofrvert)
+    !!- Nb - 28/09:
+    !!- Teneur en eau,huile,sucre différentes si une ou plusieurs récoltes
+
+
+    !!: P_nbcueille = 1
+    !if (P_nbcueille == 1) then
+
+    !  teaudecis = h2orec
+    !  sucredecis = sucre
+    !  huiledecis = huile
+
+    !  if (P_codrecolte == 2) then
+    !    if (nmat > 0 .or. teaudecis /= P_h2ofrvert) then
+    !      if (P_codeaumin == 1 .and. teaudecis >= P_h2ograinmin .and. nrec == 0) then
+    !        if (P_deshydbase >= 0.) then
+    !          call EnvoyerMsgHistorique(401)
+    !          stop
+    !        endif
+    !        nrec = n
+    !        stmatrec = somcourdrp - P_stdrpmat
+    !        group = P_variete
+    !      endif
+    !      if (P_codeaumin == 2 .and. teaudecis <= P_h2ograinmax .and. nrec == 0) then
+    !        if (P_deshydbase <= 0.) then
+    !          call EnvoyerMsgHistorique(402)
+    !          stop
+    !        endif
+    !        nrec = n
+    !        stmatrec = somcourdrp - P_stdrpmat
+    !        group = P_variete
+    !      endif
+    !    endif
+    !  endif
+
+    !  ! on récolte lorsque la teneur en sucre atteint un seuil
+    !  if (P_codrecolte == 3) then
+    !    if (nmat > 0 .or. teaudecis /= P_h2ofrvert) then
+    !      if (sucredecis >= P_sucrerec .and. nrec == 0) then
+    !        nrec = n
+    !        stmatrec = somcourdrp - P_stdrpmat
+    !        group = P_variete
+    !      endif
+    !    endif
+    !  endif
+
+    !  ! on récolte lorsque la teneur en azote atteint un seuil
+    !  if (P_codrecolte == 4) then
+    !    if (nmat > 0) then
+    !      if (CNgrain/100. >= P_CNgrainrec .and. nrec == 0) then
+    !        nrec = n
+    !        stmatrec = somcourdrp - P_stdrpmat
+    !        group = P_variete
+    !      endif
+    !    endif
+    !  endif
+
+    !  ! on récolte lorsque la teneur en huile atteint un seuil
+    !  if (P_codrecolte == 5) then
+    !    if (nmat > 0 .or. teaudecis /= P_h2ofrvert)then
+    !      if (huiledecis >= P_huilerec .and. nrec == 0) then
+    !        nrec = n
+    !        stmatrec = somcourdrp - P_stdrpmat
+    !        group = P_variete
+    !      endif
+    !    endif
+    !  endif
+
+    !endif ! fin P_nbcueille = 1
+
+
+    !!: P_nbcueille  =  2
+    !! -- if (P_nbcueille == 2.and.nrec > 0) then
+    !if (P_nbcueille == 2) then
+
+    !  teaudecis = teaugrain
+    !  !--pas utilisé-- sucredecis = sucreder
+    !  !--pas utilisé-- huiledecis = huileder
+
+    !  jdepuisrec = jdepuisrec+1
+    !  if ((n == nrec .or. jdepuisrec >= P_cadencerec) .and. pdsfruit > 0.) then
+    !    nrecint = n
+! dr!  22/12/2010 on passé le tableau entier de rdint
+    !    rdtint = pdsfruit
+!   !     rdtint(1,nbrecolte) = pdsfruit
+!   !        write(*,*)'***** dans stics_recolte',rdtint,pdsfruit
+    !    nbfrint = nfruit
+    !    teauint = teaudecis
+! dr!  22/12/2010 on passé le tableau entier de rdint
+    !    pdsfruit  =  pdsfruit - rdtint
+    !    nfruit  =  nfruit - nbfrint
+
+    !    ! NB - le 08/05/02 - réaffectation de nrec ( = n)
+    !    nrec = nrecint
+    !    nbrecolte = nbrecolte + 1
+    !    jdepuisrec = 0
+!   !     write(*,*)'**fin recolte',nbrecolte,pdsfruit
+    !  endif
+    !endif
+
+
+
+
+    !!: NB - le 02/07/02
+    !!- domi et marie - 10/10/03
+    !!- deplacé au debut de develop car dans le cas de P_codeperenne = 1 et P_codcueille = 1 on ne passe plus
+    !!- dans recolte à partir de n = nrec
+    !!- voir avec Nadine si on le vire ici
+!-- !   if (P_codeperenne == 1) then
+!-- !     if (P_codcueille == 1) then
+!-- !       if (n == nrec+1) then
+!-- !         masec = 0.0
+!-- !         zrac = 0.0
+!-- !         mafrais(:) = 0.0
+!-- !         pdsfruitfrais(:) = 0.0
+    !      ! domi - 22/10/03
+!-- !         hauteur(:) = 0.
+    !      ! PB - 03/05/2004 - remise à zéro des variables de fixation
+!-- !         demande(:)  =  0.
+    !      ! DR 13/01/06 remise à zero sinon mafrais ne revient pas nul
+!-- !         mafraisfeuille(:) = 0.
+!-- !         mafraistige(:) = 0.
+!-- !         mafraisres(:) = 0.
+!-- !         mafraisrec(:) = 0.
+!-- !       endif
+!-- !     endif
+!-- !   endif
+
+! --!     if (P_nbcueille == 1.and.n == nrec) then
+! --!       do 50 i = 1,P_nboite
+! --!         pdsfruit(i) = 0.0
+! --!         nfruit(ens,i) = 0.0
+! --!50     continue
+! --!     endif
+
+return
+end subroutine recolte
Index: /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_sticslai/Stics_init.f90
===================================================================
--- /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_sticslai/Stics_init.f90	(revision 6940)
+++ /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_sticslai/Stics_init.f90	(revision 6940)
@@ -0,0 +1,534 @@
+! INITIALIZATION OF VARIABLES REGARDING THE CROP CYCLE
+! 27/06/2013---xcw 
+
+subroutine Stics_init(&
+               kjpindex        ,&
+               !nvm             ,&
+               f_crop_init     ,&   
+               f_crop_recycle      ,&   
+               in_cycle                ,&   
+               f_sen_lai                ,&   
+               onarretesomcourdrp      ,&   
+!               nlevobs                 ,&
+!               namfobs                 ,&
+!               nfloobs                 ,&
+!               nlanobs                 ,&
+!               nlaxobs                 ,&
+!               nmatobs                 ,&
+!               nrecobs                 ,&
+!               nsenobs                 ,&
+!               ndrpobs                 ,&
+               nsendltams              ,&
+               nsendltai               ,&
+               nsenpfeuilverte         ,&
+               nsendurvie              ,&
+               nsenndurvie             ,&
+               densiteequiv            ,&
+               nplt                    ,&
+               tursla                  ,&
+               ssla                     ,&
+               pfeuilverte             ,&
+               bsenlai                 ,&
+               zrac                    ,&
+               nrec                    ,& 
+               nlan                    ,&
+               tcult                   ,&
+               udevair                 ,&
+               udevcult                ,&
+               ndrp                    ,&
+               rfvi                    ,&
+               nlev                    ,&
+               nger                    ,&
+               etatvernal              ,&
+               caljvc                  ,&
+               rfpi                    ,&
+               upvt                    ,&
+               utp                     ,&
+               somcour                 ,&
+               somcourdrp              ,&
+               somcourutp              ,&
+               tdevelop                ,&
+               somtemp                 ,&
+               somcourfauche           ,&
+               stpltger                ,&
+               R_stamflax              ,&
+               R_stlaxsen              ,&
+               R_stsenlan              ,&
+               stlevflo                ,&
+               nflo                    ,&
+               R_stlevdrp              ,&
+               R_stflodrp              ,&
+               R_stdrpmat              ,&
+               nmat                    ,&
+               nlax                    ,&
+               nrecbutoir              ,&
+               group                   ,&
+               ndebdes                 ,&
+               R_stdrpdes              ,&
+               densite                 ,&
+               densitelev              ,&
+               coeflev                 ,&
+               densiteger              ,&
+               somelong                 ,&
+               somger                  ,&
+               humectation             ,&
+               nbjhumec                ,&
+               somtemphumec            ,&
+               stpltlev                ,&
+               namf                    ,&
+               stmatrec                ,&
+               tustress                ,&
+               slai                     ,&
+               somfeuille              ,&
+               pdlai                   ,&
+               nbfeuille               ,&
+               reajust                 ,&
+               ulai                    ,&
+               pdulai                  ,&
+               efdensite               ,&
+               tempeff                 ,&
+               nstopfeuille            ,&
+               deltai                  ,&
+               svmax                    ,&
+               nsen                    ,&
+               laisen                  ,&
+               pdlaisen                ,&
+               dltaisenat              ,&
+               nsencour                ,&
+               dltamsen                ,&
+               dltaisen                ,&
+               fgellev                 ,&
+               gelee                   ,&
+               fstressgel              ,&
+               R_stlevamf              ,&
+               dernier_n               ,&
+               durvieI                 ,&
+               durvie                  ,&
+               ndebsen                 ,&
+               somsenreste             ,&
+               shumrel                  ,&
+               swfac                   ,&
+               turfac                  ,&
+               senfac                  ,&  
+               mafeuiljaune            ,&
+               msneojaune              ,&              
+               v_dltams                ,&
+               fgelflo                 ,&
+               pdircarb                ,&
+               ircarb                  ,&
+               nbgrains                ,&
+               pgrain                  ,&
+               vitmoy                  ,&
+               nbgraingel              ,&
+               pgraingel               ,&
+               dltags                  ,&
+               ftempremp               ,&
+               magrain                 ,&
+               pdmagrain               ,&
+               nbj0remp                ,&
+               pdsfruittot             ,&
+               repracmax               ,&
+               repracmin               ,&
+               kreprac                 ,&
+               somtemprac              ,&
+               urac                    ,&
+               reprac                  ,&
+               nstoprac                ,&
+               c_reserve               ,&
+               c_leafb                 ,&
+               !biomass                 ,&
+               deltgrain               ,&
+               gslen                   ,&
+               drylen, &
+               histgrowthset, hist_sencourset, hist_latestset, doyhiststset, &
+               nboxmax,box_ulai, box_ndays, box_lai, box_lairem, box_tdev, box_biom, box_biomrem, box_durage, box_somsenbase)                
+
+
+  !USE stomate_io
+  USE pft_parameters
+  USE constantes
+
+
+  implicit none
+
+  ! DECLARATION
+  integer,intent(in)                             ::         kjpindex
+  !integer,intent(in)                             ::         nvm
+  integer,intent(in)                             ::         nboxmax
+  logical, intent(in)::         f_crop_init        
+  logical,dimension(kjpindex, nvm), intent(inout)::         f_crop_recycle         
+  logical,dimension(kjpindex, nvm), intent(out)::         in_cycle         
+  logical,dimension(kjpindex, nvm), intent(out)::         f_sen_lai         
+  logical,dimension(kjpindex, nvm), intent(out)::         onarretesomcourdrp         
+!  integer,dimension(kjpindex, nvm), intent(out)::         nlevobs                 
+!  integer,dimension(kjpindex, nvm), intent(out)::         namfobs                 
+!  integer,dimension(kjpindex, nvm), intent(out)::         nfloobs                 
+!  integer,dimension(kjpindex, nvm), intent(out)::         nlanobs                 
+!  integer,dimension(kjpindex, nvm), intent(out)::         nlaxobs                 
+!  integer,dimension(kjpindex, nvm), intent(out)::         nmatobs                 
+!  integer,dimension(kjpindex, nvm), intent(out)::         nrecobs                 
+!  integer,dimension(kjpindex, nvm), intent(out)::         nsenobs                 
+!  integer,dimension(kjpindex, nvm), intent(out)::         ndrpobs                 
+  !
+  real,dimension(kjpindex, nvm), intent(out)::         nsendltams              
+  real,dimension(kjpindex, nvm), intent(out)::         nsendltai               
+  real,dimension(kjpindex, nvm), intent(out)::         nsenpfeuilverte         
+  real,dimension(kjpindex, nvm), intent(out)::         nsendurvie              
+  real,dimension(kjpindex, nvm), intent(out)::         nsenndurvie             
+  real,dimension(kjpindex, nvm), intent(out)::         densiteequiv            
+  integer,dimension(kjpindex, nvm), intent(out)::         nplt                    
+  real,dimension(kjpindex, nvm), intent(out)::         tursla                  
+  real,dimension(kjpindex, nvm), intent(out)::         ssla                     
+  real,dimension(kjpindex, nvm), intent(out)::         pfeuilverte             
+  real,dimension(kjpindex, nvm), intent(out)::         bsenlai                 
+  
+  ! STICS::LAIdev::DEVELOPMENT
+  real,dimension(kjpindex, nvm), intent(out)::         zrac                    
+  integer,dimension(kjpindex, nvm), intent(out)::         nrec                     
+  integer,dimension(kjpindex, nvm), intent(out)::         nlan                    
+  real,dimension(kjpindex, nvm), intent(out)::         tcult                   
+  real,dimension(kjpindex, nvm), intent(out)::         udevair                 
+  real,dimension(kjpindex, nvm), intent(out)::         udevcult                
+  integer,dimension(kjpindex, nvm), intent(out)::         ndrp                    
+  real,dimension(kjpindex, nvm), intent(out)::         rfvi                    
+  integer,dimension(kjpindex, nvm), intent(out)::         nlev                    
+  integer,dimension(kjpindex, nvm), intent(out)::         nger                    
+  logical,dimension(kjpindex, nvm), intent(out)::         etatvernal              
+  real,dimension(kjpindex, nvm), intent(out)::         caljvc                  
+  real,dimension(kjpindex, nvm), intent(out)::         rfpi                    
+  real,dimension(kjpindex, nvm), intent(out)::         upvt                    
+  real,dimension(kjpindex, nvm), intent(out)::         utp                     
+  real,dimension(kjpindex, nvm), intent(out)::         somcour                 
+  real,dimension(kjpindex, nvm), intent(out)::         somcourdrp              
+  real,dimension(kjpindex, nvm), intent(out)::         somcourutp              
+  real,dimension(kjpindex, nvm), intent(out)::         tdevelop                
+  real,dimension(kjpindex, nvm), intent(out)::         somtemp                 
+  real,dimension(kjpindex, nvm), intent(out)::         somcourfauche           
+  real,dimension(kjpindex, nvm), intent(out)::         stpltger                
+  real,dimension(kjpindex, nvm), intent(out)::         R_stamflax              
+  real,dimension(kjpindex, nvm), intent(out)::         R_stlaxsen              
+  real,dimension(kjpindex, nvm), intent(out)::         R_stsenlan              
+  real,dimension(kjpindex, nvm), intent(out)::         stlevflo                
+  integer,dimension(kjpindex, nvm), intent(out)::         nflo                    
+  real,dimension(kjpindex, nvm), intent(out)::         R_stlevdrp              
+  real,dimension(kjpindex, nvm), intent(out)::         R_stflodrp              
+  real,dimension(kjpindex, nvm), intent(out)::         R_stdrpmat              
+  integer,dimension(kjpindex, nvm), intent(out)::         nmat                    
+  integer,dimension(kjpindex, nvm), intent(out)::         nlax                    
+  integer,dimension(kjpindex, nvm), intent(out)::         nrecbutoir              
+  real,dimension(kjpindex, nvm), intent(out)::         group                   
+  integer,dimension(kjpindex, nvm), intent(out)::         ndebdes                 
+  real,dimension(kjpindex, nvm), intent(out)::         R_stdrpdes              
+  real,dimension(kjpindex, nvm), intent(out)::         densite                 
+  real,dimension(kjpindex, nvm), intent(out)::         densitelev
+  real,dimension(kjpindex, nvm), intent(out)::         coeflev
+              
+  real,dimension(kjpindex, nvm), intent(out)::         densiteger              
+  real,dimension(kjpindex, nvm), intent(out)::         somelong                 
+  real,dimension(kjpindex, nvm), intent(out)::         somger                  
+  logical,dimension(kjpindex, nvm), intent(out)::         humectation             
+  integer,dimension(kjpindex, nvm), intent(out)::         nbjhumec                
+  real,dimension(kjpindex, nvm), intent(out)::         somtemphumec            
+  real,dimension(kjpindex, nvm), intent(out)::         stpltlev                
+  integer,dimension(kjpindex, nvm), intent(out)::         namf                    
+  real,dimension(kjpindex, nvm), intent(out)::         stmatrec                
+  ! STICS::LAIdev:: LAI calculation
+  real,dimension(kjpindex, nvm), intent(out)::         tustress                
+  real,dimension(kjpindex, nvm), intent(out)::         slai                     
+  real,dimension(kjpindex, nvm), intent(out)::         somfeuille              
+  real,dimension(kjpindex, nvm), intent(out)::         pdlai                   
+  integer,dimension(kjpindex, nvm), intent(out)::         nbfeuille               
+  real,dimension(kjpindex, nvm), intent(out)::         reajust                 
+  real,dimension(kjpindex, nvm), intent(out)::         ulai                    
+  real,dimension(kjpindex, nvm), intent(out)::         pdulai                  
+  real,dimension(kjpindex, nvm), intent(out)::         efdensite               
+  real,dimension(kjpindex, nvm), intent(out)::         tempeff                 
+  integer,dimension(kjpindex, nvm), intent(out)::         nstopfeuille            
+  real,dimension(kjpindex, nvm), intent(out)::         deltai                  
+  real,dimension(kjpindex, nvm), intent(out)::         svmax                    
+  integer,dimension(kjpindex, nvm), intent(out)::         nsen                    
+  real,dimension(kjpindex, nvm), intent(out)::         laisen                  
+  real,dimension(kjpindex, nvm), intent(out)::         pdlaisen                
+  real,dimension(kjpindex, nvm), intent(out)::         dltaisenat              
+  ! STICS:: LAIdev:: LAI senescence 
+  integer,dimension(kjpindex, nvm), intent(out)::         nsencour                
+  real,dimension(kjpindex, nvm), intent(out)::         dltamsen                
+  real,dimension(kjpindex, nvm), intent(out)::         dltaisen                
+  real,dimension(kjpindex, nvm), intent(out)::         fgellev                 
+  logical,dimension(kjpindex, nvm), intent(out)::         gelee                   
+  real,dimension(kjpindex, nvm), intent(out)::         fstressgel              
+  real,dimension(kjpindex, nvm), intent(out)::         R_stlevamf              
+  integer,dimension(kjpindex, nvm), intent(out)::         dernier_n               
+  real,dimension(kjpindex, nvm), intent(out)::         durvieI                 
+  real,dimension(kjpindex, nvm), intent(out)::         durvie                  
+  integer,dimension(kjpindex, nvm), intent(out)::         ndebsen                 
+  real,dimension(kjpindex, nvm), intent(out)::         somsenreste
+  ! STICS:: LAIdev:: STRESS             
+  real,dimension(kjpindex, nvm), intent(out)::         shumrel                  
+  real,dimension(kjpindex, nvm), intent(out)::         swfac                   
+  real,dimension(kjpindex, nvm), intent(out)::         turfac                  
+  real,dimension(kjpindex, nvm), intent(out)::         senfac                
+ 
+  real,dimension(kjpindex, nvm), intent(out)::         mafeuiljaune                
+  real,dimension(kjpindex, nvm), intent(out)::         msneojaune                
+  ! STICS:: CARBON ALLOCATION
+
+  real,dimension(kjpindex, nvm, 60), intent(out)::         v_dltams                
+  real,dimension(kjpindex, nvm), intent(out)::         fgelflo                
+  real,dimension(kjpindex, nvm), intent(out)::         pdircarb                
+  real,dimension(kjpindex, nvm), intent(out)::         ircarb                
+  real,dimension(kjpindex, nvm), intent(out)::         nbgrains                
+  real,dimension(kjpindex, nvm), intent(out)::         pgrain              
+  real,dimension(kjpindex, nvm), intent(out)::         vitmoy                
+  real,dimension(kjpindex, nvm), intent(out)::         nbgraingel                
+  real,dimension(kjpindex, nvm), intent(out)::         pgraingel                
+  real,dimension(kjpindex, nvm), intent(out)::         dltags                
+  real,dimension(kjpindex, nvm), intent(out)::         ftempremp                
+  real,dimension(kjpindex, nvm), intent(out)::         magrain                
+  real,dimension(kjpindex, nvm), intent(out)::         pdmagrain               
+  integer,dimension(kjpindex, nvm), intent(out)::         nbj0remp                 
+  real,dimension(kjpindex, nvm), intent(out)::         pdsfruittot               
+  real,dimension(kjpindex, nvm), intent(out)::         repracmax               
+  real,dimension(kjpindex, nvm), intent(out)::         repracmin               
+  real,dimension(kjpindex, nvm), intent(out)::         kreprac               
+  real,dimension(kjpindex, nvm), intent(out)::         somtemprac               
+  real,dimension(kjpindex, nvm), intent(out)::         urac              
+  real,dimension(kjpindex, nvm), intent(out)::         reprac               
+
+  integer,dimension(kjpindex, nvm), intent(out)::         nstoprac                 
+  real,dimension(kjpindex, nvm), intent(out)::         c_reserve               
+  real,dimension(kjpindex, nvm), intent(out)::         c_leafb            
+  !real,dimension(kjpindex, nvm, nparts ), intent(out)::         biomass           
+  real,dimension(kjpindex, nvm), intent(out)::         deltgrain          
+  integer,dimension(kjpindex, nvm), intent(out)::         gslen                 
+  integer,dimension(kjpindex, nvm), intent(out)::         drylen                 
+  real,dimension(kjpindex, nvm, 300, 5), intent(out) :: histgrowthset
+  integer, dimension(kjpindex,nvm), intent(out) :: hist_sencourset
+  integer, dimension(kjpindex,nvm), intent(out) :: hist_latestset
+  integer, dimension(kjpindex,nvm), intent(out) :: doyhiststset
+
+  integer, dimension(kjpindex,nvm,nboxmax), intent(out) :: box_ndays
+  real, dimension(kjpindex,nvm,nboxmax), intent(out)    :: box_lai
+  real, dimension(kjpindex,nvm,nboxmax), intent(out)    :: box_lairem
+  real, dimension(kjpindex,nvm,nboxmax), intent(out)    :: box_tdev
+  real, dimension(kjpindex,nvm,nboxmax), intent(out)    :: box_biom
+  real, dimension(kjpindex,nvm,nboxmax), intent(out)    :: box_biomrem
+  real, dimension(kjpindex,nvm,nboxmax), intent(out)    :: box_durage
+  real, dimension(kjpindex,nvm,nboxmax), intent(out)    :: box_somsenbase
+  real, dimension(nvm,nboxmax), intent(out)             :: box_ulai
+  ! local variables
+  integer    :: j, ip, k, mid
+  real       :: uinflex
+
+ 
+  ! 
+  DO j= 1, nvm
+     
+     DO ip = 1, kjpindex 
+       IF (f_crop_init .OR. f_crop_recycle(ip, j)) THEN  
+          
+
+          ! LAIdev :: FORCED RUN VARIABLES
+          in_cycle(ip, j) = .FALSE.
+          f_sen_lai(ip, j) = .TRUE.
+          onarretesomcourdrp(ip, j) = .TRUE.
+!          nlevobs(ip, j) = 999
+!          namfobs(ip, j) = 999   
+!          nfloobs(ip, j) = 999
+!          nlanobs(ip, j) = 999
+!          nlaxobs(ip, j) = 999
+!          nmatobs(ip, j) = 999
+!          nrecobs(ip, j) = 999
+!          nsenobs(ip, j) = 999
+!          ndrpobs(ip, j) = 999
+        
+          ! LAIdev ::  SPECIFIC
+          nsendltams(ip, j) = 0.
+          nsendltai(ip, j) = 0.
+          nsenpfeuilverte(ip, j) = 0.
+          nsendurvie(ip, j) = 0.
+          nsenndurvie(ip, j) = 0.
+          densiteequiv(ip, j) = 0.
+          nplt(ip, j) = 0
+          tursla(ip, j) = 1.
+          ssla(ip, j) = 0.
+          pfeuilverte(ip, j) = 0.
+          bsenlai(ip, j) = 0.
+
+          ! LAIdev ::  DEVELOPMENT 
+          zrac(ip, j) = 0.
+          nrec(ip, j) = 0
+          nlan(ip, j) = 0
+          tcult(ip, j) = 0.
+          udevair(ip, j) = 0.
+          udevcult(ip, j) = 0.
+          ndrp(ip, j) = 0
+          rfvi(ip, j) = 0.
+          nlev(ip, j) = 0
+          nger(ip, j) = 0
+          etatvernal(ip, j) = .FALSE.
+          caljvc(ip, j) = 0.
+          rfpi(ip, j) = 0.
+          upvt(ip, j) = 0.
+          utp(ip, j) = 0.
+          somcour(ip, j) = 0.
+          somcourdrp(ip, j) = 0.
+          somcourutp(ip, j) = 0.
+          tdevelop(ip, j) = 0.
+          somtemp(ip, j) = 0.
+          somcourfauche(ip, j) = 0.
+          stpltger(ip, j) = SP_stpltger(j)
+          R_stamflax(ip, j) = SP_stamflax(j) 
+          R_stlaxsen(ip, j) = SP_stlaxsen(j)
+          R_stsenlan(ip, j) = SP_stsenlan(j)
+          stlevflo(ip, j) = SP_stlevdrp(j) - SP_stflodrp(j)
+          nflo(ip, j) = 0
+          R_stlevdrp(ip, j) = SP_stlevdrp(j)
+          R_stflodrp(ip, j) = SP_stflodrp(j)
+          R_stdrpmat(ip, j) = SP_stdrpmat(j)
+          nmat(ip, j) = 0
+          nlax(ip, j) = 0
+          nrecbutoir(ip, j) = 999
+          group(ip, j) = 0.
+          ndebdes(ip, j) = 0
+          R_stdrpdes(ip, j) = SP_stdrpdes(j)
+          densite(ip, j) = 0.
+          densitelev(ip, j) = 0.
+          coeflev(ip, j) = 1.
+          densiteger(ip, j) = 0.
+          somelong(ip, j) = 0.
+          somger(ip, j) = 0.
+          humectation(ip, j) = .FALSE.
+          nbjhumec(ip, j) = 0
+          somtemphumec(ip, j) = 0.
+          stpltlev(ip, j) = 0.
+          namf(ip, j) = 0
+          stmatrec(ip, j) = 0.
+          
+          ! LAIdev ::  LAI calculation
+          tustress(ip, j) = 1.
+          slai(ip, j) = 0.
+          somfeuille(ip, j) = 0.
+          pdlai(ip, j) = 0.
+          nbfeuille(ip, j) = 0
+          reajust(ip, j) = 0.
+          ulai(ip, j) = 0.
+          pdulai(ip, j) = 0.
+          efdensite(ip, j) = 0.
+          tempeff(ip, j) = 0.
+          nstopfeuille(ip, j) = 0
+          deltai(ip, j) = 0.
+          svmax(ip, j) = 0.
+          nsen(ip, j) = 0
+          laisen(ip, j) = 0.
+          pdlaisen(ip, j) = 0.
+          dltaisenat(ip, j) = 0.
+          
+          ! LAIdev :: LAI senescence
+          nsencour(ip, j) = 0
+          dltamsen(ip, j) = 0.
+          dltaisen(ip, j) = 0.
+          fgellev(ip, j) = 0.
+          gelee(ip, j) = .FALSE.
+          fstressgel(ip, j) = 0.
+          R_stlevamf(ip, j) = SP_stlevamf(j)
+          dernier_n(ip, j) = 0
+          durvieI(ip, j) = 0.
+          durvie(ip, j) = 0.
+          ndebsen(ip, j) = 0
+          somsenreste(ip, j) = 0.
+          
+          IF (any(ok_LAIdev(:)) .AND. any(SP_codlainet(:) == 3)) THEN
+!              write(*,*) 'xuhui: box module to be initialize ', j
+              box_ndays(ip,j,:) = 0
+              box_lai(ip,j,:) = 0.
+              box_lairem(ip,j,:) = 0.
+              box_tdev(ip,j,:) = 0.
+              box_biom(ip,j,:) = 0.
+              box_biomrem(ip,j,:) = 0.
+              box_durage(ip,j,:) = 0.
+              box_somsenbase(ip,j,:) = 0.
+!              write(*,*) 'xuhui: box module initialized ', j
+          ENDIF
+          ! LAIdev :: STRESS
+           
+          shumrel(ip, j) = 0.
+          swfac(ip, j) = 1.
+          turfac(ip, j) = 1.
+          senfac(ip, j) = 1.
+
+          mafeuiljaune(ip, j) = 0.
+          msneojaune(ip, j) = 0.
+          ! STICS: CARBON ALLOCATION 
+
+          v_dltams(ip, j, :) = 0.
+          fgelflo(ip, j) = 1.
+          pdircarb(ip, j) = 0.
+          ircarb(ip, j) = 0.
+          nbgrains(ip, j) = 0.
+          pgrain(ip, j) = 0.
+          vitmoy(ip, j) = 0.
+          nbgraingel(ip, j) = 0.
+          pgraingel(ip, j) = 0.
+          dltags(ip, j) = 0.
+          ftempremp(ip, j) = 0.
+          magrain(ip, j) = 0.
+          pdmagrain(ip, j) = 0.
+          nbj0remp(ip, j) = 0
+          pdsfruittot(ip, j) = 0.
+          repracmax(ip, j) = 0.
+          repracmin(ip, j) = 0.
+          kreprac(ip, j) = 0.
+          somtemprac(ip, j) = 0.
+          urac(ip, j) = 0.
+          reprac(ip, j) = 0.
+          nstoprac(ip, j) = 0
+          c_reserve(ip, j) = 0. 
+          c_leafb(ip, j)= 0. 
+          deltgrain(ip, j) = 0.
+          gslen(ip, j) = 0 
+          drylen(ip, j) = 0 
+          ! FINISH THE INITIALIZATION AND RESET THE VALUE
+          IF (any(ok_LAIdev(:)) .AND. any(SP_codlainet(:) == 2)) THEN
+              histgrowthset(ip,j,:,:) = 0.
+              hist_sencourset(ip,j) = 0
+              hist_latestset(ip,j) = 0
+              doyhiststset(ip,j) = 0
+          ENDIF
+          f_crop_recycle(ip, j) = .FALSE.
+
+        ENDIF
+     ENDDO ! ip
+  ENDDO ! j
+    
+!    write(*,*) 'xuhui: initialized boxulai'
+    IF (any(ok_LAIdev(:)) .AND. any(SP_codlainet(:)==3)) THEN
+        box_ulai(:,:) = 0.
+        DO j=1,nvm
+    !        IF (f_crop_init) THEN
+!            IF (f_crop_init .OR. any(f_crop_recycle(:, j))) THEN
+                if (SP_nbox(j) < 2) then
+!                    write(*,*) 'xuhui: box_ulai not allocated for ', j, 'with nbox ', SP_nbox(j)
+                else    
+                    uinflex = SP_vlaimax(j)
+                    mid = floor(real(SP_nbox(j))/2)
+                    if (mid<1) then
+                        mid=1
+                    elseif (mid .eq. SP_nbox(j)) then
+                        mid=SP_nbox(j)-1
+                    endif
+                    do k=1,mid
+                        box_ulai(j,k) = 1+(k-1)*((uinflex-1)/real(mid))
+                    enddo
+                    do k=mid+1,SP_nbox(j)
+                        box_ulai(j,k) = uinflex + (k-mid-1)*(3-uinflex)/real(SP_nbox(j)-mid)
+                    enddo
+!                    write(*,*) 'xuhui: box_ulai for pft ', j, ': ',box_ulai(j,:)
+                endif
+                
+ !           ENDIF
+        ENDDO
+    ENDIF
+
+end subroutine Stics_init
+
Index: /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_sticslai/crop_alloc.f90
===================================================================
--- /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_sticslai/crop_alloc.f90	(revision 6940)
+++ /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_sticslai/crop_alloc.f90	(revision 6940)
@@ -0,0 +1,386 @@
+! This subrutine is addressing the Carbon allocation for crops in combination with STICS
+! Author: Xuhui Wang
+! Date: 03/12/2014
+
+module crop_alloc
+
+! use modules
+
+USE ioipsl
+USE pft_parameters
+USE constantes
+USE netcdf
+
+IMPLICIT NONE
+
+CONTAINS
+
+subroutine crop_bmalloc(in_cycle,         &
+                      deltai,           &
+                      dltaisen,         &
+                      ssla,             &
+                      pgrain,           &
+                      deltgrain,          &
+                      reprac,           &
+                      nger,             &
+                      nlev,             &
+                      ndrp,             &
+                      nlax,             &    ! input 
+                      nmat,             &
+                      nrec,             &
+!                      is_recycle,       &
+                      bm_alloc_tot,     &    ! input
+                      biomass,          &
+                      c_reserve,        &    ! out
+                      c_leafb,          &    ! out
+                      bm_alloc,         &    ! inout
+                      P_densitesem,     &
+                      P_pgrainmaxi,     &
+                      P_tigefeuil,     &
+                      P_slamax,        &
+                      slai,            &
+                      tday_counter)               ! parameter
+
+   !USE ioipsl
+   !USE pft_parameters
+   !USE constantes
+   
+   ! Declaration part
+   
+   ! 0.0 INPUT PART
+   LOGICAL, INTENT(IN)                 :: in_cycle            
+   REAL(r_std),  INTENT(IN)            :: deltai         ! lai increment  // unit in m2 m-2
+   REAL(r_std),  INTENT(IN)            :: dltaisen       ! lai senescence  // unit in m2 m-2
+   REAL(r_std),  INTENT(IN)            :: ssla           ! sla from STICS // unit in g cm -2
+   REAL(r_std),  INTENT(IN)            :: pgrain         ! weight per grain (dry matter, but not carbon)  // g
+   REAL(r_std),  INTENT(IN)            :: deltgrain        ! grain yield increment (dry matter but not carbon)  // unit g c / m2
+   REAL(r_std),  INTENT(IN)            :: reprac 
+   INTEGER(i_std),  INTENT(IN)            :: nger
+   INTEGER(i_std),  INTENT(IN)            :: nlev 
+   INTEGER(i_std),  INTENT(IN)            :: ndrp
+   INTEGER(i_std),  INTENT(IN)            :: nlax
+   INTEGER(i_std),  INTENT(IN)            :: nmat
+   INTEGER(i_std),  INTENT(IN)            :: nrec
+!   LOGICAL,  INTENT(IN)                   :: is_recycle
+   REAL(r_std), INTENT(IN)             :: bm_alloc_tot   ! unit in g m-2 
+   REAL(r_std),  INTENT(IN)            :: P_densitesem
+   REAL(r_std),  INTENT(IN)            :: P_tigefeuil
+   REAL(r_std),  INTENT(IN)            :: P_pgrainmaxi
+   REAL(r_std),  INTENT(IN)            :: P_slamax
+   REAL(r_std), DIMENSION(nparts), INTENT(INOUT)             :: biomass   ! unit in g m-2 
+   INTEGER(i_std), INTENT(IN)             :: tday_counter
+   ! 1.0 INOUT PART
+
+   REAL(r_std), INTENT(INOUT)            ::c_reserve  ! crop reserve 
+   REAL(r_std), INTENT(INOUT)            ::c_leafb ! crop leaf biomass derived from STICS
+   REAL(r_std), INTENT(INOUT)            ::slai ! stics simulated lai
+   REAL(r_std), DIMENSION(nparts), INTENT(INOUT)            ::bm_alloc ! crop leaf biomass derived from STICS
+   
+   ! 2.0 local 
+   REAL(r_std)      ::  grainrem   ! daily grain minus reservoir, the remaining carbon
+   REAL(r_std)      ::  deltmagrain   ! daily grain/ (unit in carbon)
+   INTEGER(i_std)   :: ipart
+   REAL(r_std)      :: tempalloc
+   REAL(r_std)      :: tempdlai
+   REAL(r_std)      :: netdeltai
+   REAL(r_std)      :: temprest
+   REAL(r_std)      :: maxremobi,sla0,sla1,remobi
+   LOGICAL, PARAMETER :: mydebug=.FALSE.
+
+
+    ! Part one: conversion from biomass(dry matter) to carbon
+    deltmagrain = deltgrain*0.48
+
+    ! STRATEGY: 
+    ! We keep the leaf biomass, grain and reprac from STICS 
+    ! Total available biomass for allocation is dltams and cropreserv. 
+
+    !IF (bavard .GE. 3) WRITE(numout,*) 'Entering crop alloc'
+    
+    ! 1. whether or not necessary to enter into this process
+    
+    if (.not. in_cycle) then
+        return   ! if not yet into the crop cycle or finish the cycle
+    endif
+
+    ! 1. initialize the bm_alloc (biomass allocation)
+    !
+
+    bm_alloc(:) = 0.      ! 8 parts
+       
+    ! 2.  leaf biomass from STICS 
+    ! in this subroutine, we USED the Leaf biomass and GRAIN yield, the leaf biomass and grain production is adjusted accoring to different stages (in detail see leaf and grain processes)
+    c_leafb = 0.
+    if (in_cycle) then
+       if (deltai > 0.) then  ! just for leaf growth period
+           c_leafb = deltai/ssla*10000.0*0.48
+       elseif (deltai < 0.) then
+           c_leafb = deltai/ssla*10000.0*0.48
+       else
+           c_leafb = 0.
+       endif
+    else
+       c_leafb = 0.
+    endif
+    netdeltai = deltai - dltaisen
+  
+    
+    ! 3. reinitialization of leaf and fruit biomass
+    if (biomass(ileaf) .gt. 0.0) then
+        sla0 = slai/biomass(ileaf)
+    else
+        sla0 = P_slamax
+    endif
+    if (sla0 .eq. 0.0) then
+        sla0 = P_slamax
+    endif
+    if (sla0 .LT. 0) then
+       write(*,*) 'allocation sla error: sla0,',sla0
+       STOP
+    endif
+    bm_alloc(ileaf) = c_leafb - dltaisen/sla0
+    if (bm_alloc(ileaf) .LT. 0 .and. netdeltai .GT. 0) then
+        write(*,*) 'allocation leaf error: bm_alloc(ileaf)',bm_alloc(ileaf)
+    endif
+    if (bm_alloc(ileaf)<0 .and. biomass(ileaf)+bm_alloc(ileaf)<0) then
+        bm_alloc(ileaf) = -biomass(ileaf)
+    endif
+    bm_alloc(ifruit)= deltmagrain
+    bm_alloc(iroot) = bm_alloc_tot * reprac
+    if (reprac .GE. 1.) then
+       write(numout,*) 'reprac > 1: ',reprac
+       stop
+    endif
+    bm_alloc(isapabove) = P_tigefeuil * c_leafb
+    bm_alloc(icarbres) = 0.
+
+    if (mydebug) then
+        write(numout,*) 'xuhui, alloc initial:'
+        write(numout,*) 'biomass(ileaf) ', biomass(ileaf)
+        write(numout,*) 'slai ', slai
+        write(numout,*) 'sla0 ', sla0
+        write(numout,*) 'deltai ', deltai
+        write(numout,*) 'dltaisen ', dltaisen
+        write(numout,*) 'reprac ', reprac
+        write(numout,*) 'deltmagrain ', deltmagrain
+        write(numout,*) 'P_tigefeuil ', P_tigefeuil
+        write(numout,*) 'bm_alloc_tot ', bm_alloc_tot
+        write(numout,*) 'bm_alloc(ileaf,isapabove,iroot,ifruit) '
+        write(numout,*)  bm_alloc(ileaf), bm_alloc(isapabove), bm_alloc(iroot), bm_alloc(ifruit)
+        write(numout,*) 'nger nlev nlax ndrp nrec '
+        write(numout,*)  nger, nlev, nlax, ndrp,  nrec
+        write(numout,*) 'biomass(ileaf, isapabove, iroot, ifruit, icarbres) '
+        write(numout,*)  biomass(ileaf), biomass(isapabove), biomass(iroot), biomass(ifruit), biomass(icarbres)
+    endif
+    
+    ! it is possible that bm_alloc(ileaf) is negative
+ 
+    ! 4.  real allocation for each grid and each pft
+
+
+    ! STRATEGY: 
+    ! 1. carbon allocation priority is different for different parts;
+    ! 2. even for the same pool, the priority is changing along with time (stage revolution) 
+    
+    ! 3.1 FOR STAGE [nger, nlev]
+
+    ! the c_reserve starts to decreasing because the root growth
+    ! and we allocate all carbon into root
+
+    if ((nger .gt. 0) .and. (nlev .eq. 0)) then ! germination occured but did not emerge, during this stage only root and reserve pools
+       if ( biomass(icarbres) > 0.) then  ! adjust the reserve dynamics
+          ! addressing the c_reserve dynamics
+          bm_alloc(iroot) = biomass(icarbres)*reprac 
+          bm_alloc(icarbres) = 0. - biomass(icarbres)*reprac 
+          bm_alloc(ileaf) = 0.
+          bm_alloc(isapabove) = 0.
+          bm_alloc(ifruit) = 0.
+       else
+          !c_reserve = 0.
+          bm_alloc(icarbres) = 0.
+          bm_alloc(iroot) = 0.
+          bm_alloc(ileaf) = 0.
+          bm_alloc(isapabove) = 0.
+          bm_alloc(ifruit) = 0.
+       endif
+    endif
+    
+    ! 3.2 FOR STAGE [NLEV, NDRP)
+    if ((nlev .gt. 0) .and. (ndrp .eq. 0)) then 
+    ! emergence and photosynthese, whereas grain is not filling
+    ! in this stage, we keep the leaf and grain biomass
+    ! root with the higher priority
+        tempalloc =  bm_alloc(ileaf)+bm_alloc(iroot)+bm_alloc(isapabove)
+        bm_alloc(ifruit) = 0.
+        if (tempalloc > bm_alloc_tot) then
+            if (tempalloc < bm_alloc_tot + biomass(icarbres)) then                
+!                biomass(icarbres) = biomass(icarbres) - (tempalloc - bm_alloc_tot)
+                bm_alloc(icarbres) = - (tempalloc - bm_alloc_tot)
+            else ! new c + c reserve is insufficient to meet the demand
+                if (biomass(icarbres)<0) then
+                    biomass(icarbres) = 0.
+                    bm_alloc(icarbres) = 0.
+                else
+                    bm_alloc(icarbres) = - biomass(icarbres)
+                endif
+                bm_alloc(iroot) = reprac * bm_alloc_tot
+                if ( tday_counter >= nlev .and. tday_counter < nlev+8) then ! we create some biomass for leaf at the beginning
+                    bm_alloc(ileaf) = deltai/P_slamax*10000.0*0.48
+                    bm_alloc(icarbres) = -bm_alloc(ileaf)
+                else
+                    tempdlai = (bm_alloc_tot + biomass(icarbres) - bm_alloc(iroot))/(1+P_tigefeuil)*ssla/10000.0/0.48
+                    bm_alloc(ileaf) = tempdlai/ssla*10000.0*0.48
+                    bm_alloc(isapabove) = P_tigefeuil*bm_alloc(ileaf)
+                    if (netdeltai > tempdlai) then
+                        slai = slai - (netdeltai - tempdlai)
+                    endif
+                endif
+            endif
+        else
+            bm_alloc(icarbres) = bm_alloc_tot - tempalloc
+        endif
+!        if (bm_alloc(ileaf)<0) then ! remobilize the leaf biomass for future use (grain mainly)
+!           bm_alloc(icarbres) = bm_alloc(icarbres) - bm_alloc(ileaf)
+!        endif
+!    endif
+  
+    
+    ! 3.3 STAGE [ndrp nrec) 
+    ! in this stage, there is potentially competition between leaf and fruit,
+    ! conserve root/shoot ratio, fulfil grain first, reduce deltai when necessary
+    ! note that leaf growth stop at nlax, grain filling stop at nmat
+    ! no fundamental differences exist for [nlax, nmat)
+       
+    else if ((ndrp .gt. 0) .and. ( (nmat .eq. 0) .or. (tday_counter .eq. nmat))) then ! from grain filling to maturity
+       tempalloc =  bm_alloc(ileaf)+bm_alloc(ifruit)+bm_alloc(iroot)+bm_alloc(isapabove)
+
+       if (tempalloc > bm_alloc_tot) then
+           if (tempalloc < bm_alloc_tot + biomass(icarbres)) then ! use c reserval
+!               biomass(icarbres) = biomass(icarbres) - (tempalloc - bm_alloc_tot)
+               bm_alloc(icarbres) = - (tempalloc - bm_alloc_tot)
+           else ! new c + c reserval is insufficient to meet the demand
+               if (biomass(icarbres)<0) then
+                   biomass(icarbres) = 0.
+               else
+                   bm_alloc(icarbres) = 0. - biomass(icarbres)
+               endif
+               bm_alloc(iroot) = reprac * bm_alloc_tot
+               if (bm_alloc(ileaf)>=0) then
+                   temprest = bm_alloc_tot + biomass(icarbres) - bm_alloc(iroot)
+               else ! bm_alloc(ileaf) < 0 
+                   temprest = bm_alloc_tot + biomass(icarbres) - bm_alloc(ileaf) - bm_alloc(iroot)
+               endif
+               if (temprest < bm_alloc(ifruit)) then ! if not sufficient for grain alone
+                   if (nlax .gt. 0) then ! remobilize some carbon from leaf
+                       sla0 = slai/biomass(ileaf)*10000.0*0.48 ! m2/gC --> cm2/g drymass
+                       sla1 = min(sla0+5,P_slamax)
+                       maxremobi = slai/(sla0/0.48/10000.0) - slai/(sla1/0.48/10000)   !cm2/g --> m2/gC
+                       remobi = min(maxremobi, bm_alloc(ifruit)-temprest)
+                       
+                       bm_alloc(ifruit) = temprest + remobi
+                       bm_alloc(ileaf) = min(bm_alloc(ileaf),0.) - remobi
+                       ! when bm_alloc(ileaf)<0, further remove remobi
+                       ! when bm_alloc(ileaf)>0, then stop the planned location to lai
+                       bm_alloc(isapabove) = 0.
+                   else
+                       bm_alloc(ifruit) = temprest
+                       bm_alloc(ileaf) = min(0., bm_alloc(ileaf))
+                       bm_alloc(isapabove) = 0.
+                       if (netdeltai>0) then
+                           slai = slai - netdeltai
+                       endif
+                   endif
+               else !temprest >= bm_alloc(ifruit)
+                   if (bm_alloc(ileaf)<0) then ! the rest is left in reserval
+                       bm_alloc(icarbres) = temprest - bm_alloc(ifruit)
+                   else !  the rest goes to leaf
+                       tempdlai = (temprest - bm_alloc(ifruit))/(1+P_tigefeuil)*ssla/10000.0/0.48
+                       bm_alloc(ileaf) = tempdlai/ssla*10000.0*0.48
+                       bm_alloc(isapabove) = P_tigefeuil*bm_alloc(ileaf)
+                       if (netdeltai > tempdlai) then ! which is almost guarantee because bm_alloc(ileaf)>0
+                           slai = slai - (netdeltai - tempdlai)
+                       endif
+                   endif
+               endif
+           endif
+       else
+           bm_alloc(icarbres) = bm_alloc_tot - tempalloc
+       endif   
+!    endif
+
+    ! 3.5 stage [nmat nrec)
+    else if ((nmat .gt. 0) .and. (nrec .eq. 0))  then
+        ! xuhui noted:
+        ! in STICS, nmat = physiology maturity, which means 
+        ! harvested organs stop growing in dry matter (p20 STICS book)
+        ! It is difficult to imagine vegetative part (leaf, root) are still growing,
+        ! while the harvest organs are not. So my decision is that
+        ! no allocation to any parts of the crop
+        ! = no more npp
+        if (bm_alloc(ileaf)<0) then
+            bm_alloc(isapabove) = -bm_alloc(ileaf)
+            bm_alloc(iroot) = 0.
+            bm_alloc(ifruit) = 0.
+            bm_alloc(icarbres) = 0.
+        else
+            bm_alloc(:) = 0.
+        endif
+!    endif    
+!    ! 3.5 STAGE [When nrec occur]
+!    ! when harvest, we alloc some carbon into reservoire pool
+!    
+!    else if ( nrec .gt. 0  .OR.  (nmat .GT. 0 .AND. is_recycle) ) then  ! harvest occurs
+    else if ( nrec .gt. 0 ) then  ! harvest occurs
+!    ! only allocate to root & grain
+!       bm_alloc(isapabove) = 0.
+!       if (bm_alloc(ileaf)<0)  then
+!           tempalloc =  bm_alloc(ifruit) + bm_alloc(iroot) + bm_alloc(ileaf)
+!       else !bm_alloc(ileaf)>0 ! this should be a buggy boundary condition
+!           bm_alloc(ileaf) = 0.
+!           tempalloc = bm_alloc(ifruit) + bm_alloc(iroot)
+!       endif
+!
+!       if (tempalloc >= bm_alloc_tot) then !no enough c
+!          bm_alloc(ifruit) = bm_alloc_tot - bm_alloc(iroot)
+!          bm_alloc(icarbres) = 0.          
+!       else 
+!          bm_alloc(icarbres) =bm_alloc_tot - tempalloc
+!       endif
+       ! but we have to put some carbon into reserve (seeds for the next year) 
+       c_reserve = P_densitesem*pgrain*0.48 ! seeds 
+       bm_alloc(ileaf) = 0. !at harvest, the senescence will be treated as litter, not as re-allocation
+       if (biomass(icarbres) > 0.) then
+           bm_alloc(isapabove) = biomass(icarbres) !the rest of c reservoire will be return to soil as litter
+           bm_alloc(icarbres) = -biomass(icarbres)
+       else
+           bm_alloc(isapabove) = 0.
+           bm_alloc(icarbres) = 0.
+       endif
+!       biomass(ifruit) =  biomass(ifruit) - c_reserve   !max(grainrem, 0.); 
+       bm_alloc(ifruit) = -c_reserve
+       bm_alloc(icarbres) = bm_alloc(icarbres) + c_reserve
+       DO ipart = 1,nparts
+           IF (bm_alloc(ipart)<0) THEN
+               WRITE(numout,*) 'ipart :',ipart
+               WRITE(numout,*) 'bm_alloc < 0 :',bm_alloc(ipart)
+               WRITE(numout,*) 'biomass :', biomass(ipart)
+           ENDIF
+       ENDDO
+    else
+!        write(numout,*) 'growth stage not recognized'
+        write(numout,*) 'no allocation occurred in tday_counter: ', tday_counter
+        write(numout,*) 'nger, nlev, ndrp, nmat, nrec'
+        write(numout,*) nger, nlev, ndrp, nmat, nrec
+!        STOP
+    endif
+
+    if (mydebug)  then
+        write(numout,*) 'xuhui, leaving crop_alloc'
+        write(numout,*) 'bm_alloc(ileaf,isapabove,iroot,ifruit,icarbres) '
+        write(numout,*)  bm_alloc(ileaf), bm_alloc(isapabove), bm_alloc(iroot), bm_alloc(ifruit), bm_alloc(icarbres)
+        write(numout,*) 'slai: ', slai
+    endif
+  
+end subroutine crop_bmalloc
+
+end module crop_alloc
Index: /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_sticslai/crop_alloc.f90.backup
===================================================================
--- /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_sticslai/crop_alloc.f90.backup	(revision 6940)
+++ /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_sticslai/crop_alloc.f90.backup	(revision 6940)
@@ -0,0 +1,331 @@
+! This subrutine is addressing the Carbon allocation for crops in combination with STICS
+! Author: Xiuchen Wu
+! Date: 1/08/2013
+
+module crop_alloc
+
+! use modules
+
+USE ioipsl
+USE pft_parameters
+USE constantes
+USE netcdf
+
+IMPLICIT NONE
+
+CONTAINS
+
+subroutine crop_bmalloc(in_cycle,         &
+                      deltai,           &
+                      dltaisen,         &
+                      ssla,             &
+                      pgrain,           &
+                      deltgrain,          &
+                      reprac,           &
+                      nger,             &
+                      nlev,             &
+                      ndrp,             &
+                      nlax,             &    ! input 
+                      nrec,             &
+                      bm_alloc_tot,     &    ! input
+                      biomass,          &
+                      c_reserve,        &    ! out
+                      c_leafb,          &    ! out
+                      bm_alloc,         &    ! inout
+                      P_densitesem,     &
+                      P_pgrainmaxi,     &
+                      P_tigefeuil,     &
+                      P_slamax,        &
+                      slai)               ! parameter
+
+   !USE ioipsl
+   !USE pft_parameters
+   !USE constantes
+   
+   ! Declaration part
+   
+   ! 0.0 INPUT PART
+   LOGICAL, INTENT(IN)                 :: in_cycle            
+   REAL(r_std),  INTENT(IN)            :: deltai         ! lai increment  // unit in m2 m-2
+   REAL(r_std),  INTENT(IN)            :: dltaisen       ! lai senescence  // unit in m2 m-2
+   REAL(r_std),  INTENT(IN)            :: ssla           ! sla from STICS // unit in g cm -2
+   REAL(r_std),  INTENT(IN)            :: pgrain         ! weight per grain (dry matter, but not carbon)  // g
+   REAL(r_std),  INTENT(IN)            :: deltgrain        ! grain yield increment (dry matter but not carbon)  // unit g c / m2
+   REAL(r_std),  INTENT(IN)            :: reprac 
+   INTEGER(i_std),  INTENT(IN)            :: nger
+   INTEGER(i_std),  INTENT(IN)            :: nlev 
+   INTEGER(i_std),  INTENT(IN)            :: ndrp
+   INTEGER(i_std), INTENT(IN)            :: nlax
+   INTEGER(i_std), INTENT(IN)            :: nrec
+   REAL(r_std), INTENT(IN)             :: bm_alloc_tot   ! unit in g m-2 
+   REAL(r_std),  INTENT(IN)            :: P_densitesem
+   REAL(r_std),  INTENT(IN)            :: P_pgrainmaxi
+   REAL(r_std),  INTENT(IN)            :: P_tigefeuil
+   REAL(r_std),  INTENT(IN)            :: P_slamax
+
+   REAL(r_std), DIMENSION(nparts), INTENT(INOUT)             :: biomass   ! unit in g m-2 
+   
+   ! 1.0 INOUT PART
+
+   REAL(r_std), INTENT(INOUT)            ::c_reserve  ! crop reserve 
+   REAL(r_std), INTENT(INOUT)            ::c_leafb ! crop leaf biomass derived from STICS
+   REAL(r_std), INTENT(INOUT)            ::slai ! stics simulated lai
+
+   REAL(r_std), DIMENSION(nparts), INTENT(INOUT)            ::bm_alloc ! crop leaf biomass derived from STICS
+   
+   ! 2.0 local 
+   REAL             ::  grainrem   ! daily grain minus reservoir, the remaining carbon
+   REAL             ::  deltmagrain   ! daily grain/ (unit in carbon)
+   INTEGER          :: ipart
+
+
+    ! Part one: conversion from biomass(dry matter) to carbon
+    deltmagrain = deltgrain*0.48
+
+    ! STRATEGY: 
+    ! We keep the leaf biomass, grain and reprac from STICS 
+    ! Total available biomass for allocation is dltams and cropreserv. 
+
+    !IF (bavard .GE. 3) WRITE(numout,*) 'Entering crop alloc'
+    
+    ! 1. whether or not necessary to enter into this process
+    
+    if (.not. in_cycle) return   ! if not yet into the crop cycle or finish the cycle
+
+    ! 1. initialize the bm_alloc (biomass allocation)
+    !
+
+    bm_alloc(:) = 0.      ! 8 parts
+       
+    ! 2.  leaf biomass from STICS 
+    ! in this subroutine, we USED the Leaf biomass and GRAIN yield, the leaf biomass and grain production is adjusted accoring to different stages (in detail see leaf and grain processes)
+
+    c_leafb = 0.
+    if (in_cycle) then
+       if (deltai > 0.) then  ! just for leaf growth period
+           c_leafb = deltai/ssla*10000.0*0.48
+       else
+           c_leafb = 0.
+       endif
+    else
+       c_leafb = 0.
+    endif
+  
+    
+    ! 3. reinitialization of leaf and fruit biomass
+ 
+    bm_alloc(ileaf) = c_leafb
+    bm_alloc(ifruit)= deltmagrain
+    !bm_alloc(icarbres) = c_reserve
+   
+ 
+    ! 4.  real allocation for each grid and each pft
+
+    ! STRATEGY: 
+    ! 1. carbon allocation priority is different for different parts;
+    ! 2. even for the same pool, the priority is changing along with time (stage revolution) 
+    
+    ! 3.1 FOR STAGE [nger, nlev]
+
+    ! the c_reserve starts to decreasing because the root growth
+    ! and we allocate all carbon into root
+
+    if ((nger .gt. 0) .and. (nlev .eq. 0)) then ! germination occured but did not emerge, during this stage only root and reserve pools
+       if ( biomass(icarbres) > 0.) then  ! adjust the reserve dynamics
+          ! addressing the c_reserve dynamics
+          bm_alloc(iroot) = biomass(icarbres)*reprac 
+          bm_alloc(icarbres) = 0. - biomass(icarbres)*reprac 
+       else
+          !c_reserve = 0.
+          bm_alloc(icarbres) = 0.
+          bm_alloc(iroot) = 0.
+       endif
+    endif
+    
+    ! 3.2 FOR STAGE [NLEV, NDRP]
+    if ((nlev .gt. 0) .and. (ndrp .eq. 0)) then 
+    ! emergence and photosynthese, whereas grain is not filling
+    ! in this stage, we keep the leaf and grain biomass
+    ! root with the higher priority
+
+       ! in this stage, the allocation of leaf and root is with higher priority
+       bm_alloc(ileaf) = c_leafb
+       bm_alloc(iroot) = reprac*bm_alloc_tot   ! root biomass
+       !bm_alloc(icarbres) = c_reserve       
+ 
+       if (c_leafb >= bm_alloc_tot) then 
+
+          if (biomass(icarbres) >= (c_leafb - bm_alloc_tot )) then ! enough for leaf and root
+             bm_alloc(ileaf) = c_leafb 
+             !c_reserve = c_reserve - (c_leafb - bm_alloc_tot)   ! leaf with the highest priority          
+             bm_alloc(icarbres) = 0. - (c_leafb - bm_alloc_tot)
+          else 
+             bm_alloc(ileaf) = bm_alloc_tot + biomass(icarbres)
+             !c_reserve = 0.
+             bm_alloc(icarbres) = 0. - biomass(icarbres)
+          end if ! keep the leaf biomass
+         
+          ! judge the remaining c_reserve
+!          if (biomass(icarbres) > reprac*bm_alloc_tot) then 
+!!!!!! xuhui: it forgot to consider the previously leaf removed carbon from the reserve
+          if ( (biomass(icarbres)+bm_alloc(icarbres)) > reprac*bm_alloc_tot) then
+             bm_alloc(iroot) = reprac*bm_alloc_tot
+             !c_reserve = c_reserve - bm_alloc(iroot)
+             ! bm_alloc(icarbres) = 0. - reprac*bm_alloc_tot             
+!!!!!! xuhui: again, need to include the leaf removal from the carbon reserve
+             bm_alloc(icarbres) = bm_alloc(icarbres) - reprac*bm_alloc_tot             
+
+          else  
+             !bm_alloc(iroot) = biomass(icarbres)
+!!!!!! xuhui: again, need to include the leaf removal already
+             bm_alloc(iroot) = biomass(icarbres) + bm_alloc(icarbres)
+             !c_reserve = 0.
+             bm_alloc(icarbres) = 0. - biomass(icarbres)
+          endif
+
+       else if ((bm_alloc(ileaf) + bm_alloc(iroot)) > bm_alloc_tot) then  ! leaf is with higher priority 
+          if (biomass(icarbres) >= (bm_alloc(ileaf) + bm_alloc(iroot)- bm_alloc_tot)) then
+             bm_alloc(ileaf) = c_leafb
+             bm_alloc(iroot) = reprac*bm_alloc_tot
+             !c_reserve = c_reserve - (bm_alloc(ileaf) + bm_alloc(iroot)-bm_alloc_tot)
+             bm_alloc(icarbres) = 0. - (bm_alloc(ileaf) + bm_alloc(iroot)- bm_alloc_tot)
+          else 
+             bm_alloc(ileaf) = c_leafb
+             bm_alloc(iroot) = bm_alloc_tot - bm_alloc(ileaf) + biomass(icarbres)
+             !c_reserve = 0.
+             bm_alloc(icarbres) = 0. - biomass(icarbres)
+          endif
+       !else if ((bm_alloc(ileaf) + bm_alloc(iroot) + bm_alloc(ifruit)) >= bm_alloc_tot) then
+       !    
+       !   bm_alloc(ileaf) = c_leafb
+       !   bm_alloc(iroot) = reprac*bm_alloc_tot
+       !   bm_alloc(ifruit) = bm_alloc_tot-bm_alloc(iroot)-bm_alloc(ileaf)
+       !   bm_alloc(ifruit) = max(0., bm_alloc(ifruit))
+       else ! 
+          bm_alloc(isapabove) = bm_alloc_tot -bm_alloc(ileaf) - bm_alloc(iroot)
+          bm_alloc(icarbres) = 0.
+       endif
+    endif
+  
+    
+    ! 3.3 STAGE [ndrp nlax] 
+    ! in this stage, the allocation of leaf and grain is with higher priority
+    ! second, root and sapwoodabove
+    ! at the same times, we put some parts into reserve
+       
+    if ((ndrp > 0) .and. (nlax == 0)) then ! from frain filling to lai plateau
+       
+       ! in this stage the c_reserve should used out
+       if ( biomass(icarbres) > 0. ) then 
+          bm_alloc(isapabove) = biomass(icarbres)
+          bm_alloc(icarbres) = 0. - biomass(icarbres) ! in this stage, the carbon reserve should be used out.
+       endif 
+
+       ! initilize the values 
+       bm_alloc(iroot) = reprac*bm_alloc_tot              
+       !bm_alloc(icarbres) = P_densitesem*pgrain ! original reserve fraction
+
+       !if (bm_alloc(ileaf) >= bm_alloc_tot) then
+       if (bm_alloc(ifruit) >= bm_alloc_tot) then
+          bm_alloc(ileaf) = 0.  
+          bm_alloc(ifruit) = deltmagrain ! keep the grain yield 
+          bm_alloc(iroot) = 0. - (deltmagrain - bm_alloc_tot)*reprac
+          bm_alloc(isapabove) = 0. - (deltmagrain - bm_alloc_tot)*(1.0 - reprac)
+          bm_alloc(icarbres) = 0.
+       else if ((bm_alloc(ileaf)+ bm_alloc(ifruit)) >= bm_alloc_tot) then  !  
+          bm_alloc(ifruit) = deltmagrain !bm_alloc_tot - bm_alloc(ileaf)
+          bm_alloc(ileaf) = bm_alloc_tot - bm_alloc(ifruit) ! remaining
+          bm_alloc(iroot) = 0.
+          bm_alloc(isapabove) = 0.
+          bm_alloc(icarbres) = 0.
+       else if ((bm_alloc(ileaf)+ bm_alloc(ifruit) + bm_alloc(iroot)) >= bm_alloc_tot) then
+          bm_alloc(ifruit) = deltmagrain
+          bm_alloc(ileaf) = c_leafb
+          bm_alloc(iroot) = bm_alloc_tot - bm_alloc(ifruit)-bm_alloc(ileaf)
+          bm_alloc(icarbres) = 0.
+          bm_alloc(isapabove) = 0.
+       !else if ((bm_alloc(ileaf)+ bm_alloc(ifruit) + bm_alloc(iroot) + bm_alloc(icarbres)) >= bm_alloc_tot) then
+       !   ! that means there is some remainings after allocating carbon to leaf, grain, and reserve.
+       !   bm_alloc(icarbres) = bm_alloc_tot - bm_alloc(ileaf)- bm_alloc(ifruit)-bm_alloc(iroot)
+       else
+          bm_alloc(ifruit) = deltmagrain
+          bm_alloc(ileaf) = c_leafb
+          bm_alloc(iroot) = reprac*bm_alloc_tot
+          !bm_alloc(icarbres) = P_densitesem*pgrain
+          bm_alloc(isapabove) = bm_alloc_tot-bm_alloc(ileaf)- bm_alloc(ifruit)- bm_alloc(iroot)
+       endif
+    endif
+
+    
+    ! 3.4 STAGE [nlax nrec]
+    ! in this stage, the allocation  of leaf is 0. Whereas, the allocation of grain and reserve is with higher priority
+    ! grain
+    ! sapwood
+    ! root
+
+    if ((nlax > 0) .and. (nrec == 0)) then ! from lai plateau to harvest
+       ! initilize the values 
+       !bm_alloc(ifruit) = magrain   ! fruit fraction
+       !bm_alloc(icarbres) = P_densitesem*pgrain ! original reserve fraction
+       !bm_alloc(ileaf) = c_leafb ! leaf fraction
+       bm_alloc(iroot) = reprac*bm_alloc_tot              
+       
+       if (bm_alloc(ifruit) >= bm_alloc_tot) then  ! highest priority
+          bm_alloc(ifruit) = deltmagrain 
+          bm_alloc(icarbres) = 0.          
+          bm_alloc(ileaf) = 0.
+          bm_alloc(iroot) = 0. - (deltmagrain - bm_alloc_tot)*reprac
+          bm_alloc(isapabove) = 0. - (deltmagrain - bm_alloc_tot)*(1.0 - reprac)
+       !else if ((bm_alloc(ifruit) + bm_alloc(icarbres)) >= bm_alloc_tot) then  ! former 
+       else if ((bm_alloc(ifruit) + bm_alloc(iroot)) >= bm_alloc_tot) then  !  
+          bm_alloc(iroot) = bm_alloc_tot - bm_alloc(ifruit)
+          bm_alloc(ileaf) = 0.
+          bm_alloc(icarbres) = 0.
+      ! else if ((bm_alloc(ifruit) + bm_alloc(icarbres) + bm_alloc(iroot))>= bm_alloc_tot) then
+      !    bm_alloc(iroot) = bm_alloc_tot- bm_alloc(ifruit)-bm_alloc(icarbres)
+      !    bm_alloc(ileaf) = 0.
+      ! else if ((bm_alloc(ifruit) + bm_alloc(icarbres) + bm_alloc(iroot) + bm_alloc(ileaf)) >= bm_alloc_tot) then 
+      !    ! that means there is some remainings after allocating carbon to leaf, grain and reserve.
+      !    bm_alloc(ileaf) = bm_alloc_tot- bm_alloc(ifruit)-bm_alloc(icarbres)-bm_alloc(iroot)
+       else 
+          ! that means NPP is enough, we 
+          !bm_alloc(isapabove) =bm_alloc_tot- bm_alloc(ifruit)-bm_alloc(icarbres)-bm_alloc(iroot) - bm_alloc(ileaf) 
+          !bm_alloc(isapabove) =bm_alloc_tot- bm_alloc(ifruit)-bm_alloc(iroot) 
+          bm_alloc(isapabove) =bm_alloc_tot- bm_alloc(ifruit)-bm_alloc(iroot) 
+       endif
+    endif
+    
+    ! 3.5 STAGE [When nrec occur]
+    ! when harvest, we alloc some carbon into reservoire pool
+    
+    if ( nrec /= 0 ) then  ! harvest occurs
+       bm_alloc(iroot) = reprac*bm_alloc_tot
+       if (bm_alloc(ifruit) >= bm_alloc_tot) then
+          bm_alloc(ifruit) = deltmagrain 
+          bm_alloc(icarbres) = 0.          
+          bm_alloc(ileaf) = 0.
+          bm_alloc(iroot) = 0. - (deltmagrain - bm_alloc_tot)*reprac
+          bm_alloc(isapabove) = 0. - (deltmagrain - bm_alloc_tot)*(1.0 - reprac)
+       else if ((bm_alloc(ifruit) + bm_alloc(iroot)) >= bm_alloc_tot) then
+          bm_alloc(iroot) = bm_alloc_tot - bm_alloc(ifruit)
+          bm_alloc(ileaf) = 0.
+          bm_alloc(icarbres) = 0.
+       else 
+          bm_alloc(isapabove) =bm_alloc_tot- bm_alloc(ifruit)-bm_alloc(iroot)
+       endif
+       ! but we have to put some carbon into reserve (seeds for the next year) 
+       c_reserve = P_densitesem*pgrain*0.48 ! seeds 
+       biomass(ifruit) =  biomass(ifruit) - c_reserve   !max(grainrem, 0.); 
+       bm_alloc(icarbres) = c_reserve
+       DO ipart = 1,nparts
+           IF (bm_alloc(ipart)<0) THEN
+               WRITE(numout,*) 'ipart :',ipart
+               WRITE(numout,*) 'bm_alloc < 0 :',bm_alloc(ipart)
+               WRITE(numout,*) 'biomass :', biomass(ipart)
+           ENDIF
+       ENDDO
+    endif
+  
+end subroutine crop_bmalloc
+
+end module crop_alloc
Index: /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_sticslai/crop_alloc.f90.new
===================================================================
--- /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_sticslai/crop_alloc.f90.new	(revision 6940)
+++ /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_sticslai/crop_alloc.f90.new	(revision 6940)
@@ -0,0 +1,319 @@
+! This subrutine is addressing the Carbon allocation for crops in combination with STICS
+! Author: Xuhui Wang
+! Date: 03/12/2014
+
+module crop_alloc
+
+! use modules
+
+USE ioipsl
+USE pft_parameters
+USE constantes
+USE netcdf
+
+IMPLICIT NONE
+
+CONTAINS
+
+subroutine crop_bmalloc(in_cycle,         &
+                      deltai,           &
+                      dltaisen,         &
+                      ssla,             &
+                      pgrain,           &
+                      deltgrain,          &
+                      reprac,           &
+                      nger,             &
+                      nlev,             &
+                      ndrp,             &
+                      nlax,             &    ! input 
+                      nrec,             &
+                      bm_alloc_tot,     &    ! input
+                      biomass,          &
+                      c_reserve,        &    ! out
+                      c_leafb,          &    ! out
+                      bm_alloc,         &    ! inout
+                      P_densitesem,     &
+                      P_pgrainmaxi,     &
+                      P_tigefeuil,     &
+                      P_slamax,        &
+                      slai)               ! parameter
+
+   !USE ioipsl
+   !USE pft_parameters
+   !USE constantes
+   
+   ! Declaration part
+   
+   ! 0.0 INPUT PART
+   LOGICAL, INTENT(IN)                 :: in_cycle            
+   REAL(r_std),  INTENT(IN)            :: deltai         ! lai increment  // unit in m2 m-2
+   REAL(r_std),  INTENT(IN)            :: dltaisen       ! lai senescence  // unit in m2 m-2
+   REAL(r_std),  INTENT(IN)            :: ssla           ! sla from STICS // unit in g cm -2
+   REAL(r_std),  INTENT(IN)            :: pgrain         ! weight per grain (dry matter, but not carbon)  // g
+   REAL(r_std),  INTENT(IN)            :: deltgrain        ! grain yield increment (dry matter but not carbon)  // unit g c / m2
+   REAL(r_std),  INTENT(IN)            :: reprac 
+   INTEGER(i_std),  INTENT(IN)            :: nger
+   INTEGER(i_std),  INTENT(IN)            :: nlev 
+   INTEGER(i_std),  INTENT(IN)            :: ndrp
+   INTEGER(i_std), INTENT(IN)            :: nlax
+   INTEGER(i_std), INTENT(IN)            :: nrec
+   REAL(r_std), INTENT(IN)             :: bm_alloc_tot   ! unit in g m-2 
+   REAL(r_std),  INTENT(IN)            :: P_densitesem
+   REAL(r_std),  INTENT(IN)            :: P_tigefeuil
+   REAL(r_std),  INTENT(IN)            :: P_pgrainmaxi
+   REAL(r_std),  INTENT(IN)            :: P_slamax
+   REAL(r_std), DIMENSION(nparts), INTENT(INOUT)             :: biomass   ! unit in g m-2 
+   
+   ! 1.0 INOUT PART
+
+   REAL(r_std), INTENT(INOUT)            ::c_reserve  ! crop reserve 
+   REAL(r_std), INTENT(INOUT)            ::c_leafb ! crop leaf biomass derived from STICS
+   REAL(r_std), INTENT(INOUT)            ::slai ! stics simulated lai
+   REAL(r_std), DIMENSION(nparts), INTENT(INOUT)            ::bm_alloc ! crop leaf biomass derived from STICS
+   
+   ! 2.0 local 
+   REAL(r_std)      ::  grainrem   ! daily grain minus reservoir, the remaining carbon
+   REAL(r_std)      ::  deltmagrain   ! daily grain/ (unit in carbon)
+   INTEGER(i_std)   :: ipart
+   REAL(r_std)      :: tempalloc
+   REAL(r_std)      :: tempdlai
+   REAL(r_std)      :: netdeltai
+   REAL(r_std)      :: temprest
+   REAL(r_std)      :: maxremobi,sla0,sla1,remobi
+   LOGICAL, PARAMETER :: mydebug=.TRUE.
+
+
+    ! Part one: conversion from biomass(dry matter) to carbon
+    deltmagrain = deltgrain*0.48
+
+    ! STRATEGY: 
+    ! We keep the leaf biomass, grain and reprac from STICS 
+    ! Total available biomass for allocation is dltams and cropreserv. 
+
+    !IF (bavard .GE. 3) WRITE(numout,*) 'Entering crop alloc'
+    
+    ! 1. whether or not necessary to enter into this process
+    
+    if (.not. in_cycle) return   ! if not yet into the crop cycle or finish the cycle
+
+    ! 1. initialize the bm_alloc (biomass allocation)
+    !
+
+    bm_alloc(:) = 0.      ! 8 parts
+       
+    ! 2.  leaf biomass from STICS 
+    ! in this subroutine, we USED the Leaf biomass and GRAIN yield, the leaf biomass and grain production is adjusted accoring to different stages (in detail see leaf and grain processes)
+    c_leafb = 0.
+    if (in_cycle) then
+       if (deltai > 0.) then  ! just for leaf growth period
+           c_leafb = deltai/ssla*10000.0*0.48
+       elseif (netdeltai < 0.) then
+           c_leafb = deltai/ssla*10000.0*0.48
+       else
+           c_leafb = 0.
+       endif
+    else
+       c_leafb = 0.
+    endif
+    netdeltai = deltai - dltaisen
+  
+    
+    ! 3. reinitialization of leaf and fruit biomass
+    if (biomass(ileaf) .gt. 0) then
+        sla0 = slai/biomass(ileaf)
+    else
+        sla0 = P_slamax
+    endif
+    bm_alloc(ileaf) = c_leafb - dltaisen/sla0
+    if (bm_alloc(ileaf)<0 .and. biomass(ileaf)+bm_alloc(ileaf)<0) then
+        bm_alloc(ileaf) = -biomass(ileaf)
+    endif
+    bm_alloc(ifruit)= deltmagrain
+    bm_alloc(iroot) = bm_alloc_tot * reprac
+    if (reprac .GE. 1.) then
+       write(numout,*) 'reprac > 1: ',reprac
+       stop
+    endif
+    bm_alloc(isapabove) = P_tigefeuil * c_leafb
+    bm_alloc(icarbres) = 0.
+
+    if (mydebug) then
+        write(numout,*) 'xuhui, alloc initial:'
+        write(numout,*) 'biomass(ileaf) ', biomass(ileaf)
+        write(numout,*) 'slai ', slai
+        write(numout,*) 'sla0 ', sla0
+        write(numout,*) 'deltai ', deltai
+        write(numout,*) 'dltaisen ', dltaisen
+        write(numout,*) 'reprac ', reprac
+        write(numout,*) 'deltmagrain ', deltmagrain
+        write(numout,*) 'P_tigefeuil ', P_tigefeuil
+        write(numout,*) 'bm_alloc_tot ', bm_alloc_tot
+        write(numout,*) 'bm_alloc(ileaf,isapabove,iroot,ifruit) '
+        write(numout,*)  bm_alloc(ileaf), bm_alloc(isapabove), bm_alloc(iroot), bm_alloc(ifruit)
+        write(numout,*) 'nger nlev nlax ndrp nrec '
+        write(numout,*)  nger, nlev, nlax, ndrp,  nrec
+        write(numout,*) 'biomass(ileaf, isapabove, iroot, ifruit, icarbres) '
+        write(numout,*)  biomass(ileaf), biomass(isapabove), biomass(iroot), biomass(ifruit), biomass(icarbres)
+    endif
+    
+    ! it is possible that bm_alloc(ileaf) is negative
+ 
+    ! 4.  real allocation for each grid and each pft
+
+
+    ! STRATEGY: 
+    ! 1. carbon allocation priority is different for different parts;
+    ! 2. even for the same pool, the priority is changing along with time (stage revolution) 
+    
+    ! 3.1 FOR STAGE [nger, nlev]
+
+    ! the c_reserve starts to decreasing because the root growth
+    ! and we allocate all carbon into root
+
+    if ((nger .gt. 0) .and. (nlev .eq. 0)) then ! germination occured but did not emerge, during this stage only root and reserve pools
+       if ( biomass(icarbres) > 0.) then  ! adjust the reserve dynamics
+          ! addressing the c_reserve dynamics
+          bm_alloc(iroot) = biomass(icarbres)*reprac 
+          bm_alloc(icarbres) = 0. - biomass(icarbres)*reprac 
+          bm_alloc(ileaf) = 0.
+          bm_alloc(isapabove) = 0.
+          bm_alloc(ifruit) = 0.
+       else
+          !c_reserve = 0.
+          bm_alloc(icarbres) = 0.
+          bm_alloc(iroot) = 0.
+          bm_alloc(ileaf) = 0.
+          bm_alloc(isapabove) = 0.
+          bm_alloc(ifruit) = 0.
+       endif
+    endif
+    
+    ! 3.2 FOR STAGE [NLEV, NDRP)
+    if ((nlev .gt. 0) .and. (ndrp .eq. 0)) then 
+    ! emergence and photosynthese, whereas grain is not filling
+    ! in this stage, we keep the leaf and grain biomass
+    ! root with the higher priority
+        tempalloc =  bm_alloc(ileaf)+bm_alloc(iroot)+bm_alloc(isapabove)
+        bm_alloc(ifruit) = 0.
+        if (tempalloc > bm_alloc_tot) then
+            if (tempalloc < bm_alloc_tot + biomass(icarbres)) then                
+                biomass(icarbres) = biomass(icarbres) - (tempalloc - bm_alloc_tot)
+            else ! new c + c reserve is insufficient to meet the demand
+                if (biomass(icarbres)<0) biomass(icarbres) = 0.
+                bm_alloc(iroot) = reprac * bm_alloc_tot
+                tempdlai = (bm_alloc_tot + biomass(icarbres) - bm_alloc(iroot))/(1+P_tigefeuil)*ssla/10000.0/0.48
+                bm_alloc(ileaf) = tempdlai/ssla*10000.0*0.48
+                bm_alloc(isapabove) = P_tigefeuil*bm_alloc(ileaf)
+                if (netdeltai > tempdlai) then
+                    slai = slai - (netdeltai - tempdlai)
+                endif
+            endif
+        else
+            bm_alloc(icarbres) = bm_alloc_tot - tempalloc
+        endif
+!        if (bm_alloc(ileaf)<0) then ! remobilize the leaf biomass for future use (grain mainly)
+!           bm_alloc(icarbres) = bm_alloc(icarbres) - bm_alloc(ileaf)
+!        endif
+    endif
+  
+    
+    ! 3.3 STAGE [ndrp nrec) 
+    ! in this stage, there is potentially competition between leaf and fruit,
+    ! conserve root/shoot ratio, fulfil grain first, reduce deltai when necessary
+    ! note that leaf growth stop at nlax, grain filling stop at nmat
+    ! no fundamental differences exist for [nlax, nrec)
+       
+    if ((ndrp .gt. 0) .and. (nrec .eq. 0)) then ! from frain filling to lai plateau
+       tempalloc =  bm_alloc(ileaf)+bm_alloc(ifruit)+bm_alloc(iroot)+bm_alloc(isapabove)
+
+       if (tempalloc > bm_alloc_tot) then
+           if (tempalloc < bm_alloc_tot + biomass(icarbres)) then ! use c reserval
+               biomass(icarbres) = biomass(icarbres) - (tempalloc - bm_alloc_tot)
+           else ! new c + c reserval is insufficient to meet the demand
+               if (biomass(icarbres)<0) biomass(icarbres) = 0.
+               bm_alloc(iroot) = reprac * bm_alloc_tot
+               if (bm_alloc(ileaf)>=0) then
+                   temprest = bm_alloc_tot + biomass(icarbres) - bm_alloc(iroot)
+               else ! bm_alloc(ileaf) < 0 
+                   temprest = bm_alloc_tot + biomass(icarbres) - bm_alloc(ileaf) - bm_alloc(iroot)
+               endif
+               if (temprest < bm_alloc(ifruit)) then ! if not sufficient for grain alone
+                   if (nlax .gt. 0) then ! remobilize some carbon from leaf
+                       sla0 = slai/biomass(ileaf)*10000.0*0.48 ! m2/gC --> cm2/g drymass
+                       sla1 = min(sla0+10,P_slamax)
+                       maxremobi = slai/(sla0/0.48/10000.0) - slai/(sla1/0.48/10000)   !cm2/g --> m2/gC
+                       remobi = min(maxremobi, bm_alloc(ifruit)-temprest)
+                       
+                       bm_alloc(ifruit) = temprest + remobi
+                       bm_alloc(ileaf) = min(bm_alloc(ileaf),0.) - remobi
+                       ! when bm_alloc(ileaf)<0, further remove remobi
+                       ! when bm_alloc(ileaf)>0, then stop the planned location to lai
+                       bm_alloc(isapabove) = 0.
+                   else
+                       bm_alloc(ifruit) = temprest
+                       bm_alloc(ileaf) = min(0., bm_alloc(ileaf))
+                       bm_alloc(isapabove) = 0.
+                       if (netdeltai>0) then
+                           slai = slai - netdeltai
+                       endif
+                   endif
+               else !temprest >= bm_alloc(ifruit)
+                   if (bm_alloc(ileaf)<0) then ! the rest is left in reserval
+                       bm_alloc(icarbres) = temprest - bm_alloc(ifruit)
+                   else !  the rest goes to leaf
+                       tempdlai = (temprest - bm_alloc(ifruit))/(1+P_tigefeuil)*ssla/10000.0/0.48
+                       bm_alloc(ileaf) = tempdlai/ssla*10000.0*0.48
+                       bm_alloc(isapabove) = P_tigefeuil*bm_alloc(ileaf)
+                       if (netdeltai > tempdlai) then ! which is almost guarantee because bm_alloc(ileaf)>0
+                           slai = slai - (netdeltai - tempdlai)
+                       endif
+                   endif
+               endif
+           endif
+       else
+           bm_alloc(icarbres) = bm_alloc_tot - tempalloc
+       endif   
+    endif
+
+    
+    ! 3.5 STAGE [When nrec occur]
+    ! when harvest, we alloc some carbon into reservoire pool
+    
+    if ( nrec .gt. 0 ) then  ! harvest occurs
+    ! only allocate to root & grain
+       bm_alloc(isapabove) = 0.
+       if (bm_alloc(ileaf)<0)  then
+           tempalloc =  bm_alloc(ifruit) + bm_alloc(iroot) + bm_alloc(ileaf)
+       else !bm_alloc(ileaf)>0 ! this should be a buggy boundary condition
+           bm_alloc(ileaf) = 0.
+           tempalloc = bm_alloc(ifruit) + bm_alloc(iroot)
+       endif
+
+       if (tempalloc >= bm_alloc_tot) then !no enough c
+          bm_alloc(ifruit) = bm_alloc_tot - bm_alloc(iroot)
+          bm_alloc(icarbres) = 0.          
+       else 
+          bm_alloc(icarbres) =bm_alloc_tot - tempalloc
+       endif
+       ! but we have to put some carbon into reserve (seeds for the next year) 
+       c_reserve = P_densitesem*pgrain*0.48 ! seeds 
+       biomass(ifruit) =  biomass(ifruit) - c_reserve   !max(grainrem, 0.); 
+       bm_alloc(icarbres) = c_reserve
+       DO ipart = 1,nparts
+           IF (bm_alloc(ipart)<0) THEN
+               WRITE(numout,*) 'ipart :',ipart
+               WRITE(numout,*) 'bm_alloc < 0 :',bm_alloc(ipart)
+               WRITE(numout,*) 'biomass :', biomass(ipart)
+           ENDIF
+       ENDDO
+    endif
+
+    if (mydebug)  then
+        write(numout,*) 'xuhui, leaving crop_alloc'
+        write(numout,*) 'bm_alloc(ileaf,isapabove,iroot,ifruit,icarbres) '
+        write(numout,*)  bm_alloc(ileaf), bm_alloc(isapabove), bm_alloc(iroot), bm_alloc(ifruit), bm_alloc(icarbres)
+    endif
+  
+end subroutine crop_bmalloc
+
+end module crop_alloc
Index: /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_sticslai/gel.f90
===================================================================
--- /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_sticslai/gel.f90	(revision 6940)
+++ /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_sticslai/gel.f90	(revision 6940)
@@ -0,0 +1,86 @@
+! ****************************************************************
+!   1) entre P_tdebgel (0 degrees C) et tgel10 : GEL varie de 1.0 à 0.9
+!   2) entre tgel10 et tgel90        : GEL varie de 0.9 à 0.1
+!   3) entre tgel90 et P_tletale       : GEL varie de 0.1 à 0.0
+! ****************************************************************
+! ml_com !
+! *-----------------------------------------------------------------------------------------------------------------------------------------------------------* c!
+!! This function calculates the frost index according to the temperatures
+!> - tdebgel, corresponding to the beginning of frost damage
+!> - tgel10, corresponding to 10 % of frost damages
+!> - tgel90, corresponding to 90 % of frost damages
+!> - tletale, corresponding to the lethal temperature for the plant
+! *-----------------------------------------------------------------------------------------------------------------------------------------------------------* c!
+
+
+module Divers_gel
+
+USE Stics
+
+IMPLICIT NONE 
+PRIVATE
+PUBLIC GEL
+
+contains
+
+  real function GEL(codegel,t,tgel90,tgel10)
+  
+    implicit none
+    
+  !: Arguments
+    integer, intent(IN) :: codegel  
+    real,    intent(IN) :: t  
+    !real,    intent(IN) :: P_tletale  !> // PARAMETER // lethal temperature for the plant // degree C // PARPLT // 1
+    !real,    intent(IN) :: P_tdebgel  !> // PARAMETER // temperature of frost beginning // degree C // PARPLT // 1
+    real,    intent(IN) :: tgel10  
+    real,    intent(IN) :: tgel90  
+  
+  !: Variables locales
+    real :: a  !>  
+    real :: b  
+        
+        !: Pas de stress si codegel = 1
+        if (codegel == 1) then
+          GEL = 1.
+          return
+        endif
+  
+        !: Si t > P_tdebgel : pas de GEL
+        if (t >= P_tdebgel) then
+          GEL = 1.
+          return
+        endif
+        
+        !: De P_tdebgel à tgel10
+        if (t < P_tdebgel .and. t >= tgel10 .and. tgel10 < P_tdebgel) then
+          a = (0.9 - 1.0) / (tgel10 - P_tdebgel)
+          b = 1.0 - (a * P_tdebgel)
+          GEL = (a * t) + b
+          return
+        endif
+  
+        !: De tgel10 à tgel90
+        if (t < tgel10 .and. t >= tgel90 .and. tgel90 < tgel10) then
+          a = (0.9 - 0.1) / (tgel10 - tgel90)
+          b = 0.9 - (a * tgel10)
+          GEL = (a * t) + b
+          return
+        endif
+        
+        !: De tgel90 à P_tletale
+        if (t < tgel90 .and. t >= P_tletale .and. P_tletale < tgel90) then
+          a = (0. - 0.1) / (P_tletale - tgel90)
+          b = 0. - (a * P_tletale)
+          GEL = (a * t) + b
+          return
+        endif
+        
+        !: En dessous de P_tletale
+        if (t < P_tletale) then
+          GEL = 0.
+          return
+        endif
+        
+  return
+  end function GEL 
+end module Divers_gel 
Index: /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_sticslai/grain.f90
===================================================================
--- /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_sticslai/grain.f90	(revision 6940)
+++ /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_sticslai/grain.f90	(revision 6940)
@@ -0,0 +1,334 @@
+! ******************************************************** c
+! * - derniere modif le 28/06/01                         * c
+! * - version 3.3 18/03/98                               * c
+! * - dernière modif le 22/5/98  paramétrage de P_irmax    * c
+! * - derniere modif le 17/11/00     magrain constant    * c
+! * - derniere modif le 08/04/01     GEL                 * c
+! * - derniere modif le 02/05        sucre,huile         * c
+! * - derniere modif dr 25/10/05 pb proteines            * c
+! ******************************************************** c
+!> Calculation of the number and filling of organs for harvest in the case of plants with determinate growth.
+!> - Stics book paragraphe 4,1, page 74-76
+!>
+!> In the case of plants with determinate growth, the hypothesis is made that the number and filling of organs for harvest do not depend on the other
+!! organs growth requirements. The number of grains is fixed during a phase of variable duration (nbjgrain in days), which precedes the onset of filling (IDRP).
+!! This number depends on the mean growth rate of the canopy during this period (vitmoy in gm-2d-1), which in turns depends on dynamics specific to the
+!! particular species.
+!>
+!> The number of grains per m2 (nbgrains) is defined at the IDRP stage. It depends on the growth variable (vitmoy in g m-2) that integrates the effect of the
+!! prevailing stresses during the period preceding the IDRP stage, on two species-dependent parameters cgrain (in g-1 m2) and nbgrmin (grains m-2) and a
+!! genetic-dependent parameter nbgrmax (grains m-2).  The last two parameters define the limits of variation of nbgrains.
+!! After the IDRP stage, the grain number can be reduced in the event of frost and the daily proportion of grains affected is (1-fgelflo), whatever their
+!! state of growth. The corresponding weight (pgraingel in gm-2) is deducted from the grain weight, using the elementary current grain weight (pgrain in g).
+!>
+!> The quantity of dry matter accumulated in grains is calculated by applying a progressive "harvest index" to the dry weight of the plant.
+!! This ircarb index increases linearly with time (vitircarb in g grain g biomass 1 d-1), from the IDRP stage to the IMAT stage and the final harvest index
+!! is restricted to the irmax parameter. Yet this dynamics may not be the actual grain filling dynamics since threshold translocation temperatures defining
+!! the thermal stress ftempremp (tminremp and tmaxremp) may stop the carbon filling of harvested organs.
+!! Consequently the grain filling is calculated daily (dltags in t ha-1) to allow the effect of the thermal stress and then accumulated within the
+!! mafruit (in t ha-1) variable. The mass of each grain is then calculated as the ratio of the mass to the number of grains, although this cannot exceed
+!! the genetic pgrainmaxi limit.
+!-----------------------------------------------------------------------------------------------
+!subroutine grain(n,ndrp,nrec,nlev,nrecbutoir,P_nbjgrain,dltams,P_cgrain,P_cgrainv0, & ! IN
+!                 P_nbgrmin,P_nbgrmax,P_codazofruit,P_codeinnact,inns,fgelflo,P_codeir,  & ! IN
+!                 P_vitircarb,P_irmax,P_vitircarbT,somcourdrp,nmat,masec,P_codetremp,  & ! IN
+!                 tcultmin,tcultmax,P_tminremp,P_tmaxremp,P_pgrainmaxi,              & ! IN
+!                 ircarb,nbgrains,pgrain,CNgrain,vitmoy,nbgraingel,pgraingel,  & ! INOUT
+!                 dltags,ftempremp,magrain,nbj0remp,pdsfruittot)                 ! INOUT
+
+
+subroutine grain(n,vday_counter, dltams, nflo, ndrp,nrec,nlev,nrecbutoir, & ! IN
+                 somcourdrp,nmat,masec, pdmasec, tcultmin, tcultmax,  & ! IN
+                 v_dltams, fgelflo, pdircarb, ircarb, nbgrains, pgrain, vitmoy,nbgraingel,pgraingel,  & ! INOUT
+                 dltags,ftempremp,magrain, pdmagrain, nbj0remp,pdsfruittot, deltgrain, & ! INOUT
+                 P_nbjgrain, P_codeplante, P_codgelflo, P_tgelflo10, P_tgelflo90, P_cgrain, P_cgrainv0, &
+                 P_nbgrmax, P_nbgrmin, P_codazofruit, P_codeinnact, P_codeir, P_vitircarb, P_irmax, P_vitircarbT, &
+                 P_codetremp, P_tminremp, P_tmaxremp, P_pgrainmaxi)                 ! IN, parameter
+
+  !USE Messages
+  USE constantes
+  USE Divers_gel
+
+
+  implicit none
+
+!: Arguments
+
+  integer, intent(IN)    :: n     ! date // actually stomate slow step  
+  integer, intent(IN)    :: vday_counter ! day_counter but not be reinitilized  
+  real,    intent(IN)    :: dltams !//unit with t ha-1 j-1 
+  integer, intent(IN)    :: nflo  
+  integer, intent(IN)    :: ndrp  
+  integer, intent(IN)    :: nrec  
+  integer, intent(IN)    :: nlev  
+  integer, intent(IN)    :: nrecbutoir  
+  integer, intent(IN)    :: P_nbjgrain  !> // PARAMETER // Period to compute NBGRAIN // days // PARPLT // 1 
+  character, intent(IN)  :: P_codeplante ! //parameter
+  integer,     intent(IN)   :: P_codgelflo  ! 
+  real,     intent(IN)   :: P_tgelflo10 ! 
+  real,     intent(IN)   :: P_tgelflo90  ! 
+  !real,    intent(IN)    :: dltams(ndrp) ! ndrp-P_nbjgrain+1 to ndrp    // OUTPUT // Growth rate of the plant  // t ha-1.j-1
+  real,    intent(IN)    :: P_cgrain  !> // PARAMETER // slope of the relationship between grain number and growth rate  // grains gMS -1 jour // PARPLT // 1 
+  real,    intent(IN)    :: P_cgrainv0  !> // PARAMETER // number of grains produced when growth rate is zero // grains m-2 // PARPLT // 1 
+  real,    intent(IN)    :: P_nbgrmin  !> // PARAMETER // Minimum number of grain // grains m-2  // PARPLT // 1 
+  real,    intent(IN)    :: P_nbgrmax  !> // PARAMETER // Maximum number of grain // grains m-2 // PARPLT // 1 
+  integer, intent(IN)    :: P_codazofruit  !> // PARAMETER // option of activation of the direct effect of the nitrogen plant status upon the fruit/grain number // code 1/2 // PARPLT // 0 
+  integer, intent(IN)    :: P_codeinnact  !> // PARAMETER // code activating  nitrogen stress effect on the crop: yes (1), no (2) // code 1/2 // PARAM // 0 
+  !!real,    intent(IN)    :: inns   !> // OUTPUT // Index of nitrogen stress active on growth in biomass // P_innmin to 1
+  integer, intent(IN)    :: P_codeir  !> // PARAMETER // option of computing the ratio grain weight/total biomass: proportional to time(1), proportional to sum temperatures (2) // code 1/2 // PARPLT // 0 
+  real,    intent(IN)    :: P_vitircarb  !> // PARAMETER // Rate of increase of the carbon harvest index // g grain g plant -1 day-1 // PARPLT // 1 
+  real,    intent(IN)    :: P_irmax  !> // PARAMETER // Maximum harvest index // SD // PARPLT // 1 
+  real,    intent(IN)    :: P_vitircarbT  !> // PARAMETER // Heat rate of increase of the carbon harvest index  // g grain g plant-1 degree.day-1 // PARPLT // 1 
+  real,    intent(IN)    :: somcourdrp  
+  integer, intent(IN)    :: nmat  
+
+  !real,    intent(IN)    :: masec(0:1)  ! n-1 (0) & n (1)    // OUTPUT // Aboveground dry matter  // t.ha-1
+  real,    intent(IN)    :: masec  ! // Aboveground dry matter  // t.ha-1
+  real,    intent(IN)    :: pdmasec  ! // Aboveground dry matter of previous day  // t.ha-1
+
+  integer, intent(IN)    :: P_codetremp  !> // PARAMETER // option of heat effect on grain filling: yes (2), no (1) // code 1/2 // PARPLT // 0 
+  real,    intent(IN)    :: tcultmin  
+  real,    intent(IN)    :: tcultmax   !> // OUTPUT // Crop surface temperature (daily maximum) // degree C
+  real,    intent(IN)    :: P_tminremp  !> // PARAMETER // Minimal temperature for grain filling // degree C // PARPLT // 1
+  real,    intent(IN)    :: P_tmaxremp  !> // PARAMETER // maximal temperature for grain filling // degree C // PARPLT // 1
+  real,    intent(IN)    :: P_pgrainmaxi  !> // PARAMETER // Maximum weight of one grain (at 0% water content) // g // PARPLT // 1
+  !
+
+  !! INOUT 
+  real, dimension(0:vlength-1),  intent(INOUT) :: v_dltams   !biomass increment during a time period before ndrp, the length is according to P_nbjgrain  
+  real,    intent(INOUT) :: fgelflo   !> // Frost index on the number of fruits // 0-1
+  !real,    intent(INOUT) :: ircarb(0:1)   ! n-1 (0) & n (1)    // OUTPUT // Carbon harvest index // g  grain g plant-1
+  real,    intent(INOUT) :: pdircarb   !ircarb of previous day     // OUTPUT // Carbon harvest index // g  grain g plant-1
+  real,    intent(INOUT) :: ircarb   ! // Carbon harvest index // g  grain g plant-1
+
+  real,    intent(INOUT) :: nbgrains ! grains per square meter grains m-2 
+  real,    intent(INOUT) :: pgrain ! weight per grain // unit in g m-2 
+  !real,    intent(INOUT) :: CNgrain   !> // OUTPUT // Nitrogen concentration of grains  // %
+  real,    intent(INOUT) :: vitmoy   !> // OUTPUT // mean growth rate of the canopy (dans le livre c'est en g mais ca colle pas)  // g.m-2.d-1
+  real,    intent(INOUT) :: nbgraingel  
+  real,    intent(INOUT) :: pgraingel  
+  real,    intent(INOUT) :: dltags   !> // OUTPUT // Growth rate of the grains  // t ha-1.j-1
+  real,    intent(INOUT) :: ftempremp  
+  !real,    intent(INOUT) :: magrain(0:1)  ! n-1 (0) & n (1)! dry matter of the grain
+  real,    intent(INOUT) :: magrain  ! accumulated dry matter of the grain // unit is in g m-2
+  real,    intent(INOUT) :: pdmagrain  ! dry matter of the grain of the previous day // unit is in g m-2
+    
+  integer, intent(INOUT) :: nbj0remp   !> // OUTPUT // Number of shrivelling days //
+  real,    intent(INOUT) :: pdsfruittot  
+  
+  !! output
+  real,    intent(OUT) :: deltgrain  
+  !
+!:! Variables locales
+  integer :: ng  
+  real    :: tefficace  
+
+      
+
+
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
+      !>> PART ONE      
+      ! Here, we preparing the dltams for period: ndrp-P_nbjgrain+1 to ndrp
+     
+      v_dltams(MOD(vday_counter, P_nbjgrain)) = dltams 
+   
+      !>> PART TWO
+      ! Here, we calculate the gel effects on grain production 
+
+      if (P_codeplante /= 'snu') then
+         if (nflo > 0 .and. nmat == 0) then  ! from flowering to mature 
+           fgelflo = GEL(P_codgelflo,tcultmin,P_tgelflo90,P_tgelflo10)
+         else
+           fgelflo = 1.0
+           !if (fgelflo < 1.) gelee = .TRUE.
+         endif
+         !if (gelee .eqv. .TRUE.) nbjgel = nbjgel + 1
+      endif
+
+
+      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>  
+      !>> PART THREE
+      ! Here, we calculate the grain production 
+
+      if (ndrp == 0 .or. (nrec > 0 .and. n > nrec)) then
+        !ircarb(1) = 0.0
+        ircarb = 0.0
+        return
+      endif
+      
+
+      !: Attention incohérence entre tsol qui interdit la levée et tair qui amène à drp
+      ! in case of the following situation, the simulation is wrong. 
+      if (ndrp > 0 .and. nlev == 0) then
+        !call EnvoyerMsgHistorique(51)
+        !call EnvoyerMsgHistorique(52)
+        stop
+      endif
+
+      !: Modif NB - 20/08/97
+      !- Si la date de récolte butoir intervient avant le début remplissage,
+      !- pas de grain.
+      if (ndrp == nrecbutoir) then
+        nbgrains = 0.0 ! number of grains 
+        pgrain   = 0.0 ! weight per grain
+        !CNgrain  = 0.0
+        return
+      endif
+   
+      
+      !: Calcul du nombre de grain
+      if (n == ndrp) then
+      
+        !: Calcul de la vitesse de croissance moyenne P_nbjgrain avant ndrp
+        !- NB - 08/04 : nbgrains remplacé par nbgrainpot
+        vitmoy = 0.0
+        ng = ndrp - P_nbjgrain + 1
+        ! 
+        !vitmoy = SUM(dltams(ng:ndrp))
+        vitmoy = SUM(v_dltams(1:P_nbjgrain))
+        vitmoy = vitmoy / P_nbjgrain * 100    ! unit in g m-2 d-1
+
+        !: nbgrains devient variétal avec P_nbgrmax
+        nbgrains = ((P_cgrain * vitmoy) + P_cgrainv0) * P_nbgrmax
+
+
+
+        !: Seuillage de nbgrains
+        nbgrains = max(nbgrains, P_nbgrmin)
+        nbgrains = min(nbgrains, P_nbgrmax)
+
+
+        !: Option P_codazofruit, addressing the direct effects of nitrogen on grain
+        if (P_codazofruit == 2 .and. P_codeinnact == 1) then
+          nbgrains = nbgrains * inns ! inns is a constance
+        endif
+      else
+        !: Dégats de GEL
+        if (fgelflo < 1.0) then
+          nbgraingel = nbgrains * (1.0 - fgelflo)
+        else
+          nbgraingel = 0.0
+        endif
+        pgraingel = (pgrain * nbgraingel) + pgraingel
+        nbgrains = nbgrains - nbgraingel
+
+
+        !: vitmoy est en g m-2 day-1
+        if (P_codeir == 1) then
+          ircarb = P_vitircarb * (n - ndrp + 1)
+          ircarb = min(ircarb, P_irmax)
+          !ircarb(1) = P_vitircarb * (n - ndrp + 1)
+          !ircarb(1) = min(ircarb(1), P_irmax)
+        endif
+
+        if (P_codeir == 2) then
+          ircarb = P_vitircarbT * somcourdrp
+          !ircarb(1) = P_vitircarbT * somcourdrp
+        endif
+
+
+        !: domi - 29/10/05: irazo deplacé dans Ngrain sinon on a pas la valeur
+        !-                  de qnplante qui est calculée dans stressn
+
+
+        if (nmat == 0 .or. n == nmat) then
+          !: Vitesse de remplissage du grain unit in t/ha
+          dltags = ircarb * masec      &
+                 - pdircarb * pdmasec
+
+          !dltags = ircarb(1) * masec(1)      &
+          !       - ircarb(0) * masec(0)
+          !: Effet température
+          ftempremp = 1.0
+          if (P_codetremp == 1) then
+            !: NB - Ajout d'un compteur jours sans remplissage
+
+            !: pour les mini
+            tefficace = tcultmin
+            
+            if (tefficace <= P_tminremp) then
+              magrain = pdmagrain
+              !magrain(1) = magrain(0)
+              ftempremp = 0.0
+              dltags = 0.0
+              nbj0remp = nbj0remp + 1
+            endif
+
+            !: pour les maxi
+            tefficace = tcultmax
+            if (tefficace >= P_tmaxremp) then
+              magrain = pdmagrain
+              !magrain(1) = magrain(0)
+              ftempremp = 0.0
+              dltags = 0.0
+              nbj0remp = nbj0remp + 1
+            endif
+          endif
+    
+          !: Le carbone des grains
+          !- NB - le 23/05 : suppression des grains gelés
+          !- NB - passage par dltags pour echaudage actif - le 11/01/02
+          !-- magrain(1) = ircarb(1)*masec(n)*100 - pgraingel
+
+          !- DR et AIG, on a trouvé un bug :
+          !- On enlevait chaque jour le cumul du poids de grain gelé
+          !- au lieu du poids de grain gelé du jour et ce meme apres
+          !- que le gel soit fini d'ou diminution
+          !- notable du rdt (dixit aig)
+          magrain = pdmagrain + (dltags * 100) - (pgrain * nbgraingel)
+          !magrain(1) = magrain(0) + (dltags * 100) - (pgrain * nbgraingel)
+          magrain = max(magrain, 0.0)
+          !magrain(1) = max(magrain(1), 0.0)
+          if (magrain > P_pgrainmaxi * nbgrains) then
+          !if (magrain(1) > P_pgrainmaxi * nbgrains) then
+            magrain = P_pgrainmaxi * nbgrains
+            !magrain(1) = P_pgrainmaxi * nbgrains
+            dltags = 0.0
+          endif
+          if (nbgrains > 0.0) then
+            pgrain = magrain / nbgrains
+            !pgrain = magrain(1) / nbgrains
+          else
+            pgrain = 0.0
+          endif
+          ! les calculs d'azote dans les grains ont ete deplacé dans Ngrain
+        endif
+
+        !: Entre maturité et récolte
+        !- DR - 050506 : Dans le cas où on repousse la recolte,
+        !-               on doit pourvoir garder masec.
+        !-- if (nrec == 0 .and. nmat > 0) then
+        if ((nrec == 0 .or. nrec == -999) .and. nmat > 0) then
+           magrain = pdmagrain
+           !magrain(1) = magrain(0)
+        endif
+        
+        if (nmat > 0 .and. nrec > 0 .and. n < nrec) magrain = pdmagrain
+    
+        if (n == nrec) magrain = pdmagrain
+        
+        
+        
+        pdsfruittot = magrain
+        !pdsfruittot = magrain(1)
+
+      endif
+
+      ! transfication between dry matter and carbon 
+      ! according to PC GBC (2007)
+     
+      ! transfer dry matter of grain to carbon
+
+      magrain = magrain
+      
+      deltgrain = magrain - pdmagrain ! this is the deltgrain
+
+  
+      pdircarb = ircarb 
+      pdmagrain = magrain   ! get the pdmagrain        
+      ! 
+       
+return
+end
+ 
+ 
Index: /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_sticslai/reprac_calc.f90
===================================================================
--- /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_sticslai/reprac_calc.f90	(revision 6940)
+++ /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_sticslai/reprac_calc.f90	(revision 6940)
@@ -0,0 +1,286 @@
+!>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>!
+!> Purpose of this subroutine: addressing the shoot/root partitioning <!
+!> Author: Xiuchen Wu                                                 <!
+!> Date  : 31/07/2013                                                 <!
+
+
+subroutine reprac_calc(n, nsen, nlax, nflo, nmat, nrec, nplt, in_cycle, nger, tcult, nlev, &      ! IN
+                     zrac, repracmax, repracmin, kreprac, somtemprac, urac, reprac, nstoprac, &     ! inout
+                  P_stoprac, P_codeperenne, P_codehypo, P_codegermin,P_zracplantule, P_profsem, P_codtrophrac,  &
+                  P_repracpermax, P_repracpermin, P_krepracperm, P_repracseumax, P_repracseumin, P_krepracseu,  &
+                  P_codetemprac, P_tcmin, P_tcmax, P_codedyntalle, P_tcxstop, P_stlevamf, P_stamflax)     ! parameter
+
+! USE Stics
+
+! DECLARATION PART
+!
+! 0.0  INPUT  
+!  
+
+integer, intent(IN)                :: n
+integer, intent(IN)                :: nsen
+integer, intent(IN)                :: nlax
+integer, intent(IN)                :: nflo
+integer, intent(IN)                :: nmat
+integer, intent(IN)                :: nrec
+integer, intent(IN)                :: nplt
+logical, intent(IN)                :: in_cycle
+integer, intent(IN)                :: nger
+real,    intent(IN)                :: tcult
+integer, intent(IN)                :: nlev
+character, intent(in)              :: P_stoprac !//parameter, stage when root stop growth
+integer, intent(in)                :: P_codeperenne   ! // parameter
+integer, intent(in)                :: P_codehypo   ! // parameter
+
+integer, intent(in)                :: P_codegermin   ! // parameter
+real,    intent(in)                :: P_zracplantule ! // parameter
+real,    intent(in)                :: P_profsem      ! // parameter
+integer, intent(in)                :: P_codtrophrac   ! // parameter
+
+real,    intent(in)                :: P_repracpermax     ! // parameter
+real,    intent(in)                :: P_repracpermin      ! // parameter
+real,    intent(in)                :: P_krepracperm      ! // parameter
+
+real,    intent(in)                :: P_repracseumax     ! // parameter
+real,    intent(in)                :: P_repracseumin      ! // parameter
+real,    intent(in)                :: P_krepracseu      ! // parameter
+
+integer, intent(in)                :: P_codetemprac   ! // parameter
+real,    intent(in)                :: P_tcmin      ! // parameter
+real,    intent(in)                :: P_tcmax      ! // parameter
+integer, intent(in)                :: P_codedyntalle   ! // parameter
+real,    intent(in)                :: P_tcxstop      ! // parameter
+
+real,    intent(in)                :: P_stlevamf      ! // parameter
+real,    intent(in)                :: P_stamflax     ! // parameter
+
+
+
+!
+! 1.0  INOUT
+
+real,    intent(INOUT)             :: zrac
+real,    intent(INOUT)             :: repracmax
+real,    intent(INOUT)             :: repracmin
+real,    intent(INOUT)             :: kreprac
+real,    intent(INOUT)             :: somtemprac
+real,    intent(INOUT)             :: urac
+real,    intent(INOUT)             :: reprac
+integer, intent(INOUT)             :: nstoprac
+
+
+
+! 2.0  OUT
+
+! 3.0  LOCAL
+
+real :: znonli
+real :: dtj
+
+
+! zrac should be initialized as 0
+! when nger ~= 0, meaning that the germination occurs, we assign the zrac as P_profsem
+
+
+     !>> FIRST 
+     ! we determine the nstoprac, this variable is dependent on P_stoprac
+
+     if (P_stoprac == 'sen' .or. P_stoprac == 'SEN') nstoprac = nsen
+     if (P_stoprac == 'lax' .or. P_stoprac == 'LAX') nstoprac = nlax
+     if (P_stoprac == 'flo' .or. P_stoprac == 'FLO') nstoprac = nflo
+     if (P_stoprac == 'mat' .or. P_stoprac == 'MAT') nstoprac = nmat
+     if (P_stoprac == 'rec' .or. P_stoprac == 'REC') nstoprac = nrec
+
+
+     !>> SECOND
+     ! adjustment of the root depth accoring to the stages 
+     ! but note that in this version, we do not calculate the growth of root
+
+     if (P_codeperenne == 1 .and. (n >= nplt .or. in_cycle == .true.)) then ! annual crop and in the growing cycle
+       if (P_codehypo == 2 .and. P_codegermin == 1) then
+         znonli = P_zracplantule + P_profsem
+         zrac = znonli
+         !return
+       else
+         znonli = P_profsem
+         zrac = znonli
+         !return
+       endif
+     else
+       znonli = 0.
+       zrac = znonli
+     endif
+     ! now we adjust the zrac 
+
+     
+     !>> THIRD
+     ! we get the three parameters for calculating the REPRAC variable
+     ! There are three cases:
+     ! 1. codtrophrac is 1
+     ! 2. codtrophrac is 2
+     ! 3. codtrophrac is 3
+
+     if (P_codtrophrac == 1) then 
+       repracmax = P_repracpermax
+       repracmin = P_repracpermin
+       kreprac   = P_krepracperm
+     endif
+     if (P_codtrophrac == 2) then
+       repracmax = P_repracseumax
+       repracmin = P_repracseumin
+       kreprac   = P_krepracseu
+     endif
+     if (P_codtrophrac == 3) then
+       repracmax = 0.
+       repracmin = 0.
+       kreprac   = 0.
+     endif
+
+ 
+     !>> FOURTH
+     ! if the germination did not occur, we do not need the shoot/root partitioning calculation, so the reprac keeps the initialization value
+     if (nger == 0) return
+    
+
+     
+     !>> FIFTH
+     ! we calculate the reprac
+
+
+     !if (n >= nger .and. nger > 0 .and. zrac > 0.) then
+     if (in_cycle == .true. .and. nger > 0 .and. zrac > 0) then ! if in growing cycle, and already germinate and depth of root front is larger than 0
+       if (P_codetemprac == 1) then ! using the crop temperature
+         dtj = max(tcult - P_tcmin, 0.)
+         dtj = min(dtj, P_tcmax - P_tcmin)
+
+       ! DR et ML et SYL 15/06/09
+       ! ************************
+       ! introduction de la fin des modifications de Sylvain (nadine et FR)
+       ! dans le cadre du projet PERMED
+         if (P_codedyntalle == 1) then
+       ! ####
+       ! NB le 06/03/2008 introduction de l'effet nÃ©gatif des tempÃ©ratures Ã©levÃ©es
+       ! sur les fonctions racinaires qui utilisent "dtj"
+           if (tcult > P_tcmax .and. P_tcxstop < 100) then
+             dtj = (P_tcmax-P_tcmin)/(-P_tcxstop+P_tcmax)*(tcult-P_tcxstop)
+             dtj = max(dtj,0.)
+           endif
+         endif
+       ! ####
+
+       !else ! using the soil temperature
+       !  dtj(n) = max(tsol(int(zrac)) - P_tgmin, 0.)
+       !  dtj(n) = min(dtj(n) ,P_tcmax - P_tgmin)
+
+       !! ####
+       !! NB le 06/03/2008 introduction de l'effet nÃ©gatif des tempÃ©ratures Ã©levÃ©es
+       !! sur les fonctions racinaires qui utilisent "dtj"
+       !  if(P_codedyntalle == 1)then
+       !    if (tsol(int(zrac)) > P_tcmax .and. P_tcxstop < 100) then
+       !      dtj(n) = (P_tcmax-P_tcmin)/(-P_tcxstop+P_tcmax)*(tsol(int(zrac))-P_tcxstop)
+       !      dtj(n) = max(dtj(n),0.)
+       !    endif
+       !  endif
+       !! ####
+
+       endif
+     else 
+       dtj = 0.
+     endif
+
+      ! addressing the cumulated effective temperature of root
+
+
+      somtemprac = somtemprac + dtj
+      if (n == nlev) somtemprac = 0.
+      if (nstoprac == 0) then
+        !: DÃ©finition d'une unitÃ© de dl racinaire urac
+        !- somme de degrÃ©.jours racine
+        urac = min(1. + (2. * somtemprac / (P_stlevamf + P_stamflax)), 3.)
+        if (nlev == 0) urac = 1.
+        !: la longueur totale de racine Ã©mise par jour (rlj)
+        !- suit une logistique de faÃ§on similaire au LAI
+        !- NB - le 28/10/01:
+        !- 07/02/08: on integre ENFIN les modifs de Samuel (vive lui)
+        !- essai de rendre nouvrac continu pour Samuel
+        !- 20/02/07:
+        !--if (int(zrac)-int(zrac-deltaz) <= int(deltaz)) then
+        !--  multlvfront = int(deltaz)
+        !--else
+        !--  multlvfront = int(deltaz)+1
+        !--endif
+        !--if (nlev == 0) multlvfront = max0(1,multlvfront)
+        !--nouvrac = P_lvfront*multlvfront
+        ! nouvrac = P_lvfront*deltaz
+
+        !: Introduction de l'indice de stress de densitÃ© racinaire idzrac / NB - le 06/06
+        !efanoxd = 1.-(1.-idzrac)*P_sensanox
+
+        !: NB - 10/03/02:
+        !- Calcul du facteur densitÃ© efdensite actif Ã  partir de P_laicomp
+        !- Calcul de l'effet densitÃ© sur la mise en place du LAI pour les stics-plante
+        !efdensite = 1.
+        !if (urac >= 1.) then
+        !  if (lai_veille < P_laicomp) then
+        !    efdensite = 1.
+        !  else
+        !    !: domi - 02/07/2002: pb si GEL total densite = 0 et pb de log(0)
+        !    if (densite == 0) then
+        !      efdensite = 0.
+        !    else
+        !      efdensite = min(exp(P_adens * (log(densite / P_bdens))), 1.)
+        !    endif
+        !  endif
+        !else
+        !  efdensite = min(exp(P_adens * (log(densite / P_bdens))),1.)
+        !endif
+
+        !rlj = (P_draclong / (1. + exp(5.5 * (P_vlaimax - urac))) * efdensite * densite *dtj(n) * efanoxd) + (nouvrac * 1.e4)
+
+        !: De la germination Ã  la levÃ©e, il n'y a qu'une croissance du front racinaire
+        !- Nb - le 17/02/2003: suppression de coderac
+        if (P_codtrophrac /= 3) then
+          !: Option trophique
+          ! *- par calcul d'une fonction de rÃ©partition reprac = souterrain/total
+          ! *- la longueur de racine au niveau du front est soustraite de la
+          ! *- longueur produite
+          ! ** ML le 25/05/2007 - les paramÃštres initiaux repracmin, repracmax et kreprac
+          ! *- ont changÃ© de noms dans le fichier plante: P_repracpermin, P_repracpermax et P_krepracperm
+          ! *- si la liaison trophique est permanente (P_codtrophrac = 1) et
+          ! *- P_repracseumin, P_repracseumax et P_krepracseu si la liaison est par seuils (P_codtrophrac = 2)
+!!!          if (P_codtrophrac == 1) then
+!!!            repracmax = P_repracpermax
+!!!            repracmin = P_repracpermin
+!!!            kreprac = P_krepracperm
+!!!          endif
+!!!
+!!!          if (P_codtrophrac == 2) then
+!!!            repracmax = P_repracseumax
+!!!            repracmin = P_repracseumin
+!!!            kreprac = P_krepracseu
+!!!          endif
+
+          reprac = (repracmax-repracmin) * (exp(-kreprac * (urac - 1.))) + repracmin
+
+          !: PB - 06/01/2005: On multiplie par P_longsperac plutot que diviser (modifs Nadine du 30/12/2004)
+          !rlj1 = reprac/(1.-reprac) * P_longsperac * 1.e2 * dltams
+
+          !if (rlj1 < nouvrac * 1.e4) nouvrac = rlj1 * 1.e-4
+          !if (P_codtrophrac == 1) then
+          !  rlj = rlj1
+          !else
+          !  if (rlj >= rlj1) rlj = rlj1
+          !endif
+        endif
+
+        !if (nlev == 0) rlj = nouvrac*1.e4
+
+      !else
+      !  rlj = 0.
+      endif
+     
+     
+      ! Here we get the reprac, which is an important variable addressing the above/below ground biomass partitioning.    
+      ! we end our subroutine 
+
+end subroutine reprac_calc
Index: /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_sticslai/senescen.f90
===================================================================
--- /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_sticslai/senescen.f90	(revision 6940)
+++ /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_sticslai/senescen.f90	(revision 6940)
@@ -0,0 +1,835 @@
+! *******************************************************************
+!    version 6.0
+!    reste pb cultures fauchées à voir avec Domi
+!--------------------------------------------------
+!    calcul de la senescence de la matiere seche
+!    avec eventuellement une partie residuelle pour les cultures fauchees
+!
+!    calcul de la sénescence du LAI pour l'option LAI brut
+! derniere modif 30/05/05
+! *******************************************************************
+!> In STICS shoot senescence only concerns leaves: dry matter and LAI.  For cut crops, it also affects residual biomass after cutting.
+!> - Stics book paragraphe 3.1.2, page 44-46
+!> While in the first versions of the model senescence was implicit (Brisson et al., 1998a), it is now explicit, with a clear distinction between natural
+!! senescence due to the natural ageing of leaves, and senescence accelerated by stresses (water, nitrogen, frost). The concept of leaf lifespan,
+!! used for example by Maas (1993), is applied to the green leaf area and biomass produced. The leaf area and part of the leaf biomass produced on a given day
+!! is therefore lost through senescence once the lifetime has elapsed (Duru et al., 1995). This part corresponds to the ratiosen parameter, taking into account
+!! the part which was remobilised during its senescence.
+!!
+!! Calculation of lifespan:
+!!
+!! The natural lifespan of leaves (durage) is defined by two values: the  lifespan of early leaves, or durvieI (expressed as a proportion of durvieF ) and the
+!! lifespan of the last leaves emitted, or durvieF (assumed genotype-dependent). Until the IAMF stage, the natural lifespan, calculated for the day when the
+!! leaves are emitted (I0) is durvieI; from IAMF to ILAX, the natural lifespan increases between durvieI and durvieF as a function of the leaf development variable ULAI.
+!! Because of water or nitrogen stress, the current lifespan may be shortened if the stress undergone is more intense than previous stresses.
+!! Specific stress indices for senescence are introduced (senfac and innsenes).  Frost (fstressgel that can be either fgeljuv or fgelveg) may also reduce or
+!! even cancel  lifespan.  In the event of over-fertilisation with nitrogen (inn >1), the foliage lifespan is increased from the IAMF stage up to a maximum
+!! given by the durviesupmax parameter.
+!! The lifespan of leaves is not expressed in degree.days (like phasic development), because this has the disadvantage of stopping any progression as soon as
+!! the temperature is lower than the base temperature (tdmin).  To remedy this problem, the senescence course (somsen) is expressed by cumulated Q10 units
+!! (with Q10=2), i.e. an exponential type function.
+!! The senescence course between I0 and I is affected by the same cardinal temperatures as phasic development and can be slown down by stresses. The lifespan parameter
+!! of the leaf (durvieF) expressed in Q10 units represents about 20% of the same  lifespan expressed in degree.days.
+!!
+!! Calculation of senescence:
+!!
+!! Material produced on day I0 disappears by senescence after a period corresponding to durvie(I0). Depending on the evolution of temperature and of lifespan
+!! as a function of phenology and stresses, senescence can vary from one day to another and affect several days of production (J=I0, I0+1, 
+) or, on the contrary,
+!! none (durvieE(I0)>somsen(I)).  This principle is applied to the biomass (dltamsen) and leaf area index (ltaisen). In general, the leaf biomass produced
+!! does not completely disappear (remobilisation):  the ratiosen (<1) parameter enables the definition of the senescent proportion with reference to production.
+!! It is the pfeuilverte ratio which defines the proportion of leaves in the biomass produced.
+!! The cumulative senescent foliage is laisen. If the crop is a forage crop benefiting from residual dry matter from the previous cycle (msresiduel parameter),
+!! the senescence of residual dry matter (deltamsresen) starts as from cutting.  It occurs at a rate estimated from the relative daily lifespan course and
+!! weighted by the remobilisation (ratiosen).
+! *-----------------------------------------------------------------------------------------------------------------------------------------------------------* c
+!subroutine senescen(nlev,n,nbjmax,lai,P_codeinnact,P_codeh2oact,senfac,innsenes,P_codlainet,  &
+!                    P_codeperenne,nbfeuille,P_nbfgellev,P_codgellev,tcultmin,P_tletale,P_tdebgel, &
+!                    P_tgellev90,P_tgellev10,ipl,densitelev,densiteassoc,P_codgeljuv,          &
+!                    P_tgeljuv90,P_tgeljuv10,P_codgelveg,P_tgelveg90,P_tgelveg10,masecveg,         &
+!                    nstopfeuille,somcour,resperenne,ndrp,nrec,P_QNpltminINN,numcult,      &
+!                    P_codeinitprec,ulai,P_vlaimax,durvieI,P_durvieF,inn,P_durviesupmax,         &
+!                    P_codestrphot,phoi,P_phobasesen,dltams,P_msresiduel,P_ratiosen,tdevelop,    &
+!                    somtemp,pfeuilverte,deltai,P_lai0,                                    &
+!                    dernier_n,nsencour,dltaisen,dltamsen,fstressgel,fgellev,gelee,      &
+!                    densite,laisen,nlan,R_stsenlan,nsen,R_stlaxsen,namf,nlax,R_stlevamf,      &
+!                    R_stamflax,nrecbutoir,mortplante,nst2,mortplanteN,durvie,strphot,     &
+!                    msres,dltamsres,ndebsen,somsenreste,msresjaune,mafeuiljaune,        &
+!                    msneojaune,dltamstombe,QNplante,P_dltamsminsen,P_dltamsmaxsen,          &
+!                    P_alphaphot,strphotveille)
+
+subroutine senescen(nlev,n, lai, senfac,  &
+                    nbfeuille,t2m_min_daily, &
+                    densitelev,          &
+                    masecveg,         &
+                    nstopfeuille,somcour,nrec,      &
+                    ulai, &
+                    tdevelop,    &
+                    somtemp,nsenpfeuilverte,nsendltai,nsendurvie, nsendltams, nsenndurvie,         &    ! INPUTS
+                    pdlaisen, dernier_n,nsencour,dltaisen,dltamsen,fstressgel,fgellev,gelee,      & !INOUT
+                    densite,laisen,nlan,R_stsenlan,nsen,R_stlaxsen,namf,nlax,R_stlevamf,      &
+                    R_stamflax,durvie,     &
+                    ndebsen,somsenreste, mafeuiljaune, msneojaune,  & !INOUT
+                    durvieI, deltai, dltams, &
+                    histgrowth, hist_sencour, hist_latest, doyhistst,  &
+                    nbox, boxulai, boxndays, boxlai, boxlairem,boxtdev, &
+                    boxbiom,boxbiomrem, boxdurage, boxsomsenbase)  ! OUTPUT
+
+USE constantes
+USE Stics
+USE Divers_gel
+!USE Messages
+
+  implicit none
+
+! DECLARATION
+
+! 0.1 INPUTS
+
+  integer, intent(IN)    :: nlev  
+  integer, intent(IN)    :: n  
+  !integer, intent(IN)    :: nbjmax  
+  real,    intent(IN)    :: lai   !> // OUTPUT // Leaf area index (table) // m2 leafs  m-2 soil
+  !integer, intent(IN)    :: P_codeinnact  !> // PARAMETER // code activating  nitrogen stress effect on the crop: yes (1), no (2) // code 1/2 // PARAM // 0 
+  !integer, intent(IN)    :: P_codeh2oact  !> // PARAMETER // code to activate  water stress effect on the crop: yes (1), no (2) // code 1/2 // PARAM // 0 
+  real,    intent(IN)    :: senfac   !> // OUTPUT // Water stress index on senescence // 0-1
+  !real,    intent(IN)    :: innsenes   !> // OUTPUT // Index of nitrogen stress active on leaf death // P_innmin to 1
+  !integer, intent(IN)    :: P_codlainet  !> // PARAMETER //option of calculation of the LAI (1 : direct LAInet; 2 : LAInet = gross LAI - senescent LAI) // code 1/2 // PARPLT // 0
+  !integer, intent(IN)    :: P_codeperenne  !> // PARAMETER // option defining the annual (1) or perenial (2) character of the plant // code 1/2 // PARPLT // 0 
+  integer, intent(IN)    :: nbfeuille   !> // OUTPUT // Number of leaves on main stem // SD
+  !integer, intent(IN)    :: P_nbfgellev  !> // PARAMETER // leaf number at the end of the juvenile phase (frost sensitivity)  // nb pl-1 // PARPLT // 1 
+  !integer, intent(IN)    :: P_codgellev  !> // PARAMETER // activation of plantlet frost // code 1/2 // PARPLT // 0 
+  real,    intent(IN)      :: t2m_min_daily    !// minimum daily temperature // celsius degree
+  !real,    intent(IN)    :: tcultmin  
+  !real,    intent(IN)    :: P_tletale  !> // PARAMETER // lethal temperature for the plant // degree C // PARPLT // 1
+  !real,    intent(IN)    :: P_tdebgel  !> // PARAMETER // temperature of frost beginning // degree C // PARPLT // 1
+  !real,    intent(IN)    :: P_tgellev90  !> // PARAMETER // temperature corresponding to 90% of frost damage on the plantlet  // degree C // PARPLT // 1
+  !real,    intent(IN)    :: P_tgellev10  !> // PARAMETER // temperature corresponding to 10% of frost damage on the plantlet  // degree C // PARPLT // 1
+  !integer, intent(IN)    :: ipl         !> number of kinds of  crops 
+  real,    intent(IN)    :: densitelev  
+  !real,    intent(IN)    :: densiteassoc  
+  !integer, intent(IN)    :: P_codgeljuv  !> // PARAMETER // activation of LAI frost at the juvenile stadge // code 1/2 // PARPLT // 0 
+  !real,    intent(IN)    :: P_tgeljuv90  !> // PARAMETER // temperature corresponding to 90 % of frost damage on the LAI (juvenile stage) // degree C // PARPLT // 1
+  !real,    intent(IN)    :: P_tgeljuv10  !> // PARAMETER // temperature corresponding to 10 % of frost damage on the LAI (juvenile stage) // degree C // PARPLT // 1
+  !integer, intent(IN)    :: P_codgelveg  !> // PARAMETER // activation of LAI frost at adult stage // code 1/2 // PARPLT // 0 
+  !real,    intent(IN)    :: P_tgelveg90  !> // PARAMETER // temperature corresponding to 90 % of frost damage on the LAI (adult stage) // degree C // PARPLT // 1
+  !real,    intent(IN)    :: P_tgelveg10  !> // PARAMETER // temperature corresponding to 10 % of frost damage on the LAI (adult stage) // degree C // PARPLT // 1
+  real,    intent(IN)    :: masecveg   !> // OUTPUT // Vegetative dry matter // t.ha-1
+  integer, intent(IN)    :: nstopfeuille  
+  real,    intent(IN)    :: somcour   !> // OUTPUT // Cumulated units of development between two stages // degree.days
+  !real,    intent(IN)    :: resperenne   !> // OUTPUT // C crop reserve, during the cropping season, or during the intercrop period (for perenial crops) // t ha-1 
+  !integer, intent(IN)    :: ndrp  
+  integer, intent(IN)    :: nrec  
+  !real,    intent(IN)    :: P_QNpltminINN  !> // PARAMETER // minimal amount of nitrogen in the plant allowing INN computing // kg ha-1 // PARAM // 1 
+  !integer, intent(IN)    :: numcult  
+  !integer, intent(IN)    :: P_codeinitprec  !> // PARAMETER // reinitializing initial status in case of chaining simulations : yes (1), no (2) // code 1/2 // PARAM // 0 
+  real,    intent(IN)    :: ulai  !>   // OUTPUT // Daily relative development unit for LAI // 0-3
+  !real,    intent(IN)    :: P_vlaimax  !> // PARAMETER // ULAI at inflection point of the function DELTAI=f(ULAI) // SD // PARPLT // 1
+  !real,    intent(IN)    :: P_durvieF  !> // PARAMETER // maximal  lifespan of an adult leaf expressed in summation of P_Q10=2 (2**(T-Tbase)) // P_Q10 // PARPLT // 1 
+  !real,    intent(IN)    :: inn   !> // OUTPUT // Nitrogen nutrition index (satisfaction of nitrogen needs ) // 0-1
+  !real,    intent(IN)    :: P_durviesupmax  !> // PARAMETER // proportion of additional lifespan due to an overfertilization // SD // PARPLT // 1 
+  !integer, intent(IN)    :: P_codestrphot  !> // PARAMETER // activation of the photoperiodic stress on lifespan : yes (1), no (2) // code 1/2 // PARPLT // 0 
+  !real,    intent(IN)    :: phoi   !> // OUTPUT // Photoperiod // hours
+  !real,    intent(IN)    :: P_phobasesen  !> // PARAMETER // photoperiod under which the photoperiodic stress is activated on the leaf lifespan // heures // PARPLT // 1 
+  !real,    intent(IN)    :: dltams(nbjmax)  !>   // OUTPUT // Growth rate of the plant  // t ha-1.j-1
+  !real,    intent(IN)    :: P_msresiduel  !> // PARAMETER // Residual dry matter after a cut // t ha-1 // PARTEC // 1 
+  !real,    intent(IN)    :: P_ratiosen  !> // PARAMETER // fraction of senescent biomass (by ratio at the total biomass) // between 0 and 1 // PARPLT // 1 
+  real,    intent(IN)    :: tdevelop
+  real,    intent(IN)    :: somtemp   !> // OUTPUT // Sum of temperatures // degree C.j
+  !real,    intent(IN)    :: pfeuilverte(nbjmax) !>  // OUTPUT // Proportion of green leaves in total non-senescent biomass // 0-1
+  !real,    intent(IN)    :: deltai(nbjmax)  !>   // OUTPUT // Daily increase of the green leaf index // m2 leafs.m-2 soil
+  !real,    intent(IN)    :: P_lai0  !> // PARAMETER // Initial leaf area index // m2 m-2 // INIT // 1 
+  !real,    intent(IN)    :: dltamstombe  
+  !real,    intent(IN)    :: QNplante   !> // OUTPUT // Amount of nitrogen taken up by the plant  // kgN.ha-1
+  !real,    intent(IN)    :: P_dltamsminsen  !> // PARAMETER // threshold value of deltams from which the photoperiodic effect on senescence is maximal // t ha-1j-1 // PARAM // 1 
+  !real,    intent(IN)    :: P_dltamsmaxsen  !> // PARAMETER // threshold value of deltams from which there is no more photoperiodic effect on senescence // t ha-1j-1 // PARPLT // 1 
+  !real,    intent(IN)    :: P_alphaphot  !> // PARAMETER // parameter of photoperiodic effect on leaf lifespan // P_Q10 // PARAM // 1 
+  real,     intent(IN)    :: nsenpfeuilverte
+  real,     intent(IN)    :: nsendltai 
+  real,     intent(IN)    :: nsendurvie 
+  real,     intent(IN)    :: nsendltams 
+  real,     intent(IN)    :: nsenndurvie 
+  real,     intent(IN)    :: deltai
+  real,     intent(IN)    :: dltams
+
+
+! 0. 2 INOUT
+
+  real,     intent(INOUT) :: pdlaisen    !>  senescence leaf area index of previous day // m2 leafs  m-2 soil 
+  integer, intent(INOUT) :: dernier_n  
+  integer, intent(INOUT) :: nsencour  
+  real,    intent(INOUT) :: dltaisen   !> // OUTPUT // Daily increase of the senescent leaf index // m2.m-2 sol.j-1
+  real,    intent(INOUT) :: dltamsen   !> // OUTPUT // Senescence rate // t ha-1 j-1
+  real,    intent(INOUT) :: fstressgel   !> // OUTPUT // Frost index on the LAI // 0-1
+  real,    intent(INOUT) :: fgellev  
+  logical, intent(INOUT) :: gelee  
+  real,    intent(INOUT) :: densite   !> // OUTPUT // Actual sowing density // plants.m-2
+  real,    intent(INOUT) :: laisen    ! // OUTPUT // Leaf area index of senescent leaves // m2 leafs  m-2 soil
+  integer, intent(INOUT) :: nlan  
+  real,    intent(INOUT) :: R_stsenlan  !> // PARAMETER // Sum of development units between the stages SEN et LAN // degree.days // PARPLT // 1 
+  integer, intent(INOUT) :: nsen  
+  real,    intent(INOUT) :: R_stlaxsen  !> // PARAMETER // Sum of development units between the stages LAX and SEN // degree.days // PARPLT // 1 
+  integer, intent(INOUT) :: namf  
+  integer, intent(INOUT) :: nlax  
+  real,    intent(INOUT) :: R_stlevamf  !> // PARAMETER // Sum of development units between the stages LEV and AMF // degree.days // PARPLT // 1 
+  real,    intent(INOUT) :: R_stamflax  !> // PARAMETER // Sum of development units between the stages AMF and LAX // degree.days // PARPLT // 1 
+  !integer, intent(INOUT) :: nrecbutoir  
+  !integer, intent(INOUT) :: mortplante  
+  !integer, intent(INOUT) :: nst2  
+  !integer, intent(INOUT) :: mortplanteN  
+  real,    intent(INOUT) :: durvie !<   // OUTPUT // Actual life span of the leaf surface //  degree C
+  !real,    intent(INOUT) :: msres  
+  !real,    intent(INOUT) :: dltamsres  
+  integer, intent(INOUT) :: ndebsen  
+  real,    intent(INOUT) :: somsenreste  
+  !real,    intent(INOUT) :: msresjaune   !> // OUTPUT // Senescent residual dry matter  // t.ha-1
+  real,    intent(INOUT) :: mafeuiljaune   !> // OUTPUT // Dry matter of yellow leaves // t.ha-1
+  real,    intent(INOUT) :: msneojaune   !> // OUTPUT // Newly-formed senescent dry matter  // t.ha-1
+  !real,    intent(INOUT) :: strphotveille  
+
+  real, dimension(300,5), intent(INOUT) :: histgrowth
+  integer, intent(INOUT)                :: hist_sencour
+  integer, intent(INOUT)                :: hist_latest
+  integer, intent(INOUT)                :: doyhistst
+
+! compartment senescence module
+!boxulai, boxndays, boxlai, boxlairem,boxtdev, boxbiom, boxbiomrem, boxdurage,
+!boxsomsenbase
+       integer(i_std), intent(IN)                  :: nbox
+       real(r_std), dimension(nbox), intent(INOUT) :: boxulai
+       integer(i_std), dimension(nbox), intent(INOUT) :: boxndays
+       real(r_std), dimension(nbox), intent(INOUT) :: boxlai
+       real(r_std), dimension(nbox), intent(INOUT) :: boxlairem
+       real(r_std), dimension(nbox), intent(INOUT) :: boxtdev
+       real(r_std), dimension(nbox), intent(INOUT) :: boxbiom
+       real(r_std), dimension(nbox), intent(INOUT) :: boxbiomrem
+       real(r_std), dimension(nbox), intent(INOUT) :: boxdurage
+       real(r_std), dimension(nbox), intent(INOUT) :: boxsomsenbase
+
+
+! 0.3 OUTPUT
+
+  !real,    intent(OUT)   :: strphot  
+  real,    intent(OUT)    :: durvieI  
+
+! 0.4 LOCAL VARIABLES
+
+  integer :: i  !>  
+  integer :: ii
+  integer :: ncompteur  !>  
+  integer :: debut  !>  
+  integer :: fin  
+  !real    :: vitsenres  !>  
+  real    :: durage  !>  
+  real    :: durviesup  !>  
+  real    :: senstress  !>  
+  real    :: somsen  !>  
+  !real    :: tgel10  !>
+  !real    :: tgel90
+  !real    :: msresTMP  
+  real   :: dtdevrat
+  real   :: tempdays, templaisen, tempamsen
+  logical :: myprint
+
+
+
+! 1. whether or not go into this subroutine
+      !:On shunte ce programme si la plante n'est pas levée ou si le lai est nul
+      ! If the emergence of crop did not occur, the value of nsencour is always 0
+      myprint = .false.
+      if (nlev == 0) then
+        ! *- 07/09/06 DR et NB et IGC (la sainte famille)
+        ! *- apres un 2 jours d'errements nadine a été notre lumiere !!
+        ! *- Qu'elle en soit louée !
+        ! *- initialisation de nsencour au debut du cycle
+
+
+        nsencour = n  !initialization of nsencour 
+
+        return
+      endif
+        if (P_codlainet==3) then ! accumulated part for compartment senescence
+            if (ulai < 1 .or. ulai > 3) then
+                write(*,*) 'xuhui: ulai: ', ulai, ', likely a bug'
+            elseif (ulai==3) then
+!                write(*,*) 'xuhui: ulai==3 with deltai ',deltai
+            else
+                ii = nbox
+                do while (ulai < boxulai(ii))
+                    ii = ii - 1
+                enddo
+                if (ii < 1) then
+                    write(*,*) 'xuhui: bug: ii<1'
+                    ii = 1
+                endif
+!                write(*,*) 'xuhui: ulai ',ulai,' ii ', ii
+!                write(*,*) 'xuhui: boxulai ',boxulai
+                if (boxndays(ii) == 0) then ! the 1st leaf in this pool
+                    boxsomsenbase(ii) = somtemp
+                    boxlai(ii) = boxlai(ii) + P_lai0/real(nbox) ! equally distributed the original lai to all boxes
+!                    if (ii == 1) then  ! put P_lai0 in the 1st box
+!                        boxlai(ii) = boxlai(ii) + P_lai0
+!                    endif
+                endif
+                boxndays(ii) = boxndays(ii) + 1
+                boxlai(ii) = boxlai(ii) + deltai
+                boxlairem(ii) = boxlairem(ii) + deltai
+                boxbiom(ii) = boxbiom(ii) + dltams
+                boxbiomrem(ii) = boxbiomrem(ii) + dltams
+                boxtdev(ii) = boxtdev(ii) + tdevelop
+            endif
+        endif
+ 
+
+      !: PB - 08/03/2005 - si encore de la matière jaune on continue la senescence
+     
+      ! in our model, we do not consider the processes regarding the yellow leaves, so the variable mafeuiljaune is not necessary
+
+      !if (lai <= 0 .and. mafeuiljaune <= 0.) then
+      if (lai <= 0) then
+        dltaisen = 0.
+        dltamsen = 0.
+        return
+      endif
+
+
+! 2. calculation of the lifetime for leaves
+ 
+! ** calcul de la durée de vie
+! *---------------------------
+! *-  a) calcul du LAI net : on utilise version 4 avec une durée de vie fixe (stlevsenms)
+! *-  b) calcul du LAI brut: la durée de vie est fonction de l'age de la plante
+! *-                         (durée de vie potentielle x facteurs de stress)
+! *-   durée de vie potentielle des feuilles (durage) calculée dans calai
+! *-   facteurs de stress eau et azote calculés à partir de senfac (transpi.for)
+! *-   et innsenes (absorn.for)
+! *-------------------------------------------------------------------
+! *- spécifiques de la sénescence
+
+
+   ! 2. 1 Comments: calculation of senstress,
+   ! if we chose the direct calculation of LAI, the senstress is 1. 
+   ! calculation of senfac is implemented in stress process
+
+
+      if (P_codeinnact == 1 .and. P_codeh2oact == 1) then
+        senstress = min(senfac,P_innsenes)
+      endif
+
+      if (P_codeinnact == 2 .and. P_codeh2oact == 1) then
+        senstress = min(senfac,1.)
+      endif
+
+      if (P_codeinnact == 1 .and. P_codeh2oact == 2) then
+        senstress = min(1.,P_innsenes)
+      endif
+
+      if (P_codeinnact == 2 .and. P_codeh2oact == 2) senstress = 1.
+
+      !if (P_codlainet == 1) senstress = 1.
+
+
+
+   ! 2. 2 ** calcul du STRESS lié au GEL  (utilisation de la fonction GEL.for)
+   ! *-------------------------------------------------------------------
+   ! *- GEL entre levée et plantule diminue la densité de population uniquement pour les annuelles
+
+      if (P_codeperenne == 1)  then
+        if (nbfeuille <= P_nbfgellev) then
+          !fgellev = GEL(P_codgellev,tcultmin,P_tletale,P_tdebgel,P_tgellev90,P_tgellev10)
+          fgellev = GEL(P_codgellev, t2m_min_daily, P_tgellev90, P_tgellev10)
+          if (fgellev < 1.) gelee = .TRUE.    ! we must consider the effects of gel
+          !if (ipl == 1) then     ! only consider one kind of plant
+            densite = min(densite, densitelev*fgellev)
+          !else
+          !  densite = min(densite, (densitelev + densiteassoc)*fgellev)
+          !endif
+        endif
+      endif
+
+      ! ** GEL de l'appareil végétatif à deux stades: juvénil (avant AMF) et adulte (après AMF)
+      if (namf <= 0) then
+        fstressgel = GEL(P_codgeljuv, t2m_min_daily, P_tgeljuv90, P_tgeljuv10)
+      else
+        fstressgel = GEL(P_codgelveg, t2m_min_daily, P_tgelveg90, P_tgelveg10)
+      endif
+      if (fstressgel < 1.) gelee = .TRUE.
+
+ 
+ 
+      ! ** GEL LETAL pour la plante
+      if (fstressgel <= 0.) then  ! frost damage occurs
+        dltaisen  = lai
+        dltamsen  = masecveg   ! daily dry matter
+        !laisen(1) = laisen(0) + dltaisen ! consider the former day
+        laisen = pdlaisen + dltaisen
+
+
+        ! ** affectation des stades
+        if (nstopfeuille > 0 .and. nlan == 0) then
+          nlan = n
+          R_stsenlan = somcour
+          if (nsen == 0) then
+            nsen = n
+            R_stlaxsen = somcour
+            R_stsenlan = 0.
+          endif
+        else
+          ! comments: resperenne is only for perennial crops
+          ! From the reptair process, we know that the resperenne is 0 for annual determinant crops
+          
+          if (resperenne <= 0.) then  ! resperenne is global constance
+            if (namf == 0) then
+              namf = n
+              nlax = n
+              nsen = n
+              nlan = n
+              R_stlevamf = somcour
+              R_stamflax = 0.
+              R_stlaxsen = 0.
+              R_stsenlan = 0.
+            endif
+            if (nlax == 0 .and. namf > 0) then
+              nlax = n
+              nsen = n
+              nlan = n
+              R_stamflax = somcour
+              R_stlaxsen = 0.
+              R_stsenlan = 0.
+            endif
+            if (nsen == 0 .and. nlax > 0) then
+              nsen = n
+              nlan = n
+              R_stlaxsen = somcour
+              R_stsenlan = 0.
+            endif
+          endif
+        endif
+        !if (resperenne <= 0.) then
+        !  call EnvoyerMsgHistorique(1167)
+        !  !: modif - NB - 20/09 - mort le jour d'apres pour écriture rapport
+        !  !nrecbutoir = n+1
+        !  !mortplante = 1
+        !  !: pour non plantade dans bilan.for - TODO : à mettre ici ou dans bilan ?
+        !  if (ndrp == 0) nst2 = 1
+        !endif
+        goto 30
+      endif
+
+      if (n == nlev .and. P_codeperenne == 1) then
+        nsencour = nlev
+      endif
+
+      ! *- DR et NB - 25/08/08 - s'il n'y a plus d'azote dans la plante on la fait mourir
+      ! DR 11/04/2012 pour le prairie on a des pbs car quand on coupe on a plus d'azote dans la  plante
+      ! donc je mets < au lieu de <=
+      
+      ! Comments: at this moment, the crop are not N limited, so QNplante >= p_qnpltmininn
+
+      !if ((namf > 0 .and. nrec == 0) .and. QNplante < P_QNpltminINN) then
+      !  call EnvoyerMsgHistorique(2099)
+      !! modif NB 20/09 mort le jour d'apres pour écriture rapport
+      !  nrecbutoir  = n+1
+      !  mortplanteN = 1
+      !! pour non plantade dans bilan.for
+      !  if (ndrp == 0) nst2 = 1
+      !endif
+
+! *- NB - le 22/12/2003 - pb senescence perenne vu avec FR
+! *- PB - 05/01/2005 - mise en commentaire jusqu'à nouvel ordre.
+! *- Sinon cela perturbe le calcul de la sénescence lors de l'enchainement des pérennes.
+      !if (n == nlev .and. P_codeperenne == 2 .and. numcult == 1) then
+      !  nsencour = 1
+      !endif
+
+! ** calcul de la durée de vie
+! *----------------------------
+! *-  nsenscour = jour où la biomasse sénescente a été produite
+! *-  durage = durée de vie potentielle fonction de la P_phénologie
+! *-  (varie entre durvieI et P_durvieF; durvieI avant lax)
+
+      debut = nsencour
+      if (P_codeperenne == 2 .and. P_codeinitprec == 2 .and. numcult > 1 .and. nsencour > n) then
+        fin = dernier_n
+      else
+        fin = n
+        dernier_n = n
+      endif
+
+! calculation of the durvieI
+      !durvieI = P_ratiodurvieI * P_durvieF(P_variete)
+      durvieI = P_ratiodurvieI * P_durvieF   !(P_variete)
+      !do i = debut, fin
+      
+      if (P_codlainet==1) then
+            if (ulai <= P_vlaimax) then
+              durage = durvieI   ! where is the durvieI??   p(ipl)%durvieI = p(ipl)%P_ratiodurvieI * p(ipl)%P_durvieF(itk(ipl)%P_variete), it seems a parameter
+            else
+              durage = durvieI + ((ulai - P_vlaimax) / (3. - P_vlaimax)) * (P_durvieF - durvieI)
+            endif
+    
+            !! ** application des stress qui raccourcissent la durée de vie
+            !if (i < fin) then
+            !  durvie(i) = min(durvie(i), durage * min(senstress, fstressgel))
+            !else
+              durvie = durage * min(senstress, fstressgel)
+            !endif
+    
+            ! ** augmentation de durée de vie maxi en cas de surfertilisation azotée
+            !if (namf > 0 .and. i > namf .and. P_codlainet == 2) then
+            !  if (inn > 1.) then
+            !    durviesup = P_durvieF * min(P_durviesupmax, (inn - 1.))
+    !	!		write(*,*)n,'durviesup',P_durvieF,durviesup
+            !  else
+            !    durviesup = 0.
+            !  endif
+            !else
+            !  durviesup = 0.
+            !endif
+    
+            durviesup = 0.
+       
+            durvie = durvie + durviesup
+    
+            ! domi 04/01/06 pour inaki insertion du stress photoperiodique
+            ! NB le 22/06/06 introduction dans la boucle des "i"
+    
+            ! at this moment, we do not consider the stress of photoperiod on senescence---xcw
+            !if (P_codestrphot == 1 .and. nlax /= 0) then
+            !  if (phoi < P_phobasesen) then
+            !    call stressphot(dltams(n), P_dltamsminsen, P_dltamsmaxsen, P_alphaphot, strphot, strphotveille)
+            !    durvie(i) = durvie(i) * strphot
+            !  endif
+            !endif
+    
+          !end do
+    
+    
+          !if (P_codeperenne == 2 .and. P_codeinitprec == 2 .and. numcult > 1 .and. debut > n) then
+          !  debut = 1
+          !  fin = n
+          !  goto 5
+          !endif
+    
+          ! ** la base de temps de la sénescence est calculée dans develop.for
+          ! *- tdevelop(n) est un P_Q10 sommé dans la variable somtemp
+    
+          ! ** pour les cultures fauchées : senescence de la matiere seche résiduelle
+          ! *- qui demarre dès la coupe
+          ! *- PB - 25/01/2004 - ajout de msresTMP et dltamsres pour calculer le delta msres(n-1)<->msres(n)
+          ! *- et ce, pour pallier à un problème dans le calcul de msresjaune pour les pérennes enchainées fauchées
+          !if (msres > 0.) then
+          !  vitsenres = P_msresiduel / durvieI
+          !  msresTMP = msres - (P_ratiosen * vitsenres * tdevelop(n))
+          !  msresTMP = max(0.,msresTMP)
+          !  dltamsres = max(0., msres - msresTMP)
+          !  msres = msresTMP
+          !else
+          !  dltamsres = 0.
+          !endif
+    
+    
+    
+          ! ** pour les autres cultures ou pour la matière sèche néoformée
+    
+    
+          ! ** DOMI VOIR POUR PRAIRIE UTILISATION DE somcourfauche
+          ! ** 2/ senescence de la matiere seche neoformee qui demarre au stade
+          ! *- debut de senescence de la matiere seche identifie par le parcours
+          ! *- de developpement depuis la levee : stlevsenms
+          ! *- on calcule vitsen le jour du début de sénescence : ndebsen
+    
+          !if (somtemp >= durvie(n)) then
+          if (somtemp >= durvie) then
+            if (ndebsen == 0) then ! premier jour de senescence
+              ndebsen = n
+              nsencour = nlev
+    
+              !dltamsen =  dltams(nsencour) * P_ratiosen * pfeuilverte(nsencour)
+              dltamsen = nsendltams * P_ratiosen * nsenpfeuilverte     
+    
+              if (P_codlainet == 2) then
+                dltaisen = nsendltai + P_lai0
+              endif
+    
+            ! ** enlever le reste du LAI si deltai(nsencour) = 0.
+    
+            else  ! jours suivants
+              somsen = somsenreste
+              dltamsen = 0.
+              ncompteur = 0
+              if (P_codlainet == 2) dltaisen = 0.
+    
+    ! ** calcul de la somme de température depuis le dernier jour de sénescence
+    ! *- PB - 05/01/2005 - ajout d'un test pour l'enchainement des pérennes. On calcul somsen
+    ! *- à partir du nsencour du cycle précédent jusqu'à la fin du cycle précédent et
+    ! *- on l'ajoute à la somme des températures depuis le début du cycle courant jusqu'au jour n
+              !if (P_codeperenne == 2 .and. P_codeinitprec == 2 .and. numcult > 1 .and. nsencour > n) then
+              !  do i = nsencour+1, dernier_n
+              !    somsen = somsen + tdevelop(i)
+              !  end do
+              !  do i = 1, n
+              !    somsen = somsen + tdevelop(i)
+              !  end do
+              !else
+                !do i = nsencour+1, n
+                !  somsen = somsen + tdevelop(i)
+                !end do
+                if (nsencour == nlev .and. nsencour /= 0) then
+                   somsen = somsen + tdevelop
+                endif
+              !endif
+    
+    
+              !if (somsen > durvie(nsencour+1)) then
+              if (somsen > nsenndurvie) then
+20              nsencour = nsencour + 1
+    
+    
+    ! *- PB - 05/01/2004 - ajout d'un test lors de l'enchainement des pérennes pour que nsencour
+    ! *- ne dépasse pas dernier_n. Si nsencour>dernier_n alors on a atteint la fin du cycle précédent,
+    ! *- et donc on doit repartir du début du cycle courant. Soit nsencour = 1
+               ! if (P_codeperenne == 2 .and. P_codeinitprec == 2 .and. numcult > 1 .and. nsencour > dernier_n) then
+               !   nsencour = 1
+               ! endif
+    
+                !somsen = somsen - durvie(nsencour)
+                somsen = somsen - nsendurvie
+                if (somsen < 0.) then
+                  somsen = 0.
+                  nsencour = nsencour - 1
+                  goto 40 ! TODO : a priori goto 40 pourrait être remplacé par goto 30s
+                endif
+    
+                !dltamsen = dltamsen + (dltams(nsencour) * P_ratiosen * pfeuilverte(nsencour))
+                dltamsen = dltamsen + (nsendltams * P_ratiosen * nsenpfeuilverte)
+                ncompteur = ncompteur+1
+                if (P_codlainet == 2) then
+                  !dltaisen = dltaisen + deltai(nsencour)
+                  dltaisen = dltaisen + nsendltai
+                endif
+    
+                ! ** si la durée de vie est raccourcie, on peut "faire mourir" plusieurs jours de production
+                ! *- PB - 10/03/2005 - Petite modificatoin, on compare nsencour à dernier_n et non plus à n.
+     
+       
+                !if (somsen > durvie(nsencour) .and. nsencour < dernier_n) goto 20
+                if (somsen >  nsendurvie .and. nsencour < dernier_n) goto 20
+    
+                somsenreste = somsen
+              else
+                dltamsen = 0.
+                if (P_codlainet == 2) dltaisen = 0.
+              endif
+40            continue
+            endif
+          else
+            dltamsen = 0.
+            if (P_codlainet == 2) dltaisen = 0.
+          endif
+    
+    elseif (P_codlainet==2) then
+!        dltaisen = 0.
+!        write(*,*) 'new senescence process, xuhui' 
+        IF (ulai <= P_vlaimax) THEN
+            durage = durvieI
+        ELSE
+            durage = durvieI + ((ulai - P_vlaimax) / (3. - P_vlaimax)) * (P_durvieF - durvieI)
+        ENDIF
+        durvie = durage * min(senstress, fstressgel)
+        ! after calculation of durvie, record it
+        histgrowth(hist_latest,5) = durvie
+        ! update all previous durvie with minimum values
+        if (hist_latest > hist_sencour) then
+            do ii = hist_sencour, hist_latest-1
+                histgrowth(ii,5) = min(histgrowth(ii,5),durvie)
+            end do
+        endif
+            !!!! this part need to be done when we have Nitrogen stress
+    !           DO ii = hist_sencour, hist_latest
+    !               if (namf > 0 .and. i > namf .and. P_codlainet == 2) then
+    !                 if (inn > 1.) then
+    !                   durviesup = P_durvieF * min(P_durviesupmax, (inn - 1.))
+    !       !           write(*,*)n,'durviesup',P_durvieF,durviesup
+    !                 else
+    !                   durviesup = 0.
+    !                 endif
+    !               else
+    !                 durviesup = 0.
+    !               endif
+    !               durvie(i) = durvie(i) + durviesup
+    !           ENDDO
+        
+        !IF (somtemp >= durvie) THEN ! histgrowth(hist_seencour+1,5)
+        IF (somtemp >= histgrowth(hist_sencour+1,5)) THEN ! histgrowth(hist_seencour+1,5)
+        ! considering durvie(1..n-1) is smaller or equal to durvie(n),
+        ! this is a conservative choice to start senescence a period of full
+        ! senescense
+        ! a radical one should be set as >= durvie(nsencour)
+            IF (ndebsen ==0) THEN
+                ndebsen = n
+    !           dltamsen = histgrowth(hist_sencour, 2) * P_ratiosen *
+    !           pfeuilverte(nsencour)
+                !!! dltamsen needs to reconsidered since pfeuilverte is not yet
+                !in  histgrowth
+                IF (P_codlainet == 2) THEN
+                    dltaisen = histgrowth(hist_sencour,1) ! + P_lai0
+                    !!! initial lai will never be senescened because we do not
+                    !know when it is initiated
+                ENDIF
+            ELSE
+                ! somsen = somsenreste
+                somsen = 0
+                dltamsen = 0.
+                IF (P_codlainet == 2) THEN
+                    dltaisen = 0.
+                ENDIF
+                DO ii = hist_sencour+1, n
+                    somsen = somsen + histgrowth(ii,3)
+                ENDDO
+                
+                IF (somsen < histgrowth(hist_sencour+1, 5) ) THEN
+                    dltamsen = 0.
+                    IF (P_codlainet == 2) THEN
+                        dltaisen = 0.
+                    ENDIF
+                ELSE
+                    DO WHILE (somsen >= histgrowth(hist_sencour+1, 5) .and. hist_sencour+1 <= hist_latest)
+                        hist_sencour = hist_sencour + 1
+                        somsen = somsen - histgrowth(hist_sencour,3)!tdevelop(hist_sencour)
+    !                   dltamsen = dltamsen + (histgrowth(hist_sencour, 2) *
+    !                   P_ratiosen * pfeuilverte(nsencour))
+                        !!! dltamsen needs to reconsidered since pfeuilverte is
+                        !not yet in  histgrowth
+                        IF (P_codlainet == 2) THEN
+                            dltaisen = dltaisen + histgrowth(hist_sencour, 1)
+                        ENDIF
+                        somsenreste = somsen
+                    ENDDO
+                    ! somsenreste = somsen - histgrowth(hist_sencour,5)
+                    !IF ( somsenreste<0 ) THEN
+                    !    write(*,*) 'xuhui: somesenreste<0, likely a bug'
+                    !    write(*,*) 'xuhui: somsen : ',somsen, 'durvie(hist_sencour) : ', histgrowth(hist_sencour,5)
+                    !ENDIF
+                ENDIF
+            ENDIF   
+        ENDIF
+
+        IF (myprint) THEN
+            write(*,*) 'xuhui: ---------------------'
+            write(*,*) 'xuhui: day, ', n
+            write(*,*) 'xuhui: hist_sencour, ',hist_sencour
+            write(*,*) 'xuhui: hist_latest, ',hist_latest
+            write(*,*) 'xuhui: dltaisen, ',dltaisen
+            write(*,*) 'xuhui: dltai, ',histgrowth(hist_latest,1)
+            write(*,*) 'xuhui: somtemp, ',somtemp
+            write(*,*) 'xuhui: durvie, ',durvie
+            write(*,*) 'xuhui: somsen, ',somsen
+            write(*,*) 'xuhui: ---------------------'
+        ENDIF
+    elseif (P_codlainet==3) then
+        IF (ulai <= P_vlaimax) THEN
+            durage = durvieI
+        ELSE
+            durage = durvieI + ((ulai - P_vlaimax) / (3. -P_vlaimax)) * (P_durvieF - durvieI)
+        ENDIF
+        durvie = durage * min(senstress, fstressgel)
+        do ii = 1, nbox
+            if (boxndays(ii) == 0) then
+                ! do nothing because of no leaf
+            else
+                if (boxdurage(ii) == 0.) then
+                    boxdurage(ii) = durvie
+                else
+                    boxdurage(ii) = min(durvie, boxdurage(ii))
+                endif
+            endif
+        enddo
+        ! senescence condition
+        dltaisen = 0.
+        dltamsen = 0.
+        do ii = 1, nbox
+            if (boxndays(ii) > 0 .and. somtemp - boxsomsenbase(ii)  >= boxdurage(ii)) then !senescence part of this compartment
+                if (ndebsen ==0) then
+                    ndebsen = n
+                    write(*,*) 'xuhui: debsen, ', ndebsen
+                endif
+!                dlairat = boxlai(ii)/real(boxndays(ii))
+!                damsrat = boxbiom(ii)/real(boxndays(ii))
+                dtdevrat = boxtdev(ii)/real(boxndays(ii))
+                
+                tempdays = (somtemp - boxsomsenbase(ii) - boxdurage(ii)) / dtdevrat
+                if (boxlairem(ii) >= 0.) then ! we have at least sth to be senesced
+                    if (tempdays >= boxndays(ii)) then
+                        templaisen = boxlai(ii)
+                    else
+                        templaisen = tempdays/real(boxndays(ii))*boxlai(ii)
+                    endif
+                    if (templaisen + boxlairem(ii) - boxlai(ii) > 0.) then
+                        dltaisen = dltaisen + templaisen + boxlairem(ii) - boxlai(ii)
+                        boxlairem(ii) = boxlairem(ii) - dltaisen
+                    else
+                        dltaisen = dltaisen + 0.
+                    endif
+                endif
+                if (boxbiomrem(ii) >= 0.) then
+                    if (tempdays >= boxndays(ii)) then 
+                        !leaf:biomass ratio (feuilverte) also change with time, 
+                        ! considering including a compartment feuilverte in
+                        ! later version
+                        tempamsen = boxbiom(ii) * P_ratiosen * nsenpfeuilverte 
+                    else
+                        tempamsen = tempdays/real(boxndays(ii)) * boxbiom(ii) * P_ratiosen * nsenpfeuilverte
+                    endif
+                    if (tempamsen + (boxbiomrem(ii) - boxbiom(ii)) * P_ratiosen * nsenpfeuilverte > 0.) then
+                        dltamsen = dltamsen + tempamsen + (boxbiomrem(ii) - boxbiom(ii)) * P_ratiosen * nsenpfeuilverte
+                    else
+                        dltamsen = dltamsen + 0.
+                    endif
+                endif
+            endif
+        enddo
+
+        IF (myprint) THEN
+            write(*,*) 'xuhui: ---------------------'
+            write(*,*) 'xuhui: day, ', n
+            write(*,*) 'xuhui: ulai, ',ulai
+            write(*,*) 'xuhui: dltai, ',deltai
+            write(*,*) 'xuhui: dltaisen, ',dltaisen
+            write(*,*) 'xuhui: somtemp, ',somtemp
+            write(*,*) 'xuhui: boxndays, ',boxndays
+            write(*,*) 'xuhui: boxdurage, ',boxdurage
+            write(*,*) 'xuhui: boxlai, ',boxlai
+            write(*,*) 'xuhui: boxtdev, ',boxtdev
+            write(*,*) 'xuhui: boxlairem, ',boxlairem
+            write(*,*) 'xuhui: boxsomsenbase, ', boxsomsenbase
+    !        write(*,*) 'xuhui: somsen, ',somsen
+            write(*,*) 'xuhui: ---------------------'
+        ENDIF
+    endif
+    
+30        continue
+      ! **      msresjaune   = matière sénescente résiduelle
+      ! *-      msneojaune   = matière sénescente néoformée (limitée au végétatif)
+      ! *-      mafeuiljaune = matière sénescente cumulée
+      ! *- Hyp: msneojaune   = mafeuiljaune
+      
+      !msresjaune = msresjaune + dltamsres
+
+      ! PB&Inaki - 08/03/2005 : On enlève les feuilles tombées de la matière jaune
+      
+      ! the purpose of dltamstombe is for recycling of biomass, but at this moment we do not consider this process---xcw
+      
+      !mafeuiljaune = mafeuiljaune + dltamsen - dltamstombe
+
+      mafeuiljaune = mafeuiljaune + dltamsen
+      msneojaune = mafeuiljaune
+
+! Storage of the laisen information, assignment of the pervious day laisen
+      
+      pdlaisen = laisen
+
+return
+end subroutine senescen
+ 
+ 
Index: /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_sticslai/sticslai_io.f90
===================================================================
--- /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_sticslai/sticslai_io.f90	(revision 6940)
+++ /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_sticslai/sticslai_io.f90	(revision 6940)
@@ -0,0 +1,2290 @@
+!< $HeadURL: svn://forge.ipsl.jussieu.fr/orchidee/perso/albert.jornet/OMCROP/src_stomate/stomate_io.f90 $ 
+!< $Date: 2016-05-09 17:27:44 +0200 (Mon, 09 May 2016) $
+!< $Author: xuhui.wang $
+!< $Revision: 3419 $
+! IPSL (2006)
+!  This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+MODULE sticslai_io
+  !---------------------------------------------------------------------
+  !- Not all variables saved in the start files are absolutely necessary.
+  !- However, Sechiba's and Stomate's PFTs are not necessarily identical,
+  !- and for that case this information needs to be saved.
+  !---------------------------------------------------------------------
+  USE defprec
+  USE stomate_data
+  USE constantes
+  USE constantes_soil
+  USE mod_orchidee_para
+  USE ioipsl
+  USE ioipsl_para 
+  !-
+  IMPLICIT NONE
+  !-
+  PRIVATE
+  PUBLIC sticslai_io_readstart, sticslai_io_writestart
+  !-
+  ! reference temperature (K)
+  !-
+  REAL(r_std),ALLOCATABLE,DIMENSION(:),SAVE :: trefe
+!$OMP THREADPRIVATE(trefe)
+  !-
+CONTAINS
+  SUBROUTINE sticslai_io_writestart (npts, & 
+       &  f_crop_recycle,in_cycle, f_sen_lai, st2m_max_daily, wut_cm_daily, wus_cm_daily, evapot_daily, pdbiomass, pdmasec, &
+       &  masecveg, masec, dltams, gdh_daily, phoi, onarretesomcourdrp,  &
+       &  nsendltams, nsendltai, nsenpfeuilverte, nsendurvie, nsenndurvie, densiteequiv, &
+       &  nplt, tursla, ssla, pfeuilverte, bsenlai, &
+       &  zrac, nrec, nlan, tcult, udevair, udevcult, ndrp, rfvi, nlev, nger, etatvernal, &
+       &  caljvc, rfpi, upvt, utp, somcour, somcourdrp, somcourutp, tdevelop, somtemp, &
+       &  somcourfauche, stpltger, R_stamflax, R_stlaxsen, R_stsenlan, stlevflo, nflo, &
+       &  R_stlevdrp, R_stflodrp, R_stdrpmat, nmat, nlax, nrecbutoir, group, ndebdes, R_stdrpdes, densite, &
+       &  densitelev, coeflev, densiteger, somelong, somger, humectation, nbjhumec, &
+       &  somtemphumec, stpltlev, namf, stmatrec, tustress, lai, somfeuille, pdlai, &
+       &  nbfeuille, reajust, ulai, pdulai, efdensite, tempeff, nstopfeuille, deltai, vmax, nsen, &
+       &  laisen, pdlaisen, dltaisenat, nsencour, dltamsen, dltaisen, fgellev, &
+       &  gelee, fstressgel, R_stlevamf, dernier_n, durvieI, durvie, ndebsen, somsenreste, &
+       &  humrel, swfac, turfac, senfac,mafeuiljaune, msneojaune, &
+       &  v_dltams, fgelflo, pdircarb, ircarb, nbgrains, pgrain, vitmoy, nbgraingel, pgraingel, &
+       &  dltags, ftempremp, magrain, pdmagrain, nbj0remp, pdsfruittot, repracmax, repracmin, &
+       &  kreprac, somtemprac, urac, reprac, nstoprac, c_reserve, c_leafb, gslen, drylen,  &
+       &  nboxmax, box_ndays, box_lai, box_lairem, box_tdev, box_biom, box_biomrem, box_durage, box_somsenbase, &
+       &  cyc_num, cyc_num_tot,rot_cmd_store, plantdate, plantdate_now )
+
+
+ ! 0.1 Inputs Variables
+
+    ! Domain size
+    INTEGER(i_std),INTENT(in) :: npts
+    LOGICAL, DIMENSION(npts, nvm), INTENT(IN)       :: in_cycle 
+    LOGICAL, DIMENSION(npts, nvm), INTENT(IN)       :: f_sen_lai
+    LOGICAL, DIMENSION(npts, nvm), INTENT(IN)       :: f_crop_recycle 
+    ! daily maximum 2 meter temperatures (K)
+    REAL(r_std), DIMENSION(npts), INTENT(IN)      :: st2m_max_daily
+    ! daily value of soil temperature at the resolution of 1 cm, the second dimension is 3
+    ! the three layers around sowing layer
+    REAL(r_std), DIMENSION(npts, nvm, 3), INTENT(IN)    :: wut_cm_daily
+    ! daily mean value of soil relative humidity at the resolution of 1 cm, the second dimension is 3
+    ! the three layers around sowing layer
+    REAL(r_std), DIMENSION(npts, nvm, 3), INTENT(IN)    :: wus_cm_daily
+    ! daily potential evapotranspiration 
+    REAL(r_std), DIMENSION(npts), INTENT(IN)      :: evapot_daily
+    ! biomass of previous day, t/ha
+    REAL(r_std), DIMENSION(npts, nvm), INTENT(IN)      :: pdbiomass
+    REAL(r_std), DIMENSION(npts, nvm), INTENT(IN)      :: pdmasec
+    ! vegetative biomass
+    REAL(r_std), DIMENSION(npts, nvm), INTENT(IN)      :: masecveg   
+    ! aboveground dry matter (t ha-1) 
+    REAL(r_std), DIMENSION(npts, nvm), INTENT(IN)      :: masec
+    ! growth rate of plant, it means the delta total biomass increment (t ha-1)
+    REAL(r_std), DIMENSION(npts, nvm), INTENT(IN)      :: dltams
+    ! daily gdh calculated according to halfhourly temperature // transmitted from stomate.f90 gdh_daily
+    REAL(r_std), DIMENSION(npts, nvm), INTENT(IN)         :: gdh_daily 
+    ! Photoperiod // hours
+    REAL(r_std),  DIMENSION(npts), INTENT(IN)                             :: phoi 
+
+    !  
+    LOGICAL, DIMENSION(npts, nvm), INTENT(IN)           :: onarretesomcourdrp 
+    !INTEGER(i_std), DIMENSION(nvm), INTENT(IN)                           :: codeulaivernal 
+    !INTEGER(i_std), DIMENSION(npts, nvm), INTENT(IN)                :: nlevobs    ! the following variables ended with obs are only used for forcing simulation.  
+    !INTEGER(i_std), DIMENSION(npts, nvm), INTENT(IN)                :: namfobs    ! the initial value should be always 999
+    !INTEGER(i_std), DIMENSION(npts, nvm), INTENT(IN)                :: nfloobs  
+    !INTEGER(i_std), DIMENSION(npts, nvm), INTENT(IN)                :: nlanobs  
+    !INTEGER(i_std), DIMENSION(npts, nvm), INTENT(IN)                :: nlaxobs  
+    !INTEGER(i_std), DIMENSION(npts, nvm), INTENT(IN)                :: nmatobs  
+    !INTEGER(i_std), DIMENSION(npts, nvm), INTENT(IN)                :: nrecobs  
+    !INTEGER(i_std), DIMENSION(npts, nvm), INTENT(IN)                :: nsenobs  
+    !INTEGER(i_std), DIMENSION(npts, nvm), INTENT(IN)                :: ndrpobs  
+
+    ! LAIdev SPECIFIC 
+    REAL(r_std), DIMENSION(npts, nvm), INTENT(IN)        :: nsendltams
+    REAL(r_std), DIMENSION(npts, nvm), INTENT(IN)        :: nsendltai
+    REAL(r_std), DIMENSION(npts, nvm), INTENT(IN)        :: nsenpfeuilverte
+    REAL(r_std), DIMENSION(npts, nvm), INTENT(IN)        :: nsendurvie
+    REAL(r_std), DIMENSION(npts, nvm), INTENT(IN)        :: nsenndurvie
+    REAL(r_std), DIMENSION(npts, nvm), INTENT(IN)        :: densiteequiv
+    INTEGER(i_std), DIMENSION(npts, nvm), INTENT(IN)        :: nplt
+    REAL(r_std), DIMENSION(npts, nvm), INTENT(IN)        :: tursla
+    REAL(r_std), DIMENSION(npts, nvm), INTENT(IN)        :: ssla
+    REAL(r_std), DIMENSION(npts, nvm), INTENT(IN)        :: pfeuilverte
+    REAL(r_std), DIMENSION(npts, nvm), INTENT(IN)        :: bsenlai
+    
+    ! variables are involved in DEVELOPMENT
+
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(IN)        :: zrac
+    INTEGER(i_std), DIMENSION(npts, nvm), INTENT(IN)        :: nrec
+    INTEGER(i_std), DIMENSION(npts, nvm), INTENT(IN)        :: nlan
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(IN)        :: tcult
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(IN)        :: udevair
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(IN)        :: udevcult
+    INTEGER(i_std),    DIMENSION(npts, nvm), INTENT(IN)        :: ndrp
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(IN)        :: rfvi
+    INTEGER(i_std),    DIMENSION(npts, nvm), INTENT(IN)        :: nlev
+    INTEGER(i_std),    DIMENSION(npts, nvm), INTENT(IN)        :: nger
+    logical,    DIMENSION(npts, nvm), INTENT(IN)        :: etatvernal
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(IN)        :: caljvc
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(IN)        :: rfpi
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(IN)        :: upvt
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(IN)        :: utp
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(IN)        :: somcour
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(IN)        :: somcourdrp
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(IN)        :: somcourutp
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(IN)        :: tdevelop
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(IN)        :: somtemp
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(IN)        :: somcourfauche
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(IN)        :: stpltger
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(IN)        :: R_stamflax
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(IN)        :: R_stlaxsen
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(IN)        :: R_stsenlan
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(IN)        :: stlevflo
+    INTEGER(i_std),    DIMENSION(npts, nvm), INTENT(IN)        :: nflo
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(IN)        :: R_stlevdrp
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(IN)        :: R_stflodrp
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(IN)        :: R_stdrpmat
+    INTEGER(i_std),    DIMENSION(npts, nvm), INTENT(IN)        :: nmat
+    INTEGER(i_std),    DIMENSION(npts, nvm), INTENT(IN)        :: nlax
+    INTEGER(i_std),    DIMENSION(npts, nvm), INTENT(IN)        :: nrecbutoir
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(IN)        :: group
+    INTEGER(i_std),    DIMENSION(npts, nvm), INTENT(IN)        :: ndebdes
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(IN)        :: R_stdrpdes
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(IN)        :: densite
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(IN)        :: densitelev
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(IN)        :: coeflev
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(IN)        :: densiteger
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(IN)        :: somelong
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(IN)        :: somger
+    logical,    DIMENSION(npts, nvm), INTENT(IN)        :: humectation
+    INTEGER(i_std),    DIMENSION(npts, nvm), INTENT(IN)        :: nbjhumec
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(IN)        :: somtemphumec
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(IN)        :: stpltlev
+    INTEGER(i_std),    DIMENSION(npts, nvm), INTENT(IN)        :: namf
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(IN)        :: stmatrec
+ 
+    ! these variables are involved in Lai_calculation
+     
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(IN)        :: tustress
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(IN)        :: lai
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(IN)        :: somfeuille
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(IN)        :: pdlai
+    INTEGER(i_std),    DIMENSION(npts, nvm), INTENT(IN)        :: nbfeuille
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(IN)        :: reajust
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(IN)        :: ulai
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(IN)        :: pdulai
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(IN)        :: efdensite
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(IN)        :: tempeff
+    INTEGER(i_std),    DIMENSION(npts, nvm), INTENT(IN)        :: nstopfeuille
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(IN)        :: deltai
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(IN)        :: vmax
+    INTEGER(i_std),    DIMENSION(npts, nvm), INTENT(IN)        :: nsen
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(IN)        :: laisen
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(IN)        :: pdlaisen
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(IN)        :: dltaisenat
+
+    ! these variables are involved in the LAIsenescence
+
+    INTEGER(i_std),    DIMENSION(npts, nvm), INTENT(IN)      :: nsencour
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(IN)      :: dltamsen
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(IN)      :: dltaisen
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(IN)      :: fgellev
+    logical,    DIMENSION(npts, nvm), INTENT(IN)      :: gelee
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(IN)      :: fstressgel
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(IN)      :: R_stlevamf
+    INTEGER(i_std),    DIMENSION(npts, nvm), INTENT(IN)      :: dernier_n
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(IN)      :: durvieI
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(IN)      :: durvie
+    INTEGER(i_std),    DIMENSION(npts, nvm), INTENT(IN)      :: ndebsen
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(IN)      :: somsenreste
+    INTEGER(i_std), INTENT(IN)     :: nboxmax
+    INTEGER(i_std),   DIMENSION(npts, nvm, nboxmax), INTENT(IN) :: box_ndays
+    REAL(r_std),   DIMENSION(npts, nvm) :: boxtemp
+    REAL(r_std),   DIMENSION(npts, nvm, nboxmax), INTENT(IN) :: box_lai
+    REAL(r_std),   DIMENSION(npts, nvm, nboxmax), INTENT(IN) :: box_lairem
+    REAL(r_std),   DIMENSION(npts, nvm, nboxmax), INTENT(IN) :: box_tdev
+    REAL(r_std),   DIMENSION(npts, nvm, nboxmax), INTENT(IN) :: box_biom
+    REAL(r_std),   DIMENSION(npts, nvm, nboxmax), INTENT(IN) :: box_biomrem
+    REAL(r_std),   DIMENSION(npts, nvm, nboxmax), INTENT(IN) :: box_durage
+    REAL(r_std),   DIMENSION(npts, nvm, nboxmax), INTENT(IN) :: box_somsenbase
+
+    ! these variables are involved in STRESS calculation
+    
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(IN)      :: humrel
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(IN)      :: swfac
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(IN)      :: turfac
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(IN)      :: senfac
+
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(IN)      :: mafeuiljaune 
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(IN)      :: msneojaune
+    ! these variables are involved in the CARBON ALLOCATION calculation
+
+    ! grain related   
+    REAL(r_std),    DIMENSION(npts, nvm, vlength)      ,INTENT(IN)       :: v_dltams
+    REAL(r_std),    DIMENSION(npts, nvm)      ,INTENT(IN)       :: fgelflo
+    REAL(r_std),    DIMENSION(npts, nvm)      ,INTENT(IN)       :: pdircarb
+    REAL(r_std),    DIMENSION(npts, nvm)      ,INTENT(IN)       :: ircarb
+    REAL(r_std),    DIMENSION(npts, nvm)      ,INTENT(IN)       :: nbgrains
+    REAL(r_std),    DIMENSION(npts, nvm)      ,INTENT(IN)       :: pgrain
+    REAL(r_std),    DIMENSION(npts, nvm)      ,INTENT(IN)       :: vitmoy
+    REAL(r_std),    DIMENSION(npts, nvm)      ,INTENT(IN)       :: nbgraingel
+    REAL(r_std),    DIMENSION(npts, nvm)      ,INTENT(IN)       :: pgraingel
+    REAL(r_std),    DIMENSION(npts, nvm)      ,INTENT(IN)       :: dltags
+    REAL(r_std),    DIMENSION(npts, nvm)      ,INTENT(IN)       :: ftempremp
+    REAL(r_std),    DIMENSION(npts, nvm)      ,INTENT(IN)       :: magrain
+    REAL(r_std),    DIMENSION(npts, nvm)      ,INTENT(IN)       :: pdmagrain
+    INTEGER(i_std), DIMENSION(npts, nvm)      ,INTENT(IN)       :: nbj0remp 
+    REAL(r_std),    DIMENSION(npts, nvm)      ,INTENT(IN)       :: pdsfruittot
+
+    ! reprac related
+
+    REAL(r_std),    DIMENSION(npts, nvm)      ,INTENT(IN)       :: repracmax
+    REAL(r_std),    DIMENSION(npts, nvm)      ,INTENT(IN)       :: repracmin
+    REAL(r_std),    DIMENSION(npts, nvm)      ,INTENT(IN)       :: kreprac
+    REAL(r_std),    DIMENSION(npts, nvm)      ,INTENT(IN)       :: somtemprac
+    REAL(r_std),    DIMENSION(npts, nvm)      ,INTENT(IN)       :: urac
+    REAL(r_std),    DIMENSION(npts, nvm)      ,INTENT(IN)       :: reprac
+    INTEGER(i_std), DIMENSION(npts, nvm)      ,INTENT(IN)       :: nstoprac 
+
+    REAL(r_std),    DIMENSION(npts, nvm)      ,INTENT(IN)       :: c_reserve
+    REAL(r_std),    DIMENSION(npts, nvm)      ,INTENT(IN)       :: c_leafb
+    INTEGER(i_std), DIMENSION(npts, nvm)      ,INTENT(IN)       :: gslen 
+    INTEGER(i_std), DIMENSION(npts, nvm)      ,INTENT(IN)       :: drylen 
+    INTEGER(i_std), DIMENSION(npts, nvm)      ,INTENT(IN)       :: cyc_num
+    INTEGER(i_std), DIMENSION(npts)           ,INTENT(IN)       :: cyc_num_tot
+    INTEGER(i_std), DIMENSION(npts, rot_cmd_max, cyc_rot_max) ,INTENT(IN) :: rot_cmd_store
+    INTEGER(i_std), DIMENSION(npts, nvm, cyc_rot_max) ,INTENT(IN) :: plantdate
+    INTEGER(i_std), DIMENSION(npts, nvm) ,INTENT(IN) :: plantdate_now
+!! some temporary variable in type of real for restput
+    REAL(r_std), DIMENSION(npts, nvm)                           :: cyc_num_real
+    REAL(r_std), DIMENSION(npts)                                :: cyc_num_tot_real
+    REAL(r_std), DIMENSION(npts, rot_cmd_max, cyc_rot_max)      :: rot_cmd_store_real
+    REAL(r_std), DIMENSION(npts, nvm, cyc_rot_max)              :: plantdate_real
+    REAL(r_std), DIMENSION(npts, nvm)              :: plantdate_now_real
+
+ ! 0.4 Local variables
+
+    ! STICS--local
+    REAL(r_std), DIMENSION(npts, nvm)                                 :: in_cycle_real        
+    REAL(r_std), DIMENSION(npts, nvm)                                 :: f_sen_lai_real        
+    REAL(r_std), DIMENSION(npts, nvm)                                 :: f_crop_recycle_real        
+    REAL(r_std), DIMENSION(npts, nvm)                                 :: onarretesomcourdrp_real        
+    REAL(r_std), DIMENSION(npts, nvm)                                 :: humectation_real        
+
+    !REAL(r_std), DIMENSION(nvm)                                       :: codeulaivernal_real        
+    
+    !REAL(r_std), DIMENSION(npts, nvm)                                 :: nlevobs_real
+    !REAL(r_std), DIMENSION(npts, nvm)                                 :: namfobs_real
+    !REAL(r_std), DIMENSION(npts, nvm)                                 :: nfloobs_real  
+    !REAL(r_std), DIMENSION(npts, nvm)                                 :: nlanobs_real  
+    !REAL(r_std), DIMENSION(npts, nvm)                                 :: nlaxobs_real  
+    !REAL(r_std), DIMENSION(npts, nvm)                                 :: nmatobs_real  
+    !REAL(r_std), DIMENSION(npts, nvm)                                 :: nrecobs_real  
+    !REAL(r_std), DIMENSION(npts, nvm)                                 :: nsenobs_real  
+    !REAL(r_std), DIMENSION(npts, nvm)                                 :: ndrpobs_real  
+
+    REAL(r_std), DIMENSION(npts, nvm)                                 :: etatvernal_real  
+    REAL(r_std), DIMENSION(npts, nvm)                                 :: gelee_real  
+
+    ! To store variables names for I/O
+    CHARACTER(LEN=80) :: var_name
+    ! string suffix indicating an index
+    CHARACTER(LEN=10) :: part_str
+    ! string suffix indicating biomass type crops
+    CHARACTER(LEN=10) :: box_str
+
+    !var_name = 'f_crop_init'
+    !WHERE (f_crop_init)
+    !   f_crop_init_real = un
+    !ELSEWHERE
+    !   f_crop_init_real = zero
+    !ENDWHERE
+    !CALL restput_p (rest_id_stomate, var_name, nbp_glo,   1, 1, itime, &
+    !     &                 f_crop_init_real, 'scatter', nbp_glo, index_g)
+   
+    var_name = 'f_crop_recycle'
+    WHERE (f_crop_recycle(:,:))
+       f_crop_recycle_real = un
+    ELSEWHERE
+       f_crop_recycle_real = zero
+    ENDWHERE
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo,   nvm, 1, itime, &
+         &                 f_crop_recycle_real, 'scatter', nbp_glo, index_g)
+
+    var_name = 'in_cycle'
+    WHERE (in_cycle(:,:))
+       in_cycle_real = un
+    ELSEWHERE
+       in_cycle_real = zero
+    ENDWHERE
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo,   nvm, 1, itime, &
+         &                 in_cycle_real, 'scatter', nbp_glo, index_g)
+
+    var_name = 'f_sen_lai'
+    WHERE (f_sen_lai(:,:))
+       f_sen_lai_real = un
+    ELSEWHERE
+       f_sen_lai_real = zero
+    ENDWHERE
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo,   nvm, 1, itime, &
+         &                 f_sen_lai_real, 'scatter', nbp_glo, index_g)
+    
+    var_name = 'st2m_max_daily'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, 1     , 1, itime, &
+         &               st2m_max_daily, 'scatter', nbp_glo, index_g)
+
+
+    CALL restput_p (rest_id_stomate, 'wut_cm_daily', nbp_glo, nvm     , 3, itime, &
+            &               wut_cm_daily, 'scatter', nbp_glo, index_g)
+
+    CALL restput_p (rest_id_stomate, 'wus_cm_daily', nbp_glo, nvm   , 3, itime, &
+            &               wus_cm_daily, 'scatter', nbp_glo, index_g)
+
+    var_name = 'evapot_daily'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, 1     , 1, itime, &
+         &               evapot_daily, 'scatter', nbp_glo, index_g)
+
+    var_name = 'pdbiomass'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               pdbiomass, 'scatter', nbp_glo, index_g)
+
+    var_name = 'pdmasec'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               pdmasec, 'scatter', nbp_glo, index_g)
+
+    var_name = 'masecveg'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               masecveg, 'scatter', nbp_glo, index_g)
+
+    var_name = 'masec'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               masec, 'scatter', nbp_glo, index_g)
+
+    var_name = 'dltams'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               dltams, 'scatter', nbp_glo, index_g)
+
+    var_name = 'gdh_daily'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               gdh_daily, 'scatter', nbp_glo, index_g)
+
+    var_name = 'phoi'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, 1     , 1, itime, &
+         &               phoi, 'scatter', nbp_glo, index_g)
+
+    var_name = 'onarretesomcourdrp'
+    WHERE (onarretesomcourdrp(:, :))
+       onarretesomcourdrp_real = un
+    ELSEWHERE
+       onarretesomcourdrp_real = zero
+    ENDWHERE
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo,   nvm, 1, itime, &
+         &                 onarretesomcourdrp_real, 'scatter', nbp_glo, index_g)
+
+    !var_name = 'codeulaivernal'
+    !codeulaivernal_real = FLOAT(codeulaivernal)
+    !CALL restput_p (rest_id_stomate, var_name, nbp_glo, 1     , 1, itime, &
+    !     &               codeulaivernal_real, 'scatter', nbp_glo, index_g)
+  
+    !var_name = 'nlevobs'
+    !nlevobs_real = FLOAT(nlevobs)
+    !CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+    !     &               nlevobs_real, 'scatter', nbp_glo, index_g)
+
+    !var_name = 'namfobs'
+    !namfobs_real = FLOAT(namfobs)
+    !CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+    !     &               namfobs_real, 'scatter', nbp_glo, index_g)
+
+    !var_name = 'nfloobs'
+    !nfloobs_real = FLOAT(nfloobs)
+    !CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+    !     &               nfloobs_real, 'scatter', nbp_glo, index_g)
+
+    !var_name = 'nlanobs'
+    !nlanobs_real = FLOAT(nlanobs)
+    !CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+    !     &               nlanobs_real, 'scatter', nbp_glo, index_g)
+
+    !var_name = 'nlaxobs'
+    !nlaxobs_real = FLOAT(nlaxobs)
+    !CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+    !     &               nlaxobs_real, 'scatter', nbp_glo, index_g)
+
+    !var_name = 'nmatobs'
+    !nmatobs_real = FLOAT(nmatobs)
+    !CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+    !     &               nmatobs_real, 'scatter', nbp_glo, index_g)
+
+    !var_name = 'nrecobs'
+    !nrecobs_real = FLOAT(nrecobs)
+    !CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+    !     &               nrecobs_real, 'scatter', nbp_glo, index_g)
+
+    !var_name = 'nsenobs'
+    !nsenobs_real = FLOAT(nsenobs)
+    !CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+    !     &               nsenobs_real, 'scatter', nbp_glo, index_g)
+
+
+    !var_name = 'ndrpobs'
+    !ndrpobs_real = FLOAT(ndrpobs)
+    !CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+    !     &               ndrpobs_real, 'scatter', nbp_glo, index_g)
+
+
+    var_name = 'nsendltams'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               nsendltams, 'scatter', nbp_glo, index_g)
+
+    var_name = 'nsendltai'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               nsendltai, 'scatter', nbp_glo, index_g)
+
+    var_name = 'nsenpfeuilverte'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               nsenpfeuilverte, 'scatter', nbp_glo, index_g)
+
+    var_name = 'nsendurvie'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               nsendurvie, 'scatter', nbp_glo, index_g)
+
+    var_name = 'nsenndurvie'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               nsenndurvie, 'scatter', nbp_glo, index_g)
+
+    var_name = 'densiteequiv'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               densiteequiv, 'scatter', nbp_glo, index_g)
+
+    var_name = 'nplt'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               nplt, 'scatter', nbp_glo, index_g)
+
+    var_name = 'tursla'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               tursla, 'scatter', nbp_glo, index_g)
+
+    var_name = 'ssla'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               ssla, 'scatter', nbp_glo, index_g)
+
+    var_name = 'pfeuilverte'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               pfeuilverte, 'scatter', nbp_glo, index_g)
+
+    var_name = 'bsenlai'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               bsenlai, 'scatter', nbp_glo, index_g)
+
+    var_name = 'zrac'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               zrac, 'scatter', nbp_glo, index_g)
+
+    var_name = 'nrec'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               nrec, 'scatter', nbp_glo, index_g)
+
+    var_name = 'nlan'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               nlan, 'scatter', nbp_glo, index_g)
+
+    var_name = 'tcult'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               tcult, 'scatter', nbp_glo, index_g)
+
+    var_name = 'udevair'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               udevair, 'scatter', nbp_glo, index_g)
+
+    var_name = 'udevcult'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               udevcult, 'scatter', nbp_glo, index_g)
+
+    var_name = 'ndrp'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               ndrp, 'scatter', nbp_glo, index_g)
+
+    var_name = 'rfvi'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               rfvi, 'scatter', nbp_glo, index_g)
+
+    var_name = 'nlev'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               nlev, 'scatter', nbp_glo, index_g)
+
+    var_name = 'nger'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               nger, 'scatter', nbp_glo, index_g)
+
+    var_name = 'etatvernal'
+    WHERE ( etatvernal(:,:) )
+       etatvernal_real = un
+    ELSEWHERE
+       etatvernal_real = zero
+    ENDWHERE
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               etatvernal_real, 'scatter', nbp_glo, index_g)
+
+    var_name = 'caljvc'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               caljvc, 'scatter', nbp_glo, index_g)
+
+    var_name = 'rfpi'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               rfpi, 'scatter', nbp_glo, index_g)
+
+    var_name = 'upvt'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               upvt, 'scatter', nbp_glo, index_g)
+
+    var_name = 'utp'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               utp, 'scatter', nbp_glo, index_g)
+
+    var_name = 'somcour'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               somcour, 'scatter', nbp_glo, index_g)
+
+    var_name = 'somcourdrp'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               somcourdrp, 'scatter', nbp_glo, index_g)
+
+    var_name = 'somcourutp'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               somcourutp, 'scatter', nbp_glo, index_g)
+
+    var_name = 'tdevelop'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               tdevelop, 'scatter', nbp_glo, index_g)
+
+    var_name = 'somtemp'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               somtemp, 'scatter', nbp_glo, index_g)
+
+    var_name = 'somcourfauche'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               somcourfauche, 'scatter', nbp_glo, index_g)
+
+    var_name = 'stpltger'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               stpltger, 'scatter', nbp_glo, index_g)
+
+    var_name = 'R_stlaxsen'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               R_stlaxsen, 'scatter', nbp_glo, index_g)
+
+    var_name = 'R_stamflax'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               R_stamflax, 'scatter', nbp_glo, index_g)
+
+    var_name = 'R_stsenlan'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               R_stsenlan, 'scatter', nbp_glo, index_g)
+
+    var_name = 'stlevflo'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               stlevflo, 'scatter', nbp_glo, index_g)
+
+    var_name = 'nflo'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               nflo, 'scatter', nbp_glo, index_g)
+
+    var_name = 'R_stlevdrp'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               R_stlevdrp, 'scatter', nbp_glo, index_g)
+
+    var_name = 'R_stflodrp'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               R_stflodrp, 'scatter', nbp_glo, index_g)
+
+    var_name = 'R_stdrpmat'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               R_stdrpmat, 'scatter', nbp_glo, index_g)
+
+    var_name = 'nmat'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               nmat, 'scatter', nbp_glo, index_g)
+
+    var_name = 'nlax'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               nlax, 'scatter', nbp_glo, index_g)
+
+    var_name = 'nrecbutoir'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               nrecbutoir, 'scatter', nbp_glo, index_g)
+
+    var_name = 'group'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               group, 'scatter', nbp_glo, index_g)
+
+    var_name = 'ndebdes'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               ndebdes, 'scatter', nbp_glo, index_g)
+
+    var_name = 'R_stdrpdes'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               R_stdrpdes, 'scatter', nbp_glo, index_g)
+
+    var_name = 'densite'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               densite, 'scatter', nbp_glo, index_g)
+
+    var_name = 'densitelev'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               densitelev, 'scatter', nbp_glo, index_g)
+
+    var_name = 'coeflev'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               coeflev, 'scatter', nbp_glo, index_g)
+
+    var_name = 'densiteger'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               densiteger, 'scatter', nbp_glo, index_g)
+
+    var_name = 'somelong'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               somelong, 'scatter', nbp_glo, index_g)
+
+    var_name = 'somger'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               somger, 'scatter', nbp_glo, index_g)
+
+    var_name = 'humectation'
+    WHERE (humectation(:, :))
+       humectation_real = un
+    ELSEWHERE
+       humectation_real = zero
+    ENDWHERE
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo,   nvm, 1, itime, &
+         &                 humectation_real, 'scatter', nbp_glo, index_g)
+
+    var_name = 'nbjhumec'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               nbjhumec, 'scatter', nbp_glo, index_g)
+
+    var_name = 'somtemphumec'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               somtemphumec, 'scatter', nbp_glo, index_g)
+
+    var_name = 'stpltlev'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               stpltlev, 'scatter', nbp_glo, index_g)
+
+    var_name = 'namf'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               namf, 'scatter', nbp_glo, index_g)
+
+    var_name = 'stmatrec'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               stmatrec, 'scatter', nbp_glo, index_g)
+
+    var_name = 'tustress'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               tustress, 'scatter', nbp_glo, index_g)
+
+    var_name = 'lai'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               lai, 'scatter', nbp_glo, index_g)
+
+    var_name = 'somfeuille'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               somfeuille, 'scatter', nbp_glo, index_g)
+
+    var_name = 'pdlai'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               pdlai, 'scatter', nbp_glo, index_g)
+
+    var_name = 'nbfeuille'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               nbfeuille, 'scatter', nbp_glo, index_g)
+
+    var_name = 'reajust'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               reajust, 'scatter', nbp_glo, index_g)
+
+    var_name = 'ulai'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               ulai, 'scatter', nbp_glo, index_g)
+
+    var_name = 'pdulai'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               pdulai, 'scatter', nbp_glo, index_g)
+
+    var_name = 'efdensite'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               efdensite, 'scatter', nbp_glo, index_g)
+
+    var_name = 'tempeff'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               tempeff, 'scatter', nbp_glo, index_g)
+
+    var_name = 'nstopfeuille'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               nstopfeuille, 'scatter', nbp_glo, index_g)
+
+    var_name = 'deltai'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               deltai, 'scatter', nbp_glo, index_g)
+
+    var_name = 'vmax'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               vmax, 'scatter', nbp_glo, index_g)
+
+    var_name = 'nsen'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               nsen, 'scatter', nbp_glo, index_g)
+
+    var_name = 'laisen'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               laisen, 'scatter', nbp_glo, index_g)
+
+    var_name = 'pdlaisen'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               pdlaisen, 'scatter', nbp_glo, index_g)
+
+    var_name = 'dltaisenat'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               dltaisenat, 'scatter', nbp_glo, index_g)
+
+    var_name = 'nsencour'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               nsencour, 'scatter', nbp_glo, index_g)
+
+    var_name = 'dltamsen'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               dltamsen, 'scatter', nbp_glo, index_g)
+
+    var_name = 'dltaisen'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               dltaisen, 'scatter', nbp_glo, index_g)
+
+    var_name = 'fgellev'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               fgellev, 'scatter', nbp_glo, index_g)
+
+    var_name = 'gelee'
+    WHERE ( gelee(:,:) )
+       gelee_real = un
+    ELSEWHERE
+       gelee_real = zero
+    ENDWHERE
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               gelee_real, 'scatter', nbp_glo, index_g)
+
+    var_name = 'fstressgel'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               fstressgel, 'scatter', nbp_glo, index_g)
+
+    var_name = 'laisen'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               laisen, 'scatter', nbp_glo, index_g)
+
+    var_name = 'R_stlevamf'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               R_stlevamf, 'scatter', nbp_glo, index_g)
+
+    var_name = 'dernier_n'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               dernier_n, 'scatter', nbp_glo, index_g)
+
+    var_name = 'durvieI'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               durvieI, 'scatter', nbp_glo, index_g)
+
+    var_name = 'durvie'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               durvie, 'scatter', nbp_glo, index_g)
+
+    var_name = 'ndebsen'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               ndebsen, 'scatter', nbp_glo, index_g)
+
+    var_name = 'somsenreste'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               somsenreste, 'scatter', nbp_glo, index_g)
+
+    var_name = 'humrel'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               humrel, 'scatter', nbp_glo, index_g)
+
+    var_name = 'swfac'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               swfac, 'scatter', nbp_glo, index_g)
+
+    var_name = 'turfac'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               turfac, 'scatter', nbp_glo, index_g)
+
+    var_name = 'senfac'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               senfac, 'scatter', nbp_glo, index_g)
+  
+
+    var_name = 'mafeuiljaune'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               mafeuiljaune, 'scatter', nbp_glo, index_g)
+
+    var_name = 'msneojaune'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               msneojaune, 'scatter', nbp_glo, index_g)
+
+!    var_name = 'myvar'
+!    CALL restput_p(rest_id_stomate, var_name, nbp_glo, nvm, nboxmax, itime, &
+!        &                myvar, 'scatter', nbp_glo, index_g)
+
+     CALL restput_p (rest_id_stomate, 'box_ndays', nbp_glo, nvm     , nboxmax, itime, &
+            &                REAL(box_ndays), 'scatter', nbp_glo, index_g)
+
+     CALL restput_p(rest_id_stomate, 'box_lai', nbp_glo, nvm     , nboxmax, itime, &
+            &                box_lai, 'scatter', nbp_glo, index_g) 
+
+     CALL restput_p(rest_id_stomate, 'box_lairem', nbp_glo, nvm     , nboxmax, itime, &
+            &                box_lairem, 'scatter', nbp_glo, index_g)
+
+     CALL restput_p(rest_id_stomate, 'box_tdev', nbp_glo, nvm     , nboxmax, itime, &
+            &                box_tdev, 'scatter', nbp_glo, index_g)
+
+     CALL restput_p(rest_id_stomate, 'box_biom', nbp_glo, nvm     , nboxmax, itime, &
+            &                box_biom, 'scatter', nbp_glo, index_g)
+
+    CALL restput_p(rest_id_stomate, 'box_biomrem', nbp_glo, nvm     , nboxmax, itime, &
+            &                box_biomrem, 'scatter', nbp_glo, index_g)
+
+    CALL restput_p(rest_id_stomate, 'box_durage', nbp_glo, nvm     , nboxmax, itime, &
+            &                box_durage, 'scatter', nbp_glo, index_g)
+
+    CALL restput_p(rest_id_stomate, 'box_somsenbase', nbp_glo, nvm     , nboxmax, itime, &
+            &                box_somsenbase, 'scatter', nbp_glo, index_g)
+
+ 
+    ! STICS:: CARBON ALLOCATION
+    CALL restput_p (rest_id_stomate, 'v_dltams', nbp_glo, nvm     , vlength, itime, &
+         &               v_dltams, 'scatter', nbp_glo, index_g)
+ 
+    var_name = 'fgelflo'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               fgelflo, 'scatter', nbp_glo, index_g)
+
+    var_name = 'pdircarb'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               pdircarb, 'scatter', nbp_glo, index_g)
+
+
+    var_name = 'ircarb'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               ircarb, 'scatter', nbp_glo, index_g)
+
+    var_name = 'nbgrains'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               nbgrains, 'scatter', nbp_glo, index_g)
+
+    var_name = 'pgrain'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               pgrain, 'scatter', nbp_glo, index_g)
+
+    var_name = 'vitmoy'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               vitmoy, 'scatter', nbp_glo, index_g)
+
+    var_name = 'nbgraingel'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               nbgraingel, 'scatter', nbp_glo, index_g)
+
+    var_name = 'pgraingel'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               pgraingel, 'scatter', nbp_glo, index_g)
+
+    var_name = 'dltags'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               dltags, 'scatter', nbp_glo, index_g)
+
+    var_name = 'ftempremp'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               ftempremp, 'scatter', nbp_glo, index_g)
+
+    var_name = 'magrain'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               magrain, 'scatter', nbp_glo, index_g)
+
+    var_name = 'pdmagrain'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               pdmagrain, 'scatter', nbp_glo, index_g)
+
+
+    var_name = 'nbj0remp'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               nbj0remp, 'scatter', nbp_glo, index_g)
+ 
+    !var_name = 'nbj0remp'
+    !CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+    !     &               nbj0remp, 'scatter', nbp_glo, index_g)
+
+    var_name = 'pdsfruittot'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               pdsfruittot, 'scatter', nbp_glo, index_g)
+
+    var_name = 'repracmax'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               repracmax, 'scatter', nbp_glo, index_g)
+
+    var_name = 'repracmin'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               repracmin, 'scatter', nbp_glo, index_g)
+
+    var_name = 'kreprac'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               kreprac, 'scatter', nbp_glo, index_g)
+
+    var_name = 'somtemprac'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               somtemprac, 'scatter', nbp_glo, index_g)
+
+    var_name = 'urac'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               urac, 'scatter', nbp_glo, index_g)
+
+    var_name = 'reprac'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               reprac, 'scatter', nbp_glo, index_g)
+
+
+    var_name = 'nstoprac'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               nstoprac, 'scatter', nbp_glo, index_g)
+
+
+    var_name = 'c_leafb'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               c_leafb, 'scatter', nbp_glo, index_g)
+
+    var_name = 'c_reserve'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               c_reserve, 'scatter', nbp_glo, index_g)
+    
+    var_name = 'gslen'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               gslen, 'scatter', nbp_glo, index_g)
+
+    var_name = 'drylen'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &               drylen, 'scatter', nbp_glo, index_g)
+    IF (ok_rotate) THEN
+        var_name = 'cyc_num'
+        CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+             &               cyc_num, 'scatter', nbp_glo, index_g)
+    
+        var_name = 'cyc_num_tot'
+        CALL restput_p (rest_id_stomate, var_name, nbp_glo, 1     , 1, itime, &
+             &               cyc_num_tot, 'scatter', nbp_glo, index_g)
+    
+        var_name = 'rot_cmd_store'
+        CALL restput_p (rest_id_stomate, var_name, nbp_glo, rot_cmd_max, cyc_rot_max, itime, &
+             &               rot_cmd_store, 'scatter', nbp_glo, index_g)
+    ENDIF
+    var_name = 'plantdate'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, cyc_rot_max, itime, &
+         &                plantdate, 'scatter', nbp_glo, index_g)
+
+    var_name = 'plantdate_now'
+    CALL restput_p (rest_id_stomate, var_name, nbp_glo, nvm, 1   , itime, &
+         &                plantdate_now, 'scatter', nbp_glo, index_g)
+
+  END SUBROUTINE sticslai_io_writestart
+  !-
+  !===
+  !-
+  SUBROUTINE sticslai_io_readstart (npts, & 
+       & f_crop_recycle, in_cycle, f_sen_lai, st2m_max_daily, wut_cm_daily, wus_cm_daily, evapot_daily, pdbiomass, pdmasec, &
+       & masecveg, masec, dltams, gdh_daily, phoi, onarretesomcourdrp,  &
+       & nsendltams, nsendltai, nsenpfeuilverte, nsendurvie, nsenndurvie, densiteequiv, &
+       & nplt, tursla, ssla, pfeuilverte, bsenlai, &
+       & zrac, nrec, nlan, tcult, udevair, udevcult, ndrp, rfvi, nlev, nger, etatvernal, &
+       & caljvc, rfpi, upvt, utp, somcour, somcourdrp, somcourutp, tdevelop, somtemp, &
+       & somcourfauche, stpltger, R_stamflax, R_stlaxsen, R_stsenlan, stlevflo, nflo, &
+       & R_stlevdrp, R_stflodrp, R_stdrpmat, nmat, nlax, nrecbutoir, group, ndebdes, R_stdrpdes, densite, &
+       & densitelev, coeflev, densiteger, somelong, somger, humectation, nbjhumec, &
+       & somtemphumec, stpltlev, namf, stmatrec, tustress, lai, somfeuille, pdlai, &
+       & nbfeuille, reajust, ulai, pdulai, efdensite, tempeff, nstopfeuille, deltai, vmax, nsen, &
+       & laisen, pdlaisen, dltaisenat, nsencour, dltamsen, dltaisen, fgellev, &
+       & gelee, fstressgel, R_stlevamf, dernier_n, durvieI, durvie, ndebsen, somsenreste, &
+       & humrel, swfac, turfac, senfac, mafeuiljaune, msneojaune,&
+       & v_dltams, fgelflo, pdircarb, ircarb, nbgrains, pgrain, vitmoy, nbgraingel, pgraingel, &
+       & dltags, ftempremp, magrain, pdmagrain, nbj0remp, pdsfruittot, repracmax, repracmin, &
+       & kreprac, somtemprac, urac, reprac, nstoprac, c_reserve, c_leafb, gslen, drylen, &
+       & nboxmax, box_ndays, box_lai, box_lairem, box_tdev, box_biom, box_biomrem,box_durage, box_somsenbase )
+!!!!! end crop, xuhui
+    !---------------------------------------------------------------------
+    !- read start file
+    !---------------------------------------------------------------------
+    !-
+    ! 0 declarations
+    !-
+    ! 0.1 input
+    !-
+    ! Domain size
+    INTEGER(i_std),INTENT(in) :: npts
+    ! Indices of the points on the map
+!!!!! crops
+
+    !LOGICAL, INTENT(OUT)       :: f_crop_init 
+    LOGICAL, DIMENSION(npts, nvm), INTENT(OUT)       :: f_crop_recycle 
+    LOGICAL, DIMENSION(npts, nvm), INTENT(OUT)       :: in_cycle 
+    LOGICAL, DIMENSION(npts, nvm), INTENT(OUT)       :: f_sen_lai 
+    ! daily maximum 2 meter temperatures (K)
+    REAL(r_std), DIMENSION(npts), INTENT(OUT)      :: st2m_max_daily
+    ! daily value of soil temperature at the resolution of 1 cm, the second dimension is 3
+    ! the three layers around sowing layer
+    REAL(r_std), DIMENSION(npts, nvm, 3), INTENT(OUT)    :: wut_cm_daily
+    ! daily mean value of soil relative humidity at the resolution of 1 cm, the second dimension is 3
+    ! the three layers around sowing layer
+    REAL(r_std), DIMENSION(npts, nvm, 3), INTENT(OUT)    :: wus_cm_daily
+    ! daily potential evapotranspiration 
+    REAL(r_std), DIMENSION(npts), INTENT(OUT)      :: evapot_daily
+    ! biomass of previous day, t/ha
+    REAL(r_std), DIMENSION(npts, nvm), INTENT(OUT)      :: pdbiomass
+    REAL(r_std), DIMENSION(npts, nvm), INTENT(OUT)      :: pdmasec
+    ! vegetative biomass
+    REAL(r_std), DIMENSION(npts, nvm), INTENT(OUT)      :: masecveg   
+    ! aboveground dry matter (t ha-1) 
+    REAL(r_std), DIMENSION(npts, nvm), INTENT(OUT)      :: masec
+    ! growth rate of plant, it means the delta total biomass increment (t ha-1)
+    REAL(r_std), DIMENSION(npts, nvm), INTENT(OUT)      :: dltams
+    ! daily gdh calculated according to halfhourly temperature // transmitted from stomate.f90 gdh_daily
+    REAL(r_std), DIMENSION(npts, nvm), INTENT(OUT)         :: gdh_daily 
+    ! Photoperiod // hours
+    REAL(r_std),  DIMENSION(npts), INTENT(OUT)                             :: phoi 
+
+    !  
+    LOGICAL, DIMENSION(npts, nvm), INTENT(OUT)           :: onarretesomcourdrp 
+    !INTEGER(i_std), DIMENSION(nvm), INTENT(OUT)                           :: codeulaivernal 
+    !INTEGER(i_std), DIMENSION(npts, nvm), INTENT(OUT)                :: nlevobs    ! the following variables ended with obs are only used for forcing simulation.  
+    !INTEGER(i_std), DIMENSION(npts, nvm), INTENT(OUT)                :: namfobs    ! the initial value should be always 999
+    !INTEGER(i_std), DIMENSION(npts, nvm), INTENT(OUT)                :: nfloobs  
+    !INTEGER(i_std), DIMENSION(npts, nvm), INTENT(OUT)                :: nlanobs  
+    !INTEGER(i_std), DIMENSION(npts, nvm), INTENT(OUT)                :: nlaxobs  
+    !INTEGER(i_std), DIMENSION(npts, nvm), INTENT(OUT)                :: nmatobs  
+    !INTEGER(i_std), DIMENSION(npts, nvm), INTENT(OUT)                :: nrecobs  
+    !INTEGER(i_std), DIMENSION(npts, nvm), INTENT(OUT)                :: nsenobs  
+    !INTEGER(i_std), DIMENSION(npts, nvm), INTENT(OUT)                :: ndrpobs  
+
+    ! LAIdev SPECIFIC 
+    REAL(r_std), DIMENSION(npts, nvm), INTENT(OUT)        :: nsendltams
+    REAL(r_std), DIMENSION(npts, nvm), INTENT(OUT)        :: nsendltai
+    REAL(r_std), DIMENSION(npts, nvm), INTENT(OUT)        :: nsenpfeuilverte
+    REAL(r_std), DIMENSION(npts, nvm), INTENT(OUT)        :: nsendurvie
+    REAL(r_std), DIMENSION(npts, nvm), INTENT(OUT)        :: nsenndurvie
+    REAL(r_std), DIMENSION(npts, nvm), INTENT(OUT)        :: densiteequiv
+    INTEGER(i_std), DIMENSION(npts, nvm), INTENT(OUT)        :: nplt
+    REAL(r_std), DIMENSION(npts, nvm), INTENT(OUT)        :: tursla
+    REAL(r_std), DIMENSION(npts, nvm), INTENT(OUT)        :: ssla
+    REAL(r_std), DIMENSION(npts, nvm), INTENT(OUT)        :: pfeuilverte
+    REAL(r_std), DIMENSION(npts, nvm), INTENT(OUT)        :: bsenlai
+    
+    ! variables are involved in DEVELOPMENT
+
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(OUT)        :: zrac
+    INTEGER(i_std), DIMENSION(npts, nvm), INTENT(OUT)        :: nrec
+    INTEGER(i_std), DIMENSION(npts, nvm), INTENT(OUT)        :: nlan
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(OUT)        :: tcult
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(OUT)        :: udevair
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(OUT)        :: udevcult
+    INTEGER(i_std),    DIMENSION(npts, nvm), INTENT(OUT)        :: ndrp
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(OUT)        :: rfvi
+    INTEGER(i_std),    DIMENSION(npts, nvm), INTENT(OUT)        :: nlev
+    INTEGER(i_std),    DIMENSION(npts, nvm), INTENT(OUT)        :: nger
+    logical,    DIMENSION(npts, nvm), INTENT(OUT)        :: etatvernal
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(OUT)        :: caljvc
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(OUT)        :: rfpi
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(OUT)        :: upvt
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(OUT)        :: utp
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(OUT)        :: somcour
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(OUT)        :: somcourdrp
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(OUT)        :: somcourutp
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(OUT)        :: tdevelop
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(OUT)        :: somtemp
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(OUT)        :: somcourfauche
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(OUT)        :: stpltger
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(OUT)        :: R_stamflax
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(OUT)        :: R_stlaxsen
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(OUT)        :: R_stsenlan
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(OUT)        :: stlevflo
+    INTEGER(i_std),    DIMENSION(npts, nvm), INTENT(OUT)        :: nflo
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(OUT)        :: R_stlevdrp
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(OUT)        :: R_stflodrp
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(OUT)        :: R_stdrpmat
+    INTEGER(i_std),    DIMENSION(npts, nvm), INTENT(OUT)        :: nmat
+    INTEGER(i_std),    DIMENSION(npts, nvm), INTENT(OUT)        :: nlax
+    INTEGER(i_std),    DIMENSION(npts, nvm), INTENT(OUT)        :: nrecbutoir
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(OUT)        :: group
+    INTEGER(i_std),    DIMENSION(npts, nvm), INTENT(OUT)        :: ndebdes
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(OUT)        :: R_stdrpdes
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(OUT)        :: densite
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(OUT)        :: densitelev
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(OUT)        :: coeflev
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(OUT)        :: densiteger
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(OUT)        :: somelong
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(OUT)        :: somger
+    logical,    DIMENSION(npts, nvm), INTENT(OUT)        :: humectation
+    INTEGER(i_std),    DIMENSION(npts, nvm), INTENT(OUT)        :: nbjhumec
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(OUT)        :: somtemphumec
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(OUT)        :: stpltlev
+    INTEGER(i_std),    DIMENSION(npts, nvm), INTENT(OUT)        :: namf
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(OUT)        :: stmatrec
+ 
+    ! these variables are involved in Lai_calculation
+     
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(OUT)        :: tustress
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(OUT)        :: lai
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(OUT)        :: somfeuille
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(OUT)        :: pdlai
+    INTEGER(i_std),    DIMENSION(npts, nvm), INTENT(OUT)        :: nbfeuille
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(OUT)        :: reajust
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(OUT)        :: ulai
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(OUT)        :: pdulai
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(OUT)        :: efdensite
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(OUT)        :: tempeff
+    INTEGER(i_std),    DIMENSION(npts, nvm), INTENT(OUT)        :: nstopfeuille
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(OUT)        :: deltai
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(OUT)        :: vmax
+    INTEGER(i_std),    DIMENSION(npts, nvm), INTENT(OUT)        :: nsen
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(OUT)        :: laisen
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(OUT)        :: pdlaisen
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(OUT)        :: dltaisenat
+
+    ! these variables are involved in the LAIsenescence
+
+    INTEGER(i_std),    DIMENSION(npts, nvm), INTENT(OUT)      :: nsencour
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(OUT)      :: dltamsen
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(OUT)      :: dltaisen
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(OUT)      :: fgellev
+    logical,    DIMENSION(npts, nvm), INTENT(OUT)      :: gelee
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(OUT)      :: fstressgel
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(OUT)      :: R_stlevamf
+    INTEGER(i_std),    DIMENSION(npts, nvm), INTENT(OUT)      :: dernier_n
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(OUT)      :: durvieI
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(OUT)      :: durvie
+    INTEGER(i_std),    DIMENSION(npts, nvm), INTENT(OUT)      :: ndebsen
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(OUT)      :: somsenreste
+
+    INTEGER(i_std), INTENT(IN)                             :: nboxmax   
+    INTEGER(i_std),    DIMENSION(npts, nvm, nboxmax), INTENT(OUT)      :: box_ndays    
+    REAL(r_std),    DIMENSION(npts, nvm, nboxmax)                   :: boxtemp
+    REAL(r_std),    DIMENSION(npts, nvm, nboxmax), INTENT(OUT)      :: box_lai
+    REAL(r_std),    DIMENSION(npts, nvm, nboxmax), INTENT(OUT)      :: box_lairem
+    REAL(r_std),    DIMENSION(npts, nvm, nboxmax), INTENT(OUT)      :: box_tdev
+    REAL(r_std),    DIMENSION(npts, nvm, nboxmax), INTENT(OUT)      :: box_biom
+    REAL(r_std),    DIMENSION(npts, nvm, nboxmax), INTENT(OUT)      :: box_biomrem
+    REAL(r_std),    DIMENSION(npts, nvm, nboxmax), INTENT(OUT)      :: box_durage
+    REAL(r_std),    DIMENSION(npts, nvm, nboxmax), INTENT(OUT)      :: box_somsenbase
+    
+
+    ! these variables are involved in STRESS calculation
+    
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(OUT)      :: humrel
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(OUT)      :: swfac
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(OUT)      :: turfac
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(OUT)      :: senfac
+
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(OUT)      :: mafeuiljaune
+    REAL(r_std),    DIMENSION(npts, nvm), INTENT(OUT)      :: msneojaune
+    ! these variables are involved in the CARBON ALLOCATION calculation
+
+    ! grain related   
+    REAL(r_std),    DIMENSION(npts, nvm, vlength)      ,INTENT(OUT)       :: v_dltams
+    REAL(r_std),    DIMENSION(npts, nvm)      ,INTENT(OUT)       :: fgelflo
+    REAL(r_std),    DIMENSION(npts, nvm)      ,INTENT(OUT)       :: pdircarb
+    REAL(r_std),    DIMENSION(npts, nvm)      ,INTENT(OUT)       :: ircarb
+    REAL(r_std),    DIMENSION(npts, nvm)      ,INTENT(OUT)       :: nbgrains
+    REAL(r_std),    DIMENSION(npts, nvm)      ,INTENT(OUT)       :: pgrain
+    REAL(r_std),    DIMENSION(npts, nvm)      ,INTENT(OUT)       :: vitmoy
+    REAL(r_std),    DIMENSION(npts, nvm)      ,INTENT(OUT)       :: nbgraingel
+    REAL(r_std),    DIMENSION(npts, nvm)      ,INTENT(OUT)       :: pgraingel
+    REAL(r_std),    DIMENSION(npts, nvm)      ,INTENT(OUT)       :: dltags
+    REAL(r_std),    DIMENSION(npts, nvm)      ,INTENT(OUT)       :: ftempremp
+    REAL(r_std),    DIMENSION(npts, nvm)      ,INTENT(OUT)       :: magrain
+    REAL(r_std),    DIMENSION(npts, nvm)      ,INTENT(OUT)       :: pdmagrain
+    INTEGER(i_std), DIMENSION(npts, nvm)      ,INTENT(OUT)       :: nbj0remp 
+    REAL(r_std),    DIMENSION(npts, nvm)      ,INTENT(OUT)       :: pdsfruittot
+
+    ! reprac related
+
+    REAL(r_std),    DIMENSION(npts, nvm)      ,INTENT(OUT)       :: repracmax
+    REAL(r_std),    DIMENSION(npts, nvm)      ,INTENT(OUT)       :: repracmin
+    REAL(r_std),    DIMENSION(npts, nvm)      ,INTENT(OUT)       :: kreprac
+    REAL(r_std),    DIMENSION(npts, nvm)      ,INTENT(OUT)       :: somtemprac
+    REAL(r_std),    DIMENSION(npts, nvm)      ,INTENT(OUT)       :: urac
+    REAL(r_std),    DIMENSION(npts, nvm)      ,INTENT(OUT)       :: reprac
+    INTEGER(i_std), DIMENSION(npts, nvm)      ,INTENT(OUT)       :: nstoprac
+
+    REAL(r_std),    DIMENSION(npts, nvm)      ,INTENT(OUT)       :: c_reserve
+    REAL(r_std),    DIMENSION(npts, nvm)      ,INTENT(OUT)       :: c_leafb
+
+    INTEGER(i_std), DIMENSION(npts, nvm)      ,INTENT(OUT)       :: gslen 
+    INTEGER(i_std), DIMENSION(npts, nvm)      ,INTENT(OUT)       :: drylen 
+
+!!!!! xuhui
+    ! STICS--local
+    CHARACTER(LEN=100)                                            :: var_name !! for restget_p
+    REAL(r_std), DIMENSION(npts, nvm)                                 :: in_cycle_real        
+    REAL(r_std), DIMENSION(npts, nvm)                                 :: f_sen_lai_real        
+    REAL(r_std), DIMENSION(npts, nvm)                                 :: f_crop_recycle_real        
+    REAL(r_std), DIMENSION(npts, nvm)                                 :: onarretesomcourdrp_real        
+    REAL(r_std), DIMENSION(npts, nvm)                                 :: humectation_real        
+
+    !REAL(r_std), DIMENSION(nvm)                                       :: codeulaivernal_real        
+    
+    !REAL(r_std), DIMENSION(npts, nvm)                                 :: nlevobs_real
+    !REAL(r_std), DIMENSION(npts, nvm)                                 :: namfobs_real
+    !REAL(r_std), DIMENSION(npts, nvm)                                 :: nfloobs_real  
+    !REAL(r_std), DIMENSION(npts, nvm)                                 :: nlanobs_real  
+    !REAL(r_std), DIMENSION(npts, nvm)                                 :: nlaxobs_real  
+    !REAL(r_std), DIMENSION(npts, nvm)                                 :: nmatobs_real  
+    !REAL(r_std), DIMENSION(npts, nvm)                                 :: nrecobs_real  
+    !REAL(r_std), DIMENSION(npts, nvm)                                 :: nsenobs_real  
+    !REAL(r_std), DIMENSION(npts, nvm)                                 :: ndrpobs_real  
+
+    REAL(r_std), DIMENSION(npts, nvm)                                 :: etatvernal_real  
+    REAL(r_std), DIMENSION(npts, nvm)                                 :: gelee_real  
+
+
+    INTEGER(i_std)                                :: l,k,ji, jv, i, j, m      !! indices    
+!!!!! xuhui
+
+    !---------------------------------------------------------------------
+    IF (printlev >= 3) WRITE(numout,*) 'Entering readstart_sticslai_io'
+
+!ENDJCADD
+!!!!! crops
+
+    !f_crop_init_real = val_exp
+    !var_name = 'f_crop_init'
+    !CALL restget_p (rest_id_stomate, var_name, nbp_glo,   1, 1, itime, &
+    !     &                .TRUE., f_crop_init_real, 'gather', nbp_glo, index_g)
+    !IF (f_crop_init_real == val_exp) f_crop_init_real = zero
+    !WHERE (f_crop_init_real == 1)
+    !   f_crop_init = .TRUE.
+    !ELSEWHERE
+    !   f_crop_init = .FALSE.
+    !ENDWHERE
+   
+    f_crop_recycle_real(:, :) = val_exp
+    var_name = 'f_crop_recycle'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo,   nvm, 1, itime, &
+         &                .TRUE., f_crop_recycle_real, 'gather', nbp_glo, index_g)
+    IF (ALL(f_crop_recycle_real(:, :) == val_exp)) f_crop_recycle_real(:, :) = zero
+    WHERE (f_crop_recycle_real(:, :) == un)
+       f_crop_recycle = .TRUE.
+    ELSEWHERE
+       f_crop_recycle = .FALSE.
+    ENDWHERE
+
+    in_cycle_real(:, :) = val_exp
+    var_name = 'in_cycle'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo,   nvm, 1, itime, &
+         &                .TRUE., in_cycle_real, 'gather', nbp_glo, index_g)
+    IF (ALL(in_cycle_real(:, :) == val_exp)) in_cycle_real(:, :) = zero
+    WHERE (in_cycle_real(:, :) == un)
+       in_cycle = .TRUE.
+    ELSEWHERE
+       in_cycle = .FALSE.
+    ENDWHERE
+    
+    f_sen_lai_real(:, :) = val_exp
+    var_name = 'f_sen_lai'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo,   nvm, 1, itime, &
+         &                .TRUE., f_sen_lai_real, 'gather', nbp_glo, index_g)
+    IF (ALL(f_sen_lai_real(:, :) == val_exp)) f_sen_lai_real(:, :) = un
+    WHERE (f_sen_lai_real(:, :) == un)
+       f_sen_lai = .TRUE.
+    ELSEWHERE
+       f_sen_lai = .FALSE.
+    ENDWHERE
+    
+    st2m_max_daily(:) = val_exp
+    var_name = 'st2m_max_daily'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1     , 1, itime, &
+         &              .TRUE., st2m_max_daily, 'gather', nbp_glo, index_g)
+    IF (ALL(st2m_max_daily(:) == val_exp)) st2m_max_daily(:) = zero
+
+    wut_cm_daily(:, :, :) = val_exp
+    CALL restget_p (rest_id_stomate, 'wut_cm_daily', nbp_glo, nvm, 3, itime, &
+         &              .TRUE., wut_cm_daily, 'gather', nbp_glo, index_g)
+    IF (ALL(wut_cm_daily == val_exp)) wut_cm_daily = zero
+
+
+    wus_cm_daily(:, :, :) = val_exp
+    CALL restget_p (rest_id_stomate, 'wus_cm_daily', nbp_glo,  nvm , 3, itime, &
+         &              .TRUE., wus_cm_daily, 'gather', nbp_glo, index_g)
+    IF (ALL(wus_cm_daily == val_exp)) wus_cm_daily = zero
+
+
+    evapot_daily(:) = val_exp
+    var_name = 'evapot_daily'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1     , 1, itime, &
+         &              .TRUE., evapot_daily, 'gather', nbp_glo, index_g)
+    IF (ALL(evapot_daily(:) == val_exp)) evapot_daily(:) = zero
+
+    pdbiomass(:, :) = val_exp
+    var_name = 'pdbiomass'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., pdbiomass, 'gather', nbp_glo, index_g)
+    IF (ALL(pdbiomass(:, :) == val_exp)) pdbiomass(:, :) = zero
+
+    pdmasec(:, :) = val_exp
+    var_name = 'pdmasec'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., pdmasec, 'gather', nbp_glo, index_g)
+    IF (ALL(pdmasec(:, :) == val_exp)) pdmasec(:, :) = zero
+
+    masecveg(:, :) = val_exp
+    var_name = 'masecveg'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., masecveg, 'gather', nbp_glo, index_g)
+    IF (ALL(masecveg(:, :) == val_exp)) masecveg(:, :) = zero
+
+    masec(:, :) = val_exp
+    var_name = 'masec'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., masec, 'gather', nbp_glo, index_g)
+    IF (ALL(masec(:, :) == val_exp)) masec(:, :) = zero
+
+    dltams(:, :) = val_exp
+    var_name = 'dltams'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., dltams, 'gather', nbp_glo, index_g)
+    IF (ALL(dltams(:, :) == val_exp)) dltams(:, :) = zero
+
+    gdh_daily(:, :) = val_exp
+    var_name = 'gdh_daily'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., gdh_daily, 'gather', nbp_glo, index_g)
+    IF (ALL(gdh_daily(:, :) == val_exp)) gdh_daily(:, :) = zero
+
+    phoi(:) = val_exp
+    var_name = 'phoi'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1     , 1, itime, &
+         &              .TRUE., phoi, 'gather', nbp_glo, index_g)
+    IF (ALL(phoi(:) == val_exp)) phoi(:) = zero
+
+    onarretesomcourdrp_real(:, :) = val_exp
+    var_name = 'onarretesomcourdrp'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo,   nvm, 1, itime, &
+         &                .TRUE., onarretesomcourdrp_real, 'gather', nbp_glo, index_g)
+    IF (ALL(onarretesomcourdrp_real(:, :) == val_exp)) onarretesomcourdrp_real(:, :) = zero
+    WHERE (onarretesomcourdrp_real(:, :) == un)
+       onarretesomcourdrp = .TRUE.
+    ELSEWHERE
+       onarretesomcourdrp = .FALSE.
+    ENDWHERE
+
+    !codeulaivernal(:) = val_exp
+    !var_name = 'codeulaivernal'
+    !CALL restget_p (rest_id_stomate, var_name, nbp_glo, 1     , 1, itime, &
+    !     &              .TRUE., codeulaivernal_real, 'gather', nbp_glo, index_g)
+    !IF (ALL(codeulaivernal_real(:) == val_exp)) codeulaivernal_real(:) = zero
+    !codeulaivernal = INT(codeulaivernal_real)
+
+    !nlevobs(:, :) = val_exp
+    !var_name = 'nlevobs'
+    !CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+    !     &              .TRUE., nlevobs_real, 'gather', nbp_glo, index_g)
+    !IF (ALL(nlevobs_real(:, :) == val_exp)) nlevobs_real(:, :) = zero
+    !nlevobs = INT(nlevobs_real)
+
+    !namfobs(:, :) = val_exp
+    !var_name = 'namfobs'
+    !CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+    !     &              .TRUE., namfobs_real, 'gather', nbp_glo, index_g)
+    !IF (ALL(namfobs_real(:, :) == val_exp)) namfobs_real(:, :) = zero
+    !namfobs = INT(namfobs_real)
+
+    !nfloobs(:, :) = val_exp
+    !var_name = 'nfloobs'
+    !CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+    !     &              .TRUE., nfloobs_real, 'gather', nbp_glo, index_g)
+    !IF (ALL(nfloobs_real(:, :) == val_exp)) nfloobs_real(:, :) = zero
+    !nfloobs = INT(nfloobs_real)
+
+    !nlanobs(:, :) = val_exp
+    !var_name = 'nlanobs'
+    !CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+    !     &              .TRUE., nlanobs_real, 'gather', nbp_glo, index_g)
+    !IF (ALL(nlanobs_real(:, :) == val_exp)) nlanobs_real(:, :) = zero
+    !nlanobs = INT(nlanobs_real)
+
+    !nlaxobs(:, :) = val_exp
+    !var_name = 'nlaxobs'
+    !CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+    !     &              .TRUE., nlaxobs_real, 'gather', nbp_glo, index_g)
+    !IF (ALL(nlaxobs_real(:, :) == val_exp)) nlaxobs_real(:, :) = zero
+    !nlaxobs = INT(nlaxobs_real)
+
+    !nmatobs(:, :) = val_exp
+    !var_name = 'nmatobs'
+    !CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+    !     &              .TRUE., nmatobs_real, 'gather', nbp_glo, index_g)
+    !IF (ALL(nmatobs_real(:, :) == val_exp)) nmatobs_real(:, :) = zero
+    !nmatobs = INT(nmatobs_real)
+
+    !nrecobs(:, :) = val_exp
+    !var_name = 'nrecobs'
+    !CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+    !     &              .TRUE., nrecobs_real, 'gather', nbp_glo, index_g)
+    !IF (ALL(nrecobs_real(:, :) == val_exp)) nrecobs_real(:, :) = zero
+    !nrecobs = INT(nrecobs_real)
+
+    !nsenobs(:, :) = val_exp
+    !var_name = 'nsenobs'
+    !CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+    !     &              .TRUE., nsenobs_real, 'gather', nbp_glo, index_g)
+    !IF (ALL(nsenobs_real(:, :) == val_exp)) nsenobs_real(:, :) = zero
+    !nsenobs = INT(nsenobs_real)
+
+
+    !ndrpobs(:, :) = val_exp
+    !var_name = 'ndrpobs'
+    !CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+    !     &              .TRUE., ndrpobs_real, 'gather', nbp_glo, index_g)
+    !IF (ALL(ndrpobs_real(:, :) == val_exp)) ndrpobs_real(:, :) = zero
+    !ndrpobs = INT(ndrpobs_real)
+
+
+
+
+    nsendltams(:, :) = val_exp
+    var_name = 'nsendltams'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., nsendltams, 'gather', nbp_glo, index_g)
+    IF (ALL(nsendltams(:, :) == val_exp)) nsendltams(:, :) = zero
+
+    nsendltai(:, :) = val_exp
+    var_name = 'nsendltai'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., nsendltai, 'gather', nbp_glo, index_g)
+    IF (ALL(nsendltai(:, :) == val_exp)) nsendltai(:, :) = zero
+
+    nsenpfeuilverte(:, :) = val_exp
+    var_name = 'nsenpfeuilverte'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., nsenpfeuilverte, 'gather', nbp_glo, index_g)
+    IF (ALL(nsenpfeuilverte(:, :) == val_exp)) nsenpfeuilverte(:, :) = zero
+
+    nsendurvie(:, :) = val_exp
+    var_name = 'nsendurvie'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., nsendurvie, 'gather', nbp_glo, index_g)
+    IF (ALL(nsendurvie(:, :) == val_exp)) nsendurvie(:, :) = zero
+
+    nsenndurvie(:, :) = val_exp
+    var_name = 'nsenndurvie'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., nsenndurvie, 'gather', nbp_glo, index_g)
+    IF (ALL(nsenndurvie(:, :) == val_exp)) nsenndurvie(:, :) = zero
+
+    densiteequiv(:, :) = val_exp
+    var_name = 'densiteequiv'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., densiteequiv, 'gather', nbp_glo, index_g)
+    IF (ALL(densiteequiv(:, :) == val_exp)) densiteequiv(:, :) = zero
+
+    nplt(:, :) = val_exp
+    var_name = 'nplt'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., nplt, 'gather', nbp_glo, index_g)
+    IF (ALL(nplt(:, :) == val_exp)) nplt(:, :) = zero
+
+    tursla(:, :) = val_exp
+    var_name = 'tursla'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., tursla, 'gather', nbp_glo, index_g)
+    IF (ALL(tursla(:, :) == val_exp)) tursla(:, :) = un
+
+    ssla(:, :) = val_exp
+    var_name = 'ssla'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., ssla, 'gather', nbp_glo, index_g)
+    IF (ALL(ssla(:, :) == val_exp)) ssla(:, :) = zero
+
+    pfeuilverte(:, :) = val_exp
+    var_name = 'pfeuilverte'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., pfeuilverte, 'gather', nbp_glo, index_g)
+    IF (ALL(pfeuilverte(:, :) == val_exp)) pfeuilverte(:, :) = zero
+
+    bsenlai(:, :) = val_exp
+    var_name = 'bsenlai'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., bsenlai, 'gather', nbp_glo, index_g)
+    IF (ALL(bsenlai(:, :) == val_exp)) bsenlai(:, :) = zero
+
+    zrac(:, :) = val_exp
+    var_name = 'zrac'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., zrac, 'gather', nbp_glo, index_g)
+    IF (ALL(zrac(:, :) == val_exp)) zrac(:, :) = zero
+
+    nrec(:, :) = val_exp
+    var_name = 'nrec'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., nrec, 'gather', nbp_glo, index_g)
+    IF (ALL(nrec(:, :) == val_exp)) nrec(:, :) = zero
+
+    nlan(:, :) = val_exp
+    var_name = 'nlan'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., nlan, 'gather', nbp_glo, index_g)
+    IF (ALL(nlan(:, :) == val_exp)) nlan(:, :) = zero
+
+    tcult(:, :) = val_exp
+    var_name = 'tcult'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., tcult, 'gather', nbp_glo, index_g)
+    IF (ALL(tcult(:, :) == val_exp)) tcult(:, :) = zero
+
+    udevair(:, :) = val_exp
+    var_name = 'udevair'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., udevair, 'gather', nbp_glo, index_g)
+    IF (ALL(udevair(:, :) == val_exp)) udevair(:, :) = zero
+
+    udevcult(:, :) = val_exp
+    var_name = 'udevcult'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., udevcult, 'gather', nbp_glo, index_g)
+    IF (ALL(udevcult(:, :) == val_exp)) udevcult(:, :) = zero
+
+    ndrp(:, :) = val_exp
+    var_name = 'ndrp'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., ndrp, 'gather', nbp_glo, index_g)
+    IF (ALL(ndrp(:, :) == val_exp)) ndrp(:, :) = zero
+
+    rfvi(:, :) = val_exp
+    var_name = 'rfvi'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., rfvi, 'gather', nbp_glo, index_g)
+    IF (ALL(rfvi(:, :) == val_exp)) rfvi(:, :) = zero
+
+    nlev(:, :) = val_exp
+    var_name = 'nlev'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., nlev, 'gather', nbp_glo, index_g)
+    IF (ALL(nlev(:, :) == val_exp)) nlev(:, :) = zero
+
+    nger(:, :) = val_exp
+    var_name = 'nger'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., nger, 'gather', nbp_glo, index_g)
+    IF (ALL(nger(:, :) == val_exp)) nger(:, :) = zero
+
+    etatvernal_real(:, :) = val_exp
+    var_name = 'etatvernal'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., etatvernal_real, 'gather', nbp_glo, index_g)
+    IF (ALL(etatvernal_real(:, :) == val_exp)) etatvernal_real(:, :) = zero
+    WHERE (etatvernal_real(:,:) == un)
+       etatvernal = .TRUE.
+    ELSEWHERE
+       etatvernal = .FALSE.
+    ENDWHERE
+    
+
+    caljvc(:, :) = val_exp
+    var_name = 'caljvc'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., caljvc, 'gather', nbp_glo, index_g)
+    IF (ALL(caljvc(:, :) == val_exp)) caljvc(:, :) = zero
+
+    rfpi(:, :) = val_exp
+    var_name = 'rfpi'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., rfpi, 'gather', nbp_glo, index_g)
+    IF (ALL(rfpi(:, :) == val_exp)) rfpi(:, :) = zero
+
+    upvt(:, :) = val_exp
+    var_name = 'upvt'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., upvt, 'gather', nbp_glo, index_g)
+    IF (ALL(upvt(:, :) == val_exp)) upvt(:, :) = zero
+
+    utp(:, :) = val_exp
+    var_name = 'utp'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., utp, 'gather', nbp_glo, index_g)
+    IF (ALL(utp(:, :) == val_exp)) utp(:, :) = zero
+
+    somcour(:, :) = val_exp
+    var_name = 'somcour'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., somcour, 'gather', nbp_glo, index_g)
+    IF (ALL(somcour(:, :) == val_exp)) somcour(:, :) = zero
+
+    somcourdrp(:, :) = val_exp
+    var_name = 'somcourdrp'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., somcourdrp, 'gather', nbp_glo, index_g)
+    IF (ALL(somcourdrp(:, :) == val_exp)) somcourdrp(:, :) = zero
+
+    somcourutp(:, :) = val_exp
+    var_name = 'somcourutp'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., somcourutp, 'gather', nbp_glo, index_g)
+    IF (ALL(somcourutp(:, :) == val_exp)) somcourutp(:, :) = zero
+
+    tdevelop(:, :) = val_exp
+    var_name = 'tdevelop'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., tdevelop, 'gather', nbp_glo, index_g)
+    IF (ALL(tdevelop(:, :) == val_exp)) tdevelop(:, :) = zero
+
+    somtemp(:, :) = val_exp
+    var_name = 'somtemp'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., somtemp, 'gather', nbp_glo, index_g)
+    IF (ALL(somtemp(:, :) == val_exp)) somtemp(:, :) = zero
+
+    somcourfauche(:, :) = val_exp
+    var_name = 'somcourfauche'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., somcourfauche, 'gather', nbp_glo, index_g)
+    IF (ALL(somcourfauche(:, :) == val_exp)) somcourfauche(:, :) = zero
+
+    stpltger(:, :) = val_exp
+    var_name = 'stpltger'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., stpltger, 'gather', nbp_glo, index_g)
+    IF (ALL(stpltger(:, :) == val_exp)) THEN
+       DO j= 1, nvm
+          stpltger(:, j) = SP_stpltger(j)
+       ENDDO
+    ENDIF
+
+    R_stlaxsen(:, :) = val_exp
+    var_name = 'R_stlaxsen'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., R_stlaxsen, 'gather', nbp_glo, index_g)
+    IF (ALL(R_stlaxsen(:, :) == val_exp)) THEN
+       DO j= 1, nvm
+          R_stlaxsen(:, j) = SP_stlaxsen(j)
+       ENDDO
+    ENDIF
+
+
+    R_stamflax(:, :) = val_exp
+    var_name = 'R_stamflax'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., R_stamflax, 'gather', nbp_glo, index_g)
+    IF (ALL(R_stamflax(:, :) == val_exp)) THEN
+       DO j= 1, nvm
+          R_stamflax(:, j) = SP_stamflax(j)
+       ENDDO
+    ENDIF
+
+    R_stsenlan(:, :) = val_exp
+    var_name = 'R_stsenlan'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., R_stsenlan, 'gather', nbp_glo, index_g)
+    IF (ALL(R_stsenlan(:, :) == val_exp)) THEN
+       DO j= 1, nvm
+          R_stsenlan(:, j) = SP_stsenlan(j)
+       ENDDO
+    ENDIF
+
+    stlevflo(:, :) = val_exp
+    var_name = 'stlevflo'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., stlevflo, 'gather', nbp_glo, index_g)
+    IF (ALL(stlevflo(:, :) == val_exp)) THEN
+       DO j= 1, nvm
+          stlevflo(:, j) = SP_stlevdrp(j) - SP_stflodrp(j)
+       ENDDO
+    ENDIF
+
+    nflo(:, :) = val_exp
+    var_name = 'nflo'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., nflo, 'gather', nbp_glo, index_g)
+    IF (ALL(nflo(:, :) == val_exp)) nflo(:, :) = zero
+
+    R_stlevdrp(:, :) = val_exp
+    var_name = 'R_stlevdrp'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., R_stlevdrp, 'gather', nbp_glo, index_g)
+    IF (ALL(R_stlevdrp(:, :) == val_exp)) THEN
+       DO j= 1, nvm
+          R_stlevdrp(:, j) = SP_stlevdrp(j)
+       ENDDO
+    ENDIF
+
+    R_stflodrp(:, :) = val_exp
+    var_name = 'R_stflodrp'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., R_stflodrp, 'gather', nbp_glo, index_g)
+    IF (ALL(R_stflodrp(:, :) == val_exp)) THEN
+       DO j= 1, nvm
+          R_stflodrp(:, j) = SP_stflodrp(j)
+       ENDDO
+    ENDIF
+
+    R_stdrpmat(:, :) = val_exp
+    var_name = 'R_stdrpmat'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., R_stdrpmat, 'gather', nbp_glo, index_g)
+    IF (ALL(R_stdrpmat(:, :) == val_exp)) THEN
+       DO j= 1, nvm
+          R_stdrpmat(:, j) = SP_stdrpmat(j)
+       ENDDO
+    ENDIF
+
+    nmat(:, :) = val_exp
+    var_name = 'nmat'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., nmat, 'gather', nbp_glo, index_g)
+    IF (ALL(nmat(:, :) == val_exp)) nmat(:, :) = zero
+
+    nlax(:, :) = val_exp
+    var_name = 'nlax'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., nlax, 'gather', nbp_glo, index_g)
+    IF (ALL(nlax(:, :) == val_exp)) nlax(:, :) = zero
+
+    nrecbutoir(:, :) = val_exp
+    var_name = 'nrecbutoir'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., nrecbutoir, 'gather', nbp_glo, index_g)
+    IF (ALL(nrecbutoir(:, :) == val_exp)) nrecbutoir(:, :) = 999.0
+
+    group(:, :) = val_exp
+    var_name = 'group'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., group, 'gather', nbp_glo, index_g)
+    IF (ALL(group(:, :) == val_exp)) group(:, :) = zero
+
+    ndebdes(:, :) = val_exp
+    var_name = 'ndebdes'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., ndebdes, 'gather', nbp_glo, index_g)
+    IF (ALL(ndebdes(:, :) == val_exp)) ndebdes(:, :) = zero
+
+    R_stdrpdes(:, :) = val_exp
+    var_name = 'R_stdrpdes'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., R_stdrpdes, 'gather', nbp_glo, index_g)
+    IF (ALL(R_stdrpdes(:, :) == val_exp)) THEN
+       DO j= 1, nvm
+          R_stdrpdes(:, j) = SP_stdrpdes(j)
+       ENDDO
+    ENDIF
+
+    densite(:, :) = val_exp
+    var_name = 'densite'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., densite, 'gather', nbp_glo, index_g)
+    IF (ALL(densite(:, :) == val_exp)) densite(:, :) = zero
+
+    densitelev(:, :) = val_exp
+    var_name = 'densitelev'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., densitelev, 'gather', nbp_glo, index_g)
+    IF (ALL(densitelev(:, :) == val_exp)) densitelev(:, :) = zero
+
+    coeflev(:, :) = val_exp
+    var_name = 'coeflev'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., coeflev, 'gather', nbp_glo, index_g)
+    IF (ALL(coeflev(:, :) == val_exp)) coeflev(:, :) = un
+
+    densiteger(:, :) = val_exp
+    var_name = 'densiteger'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., densiteger, 'gather', nbp_glo, index_g)
+    IF (ALL(densiteger(:, :) == val_exp)) densiteger(:, :) = zero
+
+    somelong(:, :) = val_exp
+    var_name = 'somelong'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., somelong, 'gather', nbp_glo, index_g)
+    IF (ALL(somelong(:, :) == val_exp)) somelong(:, :) = zero
+
+    somger(:, :) = val_exp
+    var_name = 'somger'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., somger, 'gather', nbp_glo, index_g)
+    IF (ALL(somger(:, :) == val_exp)) somger(:, :) = zero
+
+    humectation_real(:, :) = val_exp
+    var_name = 'humectation'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo,   nvm, 1, itime, &
+         &                .TRUE., humectation_real, 'gather', nbp_glo, index_g)
+    IF (ALL(humectation_real(:, :) == val_exp)) humectation_real(:, :) = zero
+    WHERE (humectation_real(:, :) == un)
+       humectation = .TRUE.
+    ELSEWHERE
+       humectation = .FALSE.
+    ENDWHERE
+
+    nbjhumec(:, :) = val_exp
+    var_name = 'nbjhumec'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., nbjhumec, 'gather', nbp_glo, index_g)
+    IF (ALL(nbjhumec(:, :) == val_exp)) nbjhumec(:, :) = zero
+
+    somtemphumec(:, :) = val_exp
+    var_name = 'somtemphumec'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., somtemphumec, 'gather', nbp_glo, index_g)
+    IF (ALL(somtemphumec(:, :) == val_exp)) somtemphumec(:, :) = zero
+
+    stpltlev(:, :) = val_exp
+    var_name = 'stpltlev'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., stpltlev, 'gather', nbp_glo, index_g)
+    IF (ALL(stpltlev(:, :) == val_exp)) stpltlev(:, :) = zero
+
+    namf(:, :) = val_exp
+    var_name = 'namf'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., namf, 'gather', nbp_glo, index_g)
+    IF (ALL(namf(:, :) == val_exp)) namf(:, :) = zero
+
+    stmatrec(:, :) = val_exp
+    var_name = 'stmatrec'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., stmatrec, 'gather', nbp_glo, index_g)
+    IF (ALL(stmatrec(:, :) == val_exp)) stmatrec(:, :) = zero
+
+    tustress(:, :) = val_exp
+    var_name = 'tustress'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., tustress, 'gather', nbp_glo, index_g)
+    IF (ALL(tustress(:, :) == val_exp)) tustress(:, :) = 1.0
+
+    lai(:, :) = val_exp
+    var_name = 'lai'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., lai, 'gather', nbp_glo, index_g)
+    IF (ALL(lai(:, :) == val_exp)) lai(:, :) = zero
+
+    somfeuille(:, :) = val_exp
+    var_name = 'somfeuille'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., somfeuille, 'gather', nbp_glo, index_g)
+    IF (ALL(somfeuille(:, :) == val_exp)) somfeuille(:, :) = zero
+
+    pdlai(:, :) = val_exp
+    var_name = 'pdlai'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., pdlai, 'gather', nbp_glo, index_g)
+    IF (ALL(pdlai(:, :) == val_exp)) pdlai(:, :) = zero
+
+    nbfeuille(:, :) = val_exp
+    var_name = 'nbfeuille'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., nbfeuille, 'gather', nbp_glo, index_g)
+    IF (ALL(nbfeuille(:, :) == val_exp)) nbfeuille(:, :) = zero
+
+    reajust(:, :) = val_exp
+    var_name = 'reajust'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., reajust, 'gather', nbp_glo, index_g)
+    IF (ALL(reajust(:, :) == val_exp)) reajust(:, :) = zero
+
+    ulai(:, :) = val_exp
+    var_name = 'ulai'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., ulai, 'gather', nbp_glo, index_g)
+    IF (ALL(ulai(:, :) == val_exp)) ulai(:, :) = zero
+
+    pdulai(:, :) = val_exp
+    var_name = 'pdulai'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., pdulai, 'gather', nbp_glo, index_g)
+    IF (ALL(pdulai(:, :) == val_exp)) pdulai(:, :) = zero
+
+    efdensite(:, :) = val_exp
+    var_name = 'efdensite'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., efdensite, 'gather', nbp_glo, index_g)
+    IF (ALL(efdensite(:, :) == val_exp)) efdensite(:, :) = zero
+
+    tempeff(:, :) = val_exp
+    var_name = 'tempeff'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., tempeff, 'gather', nbp_glo, index_g)
+    IF (ALL(tempeff(:, :) == val_exp)) tempeff(:, :) = zero
+
+    nstopfeuille(:, :) = val_exp
+    var_name = 'nstopfeuille'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., nstopfeuille, 'gather', nbp_glo, index_g)
+    IF (ALL(nstopfeuille(:, :) == val_exp)) nstopfeuille(:, :) = zero
+
+    deltai(:, :) = val_exp
+    var_name = 'deltai'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., deltai, 'gather', nbp_glo, index_g)
+    IF (ALL(deltai(:, :) == val_exp)) deltai(:, :) = zero
+
+    vmax(:, :) = val_exp
+    var_name = 'vmax'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., vmax, 'gather', nbp_glo, index_g)
+    IF (ALL(vmax(:, :) == val_exp)) vmax(:, :) = zero
+
+    nsen(:, :) = val_exp
+    var_name = 'nsen'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., nsen, 'gather', nbp_glo, index_g)
+    IF (ALL(nsen(:, :) == val_exp)) nsen(:, :) = zero
+
+
+    laisen(:, :) = val_exp
+    var_name = 'laisen'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., laisen, 'gather', nbp_glo, index_g)
+    IF (ALL(laisen(:, :) == val_exp)) laisen(:, :) = zero
+
+    pdlaisen(:, :) = val_exp
+    var_name = 'pdlaisen'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., pdlaisen, 'gather', nbp_glo, index_g)
+    IF (ALL(pdlaisen(:, :) == val_exp)) pdlaisen(:, :) = zero
+
+    dltaisenat(:, :) = val_exp
+    var_name = 'dltaisenat'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., dltaisenat, 'gather', nbp_glo, index_g)
+    IF (ALL(dltaisenat(:, :) == val_exp)) dltaisenat(:, :) = zero
+
+    nsencour(:, :) = val_exp
+    var_name = 'nsencour'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., nsencour, 'gather', nbp_glo, index_g)
+    IF (ALL(nsencour(:, :) == val_exp)) nsencour(:, :) = zero
+    nsencour = INT(nsencour)
+
+    dltamsen(:, :) = val_exp
+    var_name = 'dltamsen'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., dltamsen, 'gather', nbp_glo, index_g)
+    IF (ALL(dltamsen(:, :) == val_exp)) dltamsen(:, :) = zero
+
+    dltaisen(:, :) = val_exp
+    var_name = 'dltaisen'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., dltaisen, 'gather', nbp_glo, index_g)
+    IF (ALL(dltaisen(:, :) == val_exp)) dltaisen(:, :) = zero
+
+    fgellev(:, :) = val_exp
+    var_name = 'fgellev'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., fgellev, 'gather', nbp_glo, index_g)
+    IF (ALL(fgellev(:, :) == val_exp)) fgellev(:, :) = un
+
+    gelee_real(:, :) = val_exp
+    var_name = 'gelee'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., gelee_real, 'gather', nbp_glo, index_g)
+    IF (ALL(gelee_real(:, :) == val_exp)) gelee_real(:, :) = zero
+    WHERE (gelee_real(:,:) == un)
+       gelee = .TRUE.
+    ELSEWHERE
+       gelee = .FALSE.
+    ENDWHERE
+
+    fstressgel(:, :) = val_exp
+    var_name = 'fstressgel'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., fstressgel, 'gather', nbp_glo, index_g)
+    IF (ALL(fstressgel(:, :) == val_exp)) fstressgel(:, :) = zero
+
+    R_stlevamf(:, :) = val_exp
+    var_name = 'R_stlevamf'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., R_stlevamf, 'gather', nbp_glo, index_g)
+    IF (ALL(R_stlevamf(:, :) == val_exp)) THEN
+       DO j= 1, nvm
+          R_stlevamf(:, j) = SP_stlevamf(j)
+       ENDDO
+    ENDIF
+
+    dernier_n(:, :) = val_exp
+    var_name = 'dernier_n'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., dernier_n, 'gather', nbp_glo, index_g)
+    IF (ALL(dernier_n(:, :) == val_exp)) dernier_n(:, :) = zero
+
+    durvieI(:, :) = val_exp
+    var_name = 'durvieI'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., durvieI, 'gather', nbp_glo, index_g)
+    IF (ALL(durvieI(:, :) == val_exp)) durvieI(:, :) = zero
+
+    durvie(:, :) = val_exp
+    var_name = 'durvie'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., durvie, 'gather', nbp_glo, index_g)
+    IF (ALL(durvie(:, :) == val_exp)) durvie(:, :) = zero
+
+    ndebsen(:, :) = val_exp
+    var_name = 'ndebsen'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., ndebsen, 'gather', nbp_glo, index_g)
+    IF (ALL(ndebsen(:, :) == val_exp)) ndebsen(:, :) = zero
+
+    somsenreste(:, :) = val_exp
+    var_name = 'somsenreste'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., somsenreste, 'gather', nbp_glo, index_g)
+    IF (ALL(somsenreste(:, :) == val_exp)) somsenreste(:, :) = zero
+
+    humrel(:, :) = val_exp
+    var_name = 'humrel'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., humrel, 'gather', nbp_glo, index_g)
+    IF (ALL(humrel(:, :) == val_exp)) humrel(:, :) = zero
+
+    swfac(:, :) = val_exp
+    var_name = 'swfac'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., swfac, 'gather', nbp_glo, index_g)
+    IF (ALL(swfac(:, :) == val_exp)) swfac(:, :) = un
+
+    turfac(:, :) = val_exp
+    var_name = 'turfac'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., turfac, 'gather', nbp_glo, index_g)
+    IF (ALL(turfac(:, :) == val_exp)) turfac(:, :) = un
+
+    senfac(:, :) = val_exp
+    var_name = 'senfac'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., senfac, 'gather', nbp_glo, index_g)
+    IF (ALL(senfac(:, :) == val_exp)) senfac(:, :) = un
+  
+
+    mafeuiljaune(:, :) = val_exp
+    var_name = 'mafeuiljaune'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., mafeuiljaune, 'gather', nbp_glo, index_g)
+    IF (ALL(mafeuiljaune(:, :) == val_exp)) mafeuiljaune(:, :) = un
+    
+    msneojaune(:, :) = val_exp
+    var_name = 'msneojaune'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., msneojaune, 'gather', nbp_glo, index_g)
+    IF (ALL(msneojaune(:, :) == val_exp)) msneojaune(:, :) = un
+
+    box_ndays(:,:,:) = 0
+    box_lai(:,:,:) = 0.
+    box_lairem(:,:,:) = 0.
+    box_tdev(:,:,:) = 0.
+    box_biom(:,:,:) = 0.
+    box_biomrem(:,:,:) = 0.
+    box_durage(:,:,:) = 0.
+    box_somsenbase(:,:,:) = 0.
+    CALL restget_p(rest_id_stomate, 'box_ndays', nbp_glo, nvm,  nboxmax, itime, &
+             &              .TRUE., box_ndays, 'gather', nbp_glo, index_g)
+    IF (ALL(box_ndays == val_exp)) box_ndays = 0
+
+    CALL restget_p(rest_id_stomate, 'box_lai', nbp_glo, nvm,   nboxmax, itime, &
+            &               .TRUE., box_lai, 'gather', nbp_glo, index_g)
+    IF (ALL(box_lai == val_exp)) box_lai = 0.
+
+    CALL restget_p(rest_id_stomate, 'box_lairem', nbp_glo, nvm,   nboxmax, itime, &
+            &               .TRUE., box_lairem, 'gather', nbp_glo, index_g)
+    IF (ALL(box_lairem == val_exp)) box_lairem = 0.
+
+    CALL restget_p(rest_id_stomate, 'box_tdev', nbp_glo, nvm,   nboxmax, itime, &
+            &               .TRUE., box_tdev, 'gather', nbp_glo, index_g)
+    IF (ALL(box_tdev == val_exp)) box_tdev = 0.
+
+    CALL restget_p(rest_id_stomate, 'box_biom', nbp_glo, nvm,   nboxmax, itime, &
+            &               .TRUE., box_biom, 'gather', nbp_glo, index_g)
+    IF (ALL(box_biom == val_exp)) box_biom = 0.
+
+    CALL restget_p(rest_id_stomate, 'box_biomrem', nbp_glo, nvm,   nboxmax, itime, &
+            &               .TRUE., box_biomrem, 'gather', nbp_glo, index_g)
+    IF (ALL(box_biomrem == val_exp)) box_biomrem = 0.
+
+    CALL restget_p(rest_id_stomate, 'box_durage', nbp_glo, nvm,   nboxmax, itime, &
+            &               .TRUE., box_durage, 'gather', nbp_glo, index_g)
+    IF (ALL(box_durage == val_exp)) box_durage = 0.
+
+    CALL restget_p(rest_id_stomate, 'box_somsenbase', nbp_glo, nvm,   nboxmax, itime, &
+            &               .TRUE., box_somsenbase, 'gather', nbp_glo, index_g)
+    IF (ALL(box_somsenbase == val_exp)) box_somsenbase = 0.
+ 
+    ! STICS:: CARBON ALLOCATION
+   
+    
+    v_dltams(:,:,:) = val_exp
+    CALL restget_p (rest_id_stomate, 'v_dltams', nbp_glo, nvm  , vlength, itime, &
+            &                .TRUE., v_dltams, 'gather', nbp_glo, index_g)
+    IF (ALL(v_dltams == val_exp))  v_dltams = zero
+
+    fgelflo(:, :) = val_exp
+    var_name = 'fgelflo'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., fgelflo, 'gather', nbp_glo, index_g)
+    IF (ALL(fgelflo(:, :) == val_exp)) fgelflo(:, :) = un
+
+    pdircarb(:, :) = val_exp
+    var_name = 'pdircarb'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., pdircarb, 'gather', nbp_glo, index_g)
+    IF (ALL(pdircarb(:, :) == val_exp)) pdircarb(:, :) = zero
+
+    ircarb(:, :) = val_exp
+    var_name = 'ircarb'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., ircarb, 'gather', nbp_glo, index_g)
+    IF (ALL(ircarb(:, :) == val_exp)) ircarb(:, :) = zero
+
+    nbgrains(:, :) = val_exp
+    var_name = 'nbgrains'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., nbgrains, 'gather', nbp_glo, index_g)
+    IF (ALL(nbgrains(:, :) == val_exp)) nbgrains(:, :) = zero
+
+    pgrain(:, :) = val_exp
+    var_name = 'pgrain'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., pgrain, 'gather', nbp_glo, index_g)
+    IF (ALL(pgrain(:, :) == val_exp)) pgrain(:, :) = zero
+
+    vitmoy(:, :) = val_exp
+    var_name = 'vitmoy'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., vitmoy, 'gather', nbp_glo, index_g)
+    IF (ALL(vitmoy(:, :) == val_exp)) vitmoy(:, :) = zero
+
+    nbgraingel(:, :) = val_exp
+    var_name = 'nbgraingel'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., nbgraingel, 'gather', nbp_glo, index_g)
+    IF (ALL(nbgraingel(:, :) == val_exp)) nbgraingel(:, :) = zero
+
+    pgraingel(:, :) = val_exp
+    var_name = 'pgraingel'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., pgraingel, 'gather', nbp_glo, index_g)
+    IF (ALL(pgraingel(:, :) == val_exp)) pgraingel(:, :) = zero
+
+    dltags(:, :) = val_exp
+    var_name = 'dltags'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., dltags, 'gather', nbp_glo, index_g)
+    IF (ALL(dltags(:, :) == val_exp)) dltags(:, :) = zero
+
+    ftempremp(:, :) = val_exp
+    var_name = 'ftempremp'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., ftempremp, 'gather', nbp_glo, index_g)
+    IF (ALL(ftempremp(:, :) == val_exp)) ftempremp(:, :) = zero
+
+    magrain(:, :) = val_exp
+    var_name = 'magrain'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., magrain, 'gather', nbp_glo, index_g)
+    IF (ALL(magrain(:, :) == val_exp)) magrain(:, :) = zero
+
+    pdmagrain(:, :) = val_exp
+    var_name = 'pdmagrain'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., pdmagrain, 'gather', nbp_glo, index_g)
+    IF (ALL(pdmagrain(:, :) == val_exp)) pdmagrain(:, :) = zero
+
+    nbj0remp(:, :) = val_exp
+    var_name = 'nbj0remp'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., nbj0remp, 'gather', nbp_glo, index_g)
+    IF (ALL(nbj0remp(:, :) == val_exp)) nbj0remp(:, :) = zero
+
+   
+    !nbj0remp(:, :) = val_exp
+    !var_name = 'nbj0remp'
+    !CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+    !     &              .TRUE., nbj0remp, 'gather', nbp_glo, index_g)
+    !IF (ALL(nbj0remp(:, :) == val_exp)) nbj0remp(:, :) = zero
+
+    pdsfruittot(:, :) = val_exp
+    var_name = 'pdsfruittot'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., pdsfruittot, 'gather', nbp_glo, index_g)
+    IF (ALL(pdsfruittot(:, :) == val_exp)) pdsfruittot(:, :) = zero
+
+    repracmax(:, :) = val_exp
+    var_name = 'repracmax'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., repracmax, 'gather', nbp_glo, index_g)
+    IF (ALL(repracmax(:, :) == val_exp)) repracmax(:, :) = zero
+
+    repracmin(:, :) = val_exp
+    var_name = 'repracmin'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., repracmin, 'gather', nbp_glo, index_g)
+    IF (ALL(repracmin(:, :) == val_exp)) repracmin(:, :) = zero
+
+    kreprac(:, :) = val_exp
+    var_name = 'kreprac'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., kreprac, 'gather', nbp_glo, index_g)
+    IF (ALL(kreprac(:, :) == val_exp)) kreprac(:, :) = zero
+
+    somtemprac(:, :) = val_exp
+    var_name = 'somtemprac'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., somtemprac, 'gather', nbp_glo, index_g)
+    IF (ALL(somtemprac(:, :) == val_exp)) somtemprac(:, :) = zero
+
+    urac(:, :) = val_exp
+    var_name = 'urac'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., urac, 'gather', nbp_glo, index_g)
+    IF (ALL(urac(:, :) == val_exp)) urac(:, :) = zero
+
+    reprac(:, :) = val_exp
+    var_name = 'reprac'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., reprac, 'gather', nbp_glo, index_g)
+    IF (ALL(reprac(:, :) == val_exp)) reprac(:, :) = zero
+
+    c_reserve(:, :) = val_exp
+    var_name = 'c_reserve'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., c_reserve, 'gather', nbp_glo, index_g)
+    IF (ALL(c_reserve(:, :) == val_exp)) c_reserve(:, :) = zero
+
+
+    nstoprac(:, :) = val_exp
+    var_name = 'nstoprac'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., nstoprac, 'gather', nbp_glo, index_g)
+    IF (ALL(nstoprac(:, :) == val_exp)) nstoprac(:, :) = zero
+
+
+    var_name = 'c_leafb'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., c_leafb, 'gather', nbp_glo, index_g)
+    IF (ALL(c_leafb(:, :) == val_exp)) c_leafb(:, :) = zero
+
+    gslen(:, :) = val_exp
+    var_name = 'gslen'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., gslen, 'gather', nbp_glo, index_g)
+    IF (ALL(gslen(:, :) == val_exp)) gslen(:, :) = zero
+
+    drylen(:, :) = val_exp
+    var_name = 'drylen'
+    CALL restget_p (rest_id_stomate, var_name, nbp_glo, nvm     , 1, itime, &
+         &              .TRUE., drylen, 'gather', nbp_glo, index_g)
+    IF (ALL(drylen(:, :) == val_exp)) drylen(:, :) = zero
+!!!!! xuhui
+ 
+    IF (printlev >= 4) WRITE(numout,*) 'Leaving readstart'
+    !-----------------------
+  END SUBROUTINE sticslai_io_readstart
+  !-
+  !===
+  !-
+END MODULE sticslai_io
+
Index: /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_sticslai/stress.f90
===================================================================
--- /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_sticslai/stress.f90	(revision 6940)
+++ /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_sticslai/stress.f90	(revision 6940)
@@ -0,0 +1,127 @@
+! ml_com !
+! *-----------------------------------------------------------------------------------------------------------------------------------------------------------* c!
+!! This module calculates the water stress indices, swfac and turfac.
+!> - Stics book paragraphe 7.3.1, 7.3.2, page 138-140
+!>
+!! Relative transpiration, i.e. the relationship between actual transpiration and maximal transpiration (ep/eop), is a bilinear function of the available
+!! water content in the root zone, teta (i.e. the water content above the wilting point in cm3 of water/cm3 of dry soil).
+!!
+!! The water content threshold separating the maximal transpiration stage and the reduced transpiration stage (tetstomate) depends on root density,
+!! the stomatal functioning of the plant, and the evaporative demand (Brisson, 1998c). It was shown that this threshold does not depend on the soil type,
+!! for example via the maximal available water content, as is commonly assumed.
+!!
+!! In the calculations below, cumlracz is the summation over the whole rooting depth, zrac, of effective root length density lracz,
+!! psisto is the critical potential of stomatal closure (positive in bars) and rayon is the mean root radius which is assumed to be equal to 0.02 cm.
+!!
+!! The ep/eop ratio is equal to the stomatal stress index, swfac.  The stress turgor index turfac which affects leaf growth comes into play earlier.
+!! The method for calculating it is copied from the method used for swfac using the critical potential of cell expansion psiturg.
+!! Since psiturg is lower than psisto, we obtain a higher teturg threshold.  In other words, leaf growth can be inhibited even when transpiration is still at
+!! its maximum level.
+
+
+
+!!
+!! However, in our model, we just use the relative of available soil moisture to fielding capacity to represent the slowing effects on LAI. 
+!! The humrel is harmonized. 
+! *-----------------------------------------------------------------------------------------------------------------------------------------------------------* c!
+subroutine stress(n,                  &   ! IN
+                  nrec,               &  
+                  lai,                & 
+                  eop,                &
+                  shumdiag_cm_day,    &   ! IN
+                  vswc,               &   ! IN
+                  humrel,             &
+                  shumrel,            &
+                  swfac,              &   ! INOUT
+                  turfac,             &
+                  senfac)                 
+  USE Stics
+  USE constantes  
+
+
+  
+  IMPLICIT NONE
+
+!: Arguments
+!: IN
+
+  integer, intent(IN)                  :: n  
+  integer, intent(IN)                  :: nrec 
+  real,    intent(IN)                  :: lai           ! leaf area index
+  real,    intent(IN)                  :: eop      !> // OUTPUT // Maximum transpiration flux  // mm
+  real,    intent(IN), dimension(3)    :: shumdiag_cm_day 
+  real,    intent(IN)                  :: vswc      !> daily humrel data
+  real,    intent(IN)                  :: humrel
+  
+!: INOUT
+  real,    intent(INOUT) :: swfac      !> // OUTPUT // Index of stomatic water stress  // 0-1
+  real,    intent(INOUT) :: turfac      !> // OUTPUT // Index of turgescence water stress  // 0-1
+  real,    intent(INOUT) :: senfac      !> // OUTPUT // Water stress index on senescence // 0-1
+! OUT
+  real,    intent(OUT)    :: shumrel     ! average relative soil moisture to holding capacity at sowing depth
+
+! temporal variables 
+
+  real  ::    teta   ! volumetric soil water content m3/m3
+
+!      print *, 'in stress, the vegstress and humrel is', vswc, humrel
+      
+
+      ! ** si pas de plante
+      shumrel = sum(shumdiag_cm_day)/3.0 ! relative to soil holding capacity
+!      print *, 'humrel in stress is', humrel
+!      print *, 'eop and lai in stress is', eop, lai
+      if ((P_codelaitr == 1 .and. lai <= 0.)          &
+          .or. (nrec /= 0 .and. nrec > 0 .and. P_codcueille <= 1)     &
+          .or. (eop <= 0.)                                 &
+         ) then
+
+        swfac  = 1.
+        turfac = 1.
+        senfac = 1.
+      else
+         ! we calculate the water stress based on the volumic soil water contents.
+         
+         teta = vswc  ! this is the volumetric soil water contents
+         !teta = vswc        
+
+         !: Calcul de swfac
+              if (teta <= tetstomate) then
+                swfac = teta / tetstomate
+              else
+                swfac = 1.
+              endif
+              !write(70,*) n,'swfac=',swfac,teta,tetstomate,P_swfacmin
+              swfac = max(swfac, P_swfacmin)
+    
+    
+              !: Calcul de turfac
+              if (teta <= teturg) then
+                turfac = teta / teturg
+              else
+                turfac = 1.
+              endif
+              turfac = max(turfac, P_swfacmin)
+        
+              !: Calcul de senfac
+              if (teta <= tetsen) then
+                senfac = teta / tetsen
+              else
+                senfac = 1.0
+              endif
+              senfac = max(senfac, P_swfacmin) 
+ 
+!          print *, 'do we go into here? in stress'
+!          print *, 'in stress, the swfac, senfac, and turfac is :', swfac, senfac, turfac
+      endif
+      !!! a temporary setting to remove water stress for rice
+!      if (P_codeplante == 'ric') then
+!          swfac = 1
+!          senfac = 1
+!          turfac = 1
+!      endif
+
+return
+end subroutine stress
+ 
+ 
Index: /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_stomate/lpj_spitfire.f90
===================================================================
--- /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_stomate/lpj_spitfire.f90	(revision 6940)
+++ /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_stomate/lpj_spitfire.f90	(revision 6940)
@@ -0,0 +1,2035 @@
+!  ==============================================================================================================================
+!  MODULE		 			: lpj_spitfire
+!
+!  CONTACT		 			: orchidee-help _at_ ipsl.jussieu.fr
+!
+!  LICENCE	 			        : IPSL (2006)
+!  This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF				       This module simulates fires in
+!! natural vegetations in a prognostic way. 
+!! 
+!!
+!!\n DESCRIPTION                                : Use daily meterological
+!! information combined with information for fuel availability to simulate
+!! burned area and gas emissions in fire. Only fires in natural PFTs have been
+!! simulated.
+!!
+!! REFERENCE(S)
+!! - K.Thonicke, A.Spessa, I.C. Prentice, S.P.Harrison, L.Dong, and
+!! C.Carmona-Moreno, 2010: The influence of vegetation, fire spread and fire
+!! behaviour on biomass burning and trace gas emissions: results from a
+!! process-based model. Biogeosciences, 7, 1991-2011.
+!!
+!! SVN          :
+!! $HeadURL: svn://forge.ipsl.jussieu.fr/orchidee/branches/DOC/ORCHIDEE/src_sechiba/enerbil.f90 $
+!! $Date: 2012-00-00 12:22:59 +0100  $
+!! $Revision: ??? $
+!! \n
+!_ ================================================================================================================================
+
+!! Below are some remarks that further document model behavior or existing minor
+!! issues in the model, they're minor in nature and do not affect large-scale
+!! model performance.
+!! ----------------------- Remarks ------------------------------------------------
+!! Date 2015/04/13
+! 1. There are few places where clarifications are needed, mainmy minor, they're
+! marked as ??, or [UNCLEAR]
+! 2. some varialbes are not actually used in some SUBROUTINEs or the whole module. 
+! and they're designated as "NOT USED"
+! 3. some sources of parameters need to be check. they're marked as "SOURCE"
+! 4. it's been tested that observed BA will be read as they are (the monthly 
+! ba will be repeated by day number of concerning month) if the external observed
+! burned area is forced into the model. The only strange behavior is that the 
+! last day of the year seems to repeat the first month value (it's also the case 
+! for lightning), (cf./home/orchidee03/ychao/OUTPUT_A5F_STD_WITHFIRE_OLDmap_NA5070
+! /FIRETEST/TEST_BA_LIGHTN/BATEST/observed_ba.txt)
+! When foring BA, if we assume that BA is distributed equally across the month, 
+! we should divide the monthly BA in GFED3 by number of days in that month 
+! before feed the data into model.
+! 4. it's been test (2012/06/03) for 0.5dX0.5d lightning data, it behaves the same
+! way exactly as burned area. this means lightning data must be provided as daily
+! value. 
+! 5. as popdensity is given one value for one year. this value is read directly into
+! model (model use constant popdens value throughout the whole simulation year)
+!! --------------------------------------------------------------------------------
+
+!!------------ Explanations for forcing external Burned area ----------------------
+!! Date 2015/04/13
+! 1. External burned area could be forced into model, currently only monthly external
+! BA input is configuered, this monthly BA will be treated as to occur at the 
+! beginning day of each month. The flag to activate the external BA forcing is
+! the read_observed_ba and ratio_flag variable, for regions where ratio_flag is bigger than 0,
+! BA will be externally forced.
+! 2. When external BA is not forced, baadjust_ratio could be used to adjust the 
+! simulated BA.
+! 3. The consumption fraction in fires for fuels could also be imposed from 
+! external input, read_cf_coarse control the input of coarse fuel (corresponding
+! to 1000hr fuel in the model); read_cf_fine control the input for the fine
+! fuel (corresponding to live grass, 1hr/10hr/100hr fuel in the model).
+!
+! This behaviour is very flexible, one has to read the code to fully understand it.
+!!--------------------------------------------------------------------------------
+
+MODULE lpj_spitfire
+
+  ! modules used:
+  USE xios_orchidee
+  USE stomate_data
+  USE pft_parameters
+  USE constantes
+  USE ioipsl_para
+
+  IMPLICIT NONE
+
+  ! private & public routines
+  PRIVATE
+  PUBLIC spitfire,spitfire_clear
+
+  ! first call
+  LOGICAL, SAVE                                                   :: firstcall = .TRUE.
+
+CONTAINS
+
+
+  SUBROUTINE spitfire_clear
+    firstcall = .TRUE.
+  END SUBROUTINE spitfire_clear
+
+!! ================================================================================================================================
+!! SUBROUTINE     : SPITFIRE 
+!!
+!>\BRIEF          A prognostic fire module. It uses daily temperature and
+!! precipitation to calculate fire danger index, combined with ignition sources to
+!! derive number of fires. Then Burned area, fuel consumption and tree crown
+!! scorching, tree mortality were calculated. 
+!!
+!! DESCRIPTION	: 
+!!
+!! The module completes the following tasks:
+!! 1. Calculate fire danger index from daily temperature and precipitation using
+!! Nesterov Index (NI). The fuel mositure and moisture of extinction are compared
+!! to derive a daily Fire Danger Index (FDI). Fuel moiture is calculated using
+!! Nesterov Index by weighting among differnet types of fuels. The fuel type with
+!! a bigger surface-area-to-volume ratio receives less weight in determining the
+!! fuel moisture state.
+!! 2. Use daily FDI and ignition source data to derive daily fire numbers.
+!! 3. Apply Rothermel's equation to calculate fire Rate of Spread (ROS) for both
+!! forward and backward. Rate of spread is determined in a way related with fire
+!! reaction intensity(+), propagating flux ratio(+), wind speed(+), fuel bulk
+!! density(-),effective heating number(-), and heat of pre-ignition(-).
+!! 4. From daily FDI derive fire duration time, combined with rate of spread to
+!! derive burned area.
+!! 5. Fuel mositure calculated in the step of daily FDI can be again used to
+!! determin consumption fraction of different types of fuels in fire.
+!! 6. Calculate fire surface intensity using ROSf, fuel consumption, and burned
+!! area, thus further to determin flame height and fire damage to tree crown. 
+!! 7. Fire caused tree mortality are determined based on 2 considerations, the
+!! damage of flame to tree crown, and damage of fire residence time to tree barks.
+!! crowning scorching biomass release as emissions, while unburned dead tree
+!! biomass part transfer to litter pool.
+!! 
+!! In summary, fire weather (temperature, preciptation, wind speed) plays a central 
+!! role in this module, it determines fuel moisture, which futher determines
+!! daily fire danger index (FDI) --> nubmer of fires --> fire duration --> fire
+!! size --> burned area --> fire intensity, residence time --> tree demage
+!! 
+!! Important Note:
+!! 1. over one day and within one pixel, fire has unified size and BA=Size X
+!! Number. 
+!! 2. Fuel consumption and burned area are calculated independently.
+!! 
+!! RECENT CHANGE(S): None
+!!
+!! MAIN OUTPUT VARIABLE(S): fire_frac, co2_fire, and trace gas emissions. 
+!!
+!! REFERENCES    :
+!! - K.Thonicke, A.Spessa, I.C. Prentice, S.P.Harrison, L.Dong, and
+!! C.Carmona-Moreno, 2010: The influence of vegetation, fire spread and fire
+!! behaviour on biomass burning and trace gas emissions: results from a
+!! process-based model. Biogeosciences, 7, 1991-2011.
+!! - Rothermel, R. C.: A Mathematical Model for Predicting Fire
+!! Spread in Wildland Fuels, Intermountain Forest and Range Experiment 
+!! Station, Forest Service, US Dept. of Agriculture, Ogden, UtahUSDA 
+!! Forest Service General Technical Report INT-115, 1972.
+!! - Pyne, S. J., Andrews, P. L., and Laven, R. D.: Introduction to wildland
+!! fire, 2 edition, Wiley, New York, 769 pp., 1996
+!!
+!! FLOWCHART     : None
+!! \n 
+!_ ================================================================================================================================
+
+
+   SUBROUTINE spitfire(npts, dt_days, veget_max_org,resolution,contfrac,   &
+              PFTpresent,t2m_min_daily,t2m_max_daily,                  &
+              precip_daily,wspeed_daily,soilhum_daily,                 &
+              lightn,litter,ni_acc,fire_numday,                        &
+              fuel_1hr,fuel_10hr,fuel_100hr,                           &
+              fuel_1000hr,ind,biomass,popd,a_nd,height,                &
+              read_observed_ba, observed_ba,read_cf_fine,cf_fine,      &
+              read_cf_coarse,cf_coarse,read_ratio_flag,                &
+              ratio_flag,read_ratio,baadjust_ratio,date,               &
+              bm_to_litter,co2_fire,                                   &
+              lcc,bafrac_deforest_accu,emideforest_litter_accu,emideforest_biomass_accu,&
+              deforest_litter_remain,deforest_biomass_remain,&
+              def_fuel_1hr_remain,def_fuel_10hr_remain,&
+              def_fuel_100hr_remain,def_fuel_1000hr_remain)
+
+
+    
+    ! PARAMETERS
+    INTEGER, parameter     :: ntrace=6              !!number of different trace gas types included
+    REAL(r_std), parameter :: MINER_TOT=0.055       !!total mineral content, source: Thonicke et al., 2010. p1010 Table A1 Row 5
+    REAL(r_std), parameter :: H=18000.0             !!calorific heat content (kJ kg^{-1}), source: Thonicke et al. (2010) Appendix A
+    REAL(r_std), parameter :: sigma_1hr=66.0        !!surface-area-to-volume ratio (cm^{2} cm^{-3}), source:  (USDA 1978, Harvey et al. 1997);
+                                                    !! These two sources are given in a working doc by K. Thonicke, the exact sources unknown.
+    REAL(r_std), parameter :: sigma_10hr=3.58       !!same as above
+    REAL(r_std), parameter :: sigma_100hr=0.98      !!same as above
+    REAL(r_std), parameter :: sigma_livegrass=80.0  !! NOT USED
+    REAL(r_std), parameter :: me_livegrass=0.2      !!moisture of extinction for live grass fuel (unitless) 
+
+    ! SOURCE this two parameters are said to follow Brown et al. 1981 but I don't
+    !have the paper.
+    REAL(r_std), parameter :: fbd_a = 1.2           !!scalar used to transform FBD of 10hr fuels to 1hr equivs, FBD: fuel bulk density (kg m^{-3})
+    REAL(r_std), parameter :: fbd_b = 1.4           !!scalar used to transform FBD of 100hr fuels to 1hr equivs
+    !SOURCE
+    REAL(r_std), parameter :: fbd_C3_livegrass=4.0  !!kg/m3
+    REAL(r_std), parameter :: fbd_C4_livegrass=4.0  !!kg/m3
+
+    !INPUT VARIABLES
+    INTEGER, INTENT(in)                             :: npts             !! Domain size
+    REAL(r_std), INTENT(in)                         :: dt_days          !! time step of Stomate in days
+    INTEGER(i_std),INTENT(in)                            :: date                !! Date (days) 
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)    :: veget_max_org        !! veget_max
+    REAL(r_std), DIMENSION(npts,2), INTENT(in)      :: resolution       !! resolution at each grid point in m (1=E-W, 2=N-S)
+    REAL(r_std),DIMENSION (npts), INTENT (in)       :: contfrac         !! fraction of continent in the grid
+    LOGICAL, DIMENSION(npts,nvm), INTENT(inout)     :: PFTpresent       !! logical variables to check whether a PFT present, defined in stomate.f90
+    REAL(r_std),DIMENSION(npts), INTENT(in)         :: t2m_min_daily    !! Daily minimum 2 meter temperatures (K)
+    REAL(r_std),DIMENSION(npts), INTENT(in)         :: t2m_max_daily    !! Daily maximum 2 meter temperatures (K)
+    REAL(r_std), DIMENSION(npts), INTENT(in)        :: precip_daily     !! daily precip (mm/day)
+    REAL(r_std), DIMENSION(npts), INTENT(in)        :: wspeed_daily     !! wind speed [m/s]
+    REAL(r_std), DIMENSION(npts), INTENT(in)        :: lightn           !! number of daily lightning [flashes per km2 per day]] 
+                                                                        !! lightn declared and allocated in slowproc.f90 
+    LOGICAL, INTENT (in)                            :: read_observed_ba !! Flag for read in observed burned area, i.e., model is forced by external BA
+    REAL(r_std),DIMENSION (npts), INTENT (in)       :: observed_ba      !! Observed burned area, currently must be in monthly timestep
+
+
+    LOGICAL, INTENT (in)                            :: read_cf_coarse   !! Flag to read external forced consumption fraction for coarse fuels, will be used
+                                                                        !! on the 1000hr fuel in the model.
+    REAL(r_std),DIMENSION (npts), INTENT (in)       :: cf_coarse        !! Externally forced fire consumption fraction for coarse fuel, applied on 1000hr fuel.
+    LOGICAL, INTENT (in)                            :: read_cf_fine     !! Flag to read external forced consumption fraction for fine fuel.
+    REAL(r_std),DIMENSION (npts), INTENT (in)       :: cf_fine          !! Externally forced fire consumption fraction for fine fuel, applied on live grass,
+                                                                        !! and 1hr/10hr/100hr dead fuel.
+    LOGICAL, INTENT (in)                            :: read_ratio       !! Flag for read in ratio to adjust simulated burned area.
+    REAL(r_std),DIMENSION (npts), INTENT (in)       :: baadjust_ratio   !! gridded input data used to adjust the simulated burned area, unitless.
+    LOGICAL, INTENT (in)                            :: read_ratio_flag  !! Flag for read in observed burned area 
+    REAL(r_std),DIMENSION (npts), INTENT (in)       :: ratio_flag       !! gridded flag value indicate where the burned area, conumption fractions
+                                                                        !! will be forced in the model. When bigger than 0, the burned area and 
+                                                                        !! consumption fractions will be forced in the model.
+
+
+    REAL(r_std), DIMENSION(npts), INTENT(in)        :: popd             !! human population density [person per sqkm] 
+                                                                        !! popd declared and allocated in slowproc.f90
+    REAL(r_std), DIMENSION(npts), INTENT(in)        :: a_nd             !! parameter for potential human-caused ignitions;
+                                                                        !! a_nd is parameterized in stomate_lpj before call of SPITFIRE
+    REAL(r_std), DIMENSION(npts), INTENT(in)        :: soilhum_daily    !! daily top layer soil humidity, here we need only the top soil 
+                                                                        !! layer humdity, and this is addressed by 
+                                                                        !! passing soilhum_daily(:,1) as soilhum_daily when we 
+                                                                        !! call SPITFIRE in stomate_lpj.f90
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)    :: height           !! tree height in m
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)    :: lcc              !! gross forest loss as fraction of griecell area
+
+
+    ! MODIFIED VARIABLES
+    REAL(r_std), DIMENSION(npts,nlitt,nvm,nlevs), INTENT(inout)  :: litter       !! metabolic and structural litter, above and belowground
+    REAL(r_std), DIMENSION(npts,nvm,nparts), INTENT(inout)       :: biomass      !! biomass
+    REAL(r_std), DIMENSION(npts,nvm,nlitt), INTENT(inout)        :: fuel_1hr     !! [gC^{m-2}]
+    REAL(r_std), DIMENSION(npts,nvm,nlitt), INTENT(inout)        :: fuel_10hr    !! [gC^{m-2}]
+    REAL(r_std), DIMENSION(npts,nvm,nlitt), INTENT(inout)        :: fuel_100hr   !! [gC^{m-2}]
+    REAL(r_std), DIMENSION(npts,nvm,nlitt), INTENT(inout)        :: fuel_1000hr  !! [gC^{m-2}]
+    REAL(r_std), DIMENSION(npts,nvm,nlitt), INTENT(inout)        :: def_fuel_1hr_remain     !! [gC^{m-2}]
+    REAL(r_std), DIMENSION(npts,nvm,nlitt), INTENT(inout)        :: def_fuel_10hr_remain    !! [gC^{m-2}]
+    REAL(r_std), DIMENSION(npts,nvm,nlitt), INTENT(inout)        :: def_fuel_100hr_remain   !! [gC^{m-2}]
+    REAL(r_std), DIMENSION(npts,nvm,nlitt), INTENT(inout)        :: def_fuel_1000hr_remain  !! [gC^{m-2}]
+    REAL(r_std), DIMENSION(npts),INTENT(INOUT)                   :: ni_acc       !! ni_acc declared and allocated in stomate.f90
+    REAL(r_std), DIMENSION(npts),INTENT(INOUT)                   :: fire_numday  !! declared and allocated in stomate.f90
+    REAL(r_std), DIMENSION(npts,nvm),INTENT(inout)               :: co2_fire     !! total C emission in fire, including live crown scorching and 
+                                                                                 !! dead ground litter(tree/grass) + live grass leaf&fruit
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)              :: ind          !! Number of individuals / m2; defined in stomate.f90
+    REAL(r_std), DIMENSION(npts,nvm,nparts), INTENT(inout)       :: bm_to_litter !! Biomass transfer to litter
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)              :: bafrac_deforest_accu     !!accumulated deforestation fire fraction
+    REAL(r_std), DIMENSION(npts,nvm,nlitt), INTENT(inout)        :: emideforest_litter_accu  !!cumulative deforestation fire emissions from litter
+    REAL(r_std), DIMENSION(npts,nvm,nparts), INTENT(inout)       :: emideforest_biomass_accu !!cumulative deforestation fire emissions from live biomass burning
+    REAL(r_std), DIMENSION(npts,nlitt,nvm,nlevs), INTENT(inout) :: deforest_litter_remain 
+    REAL(r_std), DIMENSION(npts,nvm,nparts), INTENT(inout)      :: deforest_biomass_remain 
+
+
+
+    ! LOCAL SPITFIRE VARIABLES
+    REAL(r_std), DIMENSION(npts)                    :: dfm_lg                  !! Daily fuel moisture for live grass, unitless, (0,1)
+    REAL(r_std), DIMENSION(npts)                    :: dfm                     !! Daily fuel moisture of dead fuels on ground excluding 1000hr fuel,(0,1)
+    REAL(r_std), DIMENSION(npts)                    :: ignition_efficiency     !! Ignition efficiency as limited by fuel load, (0,1), unitless.
+    REAL(r_std), DIMENSION(npts)                    :: dfm_1hr                 !! daily fuel moisture for 1hr-fuel
+    REAL(r_std), DIMENSION(npts)                    :: fuel_1hr_total          !! fuel_1hr_total is different from fuel_1hr(unit in C) and 
+                                                                               !! it combines the fuel of all types and PFTs. unit: dry mass
+    REAL(r_std), DIMENSION(npts)                    :: fuel_10hr_total         !! fuel_1hr/10hr/100hr/_total unit in dry mass for all natural PFTs
+    REAL(r_std), DIMENSION(npts)                    :: fuel_100hr_total
+    REAL(r_std), DIMENSION(npts)                    :: fuel_1000hr_total
+    REAL(r_std), DIMENSION(npts)                    :: natural_litter_ag_total !! total above-ground litter of natural PFTs
+    REAL(r_std), DIMENSION(npts)                    :: dead_fuel               !! sum of 1hr/10hr/100hr dead fuel (g dry mass/m2) for all natural PFTs
+    REAL(r_std), DIMENSION(npts)                    :: dead_fuel_all           !! sum of 1hr/10hr/100hr/1000hr dead fuel (g dry mass/m2) for all natural PFTs
+    REAL(r_std), DIMENSION(npts)                    :: livegrass               !! sum the leaf bimoass of natural grassland PFTs. unit is in dry mass but not carbon! 
+    REAL(r_std), DIMENSION(npts)                    :: dead_fuel_all_livegrass !! sum of 1hr/10hr/100hr/1000hr dead fuel (g dry mass/m2) 
+                                                                               !! for all natural PFTs plus livegrass biomass
+    REAL(r_std), DIMENSION(npts)                    :: ratio_dead_fuel
+    REAL(r_std), DIMENSION(npts)                    :: ratio_live_fuel
+    REAL(r_std), DIMENSION(npts)                    :: me_litterfuel           !! the moisture of extinction weighted by the 
+                                                                               !! dead groud litter fuel of different natural PFTs, unitless
+    REAL(r_std), DIMENSION(npts)                    :: moist_extinction        !! the moisture of extinction weighted by ground dead fuel and livegrass,
+                                                                               !! m_{e} in Eq.(8)
+    REAL(r_std), DIMENSION(npts)                    :: d_fdi                   !! daily fire danger index,climatic fire risk, unitless between 0. and 1.
+    REAL(r_std), DIMENSION(npts)                    :: net_fuel                !! mineral content adjusted dead_fuel (in kg biomass!)
+    REAL(r_std), DIMENSION(npts)                    :: char_net_fuel           !! total net fuel(mineral content corrected) by summing the dead fuel and live grass,
+                                                                               !! , in unit of kg dry mass per m2.
+    REAL(r_std), DIMENSION(npts)                    :: wind_speed              !! wind_speed is Uforward in Thonicke et al. 2010; unit: m/min
+    REAL(r_std), DIMENSION(npts)                    :: wind_forward            !! the name here is somewhat misleading; it's only for used in Eq(A5)
+    REAL(r_std), DIMENSION(npts)                    :: lb                      !! length-to-breadth ratio of the fire ellipse, unitless, range[1,8]
+    REAL(r_std), DIMENSION(npts)                    :: df
+    REAL(r_std), DIMENSION(npts)                    :: db
+    REAL(r_std), DIMENSION(npts)                    :: fire_durat              !! fire duration (min) 
+    REAL(r_std), DIMENSION(npts)                    :: ros_f                   !! forward fire spred rate(m min^{-1})
+    REAL(r_std), DIMENSION(npts)                    :: ros_b                   !! backward fire spread rate; unit: m min^{-1}
+    REAL(r_std), DIMENSION(npts)                    :: ratio_fbd               !! proportion of dead fuel in class i PFT j as a proportion of total dead fuel
+    REAL(r_std), DIMENSION(npts)                    :: ratio_C3_livegrass      !! ratio of C3 and C4 livegrass in total livegrass
+    REAL(r_std), DIMENSION(npts)                    :: ratio_C4_livegrass
+    REAL(r_std), DIMENSION(npts)                    :: dens_fuel_ave           !! weighted fuel bulk density by different fuel types except 1000h fuel,
+                                                                               !! including only natural PFTs, in unit of kg dry mass per m3. 
+    REAL(r_std), DIMENSION(npts)                    :: dens_livegrass_ave      !! C3/C4 weighted livegrass fuel bulk density, kg m^{-3}
+    REAL(r_std), DIMENSION(npts)                    :: char_dens_fuel_ave      !! livegrass and dead fule weighted fuel bulk density 
+                                                                               !! (excluding 1000hr dead fuel), in unit of kg dry mass per m3.
+    REAL(r_std), DIMENSION(npts)                    :: sigma                   !! mass weighted mean fuel surface-area-to-volume ratio by different fuel types,
+                                                                               !! in unit of cm^{-1}, given that area in unit of cm^{2} and volume in cm^{3}
+    REAL(r_std), DIMENSION(npts)                    :: gamma                   !! tau_max*ita_m*ita_s; used in calculation of tau_l for postfire mortality.
+    REAL(r_std), DIMENSION(npts)                    :: fpc_tree_total          !! total tree fraction
+    REAL(r_std), DIMENSION(npts)                    :: fpc_grass_total         !! total grass fraction (including natural and agricultural grassland)
+    REAL(r_std), DIMENSION(npts)                    :: area
+    REAL(r_std), DIMENSION(npts)                    :: wetness                 !! wetness of fuel, calculated as dfm/moisture_of_extinction
+    REAL(r_std), DIMENSION(npts)                    :: fuel_consum             !! total fuel consumption including 1hr/10hr/100hr (not 1000hr!) fuel. [g mass m^{-2}]
+    REAL(r_std), DIMENSION(npts)                    :: d_i_surface             !! surface fire intensity [kW m^{-1}]
+    REAL(r_std), DIMENSION(npts,nvm)                :: disturb_crown           !! a temporary variable, used to store the C emissions 
+                                                                               !! from crown scorch of live tree crown.
+    REAL(r_std), DIMENSION(npts)                    :: fc_crown                !! PFT weighted carbon emissions caused by crown scorching (gCm^{-2}).
+                                                                               !! only for history file writing.
+                                                                               !! this variable is PFT vcmax weighted sum of above one
+    REAL(r_std), DIMENSION(npts)                    :: d_area_burnt            !! daily burned area (ha); local variable, only for history file writing.
+    REAL(r_std), DIMENSION(npts)                    :: ba_escape               !! Escaped deforestation fire burned area (ha), it's included in d_area_burnt,
+                                                                               !! However is separated for being put into history file.
+    REAL(r_std), DIMENSION(npts)                    :: d_numfire               !! local variable, only for history file writing
+    REAL(r_std), DIMENSION(npts)                    :: human_numfire           !! local variable, only for history file writing.
+    REAL(r_std), DIMENSION(npts)                    :: lightn_numfire          !! local variable, only for history file writing.
+    REAL(r_std), DIMENSION(npts)                    :: fire_frac               !! burned fraction, unitless
+    REAL(r_std), DIMENSION(npts)                    :: area_land               !! Land area within gridcel excluding water body,[hectar=10000 m2]
+    REAL(r_std), DIMENSION(npts)                    :: area_natural_veg         !! Land area covered with vegetation within gridcell [hectar]
+    REAL(r_std), DIMENSION(npts)                    :: human_ign               !! human ignitions, [1 day^{-1} km^{-2}]
+    REAL(r_std), DIMENSION(npts)                    :: lightn_efficiency       !! ligtning fractions that reach ground with sufficient energy to ignite,unitless
+    REAL(r_std), DIMENSION(npts)                    :: human_suppression       !! huamn suppression effects on fires, unitless
+    REAL(r_std), DIMENSION(npts)                    :: lightn_ign              !! lightning ignitions, [1 day^{-1} km^{-2}]
+    REAL(r_std), DIMENSION(npts,ntrace)             :: dcflux_trace
+    REAL(r_std), DIMENSION(npts,nvm,nlitt)          :: fc_1hr                  !! fule consumption for 1hr fuel, [g biomass^m{-2}]
+    REAL(r_std), DIMENSION(npts,nvm,nlitt)          :: fc_10hr                 !! fule consumption for 10hr fuel, [g biomass^m{-2}]
+    REAL(r_std), DIMENSION(npts,nvm,nlitt)          :: fc_100hr                !! fule consumption for 100hr fuel, in the unit of g dry mass/m**2 (C/0.45)
+    REAL(r_std), DIMENSION(npts,nvm,nlitt)          :: fc_1000hr               !! fule consumption for 1000hr fuel, [gC^{m-2}]
+    REAL(r_std), DIMENSION(npts,nvm)                :: fc_lg                   !! leaf biomass consumption for GRASS, [gC m^{-2}]
+    REAL(r_std), DIMENSION(npts,nvm)                :: fc_lf                   !! fruit biomass consumption for GRASS, [gC m^{-2}]
+    REAL(r_std), DIMENSION(npts)                    :: cf_ave                  !! the average fuel fire consumption fraction of 1hr/10hr/100hr fuel, unitless
+    REAL(r_std), DIMENSION(npts)                    :: cf_1hr                  !! fire fuel consumption fraction for 1hr fuel, unitless
+    REAL(r_std), DIMENSION(npts)                    :: cf_10hr                 !! fire fuel consumption fraction for 10hr fuel, unitless
+    REAL(r_std), DIMENSION(npts)                    :: cf_100hr                !! fire fuel consumption fraction for 100hr fuel, unitless
+    REAL(r_std), DIMENSION(npts)                    :: cf_1000hr               !! fire fuel consumption fraction for 1000hr fuel, unitless
+    REAL(r_std), DIMENSION(npts)                    :: cf_lg                   !! fire fule consumption for livegrass leaf and fruit biomass, unitless
+    REAL(r_std), DIMENSION(npts,nvm)                :: tau_l                   !! the residence time of fire; used in Eq(19)
+    REAL(r_std), DIMENSION(npts,nvm)                :: ck                      !!the proportion of crown affected by fire ( Eq17: CK=(SH-H+CL)/CL )
+    REAL(r_std), DIMENSION(npts,nvm)                :: postf_mort              !!
+    REAL(r_std), DIMENSION(npts,nvm)                :: pm_tau
+    REAL(r_std), DIMENSION(npts,nvm)                :: pm_ck
+    REAL(r_std), DIMENSION(npts,nvm)                :: sh
+    REAL(r_std), DIMENSION(npts,nvm)                :: nind_fa                 !! # trees affected by fire
+    REAL(r_std), DIMENSION(npts,nvm)                :: nind_kill               !! # trees killed by fire
+    REAL(r_std), DIMENSION(npts,nvm)                :: prop_fa_nk              !! propn of indivs fire affected but not killed
+    REAL(r_std), DIMENSION(npts,nvm)                :: dcflux_fire_pft         !! fire carbon flux to atmosphere; including both crown emssions 
+                                                                               !! and litter consumption emissions
+    REAL(r_std), DIMENSION(npts,nvm,ntrace)         :: dcflux_trace_pft
+    REAL(r_std), DIMENSION(npts,nvm)                :: litter_consump_pft      !! C emissions from ground litter burning (tree&grass) and grass leaf&fruit.
+    REAL(r_std), DIMENSION(npts)                    :: litter_consump          !! Consumed litter during fire for each PFT,including ground dead litter for
+                                                                               !! trees and grasses, and live grass leaf and fruit burning. (gCm^{-2})
+    REAL(r_std), DIMENSION(npts,nvm)                :: tau_c                   !! critical time to cambial kill
+    REAL(r_std), DIMENSION(npts)                    :: dia                     !! stem diameter (cm)
+    REAL(r_std), DIMENSION(npts,nvm)                :: bt                      !! bark thickness (cm)
+    REAL(r_std), DIMENSION(npts)                    :: tree_kill_frac          !! tree fraction that are killed in fire
+    REAL(r_std), DIMENSION(npts)                    :: mean_fire_size_original !! mean fire size before the correction of surface fire intensity
+    REAL(r_std), DIMENSION(npts)                    :: mean_fire_size          !! mean fire size
+    REAL(r_std), DIMENSION(npts)                    :: natural_vegfrac         !! the fraction of the grid cell that are occupied by natural vegetation.
+    REAL(r_std), DIMENSION(nvm,ntrace)              :: ef_trace                !! emission factors for trace gases
+    REAL(r_std), DIMENSION(npts,nvm)                :: fc_1hr_carbon           !! [gCm^{-2}]
+    REAL(r_std), DIMENSION(npts,nvm)                :: fc_10hr_carbon          !! [gCm^{-2}]  
+    REAL(r_std), DIMENSION(npts,nvm)                :: fc_100hr_carbon         !! [gCm^{-2}]
+    REAL(r_std), DIMENSION(npts,nvm)                :: fc_1000hr_carbon        !! [gCm^{-2}]
+    REAL(r_std), DIMENSION(npts,nvm,nlitt)          :: emideforest_fuel_1hr      !! fire emissions from deforestation fires for 1hr fuel [gC^{m-2}]
+    REAL(r_std), DIMENSION(npts,nvm,nlitt)          :: emideforest_fuel_10hr     !! [gC^{m-2}]
+    REAL(r_std), DIMENSION(npts,nvm,nlitt)          :: emideforest_fuel_100hr    !! [gC^{m-2}]
+    REAL(r_std), DIMENSION(npts,nvm,nlitt)          :: emideforest_fuel_1000hr   !! [gC^{m-2}]
+    REAL(r_std), DIMENSION(npts,nvm)                :: emi_nondef                !! Fire carbon emissions not including deforestation fires, based on PFT area
+    REAL(r_std), DIMENSION(npts,nvm)                :: emideforest_all           !! Fire carbon emissions from deforestation fires, based on PFT area
+    REAL(r_std), DIMENSION(npts,nvm)                :: bafrac_deforest           !! Deforestation fire burned fraction as gridcell area
+    REAL(r_std), DIMENSION(npts,nvm,nlitt)          :: emideforest_litter        !! Deforestation fire emissions from litter burning [gCm^{-2}], based on ground area
+    REAL(r_std), DIMENSION(npts,nvm,nparts)         :: emideforest_biomass       !! live biomass emissions from deforestation fires [gCm^{-2}], based on ground area
+    REAL(r_std), DIMENSION(npts,nvm)                :: veget_max           !! 
+    INTEGER :: j,x,m,k,n,i,ivm,ipts
+
+    REAL(r_std), DIMENSION(npts)                    :: proc_ba                 !! a proxy variable used to put the monthly observed BA at the first day
+                                                                               !! of each month.
+    REAL(r_std)                                     :: surface_threshold=50.0
+    REAL(r_std)                                     :: fuel_low_bound=444.     !! below this ignition efficiency is 0 [dry matter/m2], 
+                                                                               !! assuming a 0.45 carbon fraction.
+    REAL(r_std)                                     :: fuel_high_bound=2222.   !! above this ignition efficiency is 1 [dry matter/m2], 
+                                                                               !! assuming a 0.45 carbon fraction.
+                                                                               !! the bounds sources are Arora & Boer (2005)
+    INTEGER(r_std),DIMENSION(12)  :: monthday
+    monthday = (/1, 32, 60, 91, 121, 152, 182, 213, 244, 274, 305, 335/)
+    
+
+
+    ! Initialise variables
+    disturb_crown(:,:)=0.0
+    sigma(:)=0.0
+    lb(:)=0.0
+
+    cf_lg(:)=0.0
+    cf_1hr(:)=0.0
+    cf_10hr(:)=0.0
+    cf_100hr(:)=0.0
+    cf_1000hr(:)=0.0
+    fpc_tree_total(:)=0.0
+    fpc_grass_total(:)=0.0
+    net_fuel(:)=0.0
+    dead_fuel(:)=0.0
+    ratio_dead_fuel(:)=0.0
+    ratio_live_fuel(:)=0.0
+    livegrass(:)=0.0
+    dead_fuel_all_livegrass(:)=0.0
+    fuel_1hr_total(:)=0.0
+    fuel_10hr_total(:)=0.0
+    fuel_100hr_total(:)=0.0
+    fuel_1000hr_total(:)=0
+    dens_fuel_ave(:)=0.0
+    d_area_burnt(:)=0.0
+    ba_escape(:)=0.0
+    fire_frac(:)=0.0
+    d_i_surface(:)=0.0
+    ck(:,:)=0.0
+    tau_l(:,:)=0.0
+    pm_tau(:,:)=0.0
+    postf_mort(:,:)=0.0
+    prop_fa_nk(:,:)=0.0
+    nind_fa(:,:)=0.0
+    nind_kill(:,:)=0.0
+    dcflux_fire_pft(:,:)=0.0
+    dcflux_trace(:,:)=0.0
+    dcflux_trace_pft(:,:,:)=0.0
+    fc_crown(:)=0.0
+    litter_consump_pft(:,:)=0.0
+    litter_consump(:)=0.0
+    emi_nondef(:,:)=0.0
+    co2_fire(:,:)=0.0
+    human_ign(:)=0.0
+    tree_kill_frac(:)=0.0
+    fc_1hr_carbon(:,:)=0.0
+    fc_10hr_carbon(:,:)=0.0   
+    fc_100hr_carbon(:,:)=0.0
+    fc_1000hr_carbon(:,:)=0.0
+    human_suppression(:)=0.0
+    natural_vegfrac(:) = zero
+    veget_max(:,:) = veget_max_org(:,:) - lcc(:,:)
+    WHERE(veget_max(:,:) <= zero) veget_max(:,:)=zero
+
+    emideforest_fuel_1hr(:,:,:) = zero
+    emideforest_fuel_10hr(:,:,:) = zero
+    emideforest_fuel_100hr(:,:,:) = zero
+    emideforest_fuel_1000hr(:,:,:) = zero
+    emideforest_litter(:,:,:) = zero
+    emideforest_biomass(:,:,:) = zero
+    emideforest_all(:,:) = zero
+    bafrac_deforest(:,:) = zero
+
+    ratio_C3_livegrass(:) = 1.0
+    ratio_C4_livegrass(:) = zero
+    char_dens_fuel_ave(:) = zero
+
+    !we assume 0.03 of lightnning flashes input has the power to ignite a fire
+    lightn_efficiency(:)=0.03
+
+
+    ! Assign emission factors for trace gas emissions resulting from acflux_fire_pft
+    ! ef_CO2 defined in stomate_constants.f90; the unit of ef_trace(:) is in g/(g mass burned)
+    DO j=1,nvm
+       ef_trace(j,1)=ef_CO2(j)/1000.0   !CO2
+       ef_trace(j,2)=ef_CO(j)/1000.0    !CO
+       ef_trace(j,3)=ef_CH4(j)/1000.0   !CH4
+       ef_trace(j,4)=ef_VOC(j)/1000.0   !VOC
+       ef_trace(j,5)=ef_TPM(j)/1000.0   !TPM
+       ef_trace(j,6)=ef_NOx(j)/1000.0   !NOx
+    ENDDO
+
+    ! this is done by assuming that in forced-BA simulations, the input BA data
+    ! is at monthly time step.
+    IF (ANY(monthday.eq.date)) THEN
+      proc_ba(:)=observed_ba(:)
+    ELSE
+      proc_ba(:)=0.
+    ENDIF
+
+    !----------------------------------------------------------------
+    !      Prepare multiple variables needed for fire simulation
+    !----------------------------------------------------------------
+
+    !! 0. Prepare some parameters for the simulation of fires.
+
+    !0.1 calculate the fraction of area occupied by natural PFTs.
+    DO j=2,nvm
+      IF (natural(j)) THEN 
+           natural_vegfrac(:)=natural_vegfrac(:)+veget_max(:,j)
+      ENDIF
+    ENDDO
+    !calculate pixelarea(lat,area)
+    area_land(:) = (resolution(:,1)*resolution(:,2)*contfrac(:))/10000.0  !unit:hectar (10000m2)
+    area_natural_veg(:) = area_land(:)*natural_vegfrac(:)  !unit:hectar (10000m2)
+
+    ! Calculate total above-ground litter
+    natural_litter_ag_total(:)=0.0  !natural_litter_ag_total include litter from all natural PFTs.
+    DO j=1,nvm
+      IF (natural(j)) THEN 
+           natural_litter_ag_total(:)=natural_litter_ag_total(:)+(litter(:,imetabolic,j,iabove)+ &
+           litter(:,istructural,j,iabove))*veget_max(:,j)
+      ENDIF
+    ENDDO
+
+    !0.2 Calculate the moisture of extinction weighted by the fuel presence
+    ! of different natural PFTs (only dead fuel expressed by sum of litter)
+    ! me: moisture of extinction; me is defined in constantes_mtc.f90 
+    ! as 'flammability threshold' and is PFT-specific
+    me_litterfuel(:)=0.0  !PFT weighted moisture of extinction.
+    DO j=1,nvm
+      IF (natural(j)) THEN
+        WHERE (natural_litter_ag_total(:).gt.min_stomate)
+          me_litterfuel(:)=me_litterfuel(:)+((litter(:,imetabolic,j,iabove)+litter(:,istructural,j,iabove)) * &
+            veget_max(:,j)/natural_litter_ag_total(:))*me(j)
+        ELSEWHERE
+          me_litterfuel(:)=0.0
+        ENDWHERE
+      ENDIF
+    ENDDO
+
+    ! calculate tree and grass coverage respectively, here the grass should
+    ! not include pasture, so if the pasture PFT is included, the `natural` 
+    ! variable for the pasture PFTs should be FALSE
+    fpc_tree_total(:)=0.0; fpc_grass_total(:)=0.0  
+    DO j=1,nvm
+      IF (natural(j)) THEN
+        IF (is_tree(j)) THEN
+          fpc_tree_total(:)=fpc_tree_total(:)+veget_max(:,j)
+        ELSE
+          fpc_grass_total(:)=fpc_grass_total(:)+veget_max(:,j) 
+        ENDIF
+      ENDIF
+    ENDDO
+
+    !0.3 Introduce reduction factor for wind speed with respect to forest or grass ground coverage.
+    ! wind_speed is @tex $U_{forward}$ @endtex in Thonicke 2010.
+    ! Note that the unit of input wind speed (wspeed_daily) should be @tex $m s^{-1}$ @endtex, 
+    ! so that ROS is in unit of @tex $m min^{-1}$ @endtex.
+    wind_speed(:)=(fpc_tree_total(:)*wspeed_daily(:)*60.0*0.4)+ &
+                (fpc_grass_total(:)*wspeed_daily(:)*60.0*0.6)  
+    wind_forward(:)=3.281*wind_speed(:) !wind_forward is used in Eq(A5) as 3.281*Uforward      
+
+    !0.4 Calculate the length-to-breadth ratio of the elliptical fire scar.
+    ! the minimum value of lb is 1 and maximum value 8
+    ! [UNCLEAR] Notice that for Eq.(12) and Eq.(13) in Thonicke 2010, 
+    ! 0.06*wind_speed is used here as U_{forward}. Compared with original Eq.(12),
+    ! an extra 0.06 was multiplied. Not yet know why this 0.06 is used, it's
+    ! in the original code given to me by Patricia.
+    WHERE (wind_speed(:).lt.16.67)
+      lb(:) = 1    
+    ELSEWHERE (wind_speed(:).ge.16.67)
+      lb(:)=min(8.,fpc_tree_total(:)* &
+            (1.0+(8.729*((1.0-(exp(-0.03*0.06*wind_speed(:))))**2.155)))+ &
+            (fpc_grass_total(:)*(1.1+((0.06*wind_speed(:))**0.0464))))
+    ENDWHERE
+
+    !0.5 Calculate fuel characteristics, fuel amount, bulk density.
+    DO k=1,nlitt
+      DO j=1,nvm
+        IF (natural(j)) THEN 
+          WHERE (fuel_1hr(:,j,k).gt.0.0)
+            fuel_1hr_total(:)=fuel_1hr_total(:) + (fuel_1hr(:,j,k)/0.45)*veget_max(:,j) !fuel_1hr devided by 0.45 to change into the unit of dry mass(ranther than C)
+          ENDWHERE
+
+          WHERE (fuel_10hr(:,j,k).gt.0.0)
+            fuel_10hr_total(:)=fuel_10hr_total(:) + (fuel_10hr(:,j,k)/0.45)*veget_max(:,j)
+          ENDWHERE    
+
+          WHERE (fuel_100hr(:,j,k).gt.0.0)
+            fuel_100hr_total(:)=fuel_100hr_total(:) + (fuel_100hr(:,j,k)/0.45)*veget_max(:,j)
+          ENDWHERE    
+
+          WHERE (fuel_1000hr(:,j,k).gt.0.0)
+            fuel_1000hr_total(:)=fuel_1000hr_total(:) + (fuel_1000hr(:,j,k)/0.45)*veget_max(:,j) 
+          ENDWHERE
+
+          ! k.eq.1 so that the grass leaf biomass would not be counted twice in the livegrass
+          ! the PFT should be natural but grass(i.e., not tree or pasture),
+          ! note livegrass is in unit of dry mass but not carbon!
+          IF (k.eq.1 .and. natural(j) .and. (.not. is_tree(j))) THEN   
+             livegrass(:)=livegrass(:) + (biomass(:,j,ileaf)/0.45)*veget_max(:,j)
+          ENDIF !k
+        ENDIF!natural
+      ENDDO
+    ENDDO
+
+    ! calculate dead fuel load on the groud, note that dead fuel load include 
+    ! 1_hr/10_hr/100_hr fuel class of natural PFTs, and 1000_hr fuel is not
+    ! included in deaf_fuel and net_fuel
+    dead_fuel(:) = fuel_1hr_total(:) + fuel_10hr_total(:) + &
+       fuel_100hr_total(:)  !total dead fuel g dry mass per m2
+    dead_fuel_all(:) = fuel_1hr_total(:) + fuel_10hr_total(:) + &
+       fuel_100hr_total(:)+fuel_1000hr_total(:) 
+    dead_fuel_all_livegrass(:)=dead_fuel_all(:)+livegrass(:)
+    net_fuel(:)=(1.0-MINER_TOT)*(dead_fuel(:)/1000.0)  ! in unit of kg dry matter per m2
+    ! total net fuel accounting for mineral content, in kg dry mass per m2. 
+    char_net_fuel(:) = net_fuel(:) +(1.0-MINER_TOT)*livegrass(:)/1000.0 ! in kg dry mass
+
+    !fuel bulk density, weighted per fuel class and fuel load   
+    !dens_fuel is PFT-specific defined and initiated in constantes_mtc.f90, unit: kg/m3 
+    dens_fuel_ave(:)=0.0
+    DO j=1,nvm
+      IF (natural(j)) THEN
+        WHERE (dead_fuel(:).gt.min_stomate)
+          ratio_fbd(:) = ( ( (fuel_1hr(:,j,istructural) + fuel_1hr(:,j,imetabolic)) &
+                + fbd_a * (fuel_10hr(:,j,istructural)+ fuel_10hr(:,j,imetabolic)) &
+                + fbd_b * (fuel_100hr(:,j,istructural) + fuel_100hr(:,j,imetabolic)) ) *veget_max(:,j) / 0.45) &
+                / dead_fuel(:) 
+          dens_fuel_ave(:) = dens_fuel_ave(:) + dens_fuel(j) * ratio_fbd(:)  !kg/m3
+        ELSEWHERE
+          dens_fuel_ave(:)=0.0
+        ENDWHERE
+      ENDIF
+    ENDDO
+
+    !calculate livegrass fuel moisture
+    WHERE (livegrass(:).GT.min_stomate)
+      !Eq(B2); soilhum_daily is \omiga_{s} in Eq.(B2); dfm_lg is live grass moisture
+      dfm_lg(:) = max(0.0,((10.0/9.0)*soilhum_daily(:)-(1.0/9.0)))  
+      ratio_C3_livegrass(:) = biomass(:,8,ileaf)/0.45*veget_max(:,8) / livegrass(:)  
+      ratio_C4_livegrass(:) = biomass(:,9,ileaf)/0.45*veget_max(:,9) / livegrass(:)
+    ELSEWHERE
+      dfm_lg(:)=0.0
+    ENDWHERE
+
+    ! influence of livegrass on FBD(fuel bulk density)
+    dens_livegrass_ave(:) = & 
+       fbd_C3_livegrass *  ratio_C3_livegrass(:) + &
+       fbd_C4_livegrass *  ratio_C4_livegrass(:)
+
+    !calculate average fuel density weighted by different PFT and deal fuel & live grass 
+    WHERE (dead_fuel(:).gt.min_stomate.or. livegrass(:).gt.min_stomate)
+      ratio_dead_fuel(:) = dead_fuel(:)  / (dead_fuel(:) + livegrass(:))
+      ratio_live_fuel(:) = livegrass(:) / (dead_fuel(:) + livegrass(:))
+      char_dens_fuel_ave(:) = dens_fuel_ave(:)* ratio_dead_fuel(:) + &
+                              dens_livegrass_ave(:) * ratio_live_fuel(:)
+    ENDWHERE
+
+    ! calculate deal fuel and livegrass weighted average moisture of extinction.
+    ! moist_extinction is me in Eq(8); moisture of extinction. 
+    moist_extinction(:) = me_litterfuel(:) *  ratio_dead_fuel(:) + &
+         me_livegrass * ratio_live_fuel(:)
+
+    !calculate mass weighted surface-area-to-volume ratio by fuel types.
+    WHERE (dead_fuel(:).gt.min_stomate)
+      sigma(:)=(fuel_1hr_total(:) * sigma_1hr + &
+           fuel_10hr_total(:) * sigma_10hr + &
+           fuel_100hr_total(:) * sigma_100hr) / dead_fuel(:)
+    ELSEWHERE
+      sigma(:)=0.00001
+    ENDWHERE
+
+    !-----------------------------------------------------------
+    !      end preparing daily variables - start of simulation
+    !-----------------------------------------------------------
+
+
+    !! 1 Calculate daily fire burned area
+    !! 1.1 Calculate fire danger index
+    ! output variables: dfm(\omiga_{0} in Eq.6); dfm_1hr(moisture content for 1hr fuel);
+    !                   d_fdi(fire danger index);
+    ! modified variables: ni_acc(accumulative Nesterov Index)  
+    CALL fire_danger_index(npts,d_fdi,dfm,dfm_1hr,t2m_min_daily,     &
+              t2m_max_daily, precip_daily,me_litterfuel, ni_acc,     &
+              fuel_1hr_total, fuel_10hr_total,fuel_100hr_total,      &
+              dead_fuel,moist_extinction, ratio_dead_fuel,ratio_live_fuel)
+
+    !calculate human ignitions
+    CALL human_ign_fct(npts,popd,a_nd,human_ign)
+    !CALL human_suppression_func(npts,popd,human_suppression)
+
+    !apply the ignition efficiency as adjusted by fuel load
+    WHERE (dead_fuel_all_livegrass(:) .LE. fuel_low_bound) 
+      ignition_efficiency(:)=0.
+    ELSEWHERE (dead_fuel_all_livegrass(:) .GT. fuel_low_bound .AND. dead_fuel_all_livegrass(:) .LT. fuel_high_bound)
+      ignition_efficiency(:)=(dead_fuel_all_livegrass(:) - fuel_low_bound)/(fuel_high_bound - fuel_low_bound)
+    ELSEWHERE
+      ignition_efficiency(:)=1.
+    ENDWHERE
+
+    !! 1.2 Calculate number of fires from lightning and human ignitions
+
+    !dervie potential fire number by lightnings
+    lightn_ign(:)=lightn(:)*lightn_efficiency(:)*(1-human_suppression(:))
+
+    !Here we apply Eq.(2), d_fdi: unitless; lightning ignition: 1/day/km**2 (as in the original nc file); 
+    !human_ign: unit as 1/day/km**2
+    !0.01*area_land: grid cell total land area in km**2; 
+    !final unit: 1/day in the concered grid cell 
+    WHERE (net_fuel(:).gt.0.001)  
+      lightn_numfire(:)=d_fdi(:)*ignition_efficiency(:)* lightn_ign(:) * (0.01 * area_natural_veg(:))  
+      human_numfire(:)=d_fdi(:)*ignition_efficiency(:)* human_ign(:) * (0.01 * area_natural_veg(:))
+      d_numfire(:)=lightn_numfire(:) + human_numfire(:)
+    ELSEWHERE  !not enough fuel
+      d_numfire(:)=0.0
+    ENDWHERE
+
+    !! 1.3 Calculate daily area burnt
+
+    ! calculate fire spread rate
+    !output variables: ros_f(ROS_{f,surface} in Eq.9); gamma(used in calculation of tau_l); 
+    !                  wetness (dfm/me).
+    ! note when call rate_of_spread, ros_f has replaced U_front in the definition of rate_of_spread SUBROUTINE
+    CALL rate_of_spread(npts,ros_f,wind_forward,sigma,  &
+             dfm,me_litterfuel,H,char_dens_fuel_ave,    &
+             char_net_fuel,moist_extinction,gamma,wetness)
+
+    ! Calculate ROS_{b,surface}; Eq(10); wind_speed is U_{forward} in Eq.(10) 
+    ros_b(:) = ros_f(:) * exp(-0.012 * wind_speed(:)) !Can FBP System; Eq.(10) in Thonicke et al. (2010)
+    WHERE (ros_b(:).lt. 0.05) 
+      ros_b(:) = 0.0 
+    ENDWHERE 
+
+    ! fire duration as a function of d_fdi; Eq(14)
+    WHERE (d_fdi(:).ge.min_stomate)
+      fire_durat(:)=241.0/(1.0+(240.0*exp(-11.06*d_fdi(:))))    !unit:min, Eq.(14) in Thonicke et al. (2010)
+    ELSEWHERE
+      fire_durat(:)=0.0
+    ENDWHERE
+
+    db(:)=ros_b(:)*fire_durat(:) !unit: m/min * min = m
+    df(:)=ros_f(:)*fire_durat(:)
+
+    ! Here we call deforestation fire process
+    IF (allow_deforest_fire) THEN
+      ! Calculate deforestation fire burned area fraction and emissions
+      CALL deforestation_fire_proxy(npts,d_fdi,lcc,                     &
+         deforest_biomass_remain,                     &
+         def_fuel_1hr_remain,def_fuel_10hr_remain,                           &
+         def_fuel_100hr_remain,def_fuel_1000hr_remain,                       &
+         bafrac_deforest,emideforest_fuel_1hr,emideforest_fuel_10hr,        &
+         emideforest_fuel_100hr, emideforest_fuel_1000hr,emideforest_biomass)
+
+      ! If the accumulated deforestation fire burned area is higher than two times 
+      ! of deforested area, we treat the surpassing part as natural fires.
+      DO ivm = 1,nvm
+        IF (is_tree(ivm)) THEN
+          DO ipts = 1,npts
+            IF (bafrac_deforest(ipts,ivm) > min_stomate) THEN
+              IF (bafrac_deforest_accu(ipts,ivm)+bafrac_deforest(ipts,ivm) > 3*lcc(ipts,ivm)) THEN
+                 d_area_burnt(ipts) = d_area_burnt(ipts) + bafrac_deforest(ipts,ivm) * area_land(ipts)
+                 ba_escape(ipts) = ba_escape(ipts) + bafrac_deforest(ipts,ivm) * area_land(ipts)
+                 emideforest_fuel_1hr(ipts,ivm,:) = zero
+                 emideforest_fuel_10hr(ipts,ivm,:) = zero
+                 emideforest_fuel_100hr(ipts,ivm,:) = zero
+                 emideforest_fuel_1000hr(ipts,ivm,:) = zero
+                 emideforest_biomass(ipts,ivm,:) = zero 
+                 bafrac_deforest(ipts,ivm) = zero
+              ELSE
+                 bafrac_deforest_accu(ipts,ivm) = bafrac_deforest_accu(ipts,ivm) + bafrac_deforest(ipts,ivm)
+                 emideforest_litter(ipts,ivm,:) = emideforest_fuel_1hr(ipts,ivm,:) + emideforest_fuel_10hr(ipts,ivm,:) &
+                                             + emideforest_fuel_100hr(ipts,ivm,:) + emideforest_fuel_1000hr(ipts,ivm,:)
+                 
+                 emideforest_litter_accu(ipts,ivm,:) = emideforest_litter_accu(ipts,ivm,:) + emideforest_litter(ipts,ivm,:)  
+                 emideforest_biomass_accu(ipts,ivm,:) = emideforest_biomass_accu(ipts,ivm,:) + emideforest_biomass(ipts,ivm,:)  
+                 !update the remaining fuel
+                 def_fuel_1hr_remain(ipts,ivm,:) = def_fuel_1hr_remain(ipts,ivm,:)-emideforest_fuel_1hr(ipts,ivm,:)
+                 def_fuel_10hr_remain(ipts,ivm,:) = def_fuel_10hr_remain(ipts,ivm,:)-emideforest_fuel_10hr(ipts,ivm,:)
+                 def_fuel_100hr_remain(ipts,ivm,:) = def_fuel_100hr_remain(ipts,ivm,:)-emideforest_fuel_100hr(ipts,ivm,:)
+                 def_fuel_1000hr_remain(ipts,ivm,:) = def_fuel_1000hr_remain(ipts,ivm,:)-emideforest_fuel_1000hr(ipts,ivm,:)
+                 deforest_biomass_remain(ipts,ivm,:) = deforest_biomass_remain(ipts,ivm,:)-emideforest_biomass(ipts,ivm,:)
+                 deforest_litter_remain(ipts,:,ivm,iabove) = deforest_litter_remain(ipts,:,ivm,iabove)-emideforest_litter(ipts,ivm,:)
+              END IF
+            END IF
+          END DO
+        END IF
+      END DO ! loop of nvm
+
+      WHERE(veget_max(:,:)>min_stomate)
+        emideforest_all(:,:) = (SUM(emideforest_litter,DIM=3) + SUM(emideforest_biomass,DIM=3))/veget_max(:,:)/dt_days
+      ENDWHERE
+    END IF
+
+    ! area burnt from caused by ignitions on "this (simulation)" day [sptifire on daily timestep]
+    WHERE (lb(:).gt.min_stomate)
+      mean_fire_size_original(:)=(pi/(4.0*lb(:)))*((df(:)+db(:))**2.0)/10000.0 !mean_fire_size with unit as ha
+      d_area_burnt(:)=d_numfire(:)* mean_fire_size_original(:)  ! d_area_burnt unit in ha
+      mean_fire_size(:)=mean_fire_size_original(:)
+      
+      !set the flag to 1 when forcing BA, otherwise set the flag as -1 or 0
+      WHERE (ratio_flag(:).gt.0.0)
+       d_area_burnt(:)=proc_ba(:)
+      ELSEWHERE
+       d_area_burnt(:)=d_area_burnt(:)*baadjust_ratio(:)   !set the ratio alwasy to 1 when not forcing BA.
+      ENDWHERE
+
+      ! Prevent burned area within the limit of vegetated area
+      WHERE (d_area_burnt(:).gt.area_natural_veg(:)) 
+            d_area_burnt(:)=area_natural_veg(:)
+      ENDWHERE
+
+      fire_frac(:) = d_area_burnt(:)/area_land(:)
+
+    ENDWHERE !  lb.gt.0
+
+    !! 1.4 Calculate daily fire emissions
+
+    fuel_consum(:)=0.0
+    CALL fuel_consumption(npts,fuel_consum,fire_frac,           &
+            fuel_1hr,fuel_10hr,fuel_100hr,fuel_1000hr,livegrass,biomass,  &
+            fuel_1hr_total,dfm,dfm_1hr,wetness,MINER_TOT,fc_1hr,fc_lg,    &
+            fc_lf,fc_10hr,fc_100hr,fc_1000hr,cf_ave,                      &
+            moist_extinction,dfm_lg,veget_max,                            &
+            ratio_flag,cf_coarse,cf_fine,cf_lg,cf_1hr,cf_10hr,cf_100hr,cf_1000hr)
+
+    ! calculate surface fire intensity
+    ! Notice the fuel_consum doesn't include the 1000hr fuel
+    WHERE ((fire_frac(:).gt.min_stomate).and.(fuel_consum(:).gt.min_stomate))
+      d_i_surface(:)=H*(fuel_consum(:)/1000.0/fire_frac(:))*(ros_f(:)/60.0)  !Eq(15); unit of d_i_surface: kW/m
+    ENDWHERE
+
+    ! we suppress the simulated fires if their intensity is too small
+    WHERE (d_i_surface(:) .lt. surface_threshold)
+      lightn_numfire(:)=0.0
+      human_numfire(:)=0.0
+      d_numfire(:)=0.0
+      d_area_burnt(:)=0.0
+      fire_frac(:)=0.0
+      d_i_surface(:)=0.0
+      mean_fire_size(:)=0.0
+      cf_lg(:)=0.0
+      cf_1hr(:)=0.0
+      cf_ave(:)=0.0
+      cf_10hr(:)=0.0
+      cf_100hr(:)=0.0
+      cf_1000hr(:)=0.0
+    ELSEWHERE
+      fire_numday(:)=fire_numday(:)+1.
+      d_numfire(:)=d_numfire(:)/area_land(:)  !change the unit of d_numfire to 1ha^{-1}day^{-1}
+      lightn_numfire(:)=lightn_numfire(:)/area_land(:)  !change the unit of d_numfire to 1ha^{-1}day^{-1}
+      human_numfire(:)=human_numfire(:)/area_land(:)  !change the unit of d_numfire to 1ha^{-1}day^{-1}
+    ENDWHERE
+
+    ! Implement fire consequences, remove biomass being burned, mortality etc.
+    DO j=1,nvm
+      IF (natural(j)) THEN
+        DO k = 1, nlitt
+          ! surface fire: update fuel load per dead fuel class and ground litter
+          WHERE (d_i_surface(:) .ge. surface_threshold)
+            fuel_1hr(:,j,k)=fuel_1hr(:,j,k) - fc_1hr(:,j,k)*0.45 ! convert back to gC/m2; fuel_1h(npts,nvm,nlitt) unit shoule be gC/m2
+            fuel_10hr(:,j,k)=fuel_10hr(:,j,k) - fc_10hr(:,j,k)*0.45
+            fuel_100hr(:,j,k)=fuel_100hr(:,j,k) - fc_100hr(:,j,k)*0.45
+            fuel_1000hr(:,j,k)=fuel_1000hr(:,j,k) - fc_1000hr(:,j,k)  !always in gC/m2
+            litter(:,k,j,iabove)=litter(:,k,j,iabove)-(fc_1hr(:,j,k)+fc_10hr(:,j,k)+fc_100hr(:,j,k))*0.45-fc_1000hr(:,j,k) 
+          ELSEWHERE
+            fc_1hr(:,j,k)=0.
+            fc_10hr(:,j,k)=0.
+            fc_100hr(:,j,k)=0.
+            fc_1000hr(:,j,k)=0.
+          ENDWHERE
+        ENDDO !nlitt
+
+        !include ground litter emission to litter_consump_pft
+        litter_consump_pft(:,j)=litter_consump_pft(:,j)  &
+        + (fc_1hr(:,j,imetabolic)+fc_10hr(:,j,imetabolic)+fc_100hr(:,j,imetabolic))*0.45 & 
+           + fc_1000hr(:,j,imetabolic)              &
+        + (fc_1hr(:,j,istructural)+fc_10hr(:,j,istructural)+fc_100hr(:,j,istructural))*0.45 &
+           + fc_1000hr(:,j,istructural)
+
+        !! Apply fire effects for trees, when surface fire intensity is greater than 50 W/m
+
+        !! start of crown scorching
+        ! crown_length defined in constantes_mtc.f90 indicating the fraction of crown length to tree height.
+        IF (is_tree(j)) THEN
+
+          !when I_{surface} < 50kWm-1, ignitions are extinguished
+          WHERE (d_i_surface(:).ge. surface_threshold .and. PFTpresent(:,j))  
+            sh(:,j)=f_sh(j)*(d_i_surface(:)**0.667)  !scorch height per PFT Eq.(16); 
+                                                     !f_sh(j) defined in constantes_mtc.f90
+          ELSEWHERE
+            sh(:,j)=0.0       
+          ENDWHERE
+
+          WHERE (gamma(:).gt.min_stomate)
+            tau_l(:,j)=2.0*(cf_ave(:)/gamma(:)) ! Equation(46) in SPITFIRE technical document.
+          ELSEWHERE
+            tau_l(:,j)=0.0
+          ENDWHERE
+
+          ck(:,j)=0.0
+          pm_ck(:,j)=0.0
+
+          WHERE (height(:,j).gt.min_stomate .and. crown_length(j).gt.min_stomate & 
+                 .and. sh(:,j).ge.(height(:,j) - (height(:,j) * crown_length(j)))) 
+            ck(:,j) = (sh(:,j) - height(:,j) + (height(:,j) * crown_length(j))) &
+                        /(height(:,j) * crown_length(j))
+          ENDWHERE
+
+          WHERE (sh(:,j).GE.height(:,j))
+            ck(:,j) = 1.0 
+          ENDWHERE
+
+          ! post-fire mortality from crown scorching
+          WHERE (ck(:,j).gt.min_stomate)
+            pm_ck(:,j)=r_ck(j)*(ck(:,j)**p_ck(j)) !Eq.(22); r_ck & p_ck defined in constantes_mtc.f90
+          ENDWHERE
+
+          ! post-fire mortality from cambial damage
+          ! calculate Bark Thickness (bt) and tau_c
+          dia(:) = (height(:,j)/pipe_tune2)**(1./pipe_tune3)*100 !height is defined as height_presc in src_parameters/constantes_veg.f90; unit:m
+          ! because in lpj_crown.f90: height(:,j) = pipe_tune2*(dia(:)**pipe_tune3)
+          bt(:,j)=BTpar1(j) * dia(:)+BTpar2(j)   !Eq(21)
+          tau_c(:,j)=2.9 * (bt(:,j)**2.0)
+
+          ! tau_l/tau_c is the ratio of the residence time of the fire to the critical time for cambial damage.
+          WHERE (tau_c(:,j).ge.min_stomate)
+            WHERE ( (tau_l(:,j)/tau_c(:,j)).ge.2.0) 
+              pm_tau(:,j)=1.0
+            ELSEWHERE ((tau_l(:,j)/tau_c(:,j)).gt.0.22)
+              pm_tau(:,j)= (0.563*(tau_l(:,j)/tau_c(:,j)))-0.125
+            ELSEWHERE ((tau_l(:,j)/tau_c(:,j)).le.0.22) 
+              pm_tau(:,j)=0.0
+            ENDWHERE
+          ELSEWHERE
+            pm_tau(:,j)=0.0    
+          ENDWHERE
+           
+          ! Calculate total post-fire mortality from crown scorching AND cambial kill; Eq(18)
+          postf_mort(:,j)=pm_tau(:,j)+pm_ck(:,j)-(pm_tau(:,j)*pm_ck(:,j))
+
+          ! number of individuals affected by fire in grid cell
+          nind_fa(:,j)=fire_frac(:)*ind(:,j)
+          ! the number of individuals killed by crown scorching is 
+          ! derived by multiplying mortality rate with number of individuals affected by fire. 
+          nind_kill(:,j) = postf_mort(:,j) * nind_fa(:,j)
+
+
+          ! Here explains how consequence of fire-killed trees are handled.
+          ! the fraction of trees that are kill in fire is `postf_mort*fire_frac`,
+          ! Of the killed trees, `ck` of them have been crown-scroached by fire
+          ! and the 1-,10- and 100-h live fuel and 5% of the 1000-h fuel are combusted. 
+          ! the biomass of trees that are crown-scoarched but not consumed in fire 
+          ! would go to bm_to_litter. Then, the killed but not crown-scroached tree
+          ! biomass (1-ck) go directly to bm_to_litter.
+          
+          ! In summary, all the biomass of killed tress should be removed from 
+          ! live biomass pool as they are either combusted or transferred to bm_to_litter. 
+          ! Of the fraction (postf_mort * fire_frac) that are killed in fire, of which
+          !    --- ck (fraction) have been crown scorached, of which
+          !        -- 1-,10- and 100-h live fule and 5% of the 1000-h fuel are combusted;
+          !        -- 95% 1000-h fuel go to bm_to_litter;  
+          !    --- (1-ck) (fraction) go to bm_to_litter.
+
+          tree_kill_frac(:)=postf_mort(:,j)*fire_frac(:)
+          !disturb_crown is carbon emssions from crown scorching.
+          disturb_crown(:,j) = tree_kill_frac(:) * ck(:,j) *                    & 
+           (biomass(:,j,ileaf) + biomass(:,j,ifruit) +  &
+            0.0450 * biomass(:,j,isapabove) + 0.0450 * biomass(:,j,iheartabove) +     &
+            0.0450 * biomass(:,j,icarbres) +                                         &
+            0.0750 * biomass(:,j,isapabove) + 0.0750 * biomass(:,j,iheartabove) +     &
+            0.0750 * biomass(:,j,icarbres) +                                         &
+            0.2100 * biomass(:,j,isapabove) + 0.2100 * biomass(:,j,icarbres) +      &
+            0.2100 * biomass(:,j,iheartabove) +                                       & 
+            0.6700 * 0.050 * biomass(:,j,icarbres) + 0.6700 * 0.050 * biomass(:,j,iheartabove) + &
+            0.6700 * 0.050 * biomass(:,j,isapabove)                               & 
+           ) 
+
+          !fire flux to atmosphere, now biomass emissions from trees are included.
+          dcflux_fire_pft(:,j)=dcflux_fire_pft(:,j)+disturb_crown(:,j)
+          fc_crown(:)=fc_crown(:)+disturb_crown(:,j)*veget_max(:,j)  
+
+          ! biomass to litter transfer; (the killed but not crown scorching) AND (crown scorching but not combusted)
+          ! 1-ck(:,j)---killed but not crown scorching;
+          ! ck(:,j)*(1-0.045-0.075-0.21-0.67*0.05)---crown scorching but not combusted. 
+          bm_to_litter(:,j,ileaf) = bm_to_litter(:,j,ileaf) +                           & 
+                                    (tree_kill_frac(:) * (1-ck(:,j)) * biomass(:,j,ileaf)) 
+          bm_to_litter(:,j,ifruit) = bm_to_litter(:,j,ifruit) +                         & 
+                                    (tree_kill_frac(:) * (1-ck(:,j)) * biomass(:,j,ifruit)) 
+          bm_to_litter(:,j,isapabove) = bm_to_litter(:,j,isapabove) +                   & 
+                           (tree_kill_frac(:) * (1-ck(:,j)+ck(:,j)*  &
+                           (1-0.045-0.075-0.21-0.67*0.05))* biomass(:,j,isapabove)) 
+          bm_to_litter(:,j,icarbres) = bm_to_litter(:,j,icarbres) +                     &
+                           (tree_kill_frac(:) * (1-ck(:,j)+ck(:,j)*  &
+                           (1-0.045-0.075-0.21-0.67*0.05))* biomass(:,j,icarbres)) 
+          bm_to_litter(:,j,iheartabove) = bm_to_litter(:,j,iheartabove) +               &
+                           (tree_kill_frac(:) * (1-ck(:,j)+ck(:,j)*  &
+                           (1-0.045-0.075-0.21-0.67*0.05))* biomass(:,j,iheartabove)) 
+          ! move root/sapbelow/heartbelow biomass to belowground litter pool.
+          bm_to_litter(:,j,iroot) = bm_to_litter(:,j,iroot) +                           & 
+                                    (tree_kill_frac(:) * biomass(:,j,iroot)) 
+          bm_to_litter(:,j,isapbelow) = bm_to_litter(:,j,isapbelow) +           & 
+                                    (tree_kill_frac(:) * biomass(:,j,isapbelow)) 
+          bm_to_litter(:,j,iheartbelow) = bm_to_litter(:,j,iheartbelow) +           & 
+                                    (tree_kill_frac(:) * biomass(:,j,iheartbelow)) 
+
+          ! biomass update after combustion and litter transfer.
+          biomass(:,j,1) = biomass(:,j,1) - (tree_kill_frac(:) * biomass(:,j,1)) 
+          biomass(:,j,2) = biomass(:,j,2) - (tree_kill_frac(:) * biomass(:,j,2)) 
+          biomass(:,j,3) = biomass(:,j,3) - (tree_kill_frac(:) * biomass(:,j,3)) 
+          biomass(:,j,4) = biomass(:,j,4) - (tree_kill_frac(:) * biomass(:,j,4)) 
+          biomass(:,j,5) = biomass(:,j,5) - (tree_kill_frac(:) * biomass(:,j,5)) 
+          biomass(:,j,6) = biomass(:,j,6) - (tree_kill_frac(:) * biomass(:,j,6)) 
+          biomass(:,j,7) = biomass(:,j,7) - (tree_kill_frac(:) * biomass(:,j,7)) 
+          biomass(:,j,8) = biomass(:,j,8) - (tree_kill_frac(:) * biomass(:,j,8)) 
+
+
+          ! Update number of individuals surviving fire, ready for the next day. 
+          ind(:,j)= ind(:,j) - nind_kill(:,j)
+
+        ELSE !grass
+
+          WHERE (d_i_surface(:).ge.surface_threshold .and. PFTpresent(:,j)) 
+            !grass leaf & fruit consumption are also included in litter consumption
+            litter_consump_pft(:,j)=litter_consump_pft(:,j)+fc_lg(:,j)+fc_lf(:,j) !leaf & fruit consumption in fire for GRASS also included in litter consumption
+            biomass(:,j,ileaf)=biomass(:,j,ileaf)-fc_lg(:,j)
+            biomass(:,j,ifruit)=biomass(:,j,ifruit)-fc_lf(:,j)
+          ENDWHERE
+        ENDIF   !IF (tree(j))
+
+        ! add ground fuel combustion to the output variable of fire carbon flux per PFT
+        ! dcflux_fire_pft:total fire emissions, including crown fuels and ground litter consumption
+        dcflux_fire_pft(:,j)=dcflux_fire_pft(:,j) + litter_consump_pft(:,j)
+        litter_consump(:)=litter_consump(:)+(litter_consump_pft(:,j) *veget_max(:,j)/dt_days)
+      ENDIF   !IF natural
+    ENDDO  !fire effects per PFTj
+
+
+    ! total carbon emission this day; co2_fire should be equal to litter_consump+fc_crown
+
+    emi_nondef(:,:)= dcflux_fire_pft(:,:)/dt_days
+    co2_fire(:,:)= emi_nondef(:,:) + emideforest_all(:,:)
+    fc_crown(:)=fc_crown(:)/dt_days 
+
+    !!1.6 Calculate trace gas emissions
+    DO x=1,6 !trace_species
+      DO j=1,nvm
+        dcflux_trace_pft(:,j,x)=dcflux_fire_pft(:,j) * ef_trace(j,x)/0.45 !
+        dcflux_trace(:,x)=dcflux_trace(:,x)+ (dcflux_trace_pft(:,j,x) / dt_days)*veget_max(:,j) ! dcflux_trace has the same unit with dcflux_fire_pft, in g/m**2/day
+      ENDDO
+    ENDDO
+
+    DO k=1,nlitt
+      fc_1hr_carbon(:,:)=fc_1hr_carbon(:,:)+fc_1hr(:,:,k)*0.45
+      fc_10hr_carbon(:,:)=fc_10hr_carbon(:,:)+fc_10hr(:,:,k)*0.45
+      fc_100hr_carbon(:,:)=fc_100hr_carbon(:,:)+fc_100hr(:,:,k)*0.45
+      fc_1000hr_carbon(:,:)=fc_1000hr_carbon(:,:)+fc_1000hr(:,:,k)
+    ENDDO
+     
+    CALL histwrite_p (hist_id_stomate, 'CO2_FIRE_NonDef', itime, &
+                    emi_nondef(:,:), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'CO2_FIRE_Def', itime, &
+                    emideforest_all(:,:), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'D_FDI', itime, &
+                    d_fdi(:), npts, hori_index)
+    CALL histwrite_p (hist_id_stomate, 'ROS_F', itime, &
+                    ros_f(:), npts, hori_index)
+    CALL histwrite_p (hist_id_stomate, 'LIGHTN_NUMFIRE', itime, &
+                    lightn_numfire(:), npts, hori_index)
+    CALL histwrite_p (hist_id_stomate, 'HUMAN_NUMFIRE', itime, &
+                    human_numfire(:), npts, hori_index)
+    CALL histwrite_p (hist_id_stomate, 'D_NUMFIRE', itime, &
+                    d_numfire(:), npts, hori_index)
+    CALL histwrite_p (hist_id_stomate, 'OBSERVED_BA', itime, &
+                    observed_ba(:), npts, hori_index)
+    CALL histwrite_p (hist_id_stomate, 'D_AREA_BURNT', itime, &
+                    d_area_burnt(:), npts, hori_index)
+    CALL histwrite_p (hist_id_stomate, 'BA_ESCAPE', itime, &
+                    ba_escape(:), npts, hori_index)
+    CALL histwrite_p (hist_id_stomate, 'FIREFRAC_SPITFIRE', itime, &
+                    fire_frac(:), npts, hori_index)
+    CALL histwrite_p (hist_id_stomate, 'CROWN_CONSUMP', itime, &
+                    fc_crown(:), npts, hori_index)
+    CALL histwrite_p (hist_id_stomate, 'LITTER_CONSUMP', itime, &
+                    litter_consump(:), npts, hori_index)
+    CALL histwrite_p (hist_id_stomate, 'LIGHTN_IGN_TOTAL', itime, &
+                    lightn(:), npts, hori_index)
+    CALL histwrite_p (hist_id_stomate, 'TRACE_GAS_CO2', itime, &
+                    dcflux_trace(:,1), npts, hori_index)
+    CALL histwrite_p (hist_id_stomate, 'TRACE_GAS_CO', itime, &
+                    dcflux_trace(:,2), npts, hori_index)
+    CALL histwrite_p (hist_id_stomate, 'TRACE_GAS_CH4', itime, &
+                    dcflux_trace(:,3), npts, hori_index)
+    CALL histwrite_p (hist_id_stomate, 'TRACE_GAS_VOC', itime, &
+                    dcflux_trace(:,4), npts, hori_index)
+    CALL histwrite_p (hist_id_stomate, 'TRACE_GAS_TPM', itime, &
+                    dcflux_trace(:,5), npts, hori_index)
+    CALL histwrite_p (hist_id_stomate, 'TRACE_GAS_NOx', itime, &
+                    dcflux_trace(:,6), npts, hori_index)
+    CALL histwrite_p (hist_id_stomate, 'FIRE_NUMDAY', itime, &
+                    fire_numday(:), npts, hori_index)
+
+    CALL histwrite_p (hist_id_stomate, 'bafrac_deforest', itime, &
+         bafrac_deforest(:,:), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'bafrac_deforest_accu', itime, &
+         bafrac_deforest_accu(:,:), npts*nvm, horipft_index)
+
+    CALL histwrite_p (hist_id_stomate, 'EDlitMET', itime, &
+         emideforest_litter(:,:,imetabolic), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'EDlitSTR', itime, &
+         emideforest_litter(:,:,istructural), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'AccEDlitMET', itime, &
+         emideforest_litter_accu(:,:,imetabolic), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'AccEDlitSTR', itime, &
+         emideforest_litter_accu(:,:,istructural), npts*nvm, horipft_index)
+
+
+
+    CALL histwrite_p (hist_id_stomate, 'EDbioLEAF', itime, &
+         emideforest_biomass(:,:,ileaf), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'EDbioRESERVE', itime, &
+         emideforest_biomass(:,:,icarbres), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'EDbioFRUIT', itime, &
+         emideforest_biomass(:,:,ifruit), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'EDbioSapABOVE', itime, &
+         emideforest_biomass(:,:,isapabove), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'EDbioHeartABOVE', itime, &
+         emideforest_biomass(:,:,iheartabove), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'EDbioSapBELOW', itime, &
+         emideforest_biomass(:,:,isapbelow), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'EDbioHeartBELOW', itime, &
+         emideforest_biomass(:,:,iheartbelow), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'EDbioROOT', itime, &
+         emideforest_biomass(:,:,iroot), npts*nvm, horipft_index)
+
+    CALL histwrite_p (hist_id_stomate, 'AccEDbioLEAF', itime, &
+         emideforest_biomass_accu(:,:,ileaf), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'AccEDbioRESERVE', itime, &
+         emideforest_biomass_accu(:,:,icarbres), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'AccEDbioFRUIT', itime, &
+         emideforest_biomass_accu(:,:,ifruit), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'AccEDbioSapABOVE', itime, &
+         emideforest_biomass_accu(:,:,isapabove), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'AccEDbioHeartABOVE', itime, &
+         emideforest_biomass_accu(:,:,iheartabove), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'AccEDbioSapBELOW', itime, &
+         emideforest_biomass_accu(:,:,isapbelow), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'AccEDbioHeartBELOW', itime, &
+         emideforest_biomass_accu(:,:,iheartbelow), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'AccEDbioROOT', itime, &
+         emideforest_biomass_accu(:,:,iroot), npts*nvm, horipft_index)
+
+
+!debuging only
+    !CALL histwrite_p (hist_id_stomate, 'cf_lg', itime, &
+    !                cf_lg(:), npts, hori_index)
+    !CALL histwrite_p (hist_id_stomate, 'cf_1hr', itime, &
+    !                cf_1hr(:), npts, hori_index)
+    !CALL histwrite_p (hist_id_stomate, 'cf_10hr', itime, &
+    !                cf_10hr(:), npts, hori_index)
+    !CALL histwrite_p (hist_id_stomate, 'cf_100hr', itime, &
+    !                cf_100hr(:), npts, hori_index)
+    !CALL histwrite_p (hist_id_stomate, 'cf_ave', itime, &
+    !                cf_ave(:), npts, horipft_index)
+    !CALL histwrite_p (hist_id_stomate, 'cf_1000hr', itime, &
+    !                cf_1000hr(:), npts, hori_index)
+    !CALL histwrite_p (hist_id_stomate, 'fc_1hr_carbon', itime, &
+    !     fc_1hr_carbon(:,:), npts*nvm, horipft_index)
+    !CALL histwrite_p (hist_id_stomate, 'fc_10hr_carbon', itime, &
+    !     fc_10hr_carbon(:,:), npts*nvm, horipft_index)
+    !CALL histwrite_p (hist_id_stomate, 'fc_100hr_carbon', itime, &
+    !     fc_100hr_carbon(:,:), npts*nvm, horipft_index)
+    !CALL histwrite_p (hist_id_stomate, 'fc_1000hr_carbon', itime, &
+    !     fc_1000hr_carbon(:,:), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'fuel_1hr_met', itime, &
+         fuel_1hr(:,:,imetabolic), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'fuel_1hr_str', itime, &
+         fuel_1hr(:,:,istructural), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'fuel_10hr_met', itime, &
+         fuel_10hr(:,:,imetabolic), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'fuel_10hr_str', itime, &
+         fuel_10hr(:,:,istructural), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'fuel_100hr_met', itime, &
+         fuel_100hr(:,:,imetabolic), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'fuel_100hr_str', itime, &
+         fuel_100hr(:,:,istructural), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'fuel_1000hr_met', itime, &
+         fuel_1000hr(:,:,imetabolic), npts*nvm, horipft_index)
+    CALL histwrite_p (hist_id_stomate, 'fuel_1000hr_str', itime, &
+         fuel_1000hr(:,:,istructural), npts*nvm, horipft_index)
+    !CALL histwrite_p (hist_id_stomate, 'dead_fuel', itime, &
+    !                dead_fuel(:), npts, hori_index)
+    !CALL histwrite_p (hist_id_stomate, 'dead_fuel_all', itime, &
+    !                dead_fuel_all(:), npts, hori_index)
+    !CALL histwrite_p (hist_id_stomate, 'ck', itime, &
+    !     ck(:,:), npts*nvm, horipft_index)
+    !CALL histwrite_p (hist_id_stomate, 'sh', itime, &
+    !     sh(:,:), npts*nvm, horipft_index)
+    !CALL histwrite_p (hist_id_stomate, 'postf_mort', itime, &
+    !     postf_mort(:,:), npts*nvm, horipft_index)
+    !CALL histwrite_p (hist_id_stomate, 'pm_tau', itime, &
+    !     pm_tau(:,:), npts*nvm, horipft_index)
+    !CALL histwrite_p (hist_id_stomate, 'pm_ck', itime, &
+    !     pm_ck(:,:), npts*nvm, horipft_index)
+
+    !CALL histwrite_p (hist_id_stomate, 'topsoilhum_daily', itime, &
+    !     soilhum_daily(:), npts, horipft_index)
+
+    !CALL histwrite_p (hist_id_stomate, 'fire_durat', itime, &
+    !                fire_durat(:), npts, hori_index)
+    !CALL histwrite_p (hist_id_stomate, 'ros_b', itime, &
+    !                ros_b(:), npts, hori_index)
+    !CALL histwrite_p (hist_id_stomate, 'ros_f', itime, &
+    !                ros_f(:), npts, hori_index)
+    !CALL histwrite_p (hist_id_stomate, 'wind_speed', itime, &
+    !                wind_speed(:), npts, hori_index)
+    !CALL histwrite_p (hist_id_stomate, 'mean_fire_size_or', itime, &
+    !                mean_fire_size_original(:), npts, hori_index)
+    !CALL histwrite_p (hist_id_stomate, 'mean_fire_size', itime, &
+    !                mean_fire_size(:), npts, hori_index)
+    !CALL histwrite_p (hist_id_stomate, 'd_i_surface', itime, &
+    !                d_i_surface(:), npts, hori_index)
+    !CALL histwrite_p (hist_id_stomate, 'sigma', itime, &
+    !                sigma(:), npts, hori_index)
+    !CALL histwrite_p (hist_id_stomate, 'char_dens_fuel_ave', itime, &
+    !                char_dens_fuel_ave(:), npts, hori_index)
+    CALL xios_orchidee_send_field("D_AREA_BURNT",d_area_burnt)     
+    CALL xios_orchidee_send_field("FIREFRAC_SPITFIRE",fire_frac) 
+
+    END SUBROUTINE SPITFIRE
+
+
+!! ================================================================================================================================
+!! SUBROUTINE     : fire_danger_index
+!!                                                                              
+!>\BRIEF        Calculation of the fire danger index using the Nesterov Index      
+!!                                                                              
+!! DESCRIPTION   : None                            
+!!                                                                              
+!! RECENT CHANGE(S): None                                                       
+!!                                                                              
+!! RETURN VALUE :  dfm, dfm_1hr, d_fdi                                               
+!! 
+!! MODIFIED VALUE: ni_acc
+!!                                                                              
+!! REFERENCE(S)   : 
+!! - K.Thonicke, A.Spessa, I.C. Prentice, S.P.Harrison, L.Dong, and
+!! C.Carmona-Moreno, 2010: The influence of vegetation, fire spread and fire
+!! behaviour on biomass burning and trace gas emissions: results from a
+!! process-based model. Biogeosciences, 7, 1991-2011.
+!!                                                                              
+!! FLOWCHART   : None                                                           
+!! \n                                                                           
+!_ ================================================================================================================================
+
+    SUBROUTINE  fire_danger_index(npts,d_fdi,dfm,dfm_1hr,t2m_min_daily,  &
+                  t2m_max_daily, precip_daily,me_litterfuel,ni_acc,      &
+                  fuel_1hr_total,fuel_10hr_total,fuel_100hr_total,       &
+                  dead_fuel,moist_extinction,ratio_dead_fuel, ratio_live_fuel)
+
+
+    implicit none
+
+    ! Domain size
+    INTEGER, INTENT(in)                                 :: npts
+
+    ! INPUT VARIABLES
+    REAL(r_std),DIMENSION(npts), INTENT(in)              :: t2m_min_daily     !! Daily minimum 2 meter temperatures (K)
+    REAL(r_std),DIMENSION(npts), INTENT(in)              :: t2m_max_daily     !! Daily maximum 2 meter temperatures (K)
+    REAL(r_std), DIMENSION(npts), INTENT(in)             :: precip_daily      !! daily precip (mm/day)
+    REAL(r_std), DIMENSION(npts), INTENT(in)             :: me_litterfuel     !! the moisture of extinction weighted by the
+                                                                              !! dead groud litter fuel of different natural PFTs, unitless
+    REAL(r_std), DIMENSION(npts), INTENT(in)             :: fuel_1hr_total    !! in the unit of dry mass rather than C
+    REAL(r_std), DIMENSION(npts), INTENT(in)             :: fuel_10hr_total
+    REAL(r_std), DIMENSION(npts), INTENT(in)             :: fuel_100hr_total
+    REAL(r_std), DIMENSION(npts), INTENT(in)             :: dead_fuel
+    REAL(r_std), DIMENSION(npts), INTENT(in)             :: moist_extinction
+    REAL(r_std), DIMENSION(npts), INTENT(in)             :: ratio_dead_fuel
+    REAL(r_std), DIMENSION(npts), INTENT(in)             :: ratio_live_fuel
+
+    ! OUTPUT VARIABLES 
+    REAL(r_std), DIMENSION(npts), INTENT(out)            :: dfm               !! Daily fuel moisture (0,1), unitless.
+    REAL(r_std), DIMENSION(npts), INTENT(out)            :: dfm_1hr           !! Fuel moisture for the 1hr fuel, used only in calculating the dfm_lg_d1hr
+    REAL(r_std), DIMENSION(npts), INTENT(out)            :: d_fdi
+
+    ! MODIFIED VARIABLES
+    REAL(r_std), DIMENSION(npts),INTENT(INOUT)           :: ni_acc !!
+
+    ! LOCAL VARIABLES
+    ! alpha values are in proportion to their surface-to-volume ratios and reflects their impact on the overall dryness of fuel.
+    ! lower suface-area-to-volume ratio leads to low alpha value, meaning that fuels needs a long time to be dry has less importance
+    ! in determinning overall fuel mositure.
+    REAL(r_std), parameter                           :: alpha=0.0015               !! this variables is NOT USED.
+    REAL(r_std), parameter                           :: alpha_1hr=0.001            !! from alpha_1hr --> alpha_1000hr: source SupInfo Table 4 and Thonicke 2010 P1996
+    REAL(r_std), parameter                           :: alpha_10hr=0.00005424
+    REAL(r_std), parameter                           :: alpha_100hr=0.00001485 
+    REAL(r_std), parameter                           :: alpha_1000hr = 0.000001    !! NOT USED
+    REAL(r_std), parameter                           :: alpha_livegrass = 0.0005   !! SOURCE
+    REAL(r_std), DIMENSION(npts)                     :: d_NI  !Nesterov Index (.C^2) 
+    REAL(r_std), DIMENSION(npts)                     :: alpha_fuel
+    REAL(r_std), DIMENSION(npts)                     :: char_alpha_fuel
+
+
+
+    ! Initialise
+    d_NI(:)=0.
+    alpha_fuel(:)=0.
+
+    ! calculate Nesterov Index Eq.(5); ZeroCelsius=273.15 in stomate_constant.f90
+    WHERE  ( (precip_daily(:) .LE. 3.) .AND. ((t2m_min_daily(:) -4.) .GE. ZeroCelsius) ) 
+      d_NI(:) = (t2m_max_daily(:)-273.16)*( t2m_max_daily(:) - (t2m_min_daily(:)-4.) )
+    ENDWHERE 
+
+    WHERE (d_NI(:) .GT. 0.)
+      ni_acc(:) = ni_acc(:) + d_NI(:)
+    ELSEWHERE
+      ni_acc(:)=0.
+    ENDWHERE
+
+    ! litter moisture index, weighted per dead fuel class and
+
+    WHERE (dead_fuel(:).gt.min_stomate) 
+       alpha_fuel(:)=(alpha_1hr*fuel_1hr_total(:)+ &
+                     alpha_10hr*fuel_10hr_total(:)+ &
+                     alpha_100hr*fuel_100hr_total(:))/dead_fuel(:)
+    ELSEWHERE
+       alpha_fuel(:)=0.00001
+    ENDWHERE
+
+    dfm(:)=exp(-alpha_fuel(:)*ni_acc(:))  ! daily fuel moisture;  \omega_{o} in Eq(6); 
+                                          ! used for fire spread rate calculation. 1000hr fuel ignored.
+    dfm_1hr(:) = exp(-alpha_1hr * ni_acc(:))  !moisture for the fuel_1hr.
+
+    ! calculate Fire Danger Index d_fdi, Eq.(8)
+    ! moist_extinction acts as the 'me' in the FDI equation (Equation 8 in Thonicke 2010 Biogeoscience)
+    WHERE (moist_extinction(:).le.min_stomate)
+       d_fdi(:)=0.0
+    ELSEWHERE
+       d_fdi(:)=max(0.0,(1.0 - 1.0/moist_extinction(:)*dfm(:) ))
+    ENDWHERE
+
+    !Fire danger index becomes zero when Nesterov index is lower than 0.
+    WHERE (d_NI(:).le.0.) 
+       d_fdi(:)=0.0
+    ENDWHERE
+
+
+    ! output for testing only
+    !CALL histwrite_p (hist_id_stomate, 'moist_extinction', itime, &
+    !                moist_extinction(:), npts, horipft_index)
+    !CALL histwrite_p (hist_id_stomate, 'alpha_fuel', itime, &
+    !                alpha_fuel(:), npts, hori_index)
+    !CALL histwrite_p (hist_id_stomate, 'ni_acc', itime, &
+    !                ni_acc(:), npts, hori_index)
+    !CALL histwrite_p (hist_id_stomate, 't2m_min_daily', itime, &
+    !                t2m_min_daily(:), npts, hori_index)
+    !CALL histwrite_p (hist_id_stomate, 't2m_max_daily', itime, &
+    !                t2m_max_daily(:), npts, hori_index)
+    !CALL histwrite_p (hist_id_stomate, 'precip_daily', itime, &
+    !                precip_daily(:), npts, hori_index)
+    !CALL histwrite_p (hist_id_stomate, 'dfm_1hr', itime, &
+    !                dfm_1hr(:), npts, hori_index)
+
+    END SUBROUTINE fire_danger_index
+
+!! ================================================================================================================================
+!! SUBROUTINE     : human_ign_fct
+!!                                                                              
+!>\BRIEF        Calculation human ignitions
+!!                                                                              
+!! DESCRIPTION   : None                            
+!!                                                                              
+!! RECENT CHANGE(S): None                                                       
+!!                                                                              
+!! RETURN VALUE :  Nonw
+!! 
+!! REFERENCE(S)   : 
+!! - K.Thonicke, A.Spessa, I.C. Prentice, S.P.Harrison, L.Dong, and
+!! C.Carmona-Moreno, 2010: The influence of vegetation, fire spread and fire
+!! behaviour on biomass burning and trace gas emissions: results from a
+!! process-based model. Biogeosciences, 7, 1991-2011.
+!!                                                                              
+!! FLOWCHART   : None                                                           
+!! \n                                                                           
+!_ ================================================================================================================================
+
+    ! Algorithm in this function is very carefully checked (2012/05/31)
+    SUBROUTINE human_ign_fct(npts,popd,a_nd,human_ign) 
+
+    implicit none
+
+    ! Domain size
+    INTEGER, INTENT(in)                              :: npts
+    ! INPUT Variables
+    REAL(r_std), DIMENSION(npts), INTENT(in)         ::  popd  !individuals km^-2
+    REAL(r_std), DIMENSION(npts), INTENT(in)         ::  a_nd  !ignitions individual^-1 d^-1
+    ! OUTPUT
+    REAL(r_std), DIMENSION(npts), INTENT(out)        ::  human_ign  
+
+    WHERE(popd(:).ge.min_stomate)
+      !compared with Eq(3) in Thonicke et al. (2010), we have to again divide
+      !by 100 to change the unit from ignitions d^{-1}ha^{-1} to ignitions d^{-1}km^{-1}
+      human_ign(:)=30.0*(exp(-0.5*(popd(:)**0.5)))*a_nd(:)*popd(:)/10000.0 !unit: ignitions d^{-1}km^{-1}
+    ELSEWHERE
+      human_ign(:)=0.0
+    ENDWHERE
+
+    END SUBROUTINE human_ign_fct
+
+
+!! ================================================================================================================================
+!! SUBROUTINE     : human_ign_fct
+!!                                                                              
+!>\BRIEF        Calculation human ignitions
+!!                                                                              
+!! DESCRIPTION   : None                            
+!!                                                                              
+!! RECENT CHANGE(S): None                                                       
+!!                                                                              
+!! RETURN VALUE :  Nonw
+!! 
+!! REFERENCE(S)   : 
+!! Li et al. (2011) A process-based fire parameterization of intermediate 
+!! complexity in a Dynamic Global Vegetation Model.
+!!                                                                              
+!! FLOWCHART   : None                                                           
+!! \n                                                                           
+!_ ================================================================================================================================
+
+    SUBROUTINE human_suppression_func(npts,popd,human_suppression)
+
+     implicit none
+
+     !Domain size
+     INTEGER, INTENT(in)                              :: npts
+
+     !INPUT Variables
+     REAL(r_std), DIMENSION(npts), INTENT(in)         ::  popd  !individuals km^-2
+     !OUTPUT
+     REAL(r_std), DIMENSION(npts), INTENT(out)        ::  human_suppression
+
+     WHERE(popd(:).ge.min_stomate)
+       ! source: Li et al. (2011) A process-based fire parameterization of intermediate complexity in a Dynamic Global
+       ! Vegetation Model. Page 2766
+       human_suppression(:) = 0.99-0.98*exp(-0.025*popd(:)) 
+     ELSEWHERE
+       human_suppression(:)=0.0
+     ENDWHERE
+
+    END SUBROUTINE human_suppression_func       
+
+
+!! ================================================================================================================================
+!! SUBROUTINE     : rate_of_spread
+!!                                                                              
+!>\BRIEF        Calculation fire spread rate, This is the application of Eq.(9) in
+!!     Thonicke et al. (2010)
+!!                                                                              
+!! DESCRIPTION   : None                            
+!!                                                                              
+!! RECENT CHANGE(S): None                                                       
+!!                                                                              
+!! RETURN VALUE :  Nonw
+!! 
+!! REFERENCE(S)   : 
+!! - K.Thonicke, A.Spessa, I.C. Prentice, S.P.Harrison, L.Dong, and
+!! C.Carmona-Moreno, 2010: The influence of vegetation, fire spread and fire
+!! behaviour on biomass burning and trace gas emissions: results from a
+!! process-based model. Biogeosciences, 7, 1991-2011.
+!!                                                                              
+!! FLOWCHART   : None                                                           
+!! \n                                                                           
+!_ ================================================================================================================================
+
+    SUBROUTINE rate_of_spread(npts,U_front,wind_forward,sigma,  &
+                  dfm,me_litterfuel,H, char_dens_fuel_ave,      &
+                  char_net_fuel, moist_extinction,gamma,wetness)
+
+    implicit none
+    
+    ! Domain size
+    INTEGER, INTENT(in)                             :: npts
+
+    ! INPUT Variables
+    REAL(r_std), DIMENSION(npts), INTENT(in)         :: wind_forward 
+    REAL(r_std), DIMENSION(npts), INTENT(in)         :: char_dens_fuel_ave
+    REAL(r_std), DIMENSION(npts), INTENT(in)         :: sigma
+    REAL(r_std), DIMENSION(npts), INTENT(in)         :: char_net_fuel
+    REAL(r_std), DIMENSION(npts), INTENT(in)         :: dfm 
+    REAL(r_std), DIMENSION(npts), INTENT(in)         :: me_litterfuel
+    REAL(r_std), DIMENSION(npts), INTENT(in)         :: moist_extinction
+    REAL(r_std), INTENT(in)                          :: H           !! heat content of the fuel (18000kJ/kg)
+
+    ! OUTPUT Variables       
+    REAL(r_std), DIMENSION(npts), INTENT(out)        :: U_front     !! Forward fire spread rate (m min^{-1}), ROS_{f,surface} in Thonicke et al. 2010 
+    REAL(r_std), DIMENSION(npts), INTENT(out)        :: gamma
+    REAL(r_std), DIMENSION(npts), INTENT(out)        :: wetness     !! wetness, unitless, the ratio of dead fuel moisture to the moisture of extinction
+
+    ! LOCAL Variables
+    REAL(r_std), DIMENSION(npts)                     :: dummy
+    REAL(r_std), DIMENSION(npts)                     :: dummy2
+    REAL(r_std), DIMENSION(npts)                     :: beta        !! Packing ratio, unitless, the ratio of fuel_bulk_density(kg m^{-3}) against 
+                                                                    !! oven-dry particle_density (513kg m^{-3}).
+    REAL(r_std), DIMENSION(npts)                     :: beta_op
+    REAL(r_std), DIMENSION(npts)                     :: q_ig
+    REAL(r_std), DIMENSION(npts)                     :: eps
+    REAL(r_std), DIMENSION(npts)                     :: b
+    REAL(r_std), DIMENSION(npts)                     :: c
+    REAL(r_std), DIMENSION(npts)                     :: e
+    REAL(r_std), DIMENSION(npts)                     :: phi_wind
+    REAL(r_std), DIMENSION(npts)                     :: xi          !!propagating flux ratio used in the calculation of ROS_{f,surface}
+    REAL(r_std), DIMENSION(npts)                     :: a
+    REAL(r_std), DIMENSION(npts)                     :: gamma_max
+    REAL(r_std), DIMENSION(npts)                     :: gamma_aptr  !!gamma'
+    REAL(r_std), DIMENSION(npts)                     :: ir
+    REAL(r_std), DIMENSION(npts)                     :: bet
+    REAL(r_std), DIMENSION(npts)                     :: moist_damp
+
+
+    ! mineral dampening coefficient
+    REAL(r_std), parameter :: MINER_DAMP=0.41739 !Thonicke 2010 Table A1 Row 7
+    REAL(r_std), parameter :: part_dens=513.0 !Thonicke 2010 Table A1 Row 5
+    INTEGER :: m
+
+
+
+    ! Initialise
+    xi(:)=0.0
+    gamma_aptr=0.0
+    dummy2(:)=0.0
+
+    beta(:) = char_dens_fuel_ave(:) / part_dens !packing ratio
+    beta_op(:) = 0.200395*(sigma(:)**(-0.8189)) !Eq.(A6)
+    bet(:) = beta(:) / beta_op(:)  !prepare for Eq.(A5)
+
+    ! heat of pre-ignition
+    q_ig(:)=581.0+2594.0*dfm(:)
+    ! effective heating number
+    eps(:)=exp(-4.528/sigma(:))
+    ! influence of wind speed
+    b(:)=0.15988*(sigma(:)**0.54)
+    c(:)=7.47*(exp(-0.8711*(sigma(:)**0.55)))
+    e(:)=0.7515*(exp(-0.01094*sigma(:)))
+
+    WHERE(bet(:).GT.0.00001.AND.wind_forward(:).GT.min_stomate)
+      phi_wind(:)=c(:)*(wind_forward(:)**b(:))*(bet(:)**(-e(:)))  !Eq.(A5)
+    ENDWHERE
+
+    WHERE(bet(:).LE.0.00001)
+      phi_wind(:)=c(:)*(wind_forward(:)**b(:))*0.00001  !??UNIMPORTANT not sure this will pose a problem 
+                                                        !but when bet --> 0+, bet**(-e) can be very big, which 
+                                                        !is on the contrary with the simplied form.
+    ENDWHERE
+
+    WHERE(wind_forward(:).LE.min_stomate)
+      phi_wind(:)=zero
+    ENDWHERE
+
+    ! propagating flux
+    WHERE (sigma(:).le.0.00001) 
+      xi(:)=0.0
+    ELSEWHERE
+      xi(:) = (exp((0.792 + 3.7597 * (sigma(:)**0.5)) * &  !Eq.(A2)
+         (beta(:) + 0.1))) / (192 + 7.9095 * sigma(:))
+    ENDWHERE
+
+    ! reaction intensity
+    a(:)=8.9033*(sigma(:)**(-0.7913))
+    WHERE (a(:).le.0.00001 .OR. bet(:).le.0.00001)
+       dummy(:)=0.0
+    ELSEWHERE
+       dummy(:)=exp(a(:)*(1.0-bet(:)))
+    ENDWHERE
+      gamma_max(:)=1.0/(0.0591+2.926*(sigma(:)**(-1.5)))  !Thonicke 2010 Table A1 Row 2
+
+    WHERE(bet(:).GT.0.0001)
+      gamma_aptr(:)=gamma_max(:)*(bet(:)**a(:))*dummy(:)
+    ELSEWHERE
+      gamma_aptr(:)=gamma_max(:)*(0.0001)*dummy(:)
+    ENDWHERE
+    
+    ! wn/me in Eq. row 6 in Table A1 in Thonicke 2010.
+    WHERE (moist_extinction(:).gt.min_stomate)
+      wetness(:)=dfm(:)/moist_extinction(:)
+    ELSEWHERE
+      wetness(:)=0.0
+    ENDWHERE
+
+    WHERE (wetness(:).gt.min_stomate)
+      moist_damp(:)=max(0.0,(1.0-(2.59*wetness(:))+ &
+        (5.11*(wetness(:)**2.0))-(3.52*(wetness(:)**3.0))))
+    ELSEWHERE
+      moist_damp(:)=0.0
+    ENDWHERE
+
+    ir(:)=gamma_aptr(:) * char_net_fuel(:) * H * moist_damp(:) * MINER_DAMP !Eq.(A1)
+
+    !for use in calculating tau_l for postfire mortality.
+    gamma(:)=gamma_aptr(:)*moist_damp(:)*MINER_DAMP
+      
+    ! reaction intensity end
+
+    WHERE ((char_dens_fuel_ave(:).le.min_stomate).or. &
+           (eps(:).le.0.0).or.(q_ig(:).le.min_stomate)) 
+      U_front(:)=0.0
+    ELSEWHERE
+      U_front(:)=(ir(:) * xi(:) * (1.0 + phi_wind(:))) / &
+          (char_dens_fuel_ave(:) * eps(:) * q_ig(:))
+    ENDWHERE
+
+    END SUBROUTINE rate_of_spread
+
+!! ================================================================================================================================
+!! SUBROUTINE     : fuel_consumption
+!!                                                                              
+!>\BRIEF        Calculation fire fuel consumption
+!!                                                                              
+!! DESCRIPTION   : None                            
+!!                                                                              
+!! RECENT CHANGE(S): None                                                       
+!!                                                                              
+!! RETURN VALUE :  Nonw
+!! 
+!! REFERENCE(S)   : 
+!! - K.Thonicke, A.Spessa, I.C. Prentice, S.P.Harrison, L.Dong, and
+!! C.Carmona-Moreno, 2010: The influence of vegetation, fire spread and fire
+!! behaviour on biomass burning and trace gas emissions: results from a
+!! process-based model. Biogeosciences, 7, 1991-2011.
+!!                                                                              
+!! FLOWCHART   : None                                                           
+!! \n                                                                           
+!_ ================================================================================================================================
+
+    !fuel_consum--total fuel consumed excluding the 1000hr fuel; fc_1hr/10hr/100hr--fuel consumed; in the unit of g biomass/m**2 (C/0.45); fc_1000hr (unit gC/m**2) 
+    !fuel_consum: unit g mass/m**2 weighted by veget_max among PFTs, includes only 1hr/10hr/100hr dead fuel, used for calculation of d_i_surface 
+    SUBROUTINE fuel_consumption(npts,fuel_consum,fire_frac,           &
+        fuel_1hr,fuel_10hr,fuel_100hr,fuel_1000hr,livegrass,biomass,  &
+        fuel_1hr_total,dfm,dfm_1hr,wetness,MINER_TOT,fc_1hr,fc_lg,    &
+        fc_lf,fc_10hr,fc_100hr,fc_1000hr,cf_ave,                      &
+        moist_extinction,dfm_lg,veget_max,                            &
+        ratio_flag,cf_coarse,cf_fine,cf_lg,cf_1hr,cf_10hr,cf_100hr,cf_1000hr)
+
+
+    implicit none
+
+    integer :: d,j,k
+
+    ! Domain size
+    INTEGER, INTENT(in)                             :: npts
+
+    REAL(r_std), DIMENSION(npts), INTENT(in)                    :: livegrass
+    REAL(r_std), DIMENSION(npts), INTENT(in)                    :: fire_frac
+    REAL(r_std), DIMENSION(npts), INTENT(in)                    :: dfm
+    REAL(r_std), DIMENSION(npts), INTENT(in)                    :: dfm_1hr          !! Daily fuel moisture for 1hr fuel, unitless, (0,1)
+    REAL(r_std), DIMENSION(npts), INTENT(in)                    :: dfm_lg           !! Daily live grass fuel moisture, unitless, (0,1)
+    REAL(r_std), DIMENSION(npts), INTENT(in)                    :: wetness
+    REAL(r_std), DIMENSION(npts), INTENT(in)                    :: moist_extinction
+    REAL(r_std), DIMENSION(npts), INTENT(in)                    :: fuel_1hr_total
+    REAL(r_std), DIMENSION(npts), INTENT(in)                    :: cf_coarse        !! Externally forced consumption fraction for coarse fuel, used
+                                                                                    !! on 1000hr fuel.
+    REAL(r_std), DIMENSION(npts), INTENT(in)                    :: cf_fine          !! Externally forced consumption fraction for fine fuel, applied
+                                                                                    !! on live grass fuel, 1hr/10hr/100hr fuel.
+    REAL(r_std), DIMENSION(npts), INTENT(in)                    :: ratio_flag       !! gridded value used to indicate where the external consumption
+                                                                                    !! fractions will be applied in the model, when ratio_flag is larger
+                                                                                    !! than 0, the external consumption fractions will be used.
+
+    REAL(r_std), DIMENSION(npts,nvm,nlitt), INTENT(in)          :: fuel_1hr
+    REAL(r_std), DIMENSION(npts,nvm,nlitt), INTENT(in)          :: fuel_10hr
+    REAL(r_std), DIMENSION(npts,nvm,nlitt), INTENT(in)          :: fuel_100hr
+    REAL(r_std), DIMENSION(npts,nvm,nlitt), INTENT(in)          :: fuel_1000hr
+    REAL(r_std), DIMENSION(npts,nvm,nparts), INTENT(in)         :: biomass
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)                :: veget_max
+    REAL(r_std), INTENT(in)                                     :: MINER_TOT
+
+    REAL(r_std), DIMENSION(npts), INTENT(inout)                 :: fuel_consum      !! total dead ground fuel consumed excluding the 1000hr fuel, as 
+                                                                                    !! weighted by presence of PFTs (g dry mass per m2)
+    REAL(r_std), DIMENSION(npts,nvm,nlitt), INTENT(out)         :: fc_1hr           !! fc_*hr:fuel consumed, in the unit of biomass (C/0.45).
+    REAL(r_std), DIMENSION(npts,nvm,nlitt), INTENT(out)         :: fc_10hr
+    REAL(r_std), DIMENSION(npts,nvm,nlitt), INTENT(out)         :: fc_100hr
+    REAL(r_std), DIMENSION(npts,nvm,nlitt), INTENT(out)         :: fc_1000hr
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)               :: fc_lg            !! livegrass leaf fuel cosumed (g C m^{-2})
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(out)               :: fc_lf            !! livegrass fruit fuel consumed (gC m^{-2})
+    REAL(r_std), DIMENSION(npts), INTENT(out)                   :: cf_ave           !! the average consumption fraction of 1hr/10hr/100hr fuel, unitless, (0,1)
+
+    !LOCAL VARIABLES
+    REAL(r_std), DIMENSION(npts)                                :: dfm_lg_d1hr      !! daily fuel moisture for 1hr dead fuel and livegrass moisture combined
+    REAL(r_std), DIMENSION(npts), INTENT(out)                   :: cf_1hr           !! cf_*hr:consumption fraction, unitless, (0,1)
+    REAL(r_std), DIMENSION(npts), INTENT(out)                   :: cf_lg
+    REAL(r_std), DIMENSION(npts), INTENT(out)                   :: cf_10hr
+    REAL(r_std), DIMENSION(npts), INTENT(out)                   :: cf_100hr
+    REAL(r_std), DIMENSION(npts), INTENT(out)                   :: cf_1000hr
+    REAL(r_std), DIMENSION(npts)                                :: wetness_lg
+    REAL(r_std), DIMENSION(npts)                                :: wetness_1hr      !! the wetness of 1hr-fuel in comparison with moisture of extinction 
+                                                                                    !! is influenced by live grass fuel moisture
+    REAL(r_std), parameter :: me_livegrass=0.2                                      !! moisture of extinction for live grass (unitless) 
+
+
+    ! Initialise
+    fuel_consum(:)=0.0
+    dfm_lg_d1hr(:)=0.0
+    wetness_lg(:)=0.0
+    wetness_1hr(:)=0.0
+
+    !dfm_lg is the wlg in Eq.(B2) and Eq.(B3)
+    WHERE (fuel_1hr_total(:).gt.min_stomate)
+      dfm_lg_d1hr(:)=dfm_1hr(:)+(dfm_lg(:)*(livegrass(:)/fuel_1hr_total(:))) !Eq.(B3)
+    ENDWHERE
+ 
+    WHERE (moist_extinction(:).gt.min_stomate)
+      wetness_lg(:)=dfm_lg(:)/me_livegrass
+      wetness_1hr(:)=dfm_lg_d1hr(:)/moist_extinction(:)
+    ELSEWHERE
+      wetness_lg(:)=1.0
+      wetness_1hr(:)=1.0
+    ENDWHERE
+
+    !Note that the fuel consumption fractions depend on only the moisture state and
+    !thus are PFT independent.
+    DO j=1,nvm
+      IF (natural(j)) THEN
+        ! livegrass consumption
+        IF (.not.is_tree(j)) THEN
+          fc_lg(:,j)=0.0
+          fc_lf(:,j)=0.0
+          WHERE (wetness_lg(:).le.0.18)
+             cf_lg(:)=1.0
+          ELSEWHERE (wetness_lg(:).gt.0.18.and.wetness_lg(:).le.0.73)
+             cf_lg(:)=1.11-0.62*wetness_lg(:)
+          ELSEWHERE (wetness_lg(:).gt.0.73.and.wetness_lg(:).le.1.0)
+             cf_lg(:)=2.45-2.45*wetness_lg(:)
+          ELSEWHERE (wetness_lg(:).gt.1.0)
+             cf_lg(:)=0.0
+          ENDWHERE
+    
+          WHERE (ratio_flag(:).gt.0.0)
+            cf_lg(:)=cf_fine(:)
+          ENDWHERE
+    
+          fc_lg(:,j)=cf_lg(:) *(1.0-MINER_TOT)* biomass(:,j,ileaf)*fire_frac(:)
+          fc_lf(:,j)=cf_lg(:) *(1.0-MINER_TOT)* biomass(:,j,ifruit)*fire_frac(:)
+        ENDIF !not a tree
+    
+        !dead fuel consumption
+        DO k=1,nlitt
+          !1hr fuel consumption
+          fc_1hr(:,j,k)=0.0
+          WHERE (fuel_1hr(:,j,k).gt.0.0)
+
+            WHERE (wetness_1hr(:).le.0.18)
+               cf_1hr(:)=1.0  
+            ELSEWHERE (wetness_1hr(:).gt.0.18.and.wetness_1hr(:).le.0.73)
+               cf_1hr(:)=1.11-0.62*wetness_1hr(:)
+            ELSEWHERE (wetness_1hr(:).gt.0.73.and.wetness_1hr(:).le.1.0)
+               cf_1hr(:)=2.45-2.45*wetness_1hr(:)
+            ELSEWHERE (wetness_1hr(:).gt.1.0)
+               cf_1hr(:)=0.0
+            ENDWHERE
+
+            WHERE (cf_1hr(:) .gt. 0.9)
+              cf_1hr(:) = 0.9
+            ENDWHERE
+    
+            WHERE (ratio_flag(:).gt.0.0)
+              cf_1hr(:)=cf_fine(:)
+            ENDWHERE
+    
+               fc_1hr(:,j,k)=cf_1hr(:)*(1.0-MINER_TOT)*(fuel_1hr(:,j,k)/0.45)*fire_frac(:)
+          ENDWHERE
+            
+    
+          !10hr fuel consumption
+          fc_10hr(:,j,k)=0.0
+          WHERE (fuel_10hr(:,j,k).gt.0.0)
+            WHERE (wetness(:).le.0.12)
+              cf_10hr(:)=1.0
+            ELSEWHERE (wetness(:).gt.0.12.and.wetness(:).le.0.51)
+              cf_10hr(:)=1.09-0.72*wetness(:)
+            ELSEWHERE (wetness(:).gt.0.51.and.wetness(:).le.1.0)
+              cf_10hr(:)=1.47-1.47*wetness(:)
+            ELSEWHERE (wetness(:).gt.1.0)
+              cf_10hr(:)=0.0
+            ENDWHERE
+    
+            WHERE (cf_10hr(:) .gt. 0.9)
+              cf_10hr(:) = 0.9
+            ENDWHERE
+
+            WHERE (ratio_flag(:).gt.0.0)
+              cf_10hr(:)=cf_fine(:)
+            ENDWHERE
+    
+            fc_10hr(:,j,k)=cf_10hr(:)* (1.0-MINER_TOT)*(fuel_10hr(:,j,k)/0.45)*fire_frac(:)
+          ENDWHERE 
+     
+    
+          !100hr fuel consumption
+          fc_100hr(:,j,k)=0.0
+          WHERE (fuel_100hr(:,j,k).gt.0.0)
+            WHERE (wetness(:).le.0.38)
+              cf_100hr(:)=0.98-0.85*wetness(:)
+            ELSEWHERE (wetness(:).gt.0.38 .and. wetness(:).le.1.0)
+              cf_100hr(:)=1.06-1.06*wetness(:)
+            ELSEWHERE (wetness(:).gt.1.0)
+              cf_100hr(:)=0.0
+            ENDWHERE
+
+            WHERE (cf_100hr(:) .gt. fire_max_cf_100hr(j))
+              cf_100hr(:) = fire_max_cf_100hr(j)
+            ENDWHERE
+    
+            WHERE (ratio_flag(:).gt.0.0)
+              cf_100hr(:)=cf_fine(:)
+            ENDWHERE
+    
+            fc_100hr(:,j,k)=cf_100hr(:)*(1.0-MINER_TOT)* (fuel_100hr(:,j,k)/0.45)*fire_frac(:)
+          ENDWHERE
+    
+          !calculating average fuel consumption fraction
+          !the 1000hr fuel consumption fraction is not included in the average consumption fraction.
+          cf_ave(:)=(cf_1hr(:)+cf_10hr(:)+cf_100hr(:))/3.0
+    
+          !1000hr fuel consumption, not influencing rate of spread or surface fire intensity (Rothermel 1972)
+          fc_1000hr(:,j,k)=0.0
+          WHERE (fuel_1000hr(:,j,k).gt.0.0 .and. wetness(:).le.1.0)
+            cf_1000hr(:) = -0.8*wetness(:)+0.8
+
+            WHERE (cf_1000hr(:) .gt. fire_max_cf_1000hr(j))
+              cf_1000hr(:) = fire_max_cf_1000hr(j)
+            ENDWHERE
+
+            WHERE (ratio_flag(:).gt.0.0)
+              cf_1000hr(:)=cf_coarse(:)
+            ENDWHERE
+            fc_1000hr(:,j,k)=cf_1000hr(:) * (1.0-MINER_TOT)* fuel_1000hr(:,j,k)*fire_frac(:)
+          ENDWHERE
+    
+          !total fuel consumption (without 1000hr fuel) in g biomass per m**2
+          !Used to calculate fire frontline intensity
+          fuel_consum(:)=fuel_consum(:)+(fc_1hr(:,j,k)+fc_10hr(:,j,k)+fc_100hr(:,j,k))*veget_max(:,j)
+        ENDDO !nlitt
+      ENDIF !natural 
+    ENDDO !pft
+
+    ! Only for debug purposes
+    !CALL histwrite_p (hist_id_stomate, 'cf_fine', itime, &
+    !                cf_fine(:), npts, hori_index)
+    !CALL histwrite_p (hist_id_stomate, 'cf_coarse', itime, &
+    !                cf_coarse(:), npts, hori_index)
+    !CALL histwrite_p (hist_id_stomate, 'dfm_lg_d1hr', itime, &
+    !                dfm_lg_d1hr(:), npts, hori_index)
+    !CALL histwrite_p (hist_id_stomate, 'dfm_lg', itime, &
+    !                dfm_lg(:), npts, hori_index)
+    !CALL histwrite_p (hist_id_stomate, 'dfm', itime, &
+    !                dfm(:), npts, hori_index)
+    !CALL histwrite_p (hist_id_stomate, 'wetness', itime, &
+    !                wetness(:), npts, hori_index)
+    !CALL histwrite_p (hist_id_stomate, 'wetness_lg', itime, &
+    !                wetness_lg(:), npts, hori_index)
+    !CALL histwrite_p (hist_id_stomate, 'wetness_1hr', itime, &
+    !                wetness_1hr(:), npts, hori_index)
+
+    END SUBROUTINE fuel_consumption
+
+
+!! ================================================================================================================================
+!! SUBROUTINE     : deforestation_fire
+!!                                                                              
+!>\BRIEF       Simulate deforestation processes from land cover change.
+!!                                                                              
+!! DESCRIPTION   : None                            
+!!                                                                              
+!! RECENT CHANGE(S): None                                                       
+!!                                                                              
+!! RETURN VALUE :  Nonw
+!! 
+!! REFERENCE(S)   : 
+!!                                                                              
+!! FLOWCHART   : None                                                           
+!! \n                                                                           
+!_ ================================================================================================================================
+
+    SUBROUTINE deforestation_fire(npts,d_fdi,lcc,biomass,fuel_1hr,&
+        fuel_10hr,fuel_100hr,fuel_1000hr,bafrac_deforest,&
+        emideforest_fuel_1hr,emideforest_fuel_10hr,emideforest_fuel_100hr,&
+        emideforest_fuel_1000hr,emideforest_biomass)
+
+    IMPLICIT NONE
+
+    !! Input variables
+    ! Domain size
+    INTEGER, INTENT(in)                                     :: npts
+    REAL(r_std), DIMENSION(npts)                            :: d_fdi             !! daily fire danger index,climatic fire risk, unitless (0,1)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)            :: lcc               !! gross forest cover loss
+    REAL(r_std), DIMENSION(npts,nvm,nparts), INTENT(in)     :: biomass
+    REAL(r_std), DIMENSION(npts,nvm,nlitt), INTENT(in)      :: fuel_1hr          !! [gC^{m-2}]
+    REAL(r_std), DIMENSION(npts,nvm,nlitt), INTENT(in)      :: fuel_10hr         !! [gC^{m-2}]
+    REAL(r_std), DIMENSION(npts,nvm,nlitt), INTENT(in)      :: fuel_100hr        !! [gC^{m-2}]
+    REAL(r_std), DIMENSION(npts,nvm,nlitt), INTENT(in)      :: fuel_1000hr       !! [gC^{m-2}]
+     
+    !! Output variables
+    REAL(r_std), DIMENSION(npts,nvm),INTENT(inout)          :: bafrac_deforest         !! Deforestation fire burned fraction,unitless
+    REAL(r_std), DIMENSION(npts,nvm,nlitt),INTENT(inout)    :: emideforest_fuel_1hr    !! fuel consumption for 1hr fuel (gCm^{-2})
+    REAL(r_std), DIMENSION(npts,nvm,nlitt),INTENT(inout)    :: emideforest_fuel_10hr   !! 
+    REAL(r_std), DIMENSION(npts,nvm,nlitt),INTENT(inout)    :: emideforest_fuel_100hr  !! 
+    REAL(r_std), DIMENSION(npts,nvm,nlitt),INTENT(inout)    :: emideforest_fuel_1000hr !! 
+    REAL(r_std), DIMENSION(npts,nvm,nparts),INTENT(inout)   :: emideforest_biomass     !! live biomass emissions from deforestation fires [gCm^{-2}]
+    
+    !! Local variables
+    REAL(r_std), DIMENSION(npts)                            :: deforest_factor         !!Factor to scale the deforestation fire fraction, unitless
+    REAL(r_std), DIMENSION(npts)                            :: vartemp
+    REAL(r_std), DIMENSION(npts)                            :: cc_litter               !! Fire consumption fraction for litter, leaf,fruit and reserve biomass
+    REAL(r_std), DIMENSION(npts)                            :: cc_wood                 !! Fire consumption fraction for heart and sapwood
+    INTEGER(i_std)                                          :: ilit,j                  !! Indices (unitless)
+
+
+    deforest_factor(:) = 0.017
+    cc_litter(:) = 0.7 + 0.3*d_fdi(:)
+    cc_wood(:) = 0.3 + d_fdi(:)*0.3  
+
+    DO j=2,nvm
+      IF (is_tree(j)) THEN
+        WHERE (lcc(:,j) > min_stomate)
+          !The equation of y=0.58*x-0.006 is derived by regressing GFED3 reported
+          !deforestation fire burned fraction to the gross forest loss by Hansen 2010
+          !for the closed canopy Amazonian forest
+          vartemp(:) = MAX(0.0001,lcc(:,j)*0.58-0.006)
+          bafrac_deforest(:,j) = deforest_factor(:) * vartemp(:) * d_fdi(:) 
+
+          !We calculate fire emissions from litter and biomass
+          emideforest_fuel_1hr(:,j,imetabolic) = cc_litter(:) * bafrac_deforest(:,j) * fuel_1hr(:,j,imetabolic)
+          emideforest_fuel_1hr(:,j,istructural) = cc_litter(:) * bafrac_deforest(:,j) * fuel_1hr(:,j,istructural)
+          emideforest_fuel_10hr(:,j,imetabolic) = cc_litter(:) * bafrac_deforest(:,j) * fuel_10hr(:,j,imetabolic)
+          emideforest_fuel_10hr(:,j,istructural) = cc_litter(:) * bafrac_deforest(:,j) * fuel_10hr(:,j,istructural)
+          emideforest_fuel_100hr(:,j,imetabolic) = cc_litter(:) * bafrac_deforest(:,j) * fuel_100hr(:,j,imetabolic)
+          emideforest_fuel_100hr(:,j,istructural) = cc_litter(:) * bafrac_deforest(:,j) * fuel_100hr(:,j,istructural)
+          emideforest_fuel_1000hr(:,j,imetabolic) = cc_litter(:) * bafrac_deforest(:,j) * fuel_1000hr(:,j,imetabolic)
+          emideforest_fuel_1000hr(:,j,istructural) = cc_litter(:) * bafrac_deforest(:,j) * fuel_1000hr(:,j,istructural)
+
+          emideforest_biomass(:,j,icarbres) = cc_litter(:) * bafrac_deforest(:,j) * biomass(:,j,icarbres)
+          emideforest_biomass(:,j,ifruit) = cc_litter(:) * bafrac_deforest(:,j) * biomass(:,j,ifruit)
+          emideforest_biomass(:,j,ileaf) = cc_litter(:) * bafrac_deforest(:,j) * biomass(:,j,ileaf)
+          emideforest_biomass(:,j,iheartabove) = cc_wood(:) * bafrac_deforest(:,j) * biomass(:,j,iheartabove)
+          emideforest_biomass(:,j,isapabove) = cc_wood(:) * bafrac_deforest(:,j) * biomass(:,j,isapabove)
+        ENDWHERE 
+      END IF
+    END DO
+   
+   END SUBROUTINE deforestation_fire
+   
+!! ================================================================================================================================
+!! SUBROUTINE     : deforestation_fire_proxy
+!!                                                                              
+!>\BRIEF       Simulate deforestation processes from land cover change.
+!!                                                                              
+!! DESCRIPTION   : None                            
+!!                                                                              
+!! RECENT CHANGE(S): None                                                       
+!!                                                                              
+!! RETURN VALUE :  Nonw
+!! 
+!! REFERENCE(S)   : 
+!!                                                                              
+!! FLOWCHART   : None                                                           
+!! \n                                                                           
+!_ ================================================================================================================================
+
+    SUBROUTINE deforestation_fire_proxy(npts,d_fdi,lcc,                     &
+        deforest_biomass_remain,                     &
+        def_fuel_1hr_remain,def_fuel_10hr_remain,                           &
+        def_fuel_100hr_remain,def_fuel_1000hr_remain,                       &
+        bafrac_deforest, emideforest_fuel_1hr,emideforest_fuel_10hr,        &
+        emideforest_fuel_100hr, emideforest_fuel_1000hr,emideforest_biomass)
+
+
+    IMPLICIT NONE
+
+    !! Input variables
+    ! Domain size
+    INTEGER, INTENT(in)                                     :: npts
+    REAL(r_std), DIMENSION(npts)                            :: d_fdi             !! daily fire danger index,climatic fire risk, unitless (0,1)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)            :: lcc               !! gross forest cover loss
+    REAL(r_std), DIMENSION(npts,nvm,nlitt), INTENT(in)        :: def_fuel_1hr_remain     !! [gC^{m-2}]
+    REAL(r_std), DIMENSION(npts,nvm,nlitt), INTENT(in)        :: def_fuel_10hr_remain    !! [gC^{m-2}]
+    REAL(r_std), DIMENSION(npts,nvm,nlitt), INTENT(in)        :: def_fuel_100hr_remain   !! [gC^{m-2}]
+    REAL(r_std), DIMENSION(npts,nvm,nlitt), INTENT(in)        :: def_fuel_1000hr_remain  !! [gC^{m-2}]
+    REAL(r_std), DIMENSION(npts,nvm,nparts), INTENT(in)      :: deforest_biomass_remain 
+     
+    !! Output variables
+    REAL(r_std), DIMENSION(npts,nvm),INTENT(inout)          :: bafrac_deforest         !! Deforestation fire burned fraction,unitless
+    REAL(r_std), DIMENSION(npts,nvm,nlitt),INTENT(inout)    :: emideforest_fuel_1hr    !! fuel consumption for 1hr fuel (gCm^{-2})
+    REAL(r_std), DIMENSION(npts,nvm,nlitt),INTENT(inout)    :: emideforest_fuel_10hr   !! 
+    REAL(r_std), DIMENSION(npts,nvm,nlitt),INTENT(inout)    :: emideforest_fuel_100hr  !! 
+    REAL(r_std), DIMENSION(npts,nvm,nlitt),INTENT(inout)    :: emideforest_fuel_1000hr !! 
+    REAL(r_std), DIMENSION(npts,nvm,nparts),INTENT(inout)   :: emideforest_biomass     !! live biomass emissions from deforestation fires [gCm^{-2}]
+    
+    !! Local variables
+    REAL(r_std), DIMENSION(npts,nvm)                        :: bafrac_net              !! Deforestation fire burned fraction,unitless
+    REAL(r_std), DIMENSION(npts)                            :: deforest_factor         !!Factor to scale the deforestation fire fraction, unitless
+    REAL(r_std), DIMENSION(npts)                            :: vartemp
+    REAL(r_std), DIMENSION(npts)                            :: cc_litter               !! Fire consumption fraction for litter, leaf,fruit and reserve biomass
+    REAL(r_std), DIMENSION(npts)                            :: cc_wood                 !! Fire consumption fraction for heart and sapwood
+    INTEGER(i_std)                                          :: ilit,j                  !! Indices (unitless)
+
+
+    ! the 7.2 is tested. The test result could be found at 
+    ! /home/cyue/Documents/ORCHIDEE/TEST_MICTv6bis/Deforestation_test/Deforestation_fire_annual_2001_2010_55e0e3e_T2.nc
+    ! with the notebook be found at: /home/cyue/Documents/ORCHIDEE/TEST_MICTv6bis/Test_tag_MICTv6bisT2
+    ! the readme file is at: /home/orchidee01/ychao/MICTv6/bin/readme.txt
+    deforest_factor(:) = 0.017*7.2
+    cc_litter(:) = 0.7 + 0.3*d_fdi(:)
+    cc_wood(:) = 0.3 + d_fdi(:)*0.3  
+
+    DO j=2,nvm
+      IF (is_tree(j)) THEN
+        WHERE (lcc(:,j) > min_stomate)
+          !The equation of y=0.58*x-0.006 is derived by regressing GFED3 reported
+          !deforestation fire burned fraction to the gross forest loss by Hansen 2010
+          !for the closed canopy Amazonian forest
+          vartemp(:) = MAX(0.0001,lcc(:,j)*0.58-0.006)
+          bafrac_deforest(:,j) = deforest_factor(:) * vartemp(:) * d_fdi(:) 
+          bafrac_net(:,j)=bafrac_deforest(:,j)/lcc(:,j)
+
+          !We calculate fire emissions from litter and biomass
+          !note here because cc_litter*bafrac_net < 1, the fuel will never be 
+          !exhausted.
+          emideforest_fuel_1hr(:,j,imetabolic) = cc_litter(:) * bafrac_net(:,j) * def_fuel_1hr_remain(:,j,imetabolic)
+          emideforest_fuel_1hr(:,j,istructural) = cc_litter(:) * bafrac_net(:,j) * def_fuel_1hr_remain(:,j,istructural)
+          emideforest_fuel_10hr(:,j,imetabolic) = cc_litter(:) * bafrac_net(:,j) * def_fuel_10hr_remain(:,j,imetabolic)
+          emideforest_fuel_10hr(:,j,istructural) = cc_litter(:) * bafrac_net(:,j) * def_fuel_10hr_remain(:,j,istructural)
+          emideforest_fuel_100hr(:,j,imetabolic) = cc_litter(:) * bafrac_net(:,j) * def_fuel_100hr_remain(:,j,imetabolic)
+          emideforest_fuel_100hr(:,j,istructural) = cc_litter(:) * bafrac_net(:,j) * def_fuel_100hr_remain(:,j,istructural)
+          emideforest_fuel_1000hr(:,j,imetabolic) = cc_litter(:) * bafrac_net(:,j) * def_fuel_1000hr_remain(:,j,imetabolic)
+          emideforest_fuel_1000hr(:,j,istructural) = cc_litter(:) * bafrac_net(:,j) * def_fuel_1000hr_remain(:,j,istructural)
+
+          emideforest_biomass(:,j,icarbres) = cc_litter(:) * bafrac_net(:,j) * deforest_biomass_remain(:,j,icarbres)
+          emideforest_biomass(:,j,ifruit) = cc_litter(:) * bafrac_net(:,j) * deforest_biomass_remain(:,j,ifruit)
+          emideforest_biomass(:,j,ileaf) = cc_litter(:) * bafrac_net(:,j) * deforest_biomass_remain(:,j,ileaf)
+          emideforest_biomass(:,j,iheartabove) = cc_wood(:) * bafrac_net(:,j) * deforest_biomass_remain(:,j,iheartabove)
+          emideforest_biomass(:,j,isapabove) = cc_wood(:) * bafrac_net(:,j) * deforest_biomass_remain(:,j,isapabove)
+        ENDWHERE 
+      END IF
+    END DO
+   
+   END SUBROUTINE deforestation_fire_proxy
+END MODULE lpj_spitfire
Index: /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_stomate/stomate_check.f90
===================================================================
--- /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_stomate/stomate_check.f90	(revision 6940)
+++ /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_stomate/stomate_check.f90	(revision 6940)
@@ -0,0 +1,311 @@
+! =================================================================================================================================
+! MODULE       : stomate_check
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF       Subroutines to check mass conservation 
+!!	
+!!\n DESCRIPTION: None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! SVN :
+!! $HeadURL: $
+!! $Date: $
+!! $Revision: $
+!! \n
+!================================================================================================================================
+
+
+MODULE stomate_check
+
+  USE xios_orchidee
+  USE constantes
+  USE stomate_data
+  USE ioipsl_para
+  USE constantes_soil
+  USE ieee_arithmetic 
+
+  IMPLICIT NONE
+
+  ! private routines
+  PRIVATE
+
+  ! public routines
+  PUBLIC stomate_check_mass_values, stomate_check_cons_mass
+
+  INTERFACE stomate_check_cons_mass
+    MODULE PROCEDURE stomate_check_cons_mass_r2d, stomate_check_cons_mass_r3d
+  END INTERFACE
+
+
+CONTAINS 
+
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: stomate_check_mass 
+!!
+!>\BRIEF       Check for biomass variable consistency  
+!!
+!! DESCRIPTION  : Check for biomass values: negatives, very big values and Nan
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): None 
+!!
+!! REFERENCES	: None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  SUBROUTINE stomate_check_mass_values(npts,biomass,identifier)
+
+  INTEGER(i_std), INTENT(in)                    :: npts         !! Domain size (unitless)
+  REAL(r_std), DIMENSION(:,:,:,:),INTENT(in)    :: biomass      !! Biomass components of the model tree  
+  
+  CHARACTER(LEN=*), INTENT(in),OPTIONAL         ::  identifier  !! string with to identify where this routine was called form
+  
+  ! locals
+  INTEGER                                       :: nelement, npart, pft, idx
+  LOGICAL                                       :: is_crash 
+  CHARACTER(LEN=:), ALLOCATABLE                 :: ident_routine
+! ===================================================================================================
+
+
+   ident_routine='No information'
+   IF (PRESENT(identifier)) THEN
+     ident_routine=identifier
+   ENDIF
+
+   ! 1. check for negative biomass pools:
+   IF (printlev >= 1) WRITE (numout,*) '=== BIOMASS CHECK ==='
+
+   is_crash=.FALSE.
+   DO nelement=1,nelements
+     DO npart=1,nparts
+        ! dont check crops and crops, it does not work yet
+        DO pft=1,nvm-2
+           DO idx=1,npts
+             IF ((biomass(idx,pft,npart,nelement) .LT. zero).OR. & ! negative
+                   (biomass(idx,pft,npart,nelement) .GT. large_value).OR. & ! infinity 
+                   (isnan(biomass(idx,pft,npart,nelement))))   THEN ! NaN
+                        WRITE (numout,*) 'FATAL negative biomass detected'
+                        WRITE (numout,*) 'routine:'  , ident_routine
+                        WRITE (numout,*) 'biomass = ', biomass(idx,pft,npart,nelement)
+                        WRITE (numout,*) 'box     = ',idx
+                        WRITE (numout,*) 'PFT     = ',pft
+                        WRITE (numout,*) 'npart   = ',npart
+                        WRITE (numout,*) '1=leaf,2=sapabov,3=sapbelo,4=heartabov,5=heatbelow,6=root,7=fruit,8=carbres,9=ilabile'
+                        WRITE (numout,*) 'element = ',nelement
+                        is_crash=.TRUE.
+             ENDIF
+           ENDDO
+        ENDDO
+     ENDDO
+   ENDDO
+
+
+   IF (is_crash) THEN
+      CALL ipslerr_p ( 3, 'stomate_check_mass_values',   &
+                          'Negative biomass pool was detected:', &
+                          'Failed for subroutine ', &
+                          identifier)
+   ELSE
+      IF (printlev >= 1) WRITE (numout,*) '     passed          '
+   ENDIF
+
+  END SUBROUTINE stomate_check_mass_values
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: stomate_check_cons_mass_r3d 
+!!
+!>\BRIEF        
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): None 
+!!
+!! REFERENCES	: None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  SUBROUTINE stomate_check_cons_mass_r3d(lalo, mass_before,      &
+                          mass_after,       &
+                          mass_change,      &
+                          identifier)
+
+  REAL(r_std),DIMENSION(:,:),INTENT(in)              :: lalo          !! Geographical coordinates (latitude,longitude) for pixels (degrees) 
+  REAL(r_std), DIMENSION(:,:,:),INTENT(in)           :: mass_before   !! Biomass old
+  REAL(r_std), DIMENSION(:,:,:),INTENT(in)           :: mass_after    !! Biomass new (npts,nvm,nelements)
+  REAL(r_std), DIMENSION(:,:,:),INTENT(in)           :: mass_change   !! Biomass change
+  CHARACTER(LEN=*), INTENT(in),OPTIONAL              ::  identifier   !! string with to identify where this routine was called form
+
+  ! locals
+  INTEGER                                            :: nelement, pft, idx, ierr
+  LOGICAL,ALLOCATABLE, DIMENSION(:,:,:)              :: is_crash
+  REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:)         :: mass_conserv  !! conservation 
+  CHARACTER(LEN=:), ALLOCATABLE                      :: ident_routine
+  ! this subroutine checks for mass conservation
+  INTEGER(i_std)                                     :: npts          !! Domain size (unitless)
+  INTEGER(i_std)                                     :: nvm           !! Domain size (unitless)
+  INTEGER(i_std)                                     :: nelements     !! Domain size (unitless)
+  
+! ===================================================================================================
+
+  npts = SIZE(mass_before, DIM=1)
+  nvm = SIZE(mass_before, DIM=2)
+  nelements = SIZE(mass_before, DIM=3)
+
+  IF (PRESENT(identifier)) THEN
+      ident_routine=identifier
+  ELSE
+       ident_routine=' no information'
+  ENDIF
+
+  ALLOCATE(is_crash(npts, nvm, nelements), stat=ierr)
+  IF (ierr /= 0) CALL ipslerr_p(3, 'stomate_chekc_cons_mass_r3d', 'Memory allocation problem with ', 'is_crash variable', '')
+
+  ALLOCATE(mass_conserv(npts, nvm, nelements), stat=ierr)
+  IF (ierr /= 0) CALL ipslerr_p(3, 'stomate_check_cons_mass_r3d', 'Memory allocation problem with ', 'mass_conserv variable', '')
+
+  is_crash(:,:,:)=.FALSE.
+  ! bookkeeping:
+  mass_conserv(:,:,:)          = mass_before(:,:,:) - mass_after(:,:,:) + mass_change(:,:,:)
+
+  ! check the bookkeeping
+  DO nelement=1, nelements-1
+    ! take out crops and grass; till they are fixed
+    DO pft=1, nvm-2
+      DO idx=1, npts
+         IF (ABS(mass_conserv(idx,pft,nelement)).GT. (min_stomate*100.)) THEN
+                WRITE (numout,*) 'FATAL mass conservation failed (positive value = leak)'
+                WRITE (numout,*) 'routine:', ident_routine
+                ! the limit is given by the allocation routine, which accepts
+                ! mass leaks<ABS(10E-6) 
+                WRITE (numout,*) ' limit: ',min_stomate*100.
+                WRITE (numout,*) ' Coordinates :', lalo(idx,:) 
+                WRITE (numout,*) ' for element :', nelement, ' of nelements: ',nelements
+                WRITE (numout,*) ' gridpoint: ',idx , ' of ngrids: ',npts
+                WRITE (numout,*) ' PFT: ',pft , ' of npfts: ',nvm
+                WRITE (numout,*) ' mismatch =', mass_conserv(idx,pft,nelement)
+                WRITE (numout,*) ' mass(before) =', mass_before(idx,pft,nelement)
+                WRITE (numout,*) ' mass(after) =', mass_after(idx,pft,nelement)
+                is_crash(idx,pft,nelement)=.TRUE.
+         ENDIF  
+      ENDDO
+    ENDDO
+  ENDDO
+
+  IF (ANY(is_crash(:,:,:))) THEN
+     CALL ipslerr_p ( 3, 'stomate_check_cons_mass_r3d', &
+                    'Mass conservation is not preserved', &
+          &         'in subroutine', &
+                    ident_routine)
+  ENDIF
+
+  DEALLOCATE(mass_conserv)
+  DEALLOCATE(is_crash)
+
+  END SUBROUTINE stomate_check_cons_mass_r3d
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: stomate_check_cons_mass_r2d
+!!
+!>\BRIEF        
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): None 
+!!
+!! REFERENCES	: None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  SUBROUTINE stomate_check_cons_mass_r2d(lalo, mass_before,      &
+                          mass_after,       &
+                          mass_change,      &
+                          identifier)
+
+
+  REAL(r_std),DIMENSION(:,:),INTENT(in)              :: lalo          !! Geographical coordinates (latitude,longitude) for pixels (degrees) 
+  ! biomass pools to be checked
+  REAL(r_std), DIMENSION(:,:),INTENT(in)             :: mass_before   !! Biomass old
+  REAL(r_std), DIMENSION(:,:),INTENT(in)             :: mass_after    !! Biomass new (npts,nvm)
+  REAL(r_std), DIMENSION(:,:),INTENT(in)             :: mass_change   !! Biomass change
+
+  CHARACTER(LEN=*), INTENT(in),OPTIONAL              ::  identifier   !! string with to identify where this routine was called form
+
+  ! locals
+  INTEGER(i_std)                                     :: pft, idx, ierr
+  LOGICAL,ALLOCATABLE,DIMENSION(:,:)                 :: is_crash
+  REAL(r_std),ALLOCATABLE, DIMENSION(:,:)            :: mass_conserv  !! conservation 
+  CHARACTER(LEN=:), ALLOCATABLE                      :: ident_routine
+  ! this subroutine checks for mass conservation
+  INTEGER(i_std)                                     :: npts          !! Domain size (unitless)
+  INTEGER(i_std)                                     :: nvm           !! Domain size (unitless)
+! ===================================================================================================
+  npts = SIZE(mass_before, DIM=1)
+  nvm = SIZE(mass_before, DIM=2)
+
+  ALLOCATE(is_crash(npts, nvm), stat=ierr)
+  IF (ierr /= 0) CALL ipslerr_p(3, 'stomate_check_cons_mass_r2d', 'Memory allocation problem with ', 'is_crash variable', '')
+
+  ALLOCATE(mass_conserv(npts, nvm), stat=ierr)
+  IF (ierr /= 0) CALL ipslerr_p(3, 'stomate_check_cons_mass_r2d', 'Memory allocation problem with ', 'mass_conserv variable', '')
+
+  IF (PRESENT(identifier)) THEN
+      ident_routine=identifier
+  ELSE
+       ident_routine=' no information'
+  ENDIF
+
+
+  is_crash(:,:)=.FALSE.
+  ! bookkeeping:
+  mass_conserv(:,:)          = mass_before(:,:) - mass_after(:,:) + mass_change(:,:)
+
+  ! check the bookkeeping
+  ! take out crops and grass; till they are fixed
+  DO pft=1,nvm-2
+    DO idx=1,npts
+       IF (ABS(mass_conserv(idx,pft)).GT. (min_stomate*100.)) THEN
+              WRITE (numout,*) 'FATAL mass conservation failed (positive value = leak)'
+              WRITE (numout,*) 'routine:', ident_routine
+                ! the limit is given by the allocation routine, which accepts
+                ! mass leaks<ABS(10E-6) 
+              WRITE (numout,*) ' limit: '       ,min_stomate*100.
+              WRITE (numout,*) ' Coordinates :' , lalo(idx,:) 
+              WRITE (numout,*) ' gridpoint: '   ,idx , ' of ngrids: ',npts
+              WRITE (numout,*) ' PFT: '         ,pft , ' of npfts: ',nvm
+              WRITE (numout,*) ' mismatch ='    , mass_conserv(idx,pft)
+              WRITE (numout,*) ' mass(before) =', mass_before(idx,pft)
+              WRITE (numout,*) ' mass(after) =' , mass_after(idx,pft)
+              is_crash(idx,pft)=.TRUE.
+       ENDIF  
+    ENDDO
+  ENDDO
+
+  IF (ANY(is_crash(:,:))) THEN
+     CALL ipslerr_p ( 3, 'stomate_check_cons_mass_r2d', &
+                    'Mass convervation is not preserved', &
+          &         'in subroutine', &
+                    ident_routine)
+  ENDIF
+
+  DEALLOCATE(mass_conserv)
+  DEALLOCATE(is_crash)
+
+  END SUBROUTINE stomate_check_cons_mass_r2d
+
+
+
+END MODULE stomate_check
Index: /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_stomate/stomate_fharvest_MulAgeC.f90
===================================================================
--- /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_stomate/stomate_fharvest_MulAgeC.f90	(revision 6940)
+++ /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_stomate/stomate_fharvest_MulAgeC.f90	(revision 6940)
@@ -0,0 +1,906 @@
+! =================================================================================================================================
+! MODULE       : stomate_lcchange_fh
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF       This module is a copy of stomate_lcchange. It includes the forestry 
+!              harvest.
+!!
+!!\n DESCRIPTION: None
+!!
+!! RECENT CHANGE(S): Including permafrost carbon
+!!
+!! REFERENCE(S)	: None
+!!
+!! SVN          :
+!! $HeadURL: svn://forge.ipsl.jussieu.fr/orchidee/perso/albert.jornet/ORCHIDEE-MICT/src_stomate/stomate_lcchange.f90 $
+!! $Date: 2015-07-30 15:38:45 +0200 (Thu, 30 Jul 2015) $
+!! $Revision: 2847 $
+!! \n
+!_ ================================================================================================================================
+
+
+MODULE stomate_fharvest_MulAgeC
+
+  ! modules used:
+  
+  USE ioipsl_para
+  USE stomate_data
+  USE pft_parameters
+  USE constantes
+  USE constantes_soil_var
+  USE stomate_gluc_common
+  USE stomate_glcchange_MulAgeC
+  USE stomate_gluc_constants
+  USE xios_orchidee
+#ifdef CPP_PARA
+  USE mpi
+#endif
+
+  IMPLICIT NONE
+
+  PRIVATE
+  PUBLIC fharvest_MulAgeC, Get_harvest_matrix
+  
+CONTAINS
+
+! ================================================================================================================================
+!! SUBROUTINE   gross_lcchange
+!!
+!>\BRIEF       : Apply gross land cover change.
+!!
+!>\DESCRIPTION  
+!_ ================================================================================================================================
+  SUBROUTINE fharvest_MulAgeC (npts, dt_days, harvest_matrix,newvegfrac,   &
+               fuelfrac, &
+               def_fuel_1hr_remain, def_fuel_10hr_remain,        &
+               def_fuel_100hr_remain, def_fuel_1000hr_remain,    &
+               deforest_litter_remain, deforest_biomass_remain,  &
+               convflux,                   &
+               glcc_pft, glcc_pftmtc,          &
+               veget_max, prod10, prod100,             &
+               PFTpresent, senescence, moiavail_month, moiavail_week,  &
+               gpp_week, ngd_minus5, resp_maint, resp_growth,          & 
+               resp_hetero, npp_daily, when_growthinit, npp_longterm,  &
+               ind, lm_lastyearmax, everywhere, age,                   &
+               co2_to_bm, gpp_daily, co2_fire,                         &
+               time_hum_min, gdd_midwinter, gdd_from_growthinit,       &
+               gdd_m5_dormance, ncd_dormance,                          &
+               lignin_struc, carbon, leaf_frac,                        &
+               deepC_a, deepC_s, deepC_p,                              &
+               leaf_age, bm_to_litter, biomass, litter,                &
+               fuel_1hr, fuel_10hr, fuel_100hr, fuel_1000hr)
+  
+    IMPLICIT NONE
+
+    !! 0.1 Input variables
+
+    INTEGER, INTENT(in)                                  :: npts             !! Domain size - number of pixels (unitless)
+    REAL(r_std), INTENT(in)                              :: dt_days          !! Time step of vegetation dynamics for stomate
+    REAL(r_std), DIMENSION (npts,12),INTENT(in)          :: harvest_matrix             !! 
+    REAL(r_std), DIMENSION (npts),INTENT(in)             :: fuelfrac             !! 
+    REAL(r_std), DIMENSION (npts,nvmap), INTENT(in)      :: newvegfrac
+                                                                             !! 
+
+    REAL(r_std), DIMENSION(npts,nvm,nlitt,nelements), INTENT(in)                 :: def_fuel_1hr_remain
+    REAL(r_std), DIMENSION(npts,nvm,nlitt,nelements), INTENT(in)                 :: def_fuel_10hr_remain
+    REAL(r_std), DIMENSION(npts,nvm,nlitt,nelements), INTENT(in)                 :: def_fuel_100hr_remain
+    REAL(r_std), DIMENSION(npts,nvm,nlitt,nelements), INTENT(in)                 :: def_fuel_1000hr_remain
+    REAL(r_std), DIMENSION(npts,nlitt,nvm,nlevs,nelements), INTENT(in) :: deforest_litter_remain   !! Vegetmax-weighted remaining litter on the ground for 
+                                                                                                      !! deforestation region.
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(in)      :: deforest_biomass_remain  !! Vegetmax-weighted remaining biomass on the ground for 
+                                                                                                      !! deforestation region.
+
+
+    !! 0.2 Output variables
+    REAL(r_std), DIMENSION(npts,nwp), INTENT(inout)            :: convflux         !! release during first year following land cover
+                                                                             !! change
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)      :: glcc_pft         !! Loss of fraction in each PFT
+    REAL(r_std), DIMENSION(npts,nvm,nvmap), INTENT(inout):: glcc_pftmtc      !! a temporary variable to hold the fractions each PFT is going to lose
+                                                                             !! i.e., the contribution of each PFT to the youngest age-class of MTC
+
+    !! 0.3 Modified variables
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)      :: veget_max        !! "maximal" coverage fraction of a PFT (LAI ->
+                                                                             !! infinity) on ground (unitless) 
+    REAL(r_std), DIMENSION(npts,0:10,nwp), INTENT(inout)     :: prod10           !! products remaining in the 10 year-turnover
+                                                                             !! pool after the annual release for each 
+                                                                             !! compartment (10 + 1 : input from year of land
+                                                                             !! cover change)
+    REAL(r_std), DIMENSION(npts,0:100,nwp), INTENT(inout)    :: prod100          !! products remaining in the 100 year-turnover
+                                                                             !! pool after the annual release for each 
+                                                                             !! compartment (100 + 1 : input from year of land
+                                                                             !! cover change)
+                                                                             !! pool compartments
+    LOGICAL, DIMENSION(:,:), INTENT(inout)               :: PFTpresent       !! Tab indicating which PFTs are present in 
+                                                                             !! each pixel
+    LOGICAL, DIMENSION(:,:), INTENT(inout)               :: senescence       !! Flag for setting senescence stage (only 
+                                                                             !! for deciduous trees)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: moiavail_month   !! "Monthly" moisture availability (0 to 1, 
+                                                                             !! unitless) 
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: moiavail_week    !! "Weekly" moisture availability 
+                                                                             !! (0 to 1, unitless)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: gpp_week         !! Mean weekly gross primary productivity 
+                                                                             !! @tex $(gC m^{-2} day^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: ngd_minus5       !! Number of growing days (days), threshold 
+                                                                             !! -5 deg C (for phenology)   
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: resp_maint       !! Maintenance respiration  
+                                                                             !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: resp_growth      !! Growth respiration  
+                                                                             !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: resp_hetero      !! Heterotrophic respiration  
+                                                                             !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: npp_daily        !! Net primary productivity 
+                                                                             !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: when_growthinit  !! How many days ago was the beginning of 
+                                                                             !! the growing season (days)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: npp_longterm     !! "Long term" mean yearly primary productivity 
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: ind              !! Number of individuals at the stand level
+                                                                             !! @tex $(m^{-2})$ @endtex 
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: lm_lastyearmax   !! last year's maximum leaf mass for each PFT 
+                                                                             !! @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: everywhere       !! is the PFT everywhere in the grid box or 
+                                                                             !! very localized (after its introduction) (?)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: age              !! mean age (years)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: co2_to_bm        !! CO2 taken from the atmosphere to get C to create  
+                                                                             !! the seedlings @tex (gC.m^{-2}dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: gpp_daily        !! Daily gross primary productivity  
+                                                                             !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: co2_fire         !! Fire carbon emissions
+                                                                             !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: time_hum_min     !! Time elapsed since strongest moisture 
+                                                                             !! availability (days) 
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: gdd_midwinter    !! Growing degree days (K), since midwinter 
+                                                                             !! (for phenology) - this is written to the
+                                                                             !!  history files 
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: gdd_from_growthinit !! growing degree days, since growthinit 
+                                                                             !! for crops
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: gdd_m5_dormance  !! Growing degree days (K), threshold -5 deg 
+                                                                             !! C (for phenology)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: ncd_dormance     !! Number of chilling days (days), since 
+                                                                             !! leaves were lost (for phenology) 
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)         :: lignin_struc     !! ratio Lignine/Carbon in structural litter,
+                                                                             !! above and below ground
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)         :: carbon           !! carbon pool: active, slow, or passive 
+                                                                             !! @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)         :: deepC_a          !! Permafrost soil carbon (g/m**3) active
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)         :: deepC_s          !! Permafrost soil carbon (g/m**3) slow
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)         :: deepC_p          !! Permafrost soil carbon (g/m**3) passive
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)         :: leaf_frac        !! fraction of leaves in leaf age class (unitless;0-1)
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)         :: leaf_age         !! Leaf age (days)
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout)       :: bm_to_litter     !! Transfer of biomass to litter 
+                                                                             !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout)       :: biomass          !! Stand level biomass @tex $(gC.m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(:,:,:,:,:), INTENT(inout)     :: litter           !! metabolic and structural litter, above and 
+                                                                             !! below ground @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout)       :: fuel_1hr
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout)       :: fuel_10hr
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout)       :: fuel_100hr
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout)       :: fuel_1000hr
+
+    !! 0.4 Local variables
+    REAL(r_std), DIMENSION(nvmap,nparts,nelements)             :: bm_to_litter_pro !! conversion of biomass to litter 
+                                                                             !! @tex ($gC m^{-2} day^{-1}$) @endtex
+    REAL(r_std), DIMENSION(nvmap,nparts,nelements)             :: biomass_pro      !! biomass @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(nvmap)                        :: veget_max_pro    !! "maximal" coverage fraction of a PFT (LAI ->
+                                                                             !! infinity) on ground (unitless) 
+    REAL(r_std), DIMENSION(nvmap,ncarb)                        :: carbon_pro       !! carbon pool: active, slow, or passive 
+                                                                             !! @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(nvmap,ndeep)                        :: deepC_a_pro      !! Permafrost carbon pool: active, slow, or passive 
+                                                                             !! @tex ($gC m^{-3}$) @endtex
+    REAL(r_std), DIMENSION(nvmap,ndeep)                        :: deepC_s_pro      !! Permafrost carbon pool: active, slow, or passive 
+                                                                             !! @tex ($gC m^{-3}$) @endtex
+    REAL(r_std), DIMENSION(nvmap,ndeep)                        :: deepC_p_pro      !! Permafrost carbon pool: active, slow, or passive 
+                                                                             !! @tex ($gC m^{-3}$) @endtex
+    REAL(r_std), DIMENSION(nvmap,nlitt,nlevs,nelements)        :: litter_pro       !! metabolic and structural litter, above and 
+                                                                             !! below ground @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(nvmap,nlitt,nelements)              :: fuel_1hr_pro
+    REAL(r_std), DIMENSION(nvmap,nlitt,nelements)              :: fuel_10hr_pro
+    REAL(r_std), DIMENSION(nvmap,nlitt,nelements)              :: fuel_100hr_pro
+    REAL(r_std), DIMENSION(nvmap,nlitt,nelements)              :: fuel_1000hr_pro
+    REAL(r_std), DIMENSION(nvmap,nlevs)                        :: lignin_struc_pro !! ratio Lignine/Carbon in structural litter
+                                                                             !! above and below ground
+    REAL(r_std), DIMENSION(nvmap,nleafages)                    :: leaf_frac_pro    !! fraction of leaves in leaf age class 
+    REAL(r_std), DIMENSION(nvmap,nleafages)                    :: leaf_age_pro     !! fraction of leaves in leaf age class 
+    LOGICAL, DIMENSION(nvmap)                :: PFTpresent_pro, senescence_pro                 !! Is pft there (unitless)
+    REAL(r_std), DIMENSION(nvmap)            :: ind_pro, age_pro, lm_lastyearmax_pro, npp_longterm_pro
+    REAL(r_std), DIMENSION(nvmap)            :: everywhere_pro
+    REAL(r_std), DIMENSION(nvmap)            :: gpp_daily_pro, npp_daily_pro, co2_to_bm_pro
+    REAL(r_std), DIMENSION(nvmap)            :: resp_maint_pro, resp_growth_pro
+    REAL(r_std), DIMENSION(nvmap)            :: resp_hetero_pro, co2_fire_pro
+  
+    INTEGER                :: ipts,ivm,ivma,l,m,ipft_young_agec
+    CHARACTER(LEN=10)      :: part_str                               !! string suffix indicating an index
+
+    REAL(r_std), DIMENSION(npts,nvmap)       :: glcc_mtc             !! Increase in fraction of each MTC in its youngest age-class
+    REAL(r_std), DIMENSION(npts,nvm)         :: glccReal_tmp         !! A temporary variable to hold glccReal
+    REAL(r_std), DIMENSION(npts)             :: Deficit_pf2yf_final     !! 
+    REAL(r_std), DIMENSION(npts)             :: Deficit_sf2yf_final     !! 
+    REAL(r_std), DIMENSION(npts)             :: pf2yf_compen_sf2yf      !! 
+    REAL(r_std), DIMENSION(npts)             :: sf2yf_compen_pf2yf      !!
+    REAL(r_std), DIMENSION(npts,nvm)         :: glcc_harvest            !! Loss of fraction due to forestry harvest
+    REAL(r_std), DIMENSION(npts)             :: harvest_wood            !! Loss of fraction due to forestry harvest
+
+    WRITE(numout,*) 'Entering fharvest_MulAgeC'
+    glcc_harvest(:,:) = zero
+    harvest_wood(:) = zero
+    glccReal_tmp(:,:) = zero
+
+    CALL MulAgeC_fh_firstday(npts,veget_max,newvegfrac,harvest_matrix, &
+                          glcc_pft,glcc_pftmtc, &
+                          Deficit_pf2yf_final, Deficit_sf2yf_final, &
+                          pf2yf_compen_sf2yf, sf2yf_compen_pf2yf)
+
+    glcc_mtc(:,:) = SUM(glcc_pftmtc,DIM=2)
+
+    ! Write out forestry harvest variables
+    DO ipts = 1,npts
+      DO ivm = 1,nvm
+        DO ivma = 1,nvmap
+          IF (is_tree(ivm) .AND. is_tree(start_index(ivma))) THEN
+            glcc_harvest(ipts,ivm) = glcc_harvest(ipts,ivm) + glcc_pftmtc(ipts,ivm,ivma)
+          ENDIF
+        ENDDO
+        harvest_wood(ipts) = harvest_wood(ipts)+ (biomass(ipts,ivm,isapabove,icarbon)+ &
+               biomass(ipts,ivm,iheartabove,icarbon))*glcc_harvest(ipts,ivm)
+      ENDDO
+    ENDDO
+
+    DO ipts=1,npts
+
+      !! Initialize the _pro variables
+      bm_to_litter_pro(:,:,:)=zero                                                
+      biomass_pro(:,:,:)=zero
+      veget_max_pro(:)=zero                                                       
+      carbon_pro(:,:)=zero                                                        
+      deepC_a_pro(:,:)=zero                                                       
+      deepC_s_pro(:,:)=zero                                                       
+      deepC_p_pro(:,:)=zero                                                       
+      litter_pro(:,:,:,:)=zero                                                    
+      fuel_1hr_pro(:,:,:)=zero                                                    
+      fuel_10hr_pro(:,:,:)=zero                                                   
+      fuel_100hr_pro(:,:,:)=zero                                                  
+      fuel_1000hr_pro(:,:,:)=zero                                                 
+      lignin_struc_pro(:,:)=zero                                                  
+
+      leaf_frac_pro = zero
+      leaf_age_pro = zero
+      PFTpresent_pro(:) = .FALSE.
+      senescence_pro(:) = .TRUE.
+      ind_pro = zero
+      age_pro = zero
+      lm_lastyearmax_pro = zero
+      npp_longterm_pro = zero
+      everywhere_pro = zero
+      
+      gpp_daily_pro=zero                                                       
+      npp_daily_pro=zero                                                       
+      co2_to_bm_pro=zero                                                       
+      resp_maint_pro=zero                                                      
+      resp_growth_pro=zero                                                     
+      resp_hetero_pro=zero                                                     
+      co2_fire_pro=zero                                                        
+
+      ! Note that we assume people don't intentionally change baresoil to 
+      ! vegetated land.
+      DO ivma = 2,nvmap
+        ! we assume only the youngest age class receives the incoming PFT
+        ! [chaoyuejoy@gmail.com 2015-08-04] This line is commented to allow
+        ! the case of only single age class being handled.
+
+        ! here we set glcc_mtc(ipts,ivma) > min_stomate as a condition,
+        ! this is necessary because later on in the subroutine of 
+        ! add_incoming_proxy_pft we have to merge the newly established
+        ! youngest proxy with potentially exisiting youngest receiving MTC,
+        ! thus have to devide a new fraction of (frac_proxy + frac_exist),
+        ! but in case frac_exist = zero, we risk deviding by a very small value
+        ! of frac_proxy and thus we want it to be bigger than min_stomate.
+        IF ( glcc_mtc(ipts,ivma) .GT. min_stomate ) THEN
+
+          ! 1. we accumulate the scalar variables that will be inherited
+          !    note we don't handle the case of harvesting forest because
+          !    we assume glcc_pftmtc(forest->forest) would be zero and this
+          !    case won't occur as it's filtered by the condition of
+          !    (frac>min_stomate)
+          CALL collect_legacy_pft_forestry(npts, ipts, ivma, glcc_pftmtc,    &
+                  fuelfrac, &
+                  biomass, bm_to_litter, carbon, litter,            &
+                  deepC_a, deepC_s, deepC_p,                        &
+                  fuel_1hr, fuel_10hr, fuel_100hr, fuel_1000hr,     &
+                  lignin_struc, co2_to_bm, gpp_daily, npp_daily,    &
+                  resp_maint, resp_growth, resp_hetero, co2_fire,   &
+                  def_fuel_1hr_remain, def_fuel_10hr_remain,        &
+                  def_fuel_100hr_remain, def_fuel_1000hr_remain,    &
+                  deforest_litter_remain, deforest_biomass_remain,  &
+                  veget_max_pro(ivma), carbon_pro(ivma,:),          &
+                  lignin_struc_pro(ivma,:), litter_pro(ivma,:,:,:), &
+                  deepC_a_pro(ivma,:), deepC_s_pro(ivma,:), deepC_p_pro(ivma,:), &
+                  fuel_1hr_pro(ivma,:,:), fuel_10hr_pro(ivma,:,:),  &
+                  fuel_100hr_pro(ivma,:,:), fuel_1000hr_pro(ivma,:,:), &
+                  bm_to_litter_pro(ivma,:,:), co2_to_bm_pro(ivma),  &
+                  gpp_daily_pro(ivma), npp_daily_pro(ivma),         &
+                  resp_maint_pro(ivma), resp_growth_pro(ivma),      &
+                  resp_hetero_pro(ivma), co2_fire_pro(ivma),        &
+                  convflux,prod10,prod100)
+
+          !++TEMP++
+          ! Here we substract the outgoing fraction from the source PFT.
+          ! If a too small fraction remains in this source PFT, then it is
+          ! exhausted, we empty it. The subroutine 'empty_pft' might be 
+          ! combined with 'collect_legacy_pft', but now we just put it here.
+          DO ivm = 1,nvm
+            IF( glcc_pftmtc(ipts,ivm,ivma)>zero ) THEN
+              veget_max(ipts,ivm) = veget_max(ipts,ivm)-glcc_pftmtc(ipts,ivm,ivma)
+              IF ( veget_max(ipts,ivm)<min_stomate ) THEN
+                CALL empty_pft(ipts, ivm, veget_max, biomass, ind,       &
+                       carbon, litter, lignin_struc, bm_to_litter,       &
+                       deepC_a, deepC_s, deepC_p,                        &
+                       fuel_1hr, fuel_10hr, fuel_100hr, fuel_1000hr,     &
+                       gpp_daily, npp_daily, gpp_week, npp_longterm,     &
+                       co2_to_bm, resp_maint, resp_growth, resp_hetero,  &
+                       lm_lastyearmax, leaf_frac, leaf_age, age,         &
+                       everywhere, PFTpresent, when_growthinit,          &
+                       senescence, gdd_from_growthinit, gdd_midwinter,   &
+                       time_hum_min, gdd_m5_dormance, ncd_dormance,      &
+                       moiavail_month, moiavail_week, ngd_minus5)
+              ENDIF
+            ENDIF
+          ENDDO
+
+        ENDIF !IF ( glcc_mtc(ipts,ivma) .GT. min_stomate )
+      ENDDO !(DO ivma = 2,nvmap)
+
+      ! We can only establish new youngest proxy and add it to the 
+      ! existing youngest-age PFT after all the harvest is done, to 
+      ! avoid the dilution of harvestable biomass by the young proxy
+      ! and ensure consistency. Therefore now we have to loop again
+      ! over nvmap.
+      DO ivma = 2,nvmap
+        IF ( glcc_mtc(ipts,ivma) .GT. min_stomate ) THEN
+
+          ipft_young_agec = start_index(ivma)
+
+          ! 2. we establish a proxy PFT with the fraction of veget_max_pro,
+          !    which is going to be either merged with existing target 
+          !    `ipft_young_agec` PFT, or fill the place if no existing target PFT
+          !    exits.
+          CALL initialize_proxy_pft(ipts,ipft_young_agec,veget_max_pro(ivma), &
+                 biomass_pro(ivma,:,:), co2_to_bm_pro(ivma), ind_pro(ivma),   &
+                 age_pro(ivma),                                               & 
+                 senescence_pro(ivma), PFTpresent_pro(ivma),                  &
+                 lm_lastyearmax_pro(ivma), everywhere_pro(ivma),              &
+                 npp_longterm_pro(ivma),                                      &
+                 leaf_frac_pro(ivma,:),leaf_age_pro(ivma,:))
+
+          CALL sap_take (ipts,ivma,veget_max,biomass_pro(ivma,:,:), &
+                         biomass,co2_to_bm_pro(ivma))
+
+          ! 3. we merge the newly initiazlized proxy PFT into existing one
+          !    or use it to fill an empty PFT slot.
+          CALL add_incoming_proxy_pft(npts, ipts, ipft_young_agec, veget_max_pro(ivma),&
+                 carbon_pro(ivma,:), litter_pro(ivma,:,:,:), lignin_struc_pro(ivma,:), &
+                 bm_to_litter_pro(ivma,:,:),    &
+                 deepC_a_pro(ivma,:), deepC_s_pro(ivma,:), deepC_p_pro(ivma,:), &
+                 fuel_1hr_pro(ivma,:,:), fuel_10hr_pro(ivma,:,:),               &
+                 fuel_100hr_pro(ivma,:,:), fuel_1000hr_pro(ivma,:,:),           &
+                 biomass_pro(ivma,:,:), co2_to_bm_pro(ivma),                    &
+                 npp_longterm_pro(ivma), ind_pro(ivma),                         &
+                 lm_lastyearmax_pro(ivma), age_pro(ivma), everywhere_pro(ivma), &  
+                 leaf_frac_pro(ivma,:), leaf_age_pro(ivma,:),                   &
+                 PFTpresent_pro(ivma), senescence_pro(ivma),                &
+                 gpp_daily_pro(ivma), npp_daily_pro(ivma),                      &
+                 resp_maint_pro(ivma), resp_growth_pro(ivma),                   &
+                 resp_hetero_pro(ivma), co2_fire_pro(ivma),                     &
+                 veget_max, carbon, litter, lignin_struc, bm_to_litter,         &
+                 deepC_a, deepC_s, deepC_p,                                     &
+                 fuel_1hr, fuel_10hr, fuel_100hr, fuel_1000hr,                  &
+                 biomass, co2_to_bm, npp_longterm, ind,                         &
+                 lm_lastyearmax, age, everywhere,                               &
+                 leaf_frac, leaf_age, PFTpresent, senescence,                   &
+                 gpp_daily, npp_daily, resp_maint, resp_growth,                 &
+                 resp_hetero, co2_fire)
+          
+        ENDIF !IF ( glcc_mtc(ipts,ivma) .GT. min_stomate )
+      ENDDO !(DO ivma=1,nvmap)
+
+    ENDDO !(DO ipts=1,npts)
+
+
+    CALL histwrite_p (hist_id_stomate, 'glcc_harvest', itime, &
+         glcc_harvest, npts*nvm, horipft_index)
+    CALL xios_orchidee_send_field ('glcc_harvest', glcc_harvest) ! kjpindex,nvm
+
+    CALL histwrite_p (hist_id_stomate, 'harvest_wood', itime, &
+         harvest_wood, npts, hori_index)
+    CALL xios_orchidee_send_field ('harvest_wood', harvest_wood) ! kjpindex
+
+    glccReal_tmp(:,:) = zero
+    glccReal_tmp(:,1) = Deficit_pf2yf_final
+    glccReal_tmp(:,2) = Deficit_sf2yf_final
+    glccReal_tmp(:,3) = pf2yf_compen_sf2yf
+    glccReal_tmp(:,4) = sf2yf_compen_pf2yf ! this is zero as currently the deficit
+                                           ! in primary forest harvest is not 
+                                           ! compensated for by the surplus in 
+                                           ! secondary forest harvest.
+
+    CALL histwrite_p (hist_id_stomate, 'DefiComForHarvest', itime, &
+         glccReal_tmp, npts*nvm, horipft_index)
+    CALL xios_orchidee_send_field ('DefiComForHarvest', glccReal_tmp) ! kjpindex,nvm
+
+  END SUBROUTINE fharvest_MulAgeC
+
+! ================================================================================================================================
+!! SUBROUTINE   : gross_lcc_firstday
+!!
+!>\BRIEF        : When necessary, adjust input glcc matrix, and allocate it
+!!                into different contributing age classes and receiving 
+!!                youngest age classes.
+!! \n
+!_ ================================================================================================================================
+
+  ! Note: it has this name because this subroutine will also be called
+  ! the first day of each year to precalculate the forest loss for the
+  ! deforestation fire module.
+  SUBROUTINE MulAgeC_fh_firstday(npts,veget_max_org,newvegfrac,harvest_matrix, &
+                          glcc_pft,glcc_pftmtc, &
+                          Deficit_pf2yf_final, Deficit_sf2yf_final, &
+                          pf2yf_compen_sf2yf, sf2yf_compen_pf2yf)
+
+    IMPLICIT NONE
+
+    !! 0.1 Input variables
+
+    INTEGER, INTENT(in)                                     :: npts           !! Domain size - number of pixels (unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)            :: veget_max_org  !! "maximal" coverage fraction of a PFT on the ground
+                                                                              !! May sum to
+                                                                              !! less than unity if the pixel has
+                                                                              !! nobio area. (unitless, 0-1)
+    REAL(r_std), DIMENSION(npts,nvmap), INTENT(in)          :: newvegfrac     !! used to guid the allocation of new PFTs.
+    REAL(r_std), DIMENSION(npts,12),INTENT(in)              :: harvest_matrix !! 
+                                                                              !! 
+    !! 0.2 Output variables
+    REAL(r_std), DIMENSION(npts,nvm,nvmap), INTENT(inout)   :: glcc_pftmtc    !! the fractions each PFT is going to lose
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)         :: glcc_pft       !! Loss of fraction in each PFT
+
+    REAL(r_std), DIMENSION(npts), INTENT(inout)    :: Deficit_pf2yf_final     !! 
+    REAL(r_std), DIMENSION(npts), INTENT(inout)    :: Deficit_sf2yf_final     !! 
+    REAL(r_std), DIMENSION(npts), INTENT(inout)    :: pf2yf_compen_sf2yf      !! 
+    REAL(r_std), DIMENSION(npts), INTENT(inout)    :: sf2yf_compen_pf2yf      !!
+
+    !! 0.3 Modified variables
+    
+    !! 0.4 Local variables
+    REAL(r_std), DIMENSION(npts,nvmap)              :: veget_mtc           !! "maximal" coverage fraction of a PFT on the ground
+    REAL(r_std), DIMENSION(npts,nvmap)              :: veget_mtc_begin     !! "maximal" coverage fraction of a PFT on the ground
+    REAL(r_std), DIMENSION(npts,nagec_tree)         :: vegagec_tree        !! fraction of tree age-class groups, in sequence of old->young
+    REAL(r_std), DIMENSION(npts,nagec_herb)         :: vegagec_grass       !! fraction of grass age-class groups, in sequence of old->young 
+    REAL(r_std), DIMENSION(npts,nagec_herb)         :: vegagec_pasture     !! fraction of pasture age-class groups, in sequence of old->young
+    REAL(r_std), DIMENSION(npts,nagec_herb)         :: vegagec_crop        !! fraction of crop age-class groups, in sequence of old->young
+
+    
+    REAL(r_std), DIMENSION(npts,4)                  :: veget_4veg      !! "maximal" coverage fraction of a PFT on the ground
+    REAL(r_std), DIMENSION(npts)                    :: veget_tree      !! "maximal" coverage fraction of a PFT on the ground
+    REAL(r_std), DIMENSION(npts)                    :: veget_grass     !! "maximal" coverage fraction of a PFT on the ground
+    REAL(r_std), DIMENSION(npts)                    :: veget_pasture   !! "maximal" coverage fraction of a PFT on the ground
+    REAL(r_std), DIMENSION(npts)                    :: veget_crop      !! "maximal" coverage fraction of a PFT on the ground
+
+    REAL(r_std), DIMENSION(npts,nvm)         :: veget_max              !! "maximal" coverage fraction of a PFT on the ground
+    REAL(r_std), DIMENSION(npts,nvm)         :: veget_max_tmp          !! "maximal" coverage fraction of a PFT on the ground
+    REAL(r_std), DIMENSION(npts,nvm)         :: veget_max_old          !! "maximal" coverage fraction of a PFT on the ground
+    REAL(r_std), DIMENSION(npts,nvm)         :: glcc_pft_tmp           !! Loss of fraction in each PFT
+
+    REAL(r_std), DIMENSION(npts,nvm,nvmap)  :: glcc_pftmtc_harvest    !! a temporary variable to hold the fractions each PFT is going to lose
+    REAL(r_std), DIMENSION(npts,12)         :: glccRealHarvest    !! real matrix applied for forestry harvest.
+
+    REAL(r_std), DIMENSION(npts,nvm)         :: glccReal_tmp         !! A temporary variable to hold glccReal
+
+    LOGICAL, SAVE  :: MulAgeC_fh_firstday_done = .FALSE.
+
+    INTEGER :: ivma, pf2yf, sf2yf, ivm
+
+    REAL(r_std), DIMENSION(npts,12)         :: FHmatrix_remainA        !! 
+    REAL(r_std), DIMENSION(npts,12)         :: FHmatrix_remainB        !! 
+    REAL(r_std), DIMENSION(npts,12)         :: glccRemain              !! 
+
+    INTEGER :: ipts,IndStart_f,IndEnd_f
+    CHARACTER(LEN=10)      :: part_str                               !! string suffix indicating an index
+
+    !Some more local configurations
+    LOGICAL                                 :: allow_youngest_forest_WoodHarvest = .FALSE.
+    
+ 
+    ! we make copies of original input veget_max (which is veget_max_org
+    ! in the subroutine parameter list).
+    ! veget_max will be modified through different operations in order to 
+    ! check for various purposes, e.g., whether input harvest matrix 
+    ! is compatible with existing veget_max and how to allocate it etc.
+    ! veget_max_old will not be modified
+    veget_max(:,:) = veget_max_org(:,:)
+    veget_max_old(:,:) = veget_max_org(:,:)
+
+    !********************** block to handle forestry harvest ****************
+    !! 1. Handle the forestry harvest process
+
+    !! 1.0 Some preparation 
+
+    pf2yf=1   !primary to young forest conversion because of harvest
+    sf2yf=2   !old secondary to young forest conversion because of harvest
+    
+    Deficit_pf2yf_final(:) = zero 
+    Deficit_sf2yf_final(:) = zero
+
+    ! Note in the naming of pf2yf_compen_sf2yf and sf2yf_compen_pf2yf, active
+    ! tense is used. I.e., pf2yf_compen_sf2yf means the fraction which pf2yf
+    ! compenstates for sf2yf
+    pf2yf_compen_sf2yf(:) = zero  !primary->young conversion that compensates 
+                               !the secondary->young conversion because of deficit
+                               !in the latter
+    sf2yf_compen_pf2yf(:) = zero  !seondary->young conversion that compensates
+                               !the primary->young conversion because of the deficit
+                               !in the latter
+
+    ! we now have to fill the transtion of forest->forest in the process of harvest
+    ! into our target matrix glcc_pftmtc. Thus we will initiliaze them first.
+    glcc_pft(:,:) = 0.
+    glcc_pft_tmp(:,:) = 0.
+    glcc_pftmtc(:,:,:) = 0.
+    glccRemain(:,:) = harvest_matrix(:,:)
+
+    !! 2.1 Handle secondary forest harvest
+
+    CALL calc_cover(npts,veget_max,veget_mtc,vegagec_tree,vegagec_grass, &
+           vegagec_pasture,vegagec_crop)
+    
+    ! In following call of calc_cover, veget_mtc will be updated each time,
+    ! but we don't want this, so we put its initial value into veget_mtc_begin
+    ! in order to retrieve this initial value later. veget_mtc is used in the 
+    ! subroutine type_conversion to guild the allocation of newly created
+    ! lands of a certain vegetation type (e.g., pasture) into its compoenent
+    ! meta-classes (e.g. C3 and C4 pasture).
+    veget_mtc_begin = veget_mtc
+
+    ! Allocate harvest-caused out-going primary and secondary forest fraction
+    ! into different primary and secondary (all other younger age classes) forest PFTs. 
+
+    ! [Note] 
+    ! Below we used the tempelate of type_conversion but in fact we need
+    ! only glcc_pft, which means the fraction loss in each PFT. We then need to
+    ! use glcc_pft to fill glcc_pftmtc (our final target matrix), assuming that
+    ! the loss of forest PFT will go to the youngest age class of its forest MTC.
+    ! Therefore we assume no changes of forset species (meta-class) in forestry 
+    ! harvest and following tree-replanting.
+    ! Although glcc_pftmtc and glcc_pft_tmp will be automatically filled when 
+    ! we use the tempelate `type_conversion` by calling it as below, but it makes
+    ! no sense because they will be reset later.
+
+    !! 1.1 Secondary forest harvest.
+
+    ! We first handle within the secondary forest age classes, in the sequence 
+    ! of old->young
+
+    IndStart_f = 2             ! note the indecies for tree age class are in the
+                               ! sequence of from old to young, thus index=2 means the
+                               ! 2nd oldest age class.
+    IndEnd_f = nagec_tree-1    ! nagec_tree-2: The 3rd youngest age class
+                               ! nagec_tree-1: The 2nd youngest age class
+                               ! nagec_tree: The youngest age class
+
+    IF (IndStart_f .LE. 0 .OR. IndEnd_f .LE. 0) THEN
+      write(numout,*) 'Forest harvest: Age class index cannot be negative or zero!'
+      STOP
+    ENDIF
+
+    DO ipts=1,npts
+      !sf2yf
+      CALL type_conversion(ipts,sf2yf,harvest_matrix,veget_mtc,newvegfrac, &
+                       indold_tree,indagec_tree,indagec_pasture,num_pasture_mulagec,&
+                       IndEnd_f,nagec_herb,                    &
+                       vegagec_tree,veget_max,glcc_pft,glcc_pftmtc,glcc_pft_tmp,&
+                       glccRemain, &
+                       .TRUE., iagec_start=IndStart_f)
+    ENDDO
+    FHmatrix_remainA(:,:) = glccRemain
+
+    !! 1.2 Use primary forest harvest to compensate the deficit in secondary 
+    !!       forest harvest. Note such compensation happens automatically here.
+
+    CALL calc_cover(npts,veget_max,veget_mtc,vegagec_tree,vegagec_grass, &
+           vegagec_pasture,vegagec_crop)
+
+    ! retrieve the initial veget_mtc value, as explained above.
+    veget_mtc = veget_mtc_begin
+
+    ! we check whether the required harvest of secondary forest
+    ! is met by the existing secondary forest fractions. Otherwise
+    ! we use the oldest-age-class forest to compenstate it. 
+    DO ipts=1,npts
+      IF (FHmatrix_remainA(ipts,sf2yf) .GT. zero) THEN
+        ! in this case, the existing secondary forest fraction
+        ! is not enough for secondary forest harvest, we have to
+        ! use primary (oldest age class) foret to compensate it.
+
+        IndStart_f = 1             ! Oldest age class
+        IndEnd_f = 1               ! Oldest age class
+
+        !sf2yf
+        CALL type_conversion(ipts,sf2yf,FHmatrix_remainA,veget_mtc,newvegfrac, &
+                         indold_tree,indagec_tree,indagec_pasture,num_pasture_mulagec,&
+                         IndEnd_f,nagec_herb,                    &
+                         vegagec_tree,veget_max,glcc_pft,glcc_pftmtc,glcc_pft_tmp,&
+                         glccRemain, &
+                         .TRUE., iagec_start=IndStart_f)
+        pf2yf_compen_sf2yf(ipts) = FHmatrix_remainA(ipts,sf2yf) - glccRemain(ipts,sf2yf)
+        
+        !!++Temp++
+        ! Normally we don't allow youngest foret cohort to be harvested,
+        ! but when external input driving data are not consistent, we harvest
+        ! even the youngest forest cohort to make sure it's consistent with
+        ! the input data and comparable with the case of SinAgeC. However, except
+        ! for the thse two reasons, we should not harvest the youngest age class
+        ! as the wood there is not feasible for usage in most cases.
+        IF (allow_youngest_forest_WoodHarvest) THEN
+          FHmatrix_remainA(ipts,sf2yf) = glccRemain(ipts,sf2yf)
+          IF (FHmatrix_remainA(ipts,sf2yf) .GT. zero) THEN
+    
+            IndStart_f = nagec_tree    ! youngest age class
+            IndEnd_f = nagec_tree      ! youngest age class
+
+            IF (IndStart_f .LE. 0 .OR. IndEnd_f .LE. 0) THEN
+              write(numout,*) 'Age class index cannot be negative or zero!'
+              STOP
+            ENDIF
+
+            !sf2yf
+            CALL type_conversion(ipts,sf2yf,FHmatrix_remainA,veget_mtc,newvegfrac, &
+                             indold_tree,indagec_tree,indagec_pasture,num_pasture_mulagec,&
+                             IndEnd_f,nagec_herb,                    &
+                             vegagec_tree,veget_max,glcc_pft,glcc_pftmtc,glcc_pft_tmp,&
+                             glccRemain, &
+                             .TRUE., iagec_start=IndStart_f)
+          ENDIF
+        ENDIF !(IF allow_youngest_forest_WoodHarvest)
+
+      ENDIF
+    ENDDO
+    FHmatrix_remainB(:,:) = glccRemain
+
+    !! 1.3 Handle primary forest harvest
+    
+    CALL calc_cover(npts,veget_max,veget_mtc,vegagec_tree,vegagec_grass, &
+           vegagec_pasture,vegagec_crop)
+    veget_mtc = veget_mtc_begin
+
+    ! We check first whether there is still deficit in the required secondary
+    ! harvest even after being compensated for by the primary forests. 
+    ! If yes, that means all existing harvestable forests
+    ! are depleted, thus required primary harvest will be suppressed.
+    ! Otherwise we will handle primary forest harvest starting from the
+    ! oldest-age-class forest
+
+    DO ipts=1,npts
+      IF (FHmatrix_remainB(ipts,sf2yf) .GT. min_stomate) THEN
+        ! in this case, all forest fraction is depleted in handling
+        ! required secondary forest harvest. We thus suppress the 
+        ! the required primary forest harvest.
+        Deficit_sf2yf_final(ipts) = -1 * FHmatrix_remainB(ipts,sf2yf)
+        Deficit_pf2yf_final(ipts) = -1 * FHmatrix_remainB(ipts,pf2yf)
+        
+
+      ELSE
+        ! there are still forest can be used for required primary forest harvest.
+        ! we assume primary harvest occurs in the oldest age class. Here,
+        ! we will start from the oldest forest and then move to the younger ones,
+        ! until the second youngest when the youngest forest cohort is not allowed
+        ! for harvesting, and to youngest one when it is allowed.
+
+        IndStart_f = 1             ! Oldest age class
+        
+        !!++Temp++
+        IF (allow_youngest_forest_WoodHarvest) THEN
+          IndEnd_f = nagec_tree      ! youngest age class
+        ELSE
+          IndEnd_f = nagec_tree-1    ! 2nd youngest age class
+        ENDIF
+
+        IF (IndStart_f .LE. 0 .OR. IndEnd_f .LE. 0) THEN
+          write(numout,*) 'Age class index cannot be negative or zero!'
+          STOP
+        ENDIF
+
+        !pf2yf
+        CALL type_conversion(ipts,pf2yf,FHmatrix_remainB,veget_mtc,newvegfrac, &
+                         indold_tree,indagec_tree,indagec_pasture,num_pasture_mulagec,&
+                         IndEnd_f,nagec_herb,                    &
+                         vegagec_tree,veget_max,glcc_pft,glcc_pftmtc,glcc_pft_tmp,&
+                         glccRemain, &
+                         .TRUE., iagec_start=IndStart_f)
+      ENDIF
+      
+      IF (glccRemain(ipts,pf2yf) .GT. min_stomate) THEN
+        Deficit_pf2yf_final(ipts) = -1 * glccRemain(ipts,pf2yf)
+      ENDIF
+    ENDDO
+    glccRealHarvest = harvest_matrix - glccRemain
+
+    ! Because we use the template of `type_conversion, now the glcc_pft_tmp
+    ! and glcc_pftmtc have wrong information (because harvest loss is assigned
+    ! on the newly created youngest-age-class pasture/crop MTCs). So they have 
+    ! to be re-initialized to zero. Only the information in glcc_pft is what
+    ! we need, as explained above.
+    glcc_pft_tmp(:,:) = 0.
+    glcc_pftmtc(:,:,:) = 0.
+    ! Here we need to put glcc_pft into glcc_pftmtc for forestry harvest.
+    ! The same MTC will be maintained when forest is harvested.
+    DO ivm =1,nvm
+      IF (is_tree(ivm)) THEN
+        glcc_pftmtc(:,ivm,pft_to_mtc(ivm)) = glcc_pft(:,ivm)
+      ENDIF 
+    ENDDO
+    glcc_pftmtc_harvest = glcc_pftmtc
+    !****************** end block to handle forestry harvest ****************
+
+    IF (.NOT. MulAgeC_fh_firstday_done) THEN
+
+      glccReal_tmp = zero
+      glccReal_tmp(:,1:12) = glccRealHarvest
+      CALL histwrite_p (hist_id_stomate, 'glccRealHarvest', itime, &
+           glccReal_tmp, npts*nvm, horipft_index)
+      CALL xios_orchidee_send_field ('glccRealHarvest', glccReal_tmp) ! kjpindex,nvm
+
+      DO ivma = 1, nvmap
+        WRITE(part_str,'(I2)') ivma
+        IF (ivma < 10) part_str(1:1) = '0'
+        CALL histwrite_p (hist_id_stomate, 'glcc_pftmtc_H_'//part_str(1:LEN_TRIM(part_str)), &
+             itime, glcc_pftmtc_harvest(:,:,ivma), npts*nvm, horipft_index)
+      ENDDO
+      CALL xios_orchidee_send_field ('glcc_pftmtc_H', glcc_pftmtc_harvest) ! kjpindex,nvm,nvmap
+     
+      MulAgeC_fh_firstday_done = .TRUE.
+    ENDIF
+
+  END SUBROUTINE MulAgeC_fh_firstday
+
+
+  SUBROUTINE Get_harvest_matrix(npts,veget_max,newvegfrac,harvest_matrix, &
+                          biomass, harvest_biomass, area_land_m2, &
+                          glcc_pft,glcc_pftmtc, &
+                          Deficit_pf2yf_final, Deficit_sf2yf_final,   &
+                          pf2yf_compen_sf2yf, sf2yf_compen_pf2yf)
+
+    IMPLICIT NONE
+
+    !! 0.1 Input variables
+
+    INTEGER, INTENT(in)                                     :: npts            !! Domain size - number of pixels (unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)            :: veget_max       !! 
+    REAL(r_std), DIMENSION(npts), INTENT(in)                :: area_land_m2
+
+    REAL(r_std), DIMENSION(npts,nvmap), INTENT(in)          :: newvegfrac
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(in)  :: biomass   !! Stand level biomass @tex $(gC.m^{-2})$ @endtex
+
+    REAL(r_std), DIMENSION(npts,12),INTENT(in)              :: harvest_biomass  !! the 1st dimension is for industrial wood, 2nd dimension for fuelwood.
+
+    !! 0.2 Output variables
+    REAL(r_std), DIMENSION(npts,12),INTENT(inout)           :: harvest_matrix !! 
+
+
+    !! 0.3 Modified variables
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)         :: glcc_pft       !! Loss of fraction in each PFT
+    REAL(r_std), DIMENSION(npts,nvm,nvmap), INTENT(inout)   :: glcc_pftmtc    !! a temporary variable to hold the fractions each PFT is going to lose
+
+    !! 0.4 Local variables
+    REAL(r_std), DIMENSION(npts)             :: mean_abwood_dens        !! Stand level biomass @tex $(gC.m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts)             :: total_abwood            !! Stand level biomass @tex $(gC.m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts)             :: total_abwood_harvest    !! Stand level biomass @tex $(gC.m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts)             :: treefrac                !! "maximal" coverage fraction of a PFT on the ground
+
+    INTEGER                :: ipts,ivm,ivma,num,ierr
+
+    ! Note: these parameters are useless here but to conform with the form they
+    ! are needed to call the subroutine MulAgeC_fh_firstday.
+    REAL(r_std), DIMENSION(npts,nvmap)       :: glcc_mtc                !! Increase in fraction of each MTC in its youngest age-class
+    REAL(r_std), DIMENSION(npts,nvm)         :: glccReal_tmp            !! A temporary variable to hold glccReal
+    REAL(r_std), DIMENSION(npts)             :: Deficit_pf2yf_final     !! 
+    REAL(r_std), DIMENSION(npts)             :: Deficit_sf2yf_final     !! 
+    REAL(r_std), DIMENSION(npts)             :: pf2yf_compen_sf2yf      !! 
+    REAL(r_std), DIMENSION(npts)             :: sf2yf_compen_pf2yf      !!
+    REAL(r_std)                              :: ratio,input_total,model_total
+    REAL(r_std)                              :: input_total_allproc,model_total_allproc
+
+
+    input_total = SUM(harvest_biomass(:,1:2))
+
+    treefrac(:) = zero
+    total_abwood(:) = zero
+    DO ivm = 1,nvm
+      IF (is_tree(ivm) ) THEN
+        total_abwood(:) = total_abwood(:) + veget_max(:,ivm) * &
+          (biomass(:,ivm,isapabove,icarbon)+biomass(:,ivm,iheartabove,icarbon))
+        treefrac(:) = treefrac(:) + veget_max(:,ivm)
+      ENDIF
+    ENDDO
+
+    mean_abwood_dens(:) = zero
+    WHERE( treefrac(:) .GT. min_stomate )
+      mean_abwood_dens(:) = total_abwood(:)/treefrac(:)
+    ENDWHERE
+
+    ! harvest_matrix(:,:) = zero
+    ! WHERE( mean_abwood_dens(:) .GT. min_stomate .AND. area_land_m2(:) .GT. min_stomate )
+    !   harvest_matrix(:,1) = SUM(harvest_biomass(:,1:2),DIM=2)/(mean_abwood_dens(:)*area_land_m2(:))
+    ! ENDWHERE
+
+    CALL MulAgeC_fh_firstday(npts,veget_max,newvegfrac,harvest_matrix,   &
+                          glcc_pft,glcc_pftmtc,  &
+                          Deficit_pf2yf_final, Deficit_sf2yf_final,   &
+                          pf2yf_compen_sf2yf, sf2yf_compen_pf2yf)
+
+
+    ! calculate model_total
+    total_abwood_harvest(:) = zero
+    DO ivm = 1,nvm
+      IF (is_tree(ivm) ) THEN
+        total_abwood_harvest(:) = total_abwood_harvest(:) + glcc_pft(:,ivm) *area_land_m2(:) * &
+          (biomass(:,ivm,isapabove,icarbon)+biomass(:,ivm,iheartabove,icarbon))
+      ENDIF
+    ENDDO
+
+    model_total = zero
+    DO ipts = 1,npts
+       model_total = model_total + total_abwood_harvest(ipts)
+    ENDDO
+    WRITE(numout,*) 'model_total: ',model_total
+
+    CALL allreduce_sum(input_total, input_total_allproc)
+    WRITE(numout,*) 'Regional total input wood harvest,', input_total_allproc
+    IF ( input_total_allproc .GT. min_stomate) THEN
+      CALL allreduce_sum(model_total, model_total_allproc)
+      ratio = model_total_allproc/input_total_allproc
+      WRITE(numout,*) 'Initial ratio is: ',ratio
+      WRITE(numout,*) 'Initial regional total output wood harvest,', model_total_allproc
+    ENDIF
+
+
+    ! We adjust the harvest_matrix if the output total harvet wood
+    ! geos beyond 10% difference with the input harvest biomass.
+    num=1
+    DO WHILE ( (ABS(ratio-1) .GT. 0.01) .AND. (ratio.GT.min_stomate) .AND. num .LT. 20)
+
+      ! Note here we treat all harvest as primary harvest
+      harvest_matrix(:,1) = harvest_matrix(:,1)/ratio
+      CALL MulAgeC_fh_firstday(npts,veget_max,newvegfrac,harvest_matrix,   &
+                            glcc_pft,glcc_pftmtc, &
+                            Deficit_pf2yf_final, Deficit_sf2yf_final,   &
+                            pf2yf_compen_sf2yf, sf2yf_compen_pf2yf)
+
+      ! calculate model_total
+      total_abwood_harvest(:) = zero
+      DO ivm = 1,nvm
+        IF (is_tree(ivm) ) THEN
+          total_abwood_harvest(:) = total_abwood_harvest(:) + glcc_pft(:,ivm) *area_land_m2(:) * &
+            (biomass(:,ivm,isapabove,icarbon)+biomass(:,ivm,iheartabove,icarbon))
+        ENDIF
+      ENDDO
+
+      model_total = zero
+      DO ipts = 1,npts
+          model_total = model_total + total_abwood_harvest(ipts)
+      ENDDO
+
+      !! recalculating the ratio.
+      CALL allreduce_sum(input_total, input_total_allproc)
+      IF ( input_total_allproc .GT. min_stomate) THEN
+         CALL allreduce_sum(model_total, model_total_allproc)
+         ratio = model_total_allproc/input_total_allproc
+         WRITE(numout,*) 'Get_harvest_matrix:: ratio = ',ratio,'model_total_allproc,',model_total_allproc
+      ENDIF
+
+      num=num+1
+      WRITE(numout,*) 'Get_harvest_matrix:: Wood harvest matrix iteration: ',num
+
+    ENDDO
+
+  END SUBROUTINE Get_harvest_matrix
+END MODULE stomate_fharvest_MulAgeC
Index: /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_stomate/stomate_fharvest_SinAgeC.f90
===================================================================
--- /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_stomate/stomate_fharvest_SinAgeC.f90	(revision 6940)
+++ /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_stomate/stomate_fharvest_SinAgeC.f90	(revision 6940)
@@ -0,0 +1,1086 @@
+! =================================================================================================================================
+! MODULE       : stomate_lcchange_fh
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF       This module is a copy of stomate_lcchange. It includes the forestry 
+!              harvest.
+!!
+!!\n DESCRIPTION: None
+!!
+!! RECENT CHANGE(S): Including permafrost carbon
+!!
+!! REFERENCE(S)	: None
+!!
+!! SVN          :
+!! $HeadURL: svn://forge.ipsl.jussieu.fr/orchidee/perso/albert.jornet/ORCHIDEE-MICT/src_stomate/stomate_lcchange.f90 $
+!! $Date: 2015-07-30 15:38:45 +0200 (Thu, 30 Jul 2015) $
+!! $Revision: 2847 $
+!! \n
+!_ ================================================================================================================================
+
+
+MODULE stomate_fharvest_SinAgeC
+
+  ! modules used:
+  
+  USE ioipsl_para
+  USE stomate_data
+  USE pft_parameters
+  USE constantes
+  USE constantes_soil_var
+  USE stomate_gluc_common
+  USE stomate_glcchange_SinAgeC
+  USE xios_orchidee
+  
+  IMPLICIT NONE
+  
+  PRIVATE
+  PUBLIC fharvest_SinAgeC
+  
+CONTAINS
+
+! ================================================================================================================================
+! Note: [2016-04-20]
+! This is a simple duplication of gross_glcchange_SinAgeC_fh, to be called in
+! StomateLpj to allow forstry harvest being handled before the land cover change.
+! Some duplicate histwrite_p are commented.
+!_ ================================================================================================================================
+  SUBROUTINE fharvest_SinAgeC (npts, dt_days, harvest_matrix,newvegfrac,   &
+               fuelfrac, &
+               glccSecondShift,glccPrimaryShift,glccNetLCC,&
+               def_fuel_1hr_remain, def_fuel_10hr_remain,        &
+               def_fuel_100hr_remain, def_fuel_1000hr_remain,    &
+               deforest_litter_remain, deforest_biomass_remain,  &
+               convflux, cflux_prod10, cflux_prod100,                  &
+               glccReal, IncreDeficit, glcc_pft, glcc_pftmtc,          &
+               veget_max, prod10, prod100, flux10, flux100,            &
+               PFTpresent, senescence, moiavail_month, moiavail_week,  &
+               gpp_week, ngd_minus5, resp_maint, resp_growth,          & 
+               resp_hetero, npp_daily, when_growthinit, npp_longterm,  &
+               ind, lm_lastyearmax, everywhere, age,                   &
+               co2_to_bm, gpp_daily, co2_fire,                         &
+               time_hum_min, gdd_midwinter, gdd_from_growthinit,       &
+               gdd_m5_dormance, ncd_dormance,                          &
+               lignin_struc, carbon, leaf_frac,                        &
+               deepC_a, deepC_s, deepC_p,                              &
+               leaf_age, bm_to_litter, biomass, litter,                &
+               fuel_1hr, fuel_10hr, fuel_100hr, fuel_1000hr)
+  
+    IMPLICIT NONE
+
+    !! 0.1 Input variables
+
+    INTEGER, INTENT(in)                                  :: npts             !! Domain size - number of pixels (unitless)
+    REAL(r_std), INTENT(in)                              :: dt_days          !! Time step of vegetation dynamics for stomate
+    REAL(r_std), DIMENSION (npts,12),INTENT(in)        :: glccSecondShift     !! the land-cover-change (LCC) matrix in case a gross LCC is 
+                                                                              !! used.
+    REAL(r_std), DIMENSION (npts,nvmap),INTENT(in)     :: newvegfrac
+    REAL(r_std), DIMENSION (npts,12),INTENT(in)        :: glccPrimaryShift    !! the land-cover-change (LCC) matrix in case a gross LCC is 
+                                                                              !! used.
+    REAL(r_std), DIMENSION (npts,12),INTENT(in)        :: glccNetLCC          !! the land-cover-change (LCC) matrix in case a gross LCC is 
+                                                                              !! used.
+    REAL(r_std), DIMENSION (npts,12),INTENT(in)          :: harvest_matrix             !! 
+    REAL(r_std), DIMENSION (npts),INTENT(in)          :: fuelfrac             !! 
+                                                                             !! 
+
+    REAL(r_std), DIMENSION(npts,nvm,nlitt,nelements), INTENT(in)                 :: def_fuel_1hr_remain
+    REAL(r_std), DIMENSION(npts,nvm,nlitt,nelements), INTENT(in)                 :: def_fuel_10hr_remain
+    REAL(r_std), DIMENSION(npts,nvm,nlitt,nelements), INTENT(in)                 :: def_fuel_100hr_remain
+    REAL(r_std), DIMENSION(npts,nvm,nlitt,nelements), INTENT(in)                 :: def_fuel_1000hr_remain
+    REAL(r_std), DIMENSION(npts,nlitt,nvm,nlevs,nelements), INTENT(in) :: deforest_litter_remain   !! Vegetmax-weighted remaining litter on the ground for 
+                                                                                                      !! deforestation region.
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(in)      :: deforest_biomass_remain  !! Vegetmax-weighted remaining biomass on the ground for 
+                                                                                                      !! deforestation region.
+
+
+    !! 0.2 Output variables
+    REAL(r_std), DIMENSION(npts,nwp), INTENT(inout)            :: convflux         !! release during first year following land cover
+                                                                             !! change
+    REAL(r_std), DIMENSION(npts,nwp), INTENT(inout)            :: cflux_prod10     !! total annual release from the 10 year-turnover
+                                                                             !! pool @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(npts,nwp), INTENT(inout)            :: cflux_prod100    !! total annual release from the 100 year-
+    REAL(r_std), DIMENSION(npts,12), INTENT(inout)       :: glccReal         !! The "real" glcc matrix that we apply in the model
+                                                                             !! after considering the consistency between presribed
+                                                                             !! glcc matrix and existing vegetation fractions.
+    REAL(r_std), DIMENSION(npts,12), INTENT(inout)        :: IncreDeficit     !! "Increment" deficits, negative values mean that 
+                                                                             !! there are not enough fractions in the source PFTs
+                                                                             !! /vegetations to target PFTs/vegetations. I.e., these
+                                                                             !! fraction transfers are presribed in LCC matrix but
+                                                                             !! not realized.
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)      :: glcc_pft         !! Loss of fraction in each PFT
+    REAL(r_std), DIMENSION(npts,nvm,nvmap), INTENT(inout):: glcc_pftmtc      !! a temporary variable to hold the fractions each PFT is going to lose
+                                                                             !! i.e., the contribution of each PFT to the youngest age-class of MTC
+
+    !! 0.3 Modified variables
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)      :: veget_max        !! "maximal" coverage fraction of a PFT (LAI ->
+                                                                             !! infinity) on ground (unitless) 
+    REAL(r_std), DIMENSION(npts,0:10,nwp), INTENT(inout)     :: prod10           !! products remaining in the 10 year-turnover
+                                                                             !! pool after the annual release for each 
+                                                                             !! compartment (10 + 1 : input from year of land
+                                                                             !! cover change)
+    REAL(r_std), DIMENSION(npts,0:100,nwp), INTENT(inout)    :: prod100          !! products remaining in the 100 year-turnover
+                                                                             !! pool after the annual release for each 
+                                                                             !! compartment (100 + 1 : input from year of land
+                                                                             !! cover change)
+    REAL(r_std), DIMENSION(npts,10,nwp), INTENT(inout)       :: flux10           !! annual release from the 10/100 year-turnover 
+                                                                             !! pool compartments
+    REAL(r_std), DIMENSION(npts,100,nwp), INTENT(inout)      :: flux100          !! annual release from the 10/100 year-turnover
+                                                                             !! pool compartments
+    LOGICAL, DIMENSION(:,:), INTENT(inout)               :: PFTpresent       !! Tab indicating which PFTs are present in 
+                                                                             !! each pixel
+    LOGICAL, DIMENSION(:,:), INTENT(inout)               :: senescence       !! Flag for setting senescence stage (only 
+                                                                             !! for deciduous trees)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: moiavail_month   !! "Monthly" moisture availability (0 to 1, 
+                                                                             !! unitless) 
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: moiavail_week    !! "Weekly" moisture availability 
+                                                                             !! (0 to 1, unitless)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: gpp_week         !! Mean weekly gross primary productivity 
+                                                                             !! @tex $(gC m^{-2} day^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: ngd_minus5       !! Number of growing days (days), threshold 
+                                                                             !! -5 deg C (for phenology)   
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: resp_maint       !! Maintenance respiration  
+                                                                             !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: resp_growth      !! Growth respiration  
+                                                                             !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: resp_hetero      !! Heterotrophic respiration  
+                                                                             !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: npp_daily        !! Net primary productivity 
+                                                                             !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: when_growthinit  !! How many days ago was the beginning of 
+                                                                             !! the growing season (days)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: npp_longterm     !! "Long term" mean yearly primary productivity 
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: ind              !! Number of individuals at the stand level
+                                                                             !! @tex $(m^{-2})$ @endtex 
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: lm_lastyearmax   !! last year's maximum leaf mass for each PFT 
+                                                                             !! @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: everywhere       !! is the PFT everywhere in the grid box or 
+                                                                             !! very localized (after its introduction) (?)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: age              !! mean age (years)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: co2_to_bm        !! CO2 taken from the atmosphere to get C to create  
+                                                                             !! the seedlings @tex (gC.m^{-2}dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: gpp_daily        !! Daily gross primary productivity  
+                                                                             !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: co2_fire         !! Fire carbon emissions
+                                                                             !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: time_hum_min     !! Time elapsed since strongest moisture 
+                                                                             !! availability (days) 
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: gdd_midwinter    !! Growing degree days (K), since midwinter 
+                                                                             !! (for phenology) - this is written to the
+                                                                             !!  history files 
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: gdd_from_growthinit !! growing degree days, since growthinit 
+                                                                             !! for crops
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: gdd_m5_dormance  !! Growing degree days (K), threshold -5 deg 
+                                                                             !! C (for phenology)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: ncd_dormance     !! Number of chilling days (days), since 
+                                                                             !! leaves were lost (for phenology) 
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)         :: lignin_struc     !! ratio Lignine/Carbon in structural litter,
+                                                                             !! above and below ground
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)         :: carbon           !! carbon pool: active, slow, or passive 
+                                                                             !! @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)         :: deepC_a          !! Permafrost soil carbon (g/m**3) active
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)         :: deepC_s          !! Permafrost soil carbon (g/m**3) slow
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)         :: deepC_p          !! Permafrost soil carbon (g/m**3) passive
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)         :: leaf_frac        !! fraction of leaves in leaf age class (unitless;0-1)
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)         :: leaf_age         !! Leaf age (days)
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout)       :: bm_to_litter     !! Transfer of biomass to litter 
+                                                                             !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout)       :: biomass          !! Stand level biomass @tex $(gC.m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(:,:,:,:,:), INTENT(inout)     :: litter           !! metabolic and structural litter, above and 
+                                                                             !! below ground @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout)       :: fuel_1hr
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout)       :: fuel_10hr
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout)       :: fuel_100hr
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout)       :: fuel_1000hr
+
+    !! 0.4 Local variables
+    REAL(r_std), DIMENSION(nvmap,nparts,nelements)             :: bm_to_litter_pro !! conversion of biomass to litter 
+                                                                             !! @tex ($gC m^{-2} day^{-1}$) @endtex
+    REAL(r_std), DIMENSION(nvmap,nparts,nelements)             :: biomass_pro      !! biomass @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(nvmap)                        :: veget_max_pro    !! "maximal" coverage fraction of a PFT (LAI ->
+                                                                             !! infinity) on ground (unitless) 
+    REAL(r_std), DIMENSION(nvmap,ncarb)                        :: carbon_pro       !! carbon pool: active, slow, or passive 
+                                                                             !! @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(nvmap,ndeep)                        :: deepC_a_pro      !! Permafrost carbon pool: active, slow, or passive 
+                                                                             !! @tex ($gC m^{-3}$) @endtex
+    REAL(r_std), DIMENSION(nvmap,ndeep)                        :: deepC_s_pro      !! Permafrost carbon pool: active, slow, or passive 
+                                                                             !! @tex ($gC m^{-3}$) @endtex
+    REAL(r_std), DIMENSION(nvmap,ndeep)                        :: deepC_p_pro      !! Permafrost carbon pool: active, slow, or passive 
+                                                                             !! @tex ($gC m^{-3}$) @endtex
+    REAL(r_std), DIMENSION(nvmap,nlitt,nlevs,nelements)        :: litter_pro       !! metabolic and structural litter, above and 
+                                                                             !! below ground @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(nvmap,nlitt,nelements)              :: fuel_1hr_pro
+    REAL(r_std), DIMENSION(nvmap,nlitt,nelements)              :: fuel_10hr_pro
+    REAL(r_std), DIMENSION(nvmap,nlitt,nelements)              :: fuel_100hr_pro
+    REAL(r_std), DIMENSION(nvmap,nlitt,nelements)              :: fuel_1000hr_pro
+    REAL(r_std), DIMENSION(nvmap,nlevs)                        :: lignin_struc_pro !! ratio Lignine/Carbon in structural litter
+                                                                             !! above and below ground
+    REAL(r_std), DIMENSION(nvmap,nleafages)                    :: leaf_frac_pro    !! fraction of leaves in leaf age class 
+    REAL(r_std), DIMENSION(nvmap,nleafages)                    :: leaf_age_pro     !! fraction of leaves in leaf age class 
+    LOGICAL, DIMENSION(nvmap)                :: PFTpresent_pro, senescence_pro                 !! Is pft there (unitless)
+    REAL(r_std), DIMENSION(nvmap)            :: ind_pro, age_pro, lm_lastyearmax_pro, npp_longterm_pro
+    REAL(r_std), DIMENSION(nvmap)            :: everywhere_pro
+    REAL(r_std), DIMENSION(nvmap)            :: gpp_daily_pro, npp_daily_pro, co2_to_bm_pro
+    REAL(r_std), DIMENSION(nvmap)            :: resp_maint_pro, resp_growth_pro
+    REAL(r_std), DIMENSION(nvmap)            :: resp_hetero_pro, co2_fire_pro
+  
+    INTEGER                :: ipts,ivm,ivma,l,m,ipft_young_agec
+    CHARACTER(LEN=10)      :: part_str                               !! string suffix indicating an index
+
+    REAL(r_std), DIMENSION(npts,nvmap)       :: glcc_mtc             !! Increase in fraction of each MTC in its youngest age-class
+    REAL(r_std), DIMENSION(npts,nvm)         :: glccReal_tmp         !! A temporary variable to hold glccReal
+    REAL(r_std), DIMENSION(npts)             :: Deficit_pf2yf_final     !! 
+    REAL(r_std), DIMENSION(npts)             :: Deficit_sf2yf_final     !! 
+    REAL(r_std), DIMENSION(npts)             :: pf2yf_compen_sf2yf      !! 
+    REAL(r_std), DIMENSION(npts)             :: sf2yf_compen_pf2yf      !!
+    REAL(r_std), DIMENSION(npts,nvm)         :: glcc_harvest            !! Loss of fraction due to forestry harvest
+
+    WRITE(numout,*) 'Entering fharvest_SinAgeC'
+    glcc_harvest(:,:) = zero
+    glccReal_tmp(:,:) = zero
+
+    CALL SinAgeC_fh_firstday(npts,veget_max,newvegfrac,harvest_matrix,   &
+                          glccSecondShift,glccPrimaryShift,glccNetLCC,&
+                          glccReal,glcc_pft,glcc_pftmtc,IncreDeficit,  &
+                          Deficit_pf2yf_final, Deficit_sf2yf_final,   &
+                          pf2yf_compen_sf2yf, sf2yf_compen_pf2yf)
+
+    glcc_mtc(:,:) = SUM(glcc_pftmtc,DIM=2)
+
+
+    DO ipts=1,npts
+
+      !! Initialize the _pro variables
+      bm_to_litter_pro(:,:,:)=zero                                                
+      biomass_pro(:,:,:)=zero
+      veget_max_pro(:)=zero                                                       
+      carbon_pro(:,:)=zero                                                        
+      deepC_a_pro(:,:)=zero                                                       
+      deepC_s_pro(:,:)=zero                                                       
+      deepC_p_pro(:,:)=zero                                                       
+      litter_pro(:,:,:,:)=zero                                                    
+      fuel_1hr_pro(:,:,:)=zero                                                    
+      fuel_10hr_pro(:,:,:)=zero                                                   
+      fuel_100hr_pro(:,:,:)=zero                                                  
+      fuel_1000hr_pro(:,:,:)=zero                                                 
+      lignin_struc_pro(:,:)=zero                                                  
+
+      leaf_frac_pro = zero
+      leaf_age_pro = zero
+      PFTpresent_pro(:) = .FALSE.
+      senescence_pro(:) = .TRUE.
+      ind_pro = zero
+      age_pro = zero
+      lm_lastyearmax_pro = zero
+      npp_longterm_pro = zero
+      everywhere_pro = zero
+      
+      gpp_daily_pro=zero                                                       
+      npp_daily_pro=zero                                                       
+      co2_to_bm_pro=zero                                                       
+      resp_maint_pro=zero                                                      
+      resp_growth_pro=zero                                                     
+      resp_hetero_pro=zero                                                     
+      co2_fire_pro=zero                                                        
+
+      ! Note that we assume people don't intentionally change baresoil to 
+      ! vegetated land.
+      DO ivma = 2,nvmap
+        ! we assume only the youngest age class receives the incoming PFT
+        ! [chaoyuejoy@gmail.com 2015-08-04] This line is commented to allow
+        ! the case of only single age class being handled.
+
+        ! here we set glcc_mtc(ipts,ivma) > min_stomate as a condition,
+        ! this is necessary because later on in the subroutine of 
+        ! add_incoming_proxy_pft we have to merge the newly established
+        ! youngest proxy with potentially exisiting youngest receiving MTC,
+        ! thus have to devide a new fraction of (frac_proxy + frac_exist),
+        ! but in case frac_exist = zero, we risk deviding by a very small value
+        ! of frac_proxy and thus we want it to be bigger than min_stomate.
+        IF ( glcc_mtc(ipts,ivma) .GT. min_stomate ) THEN
+
+          ! 1. we accumulate the scalar variables that will be inherited
+          !    note we don't handle the case of harvesting forest because
+          !    we assume glcc_pftmtc(forest->forest) would be zero and this
+          !    case won't occur as it's filtered by the condition of
+          !    (frac>min_stomate)
+          CALL collect_legacy_pft_forestry(npts, ipts, ivma, glcc_pftmtc,    &
+                  fuelfrac, &
+                  biomass, bm_to_litter, carbon, litter,            &
+                  deepC_a, deepC_s, deepC_p,                        &
+                  fuel_1hr, fuel_10hr, fuel_100hr, fuel_1000hr,     &
+                  lignin_struc, co2_to_bm, gpp_daily, npp_daily,    &
+                  resp_maint, resp_growth, resp_hetero, co2_fire,   &
+                  def_fuel_1hr_remain, def_fuel_10hr_remain,        &
+                  def_fuel_100hr_remain, def_fuel_1000hr_remain,    &
+                  deforest_litter_remain, deforest_biomass_remain,  &
+                  veget_max_pro(ivma), carbon_pro(ivma,:),          &
+                  lignin_struc_pro(ivma,:), litter_pro(ivma,:,:,:), &
+                  deepC_a_pro(ivma,:), deepC_s_pro(ivma,:), deepC_p_pro(ivma,:), &
+                  fuel_1hr_pro(ivma,:,:), fuel_10hr_pro(ivma,:,:),  &
+                  fuel_100hr_pro(ivma,:,:), fuel_1000hr_pro(ivma,:,:), &
+                  bm_to_litter_pro(ivma,:,:), co2_to_bm_pro(ivma),  &
+                  gpp_daily_pro(ivma), npp_daily_pro(ivma),         &
+                  resp_maint_pro(ivma), resp_growth_pro(ivma),      &
+                  resp_hetero_pro(ivma), co2_fire_pro(ivma),        &
+                  convflux,prod10,prod100)
+
+          !++TEMP++
+          ! Here we substract the outgoing fraction from the source PFT.
+          ! If a too small fraction remains in this source PFT, then it is
+          ! exhausted, we empty it. The subroutine 'empty_pft' might be 
+          ! combined with 'collect_legacy_pft', but now we just put it here.
+          DO ivm = 1,nvm
+            IF( glcc_pftmtc(ipts,ivm,ivma)>zero ) THEN
+              veget_max(ipts,ivm) = veget_max(ipts,ivm)-glcc_pftmtc(ipts,ivm,ivma)
+              IF ( veget_max(ipts,ivm)<min_stomate ) THEN
+                CALL empty_pft(ipts, ivm, veget_max, biomass, ind,       &
+                       carbon, litter, lignin_struc, bm_to_litter,       &
+                       deepC_a, deepC_s, deepC_p,                        &
+                       fuel_1hr, fuel_10hr, fuel_100hr, fuel_1000hr,     &
+                       gpp_daily, npp_daily, gpp_week, npp_longterm,     &
+                       co2_to_bm, resp_maint, resp_growth, resp_hetero,  &
+                       lm_lastyearmax, leaf_frac, leaf_age, age,         &
+                       everywhere, PFTpresent, when_growthinit,          &
+                       senescence, gdd_from_growthinit, gdd_midwinter,   &
+                       time_hum_min, gdd_m5_dormance, ncd_dormance,      &
+                       moiavail_month, moiavail_week, ngd_minus5)
+              ENDIF
+            ENDIF
+          ENDDO
+
+        ENDIF !IF ( glcc_mtc(ipts,ivma) .GT. min_stomate )
+      ENDDO !(DO ivma = 2,nvmap)
+
+      ! We can only establish new youngest proxy and add it to the 
+      ! existing youngest-age PFT after all the harvest is done, to 
+      ! avoid the dilution of harvestable biomass by the young proxy
+      ! and ensure consistency. Therefore now we have to loop again
+      ! over nvmap.
+      DO ivma = 2,nvmap
+        IF ( glcc_mtc(ipts,ivma) .GT. min_stomate ) THEN
+
+          ipft_young_agec = start_index(ivma)
+
+          ! 2. we establish a proxy PFT with the fraction of veget_max_pro,
+          !    which is going to be either merged with existing target 
+          !    `ipft_young_agec` PFT, or fill the place if no existing target PFT
+          !    exits.
+          CALL initialize_proxy_pft(ipts,ipft_young_agec,veget_max_pro(ivma), &
+                 biomass_pro(ivma,:,:), co2_to_bm_pro(ivma), ind_pro(ivma),   &
+                 age_pro(ivma),                                               & 
+                 senescence_pro(ivma), PFTpresent_pro(ivma),                  &
+                 lm_lastyearmax_pro(ivma), everywhere_pro(ivma),              &
+                 npp_longterm_pro(ivma),                                      &
+                 leaf_frac_pro(ivma,:),leaf_age_pro(ivma,:))
+
+          CALL sap_take (ipts,ivma,veget_max,biomass_pro(ivma,:,:), &
+                         biomass,co2_to_bm_pro(ivma))
+
+          ! 3. we merge the newly initiazlized proxy PFT into existing one
+          !    or use it to fill an empty PFT slot.
+          CALL add_incoming_proxy_pft(npts, ipts, ipft_young_agec, veget_max_pro(ivma),&
+                 carbon_pro(ivma,:), litter_pro(ivma,:,:,:), lignin_struc_pro(ivma,:), &
+                 bm_to_litter_pro(ivma,:,:),    &
+                 deepC_a_pro(ivma,:), deepC_s_pro(ivma,:), deepC_p_pro(ivma,:), &
+                 fuel_1hr_pro(ivma,:,:), fuel_10hr_pro(ivma,:,:),               &
+                 fuel_100hr_pro(ivma,:,:), fuel_1000hr_pro(ivma,:,:),           &
+                 biomass_pro(ivma,:,:), co2_to_bm_pro(ivma),                    &
+                 npp_longterm_pro(ivma), ind_pro(ivma),                         &
+                 lm_lastyearmax_pro(ivma), age_pro(ivma), everywhere_pro(ivma), &  
+                 leaf_frac_pro(ivma,:), leaf_age_pro(ivma,:),                   &
+                 PFTpresent_pro(ivma), senescence_pro(ivma),                &
+                 gpp_daily_pro(ivma), npp_daily_pro(ivma),                      &
+                 resp_maint_pro(ivma), resp_growth_pro(ivma),                   &
+                 resp_hetero_pro(ivma), co2_fire_pro(ivma),                     &
+                 veget_max, carbon, litter, lignin_struc, bm_to_litter,         &
+                 deepC_a, deepC_s, deepC_p,                                     &
+                 fuel_1hr, fuel_10hr, fuel_100hr, fuel_1000hr,                  &
+                 biomass, co2_to_bm, npp_longterm, ind,                         &
+                 lm_lastyearmax, age, everywhere,                               &
+                 leaf_frac, leaf_age, PFTpresent, senescence,                   &
+                 gpp_daily, npp_daily, resp_maint, resp_growth,                 &
+                 resp_hetero, co2_fire)
+        ENDIF !IF ( glcc_mtc(ipts,ivma) .GT. min_stomate )
+      ENDDO !(DO ivma=1,nvmap)
+
+    ENDDO !(DO ipts=1,npts)
+
+
+    ! Write out forestry harvest variables
+    DO ipts = 1,npts
+      DO ivm = 1,nvm
+        DO ivma = 1,nvmap
+          IF (is_tree(ivm) .AND. is_tree(start_index(ivma))) THEN
+            glcc_harvest(ipts,ivm) = glcc_harvest(ipts,ivm) + glcc_pftmtc(ipts,ivm,ivma)
+          ENDIF
+        ENDDO
+      ENDDO
+    ENDDO
+    CALL histwrite_p (hist_id_stomate, 'glcc_harvest', itime, &
+         glcc_harvest, npts*nvm, horipft_index)
+    CALL xios_orchidee_send_field ('glcc_harvest', glcc_harvest) ! kjpindex,nvm
+
+    ! glccReal_tmp(:,:) = zero
+    ! glccReal_tmp(:,1:12) = IncreDeficit
+    ! CALL histwrite_p (hist_id_stomate, 'IncreDeficit', itime, &
+    !      glccReal_tmp, npts*nvm, horipft_index)
+
+
+    glccReal_tmp(:,:) = zero
+    glccReal_tmp(:,1) = Deficit_pf2yf_final
+    glccReal_tmp(:,2) = Deficit_sf2yf_final    ! is always zero in case of
+                                               ! single age class
+    glccReal_tmp(:,3) = pf2yf_compen_sf2yf     ! alawys zero for SinAgeC
+    glccReal_tmp(:,4) = sf2yf_compen_pf2yf     ! always zero for SinAgeC
+
+    CALL histwrite_p (hist_id_stomate, 'DefiComForHarvest', itime, &
+         glccReal_tmp, npts*nvm, horipft_index)
+    CALL xios_orchidee_send_field ('DefiComForHarvest', glccReal_tmp) ! kjpindex,nvm
+
+    ! DO ivma = 1, nvmap
+    !   WRITE(part_str,'(I2)') ivma
+    !   IF (ivma < 10) part_str(1:1) = '0'
+    !   CALL histwrite_p (hist_id_stomate, 'glcc_pftmtc_'//part_str(1:LEN_TRIM(part_str)), &
+    !        itime, glcc_pftmtc(:,:,ivma), npts*nvm, horipft_index)
+    ! ENDDO
+
+  END SUBROUTINE fharvest_SinAgeC
+
+! ================================================================================================================================
+! Note: [2016-04-20]
+! This is a simple duplication of gross_glcchange_SinAgeC_fh, to hanle the case that
+! only forestry harvest is included.
+!_ ================================================================================================================================
+
+  ! Note: it has this name because this subroutine will also be called
+  ! the first day of each year to precalculate the forest loss for the
+  ! deforestation fire module.
+  SUBROUTINE SinAgeC_fh_firstday(npts,veget_max_org,newvegfrac,harvest_matrix, &
+                          glccSecondShift,glccPrimaryShift,glccNetLCC,&
+                          glccReal,glcc_pft,glcc_pftmtc,IncreDeficit, &
+                          Deficit_pf2yf_final, Deficit_sf2yf_final,   &
+                          pf2yf_compen_sf2yf, sf2yf_compen_pf2yf)
+
+    IMPLICIT NONE
+
+    !! 0.1 Input variables
+
+    INTEGER, INTENT(in)                                     :: npts           !! Domain size - number of pixels (unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)            :: veget_max_org  !! "maximal" coverage fraction of a PFT on the ground
+                                                                              !! May sum to
+                                                                              !! less than unity if the pixel has
+                                                                              !! nobio area. (unitless, 0-1)
+    REAL(r_std), DIMENSION(npts,nvmap), INTENT(in)          :: newvegfrac
+    REAL(r_std), DIMENSION(npts,12),INTENT(in)              :: harvest_matrix !! 
+                                                                              !! 
+    REAL(r_std), DIMENSION (npts,12),INTENT(in)        :: glccSecondShift     !! the land-cover-change (LCC) matrix in case a gross LCC is 
+                                                                              !! used.
+    REAL(r_std), DIMENSION (npts,12),INTENT(in)        :: glccPrimaryShift    !! the land-cover-change (LCC) matrix in case a gross LCC is 
+                                                                              !! used.
+    REAL(r_std), DIMENSION (npts,12),INTENT(in)        :: glccNetLCC          !! the land-cover-change (LCC) matrix in case a gross LCC is 
+                                                                              !! used.
+
+    !! 0.2 Output variables
+    REAL(r_std), DIMENSION(npts,nvm,nvmap), INTENT(inout)   :: glcc_pftmtc    !! a temporary variable to hold the fractions each PFT is going to lose
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)         :: glcc_pft       !! Loss of fraction in each PFT
+    REAL(r_std), DIMENSION(npts,12), INTENT(inout)          :: glccReal       !! The "real" glcc matrix that we apply in the model
+                                                                              !! after considering the consistency between presribed
+                                                                              !! glcc matrix and existing vegetation fractions.
+    REAL(r_std), DIMENSION(npts,12), INTENT(inout)           :: IncreDeficit   !! "Increment" deficits, negative values mean that 
+                                                                              !! there are not enough fractions in the source PFTs
+                                                                              !! /vegetations to target PFTs/vegetations. I.e., these
+                                                                              !! fraction transfers are presribed in LCC matrix but
+                                                                              !! not realized.
+    REAL(r_std), DIMENSION(npts), INTENT(inout)    :: Deficit_pf2yf_final     !! 
+    REAL(r_std), DIMENSION(npts), INTENT(inout)    :: Deficit_sf2yf_final     !! 
+    REAL(r_std), DIMENSION(npts), INTENT(inout)    :: pf2yf_compen_sf2yf      !! 
+    REAL(r_std), DIMENSION(npts), INTENT(inout)    :: sf2yf_compen_pf2yf      !!
+     
+
+    !! 0.3 Modified variables
+    
+    !! 0.4 Local variables
+    REAL(r_std), DIMENSION (npts,12)                :: glcc                !! the land-cover-change (LCC) matrix in case a gross LCC is 
+                                                                           !! used.
+    REAL(r_std), DIMENSION(npts,nvmap)              :: veget_mtc           !! "maximal" coverage fraction of a PFT on the ground
+    REAL(r_std), DIMENSION(npts,nvmap)              :: veget_mtc_begin     !! "maximal" coverage fraction of a PFT on the ground
+    REAL(r_std), DIMENSION(npts,nagec_tree)         :: vegagec_tree        !! fraction of tree age-class groups, in sequence of old->young
+    REAL(r_std), DIMENSION(npts,nagec_herb)         :: vegagec_grass       !! fraction of grass age-class groups, in sequence of old->young 
+    REAL(r_std), DIMENSION(npts,nagec_herb)         :: vegagec_pasture     !! fraction of pasture age-class groups, in sequence of old->young
+    REAL(r_std), DIMENSION(npts,nagec_herb)         :: vegagec_crop        !! fraction of crop age-class groups, in sequence of old->young
+
+    
+    REAL(r_std), DIMENSION(npts,4)                  :: veget_4veg      !! "maximal" coverage fraction of a PFT on the ground
+    REAL(r_std), DIMENSION(npts)                    :: veget_tree      !! "maximal" coverage fraction of a PFT on the ground
+    REAL(r_std), DIMENSION(npts)                    :: veget_grass     !! "maximal" coverage fraction of a PFT on the ground
+    REAL(r_std), DIMENSION(npts)                    :: veget_pasture   !! "maximal" coverage fraction of a PFT on the ground
+    REAL(r_std), DIMENSION(npts)                    :: veget_crop      !! "maximal" coverage fraction of a PFT on the ground
+
+    REAL(r_std), DIMENSION(npts,nvm)         :: veget_max         !! "maximal" coverage fraction of a PFT on the ground
+    REAL(r_std), DIMENSION(npts,nvm)         :: veget_max_tmp     !! "maximal" coverage fraction of a PFT on the ground
+    REAL(r_std), DIMENSION(npts,nvm)         :: veget_max_old     !! "maximal" coverage fraction of a PFT on the ground
+    REAL(r_std), DIMENSION(npts,nvm)         :: glcc_pft_tmp      !! Loss of fraction in each PFT
+
+    ! Different indexes for convenient local uses
+    ! We define the rules for gross land cover change matrix:
+    ! 1 forest->grass
+    ! 2 forest->pasture 
+    ! 3 forest->crop
+    ! 4 grass->forest
+    ! 5 grass->pasture
+    ! 6 grass->crop
+    ! 7 pasture->forest
+    ! 8 pasture->grass
+    ! 9 pasture->crop
+    ! 10 crop->forest
+    ! 11 crop->grass
+    ! 12 crop->pasture
+    INTEGER :: f2g=1, f2p=2, f2c=3
+    INTEGER :: g2f=4, g2p=5, g2c=6, p2f=7, p2g=8, p2c=9, c2f=10, c2g=11, c2p=12
+
+    INTEGER, ALLOCATABLE                  :: indall_tree(:)       !! Indices for all tree PFTs
+    INTEGER, ALLOCATABLE                  :: indold_tree(:)       !! Indices for old tree cohort only
+    INTEGER, ALLOCATABLE                  :: indagec_tree(:,:)    !! Indices for secondary tree cohorts, 
+                                                                  !! note the sequence is old->young.
+    INTEGER, ALLOCATABLE                  :: indall_grass(:)      !! Indices for all grass PFTs
+    INTEGER, ALLOCATABLE                  :: indold_grass(:)      !! Indices for old grasses only
+    INTEGER, ALLOCATABLE                  :: indagec_grass(:,:)   !! Indices for secondary grass cohorts
+                                                                  !! note the sequence is old->young.
+    INTEGER, ALLOCATABLE                  :: indall_pasture(:)    !! Indices for all pasture PFTs
+    INTEGER, ALLOCATABLE                  :: indold_pasture(:)    !! Indices for old pasture only
+    INTEGER, ALLOCATABLE                  :: indagec_pasture(:,:) !! Indices for secondary pasture cohorts
+                                                                  !! note the sequence is old->young.
+    INTEGER, ALLOCATABLE                  :: indall_crop(:)       !! Indices for all crop PFTs
+    INTEGER, ALLOCATABLE                  :: indold_crop(:)       !! Indices for old crops only
+    INTEGER, ALLOCATABLE                  :: indagec_crop(:,:)    !! Indices for secondary crop cohorts
+                                                                  !! note the sequence is old->young.
+    INTEGER :: num_tree_sinagec,num_tree_mulagec,num_grass_sinagec,num_grass_mulagec,     &
+               num_pasture_sinagec,num_pasture_mulagec,num_crop_sinagec,num_crop_mulagec, &
+               itree,itree2,igrass,igrass2,ipasture,ipasture2,icrop,icrop2,pf2yf,sf2yf
+    INTEGER :: i,j,ivma,staind,endind,ivm
+
+
+    REAL(r_std), DIMENSION(npts,12)         :: glccDef            !! Gross LCC deficit, negative values mean that there
+                                                                  !! are not enough fractions in the source vegetations
+                                                                  !! to the target ones as presribed by the LCC matrix.
+    REAL(r_std), DIMENSION(npts)            :: Deficit_pf2yf      !! 
+    REAL(r_std), DIMENSION(npts)            :: Deficit_sf2yf      !! 
+    REAL(r_std), DIMENSION(npts)            :: Surplus_pf2yf      !! 
+    REAL(r_std), DIMENSION(npts)            :: Surplus_sf2yf      !! 
+    REAL(r_std), DIMENSION(npts,12)         :: glccRemain      !! 
+    REAL(r_std), DIMENSION(npts,12)         :: HmatrixReal        !! 
+    INTEGER :: ipts
+    
+
+    !! 1. We first build all different indices that we are going to use
+    !!    in handling the PFT exchanges, three types of indices are built:
+    !!     - for all age classes
+    !!     - include only oldest age classes
+    !!     - include all age classes excpet the oldest ones
+    ! We have to build these indices because we would like to extract from
+    ! donating PFTs in the sequnce of old->young age classes, and add in the
+    ! receving PFTs only in the youngest-age-class PFTs. These indicies allow
+    ! us to know where the different age classes are.
+
+    num_tree_sinagec=0          ! number of tree PFTs with only one single age class 
+                                ! considered as the oldest age class
+    num_tree_mulagec=0          ! number of tree PFTs having multiple age classes
+    num_grass_sinagec=0
+    num_grass_mulagec=0
+    num_pasture_sinagec=0
+    num_pasture_mulagec=0
+    num_crop_sinagec=0
+    num_crop_mulagec=0
+    
+    !! 1.1 Calculate the number of PFTs for different MTCs and allocate
+    !! the old and all indices arrays.
+
+    ! [Note here the sequence to identify tree,pasture,grass,crop] is
+    ! critical. The similar sequence is used in the subroutine "calc_cover".
+    ! Do not forget to change the sequence there if you modify here.
+    DO ivma =2,nvmap
+      staind=start_index(ivma)
+      IF (nagec_pft(ivma)==1) THEN
+        IF (is_tree(staind)) THEN
+          num_tree_sinagec = num_tree_sinagec+1
+        ELSE IF (is_grassland_manag(staind)) THEN
+          num_pasture_sinagec = num_pasture_sinagec+1
+        ELSE IF (natural(staind)) THEN
+          num_grass_sinagec = num_grass_sinagec+1
+        ELSE
+          num_crop_sinagec = num_crop_sinagec+1
+        ENDIF
+
+      ELSE
+        IF (is_tree(staind)) THEN
+          num_tree_mulagec = num_tree_mulagec+1
+        ELSE IF (is_grassland_manag(staind)) THEN
+          num_pasture_mulagec = num_pasture_mulagec+1
+        ELSE IF (natural(staind)) THEN
+          num_grass_mulagec = num_grass_mulagec+1
+        ELSE
+          num_crop_mulagec = num_crop_mulagec+1
+        ENDIF
+      ENDIF
+    ENDDO
+    
+    !! Allocate index array
+    ! allocate all index
+    ALLOCATE(indall_tree(num_tree_sinagec+num_tree_mulagec*nagec_tree))     
+    ALLOCATE(indall_grass(num_grass_sinagec+num_grass_mulagec*nagec_herb))     
+    ALLOCATE(indall_pasture(num_pasture_sinagec+num_pasture_mulagec*nagec_herb))     
+    ALLOCATE(indall_crop(num_crop_sinagec+num_crop_mulagec*nagec_herb))     
+
+    ! allocate old-ageclass index
+    ALLOCATE(indold_tree(num_tree_sinagec+num_tree_mulagec))     
+    ALLOCATE(indold_grass(num_grass_sinagec+num_grass_mulagec))     
+    ALLOCATE(indold_pasture(num_pasture_sinagec+num_pasture_mulagec))     
+    ALLOCATE(indold_crop(num_crop_sinagec+num_crop_mulagec))     
+
+    !! 1.2 Fill the oldest-age-class and all index arrays
+    itree=0
+    igrass=0
+    ipasture=0
+    icrop=0
+    itree2=1
+    igrass2=1
+    ipasture2=1
+    icrop2=1
+    DO ivma =2,nvmap
+      staind=start_index(ivma)
+      IF (is_tree(staind)) THEN
+        itree=itree+1
+        indold_tree(itree) = staind+nagec_pft(ivma)-1
+        DO j = 0,nagec_pft(ivma)-1
+          indall_tree(itree2+j) = staind+j
+        ENDDO
+        itree2=itree2+nagec_pft(ivma)
+      ELSE IF (natural(staind) .AND. .NOT. is_grassland_manag(staind)) THEN
+        igrass=igrass+1
+        indold_grass(igrass) = staind+nagec_pft(ivma)-1
+        DO j = 0,nagec_pft(ivma)-1
+          indall_grass(igrass2+j) = staind+j
+        ENDDO
+        igrass2=igrass2+nagec_pft(ivma)
+      ELSE IF (is_grassland_manag(staind)) THEN
+        ipasture = ipasture+1
+        indold_pasture(ipasture) = staind+nagec_pft(ivma)-1
+        DO j = 0,nagec_pft(ivma)-1
+          indall_pasture(ipasture2+j) = staind+j
+        ENDDO
+        ipasture2=ipasture2+nagec_pft(ivma)
+      ELSE
+        icrop = icrop+1
+        indold_crop(icrop) = staind+nagec_pft(ivma)-1
+        DO j = 0,nagec_pft(ivma)-1
+          indall_crop(icrop2+j) = staind+j
+        ENDDO
+        icrop2=icrop2+nagec_pft(ivma)
+      ENDIF
+    ENDDO
+    
+    !! 1.3 Allocate and fill other age class index
+
+    ! [chaoyuejoy@gmail.com 2015-08-05]
+    ! note that we treat the case of (num_tree_mulagec==0) differently. In this
+    ! case there is no distinction of age groups among tree PFTs. But we still
+    ! we want to use the "gross_lcchange" subroutine. In this case we consider 
+    ! them as having a single age group. In the subroutines
+    ! of "type_conversion" and "cross_give_receive", only the youngest-age-group
+    ! PFTs of a given MTC or vegetation type could receive the incoming fractions.
+    ! To be able to handle this case with least amount of code change, we assign the index 
+    ! of PFT between youngest and second-oldes (i.e., indagec_tree etc) the same as
+    ! those of oldest tree PFTs (or all tree PFTs because in this cases these two indices
+    ! are identical) . So that this case could be correctly handled in the subrountines
+    ! of "type_conversion" and "cross_give_receive". This treatment allows use
+    ! of gross land cover change subroutine with only one single age class. This single
+    ! age class is "simultanously the oldest and youngest age class". At the same
+    ! time, we also change the num_tree_mulagec as the same of num_crop_sinagec.
+    ! The similar case also applies in grass,pasture and crop.
+
+    IF (num_tree_mulagec .EQ. 0) THEN
+      ALLOCATE(indagec_tree(num_tree_sinagec,1))
+      indagec_tree(:,1) = indall_tree(:)
+      num_tree_mulagec = num_tree_sinagec
+    ELSE
+      ALLOCATE(indagec_tree(num_tree_mulagec,nagec_tree-1))     
+    END IF
+
+    IF (num_grass_mulagec .EQ. 0) THEN
+      ALLOCATE(indagec_grass(num_grass_sinagec,1))
+      indagec_grass(:,1) = indall_grass(:)
+      num_grass_mulagec = num_grass_sinagec
+    ELSE
+      ALLOCATE(indagec_grass(num_grass_mulagec,nagec_herb-1))     
+    END IF
+
+    IF (num_pasture_mulagec .EQ. 0) THEN
+      ALLOCATE(indagec_pasture(num_pasture_sinagec,1))
+      indagec_pasture(:,1) = indall_pasture(:)
+      num_pasture_mulagec = num_pasture_sinagec
+    ELSE
+      ALLOCATE(indagec_pasture(num_pasture_mulagec,nagec_herb-1))
+    END IF
+
+    IF (num_crop_mulagec .EQ. 0) THEN
+      ALLOCATE(indagec_crop(num_crop_sinagec,1))
+      indagec_crop(:,1) = indall_crop(:)
+      num_crop_mulagec = num_crop_sinagec
+    ELSE
+      ALLOCATE(indagec_crop(num_crop_mulagec,nagec_herb-1))
+    END IF
+
+    ! fill the non-oldest age class index arrays when number of age classes
+    ! is more than 1.
+    ! [chaoyuejoy@gmail.com, 2015-08-05]
+    ! Note the corresponding part of code  will be automatically skipped
+    ! when nagec_tree ==1 and/or nagec_herb ==1, i.e., the assginment
+    ! in above codes when original num_*_mulagec variables are zero will be retained.
+    itree=0
+    igrass=0
+    ipasture=0
+    icrop=0
+    DO ivma = 2,nvmap
+      staind=start_index(ivma)
+      IF (nagec_pft(ivma) > 1) THEN
+        IF (is_tree(staind)) THEN
+          itree=itree+1
+          DO j = 1,nagec_tree-1
+            indagec_tree(itree,j) = staind+nagec_tree-j-1
+          ENDDO
+        ELSE IF (natural(staind) .AND. .NOT. is_grassland_manag(staind)) THEN
+          igrass=igrass+1
+          DO j = 1,nagec_herb-1
+            indagec_grass(igrass,j) = staind+nagec_herb-j-1
+          ENDDO
+        ELSE IF (is_grassland_manag(staind)) THEN
+          ipasture=ipasture+1
+          DO j = 1,nagec_herb-1
+            indagec_pasture(ipasture,j) = staind+nagec_herb-j-1
+          ENDDO
+        ELSE
+          icrop=icrop+1
+          DO j = 1,nagec_herb-1
+            indagec_crop(icrop,j) = staind+nagec_herb-j-1
+          ENDDO
+        ENDIF
+      ENDIF
+    ENDDO
+
+
+    ! we make copies of original input veget_max
+    ! veget_max will be modified through different operations in order to 
+    ! check various purposes, e.g., whether input glcc is compatible with
+    ! existing veget_max and how to allocate it etc.
+    ! veget_max_old will not be modified
+    veget_max(:,:) = veget_max_org(:,:)
+    veget_max_old(:,:) = veget_max_org(:,:)
+
+    !! 2. Calcuate the fractions covered by tree, grass, pasture and crops
+    !!    for each age class
+
+    !************************************************************************!
+    !****block to calculate fractions for basic veg types and age classes ***!
+    ! Note:
+    ! 1. "calc_cover" subroutine does not depend on how many age classes
+    ! there are in each MTC.
+    ! 2. Fraction of baresoil is excluded here. This means transformation
+    ! of baresoil to a vegetated PFT is excluded in gross land cover change.
+    veget_mtc(:,:) = 0.
+    vegagec_tree(:,:) = 0.
+    vegagec_grass(:,:) = 0.
+    vegagec_pasture(:,:) = 0.
+    vegagec_crop(:,:) = 0.
+
+    CALL calc_cover(npts,veget_max,veget_mtc,vegagec_tree,vegagec_grass, &
+           vegagec_pasture,vegagec_crop)
+    ! In following call of calc_cover, veget_mtc will be updated each time,
+    ! but we don't want this, so we put its initial value into veget_mtc_begin
+    ! in order to retrieve this initial value later.
+    veget_mtc_begin = veget_mtc
+ 
+    veget_tree(:) = SUM(vegagec_tree(:,:),DIM=2)
+    veget_grass(:) = SUM(vegagec_grass(:,:),DIM=2)
+    veget_pasture(:) = SUM(vegagec_pasture(:,:),DIM=2)
+    veget_crop(:) = SUM(vegagec_crop(:,:),DIM=2)
+
+    !****end block to calculate fractions for basic veg types and age classes ***!
+    !****************************************************************************!
+
+    !********************** block to handle forestry harvest ****************
+    !! 2B. Here we handle the forestry wood harvest
+    ! Rules:
+    ! 1. We take first from second oldest forest, then oldest forest
+    
+    pf2yf=1   !primary to young forest conversion because of harvest
+    sf2yf=2   !old secondary to young forest conversion because of harvest
+    
+    !! Note that Deficit_pf2yf and Deficit_sf2yf are temporary, intermediate
+    !! variables. The final deficits after mutual compensation are stored in 
+    !! Deficit_pf2yf_final and Deficit_sf2yf_final.
+    Deficit_pf2yf(:) = zero 
+    Deficit_sf2yf(:) = zero
+    Deficit_pf2yf_final(:) = zero 
+    Deficit_sf2yf_final(:) = zero
+
+    !! Note that both Surplus_pf2yf and Surplus_sf2yf and temporary intermediate
+    !! variables, the final surplus after mutual compensation are not outputed.
+    Surplus_pf2yf(:) = zero
+    Surplus_sf2yf(:) = zero
+
+    !! Note in the naming of pf2yf_compen_sf2yf and sf2yf_compen_pf2yf, active
+    !! tense is used.
+    pf2yf_compen_sf2yf(:) = zero  !primary->young conversion that compensates 
+                               !the secondary->young conversion because of deficit
+                               !in the latter
+    sf2yf_compen_pf2yf(:) = zero  !seondary->young conversion that compensates
+                               !the primary->young conversion because of the deficit
+                               !in the latter
+    
+
+    !! Define the "real" harvest matrix after considering the mutual compenstation
+    !! between primary->young and secondary->young transitions.
+    HmatrixReal(:,:) = zero  !Harvest matrix real, used to hold the 
+                                       !harvest matrix after considering the mutual
+                                       !compensation between primary and old secondary
+                                       !forest
+
+    ! we sum together harvest from primary and secondary forest and consider 
+    ! as all happening on parimary forest.
+    HmatrixReal(:,1) = harvest_matrix(:,pf2yf) + harvest_matrix(:,sf2yf)
+
+    ! Check the availability of forest fractions for harvest
+    WHERE (veget_tree(:) .LE. HmatrixReal(:,1)) 
+      Deficit_pf2yf_final(:) = veget_tree(:)-HmatrixReal(:,1)
+      HmatrixReal(:,1) = veget_tree(:)
+    ENDWHERE
+
+    glccRemain(:,:) = HmatrixReal(:,:)
+    glcc_pft(:,:) = 0.
+    glcc_pft_tmp(:,:) = 0.
+    glcc_pftmtc(:,:,:) = 0.
+
+    !! Allocate harvest-caused out-going primary and secondary forest fraction
+    !! into different primary and secondary forest PFTs. 
+    ! [Note: here we need only glcc_pft, but not glcc_pft_tmp and glcc_pftmtc.
+    ! The latter two variables will be set to zero again when handling LCC in 
+    ! later sections.]
+    DO ipts=1,npts
+      !pf2yf
+      CALL type_conversion(ipts,pf2yf,HmatrixReal,veget_mtc,newvegfrac,  &
+                       indold_tree,indagec_tree,indagec_crop,num_crop_mulagec, &
+                       1,nagec_herb,               &
+                       vegagec_tree,veget_max,glcc_pft,glcc_pftmtc,glcc_pft_tmp,&
+                       glccRemain)
+    ENDDO
+
+    ! Because we use the container of type_conversion, now the glcc_pft_tmp
+    ! and glcc_pftmtc have wrong information (because harvest loss is assigned
+    ! on the newly created youngest-age-class pasture/crop MTCs). So they have 
+    ! to be re-initialized to zero. Only the information in glcc_pft is what
+    ! we need.
+    glcc_pft_tmp(:,:) = 0.
+    glcc_pftmtc(:,:,:) = 0.
+    !Here we need to put glcc_pft into glcc_pftmtc for forestry harvest.
+    !The same MTC will be maintained when forest is harvested.
+    DO ivm =1,nvm
+      IF (is_tree(ivm)) THEN
+        glcc_pftmtc(:,ivm,pft_to_mtc(ivm)) = glcc_pft(:,ivm)
+      ENDIF 
+    ENDDO
+    !****************** end block to handle forestry harvest ****************
+    veget_max_tmp(:,:) = veget_max(:,:)
+
+
+    !************************************************************************!
+    !****block to calculate fractions for basic veg types and age classes ***!
+    ! Note:
+    ! 1. "calc_cover" subroutine does not depend on how many age classes
+    ! there are in each MTC.
+    ! 2. Fraction of baresoil is excluded here. This means transformation
+    ! of baresoil to a vegetated PFT is excluded in gross land cover change.
+    veget_mtc(:,:) = 0.
+    vegagec_tree(:,:) = 0.
+    vegagec_grass(:,:) = 0.
+    vegagec_pasture(:,:) = 0.
+    vegagec_crop(:,:) = 0.
+
+
+    CALL calc_cover(npts,veget_max,veget_mtc,vegagec_tree,vegagec_grass, &
+           vegagec_pasture,vegagec_crop)
+    veget_mtc = veget_mtc_begin
+ 
+    veget_tree(:) = SUM(vegagec_tree(:,:),DIM=2)
+    veget_grass(:) = SUM(vegagec_grass(:,:),DIM=2)
+    veget_pasture(:) = SUM(vegagec_pasture(:,:),DIM=2)
+    veget_crop(:) = SUM(vegagec_crop(:,:),DIM=2)
+    itree=1
+    igrass=2
+    ipasture=3
+    icrop=4
+    veget_4veg(:,itree) = veget_tree(:)
+    veget_4veg(:,igrass) = veget_grass(:)
+    veget_4veg(:,ipasture) = veget_pasture(:)
+    veget_4veg(:,icrop) = veget_crop(:)
+    !****end block to calculate fractions for basic veg types and age classes ***!
+    !****************************************************************************!
+
+    !! 3. Decompose the LCC matrix to different PFTs
+    !! We do this through several steps:
+    !  3.1 Check whether input LCC matrix is feasible with current PFT fractions
+    !      (i.e., the fractions of forest,grass,pasture and crops)
+    !      and if not, adjust the transfer matrix by compensating the deficits
+    !      using the surpluses.
+    !  3.2 Allocate the decreasing fractions of tree/grass/pasture/crop to their
+    !      respective age classes, in the sequences of old->young.
+    !  3.3 Allocate the incoming fractions of tree/grass/pasture/crop to their
+    !      respective youngest age classes. The incoming fractions are distributed
+    !      according to the existing fractions of youngest-age-class PFTs of the
+    !      same receiving vegetation type. If none of them exists, the incoming
+    !      fraction is distributed equally.
+
+    !!  3.1 Adjust LCC matrix if it's not feasible with current PFT fractions
+
+    !++code freezing++
+    !codes below handle the mutual compenstation of transition matrices
+    !among different land cover types. This is desgined for consistency 
+    !with activated DGVM.    
+
+    ! glcc(:,:) = glccSecondShift+glccPrimaryShift+glccNetLCC
+    ! glccReal(:,:) = 0.
+    ! glccDef(:,:) = 0.
+
+    ! !to crop - sequence: p2c,g2c,f2c
+    ! CALL glcc_compensation_full(npts,veget_4veg,glcc,glccReal,glccDef, &
+    !                        p2c,ipasture,g2c,igrass,f2c,itree,icrop, &
+    !                        IncreDeficit)
+
+    ! !to pasture - sequence: g2p,c2p,f2p
+    ! CALL glcc_compensation_full(npts,veget_4veg,glcc,glccReal,glccDef, &
+    !                        g2p,igrass,c2p,icrop,f2p,itree,ipasture, &
+    !                        IncreDeficit)
+
+    ! !to grass - sequence: p2g,c2g,f2g
+    ! CALL glcc_compensation_full(npts,veget_4veg,glcc,glccReal,glccDef, &
+    !                        p2g,ipasture,c2g,icrop,f2g,itree,igrass, &
+    !                        IncreDeficit)
+
+    ! !to forest - sequence: c2f,p2f,g2f
+    ! CALL glcc_compensation_full(npts,veget_4veg,glcc,glccReal,glccDef, &
+    !                        c2f,icrop,p2f,ipasture,g2f,igrass,itree, &
+    !                        IncreDeficit)
+
+    ! !!  3.2 & 3.3 Allocate LCC matrix to different PFTs/age-classes
+
+    ! ! because we use veget_max as a proxy variable and it has been changed
+    ! ! when we derive the glccReal, so here we have to recover its original
+    ! ! values, which is veget_max_tmp after the forestry harvest.
+    ! veget_max(:,:) = veget_max_tmp(:,:)
+
+    ! ! Calculate again fractions for different age-classes.
+    ! veget_mtc(:,:) = 0.
+    ! vegagec_tree(:,:) = 0.
+    ! vegagec_grass(:,:) = 0.
+    ! vegagec_pasture(:,:) = 0.
+    ! vegagec_crop(:,:) = 0.
+
+    ! CALL calc_cover(npts,veget_max,veget_mtc,vegagec_tree,vegagec_grass, &
+    !        vegagec_pasture,vegagec_crop)
+
+
+    !++end codes freezing ++
+
+    IncreDeficit(:,:) = 0.
+    glcc(:,:) = glccSecondShift+glccPrimaryShift+glccNetLCC
+    glccReal(:,:) = glcc(:,:)
+    glccRemain(:,:) = glcc(:,:)
+
+    !  We allocate in the sequences of old->young. Within the same age-class
+    !  group, we allocate in proportion with existing PFT fractions.
+    DO ipts=1,npts
+      !f2c
+      CALL type_conversion(ipts,f2c,glccReal,veget_mtc,newvegfrac,       &
+                       indold_tree,indagec_tree,indagec_crop,num_crop_mulagec,     &
+                       nagec_tree,nagec_herb,                    &
+                       vegagec_tree,veget_max,glcc_pft,glcc_pftmtc,glcc_pft_tmp, &
+                       glccRemain)
+      !f2p
+      CALL type_conversion(ipts,f2p,glccReal,veget_mtc,newvegfrac,       &
+                       indold_tree,indagec_tree,indagec_pasture,num_pasture_mulagec,     &
+                       nagec_tree,nagec_herb,                    &
+                       vegagec_tree,veget_max,glcc_pft,glcc_pftmtc,glcc_pft_tmp,&
+                       glccRemain)
+      !f2g
+      CALL type_conversion(ipts,f2g,glccReal,veget_mtc,newvegfrac,       &
+                       indold_tree,indagec_tree,indagec_grass,num_grass_mulagec,     &
+                       nagec_tree,nagec_herb,                    &
+                       vegagec_tree,veget_max,glcc_pft,glcc_pftmtc,glcc_pft_tmp,&
+                       glccRemain)
+      !g2c
+      CALL type_conversion(ipts,g2c,glccReal,veget_mtc,newvegfrac,       &
+                       indold_grass,indagec_grass,indagec_crop,num_crop_mulagec,     &
+                       nagec_herb,nagec_herb,                    &
+                       vegagec_grass,veget_max,glcc_pft,glcc_pftmtc,glcc_pft_tmp,&
+                       glccRemain)
+      !g2p
+      CALL type_conversion(ipts,g2p,glccReal,veget_mtc,newvegfrac,       &
+                       indold_grass,indagec_grass,indagec_pasture,num_pasture_mulagec,     &
+                       nagec_herb,nagec_herb,                    &
+                       vegagec_grass,veget_max,glcc_pft,glcc_pftmtc,glcc_pft_tmp,&
+                       glccRemain)
+      !g2f
+      CALL type_conversion(ipts,g2f,glccReal,veget_mtc,newvegfrac,       &
+                       indold_grass,indagec_grass,indagec_tree,num_tree_mulagec,     &
+                       nagec_herb,nagec_tree,                    &
+                       vegagec_grass,veget_max,glcc_pft,glcc_pftmtc,glcc_pft_tmp,&
+                       glccRemain)
+      !p2c
+      CALL type_conversion(ipts,p2c,glccReal,veget_mtc,newvegfrac,       &
+                       indold_pasture,indagec_pasture,indagec_crop,num_crop_mulagec,     &
+                       nagec_herb,nagec_herb,                    &
+                       vegagec_pasture,veget_max,glcc_pft,glcc_pftmtc,glcc_pft_tmp,&
+                       glccRemain)
+      !p2g
+      CALL type_conversion(ipts,p2g,glccReal,veget_mtc,newvegfrac,       &
+                       indold_pasture,indagec_pasture,indagec_grass,num_grass_mulagec,     &
+                       nagec_herb,nagec_herb,                    &
+                       vegagec_pasture,veget_max,glcc_pft,glcc_pftmtc,glcc_pft_tmp,&
+                       glccRemain)
+      !p2f
+      CALL type_conversion(ipts,p2f,glccReal,veget_mtc,newvegfrac,       &
+                       indold_pasture,indagec_pasture,indagec_tree,num_tree_mulagec,     &
+                       nagec_herb,nagec_tree,                    &
+                       vegagec_pasture,veget_max,glcc_pft,glcc_pftmtc,glcc_pft_tmp,&
+                       glccRemain)
+      !c2p
+      CALL type_conversion(ipts,c2p,glccReal,veget_mtc,newvegfrac,       &
+                       indold_crop,indagec_crop,indagec_pasture,num_pasture_mulagec,     &
+                       nagec_herb,nagec_herb,                    &
+                       vegagec_crop,veget_max,glcc_pft,glcc_pftmtc,glcc_pft_tmp,&
+                       glccRemain)
+      !c2g
+      CALL type_conversion(ipts,c2g,glccReal,veget_mtc,newvegfrac,       &
+                       indold_crop,indagec_crop,indagec_grass,num_grass_mulagec,     &
+                       nagec_herb,nagec_herb,                    &
+                       vegagec_crop,veget_max,glcc_pft,glcc_pftmtc,glcc_pft_tmp,&
+                       glccRemain)
+      !c2f
+      CALL type_conversion(ipts,c2f,glccReal,veget_mtc,newvegfrac,       &
+                       indold_crop,indagec_crop,indagec_tree,num_tree_mulagec,     &
+                       nagec_herb,nagec_tree,                    &
+                       vegagec_crop,veget_max,glcc_pft,glcc_pftmtc,glcc_pft_tmp,&
+                       glccRemain)
+    ENDDO
+   
+    WHERE (glccRemain .GT. zero) 
+      glccReal = glcc - glccRemain
+      IncreDeficit = -1 * glccRemain
+    ENDWHERE 
+
+  END SUBROUTINE SinAgeC_fh_firstday
+
+END MODULE stomate_fharvest_SinAgeC
Index: /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_stomate/stomate_glcc_Bioe1.f90
===================================================================
--- /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_stomate/stomate_glcc_Bioe1.f90	(revision 6940)
+++ /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_stomate/stomate_glcc_Bioe1.f90	(revision 6940)
@@ -0,0 +1,830 @@
+! Remove definition of type_conversion
+
+! =================================================================================================================================
+! MODULE       : stomate_glcc_bioe1
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF       This module implements gross land use change with age classes.
+!!
+!!\n DESCRIPTION: None
+!!
+!! RECENT CHANGE(S): Including permafrost carbon
+!!
+!! REFERENCE(S)	: None
+!!
+!! SVN          :
+!! $HeadURL: svn://forge.ipsl.jussieu.fr/orchidee/perso/albert.jornet/ORCHIDEE-MICT/src_stomate/stomate_lcchange.f90 $
+!! $Date: 2015-07-30 15:38:45 +0200 (Thu, 30 Jul 2015) $
+!! $Revision: 2847 $
+!! \n
+!_ ================================================================================================================================
+
+
+MODULE stomate_glcc_bioe1
+
+  ! modules used:
+  
+  USE ioipsl_para
+  USE stomate_data
+  USE pft_parameters
+  USE constantes
+  USE constantes_soil_var
+  USE stomate_gluc_common
+  USE stomate_gluc_constants
+  USE stomate_glcchange_MulAgeC
+  USE xios_orchidee
+
+  IMPLICIT NONE
+  
+  PRIVATE
+  PUBLIC glcc_bioe1_firstday, glcc_bioe1 
+  
+CONTAINS
+
+! ================================================================================================================================
+!! SUBROUTINE   gross_lcchange
+!!
+!>\BRIEF       : Apply gross land cover change.
+!!
+!>\DESCRIPTION  
+!_ ================================================================================================================================
+  SUBROUTINE glcc_bioe1 (npts, dt_days, newvegfrac,  &
+               glccSecondShift,&
+               def_fuel_1hr_remain, def_fuel_10hr_remain,        &
+               def_fuel_100hr_remain, def_fuel_1000hr_remain,    &
+               deforest_litter_remain, deforest_biomass_remain,  &
+               convflux, cflux_prod10, cflux_prod100,                  &
+               glcc_pft, glcc_pftmtc,          &
+               veget_max, prod10, prod100, flux10, flux100,            &
+               PFTpresent, senescence, moiavail_month, moiavail_week,  &
+               gpp_week, ngd_minus5, resp_maint, resp_growth,          & 
+               resp_hetero, npp_daily, when_growthinit, npp_longterm,  &
+               ind, lm_lastyearmax, everywhere, age,                   &
+               co2_to_bm, gpp_daily, co2_fire,                         &
+               time_hum_min, gdd_midwinter, gdd_from_growthinit,       &
+               gdd_m5_dormance, ncd_dormance,                          &
+               lignin_struc, carbon, leaf_frac,                        &
+               deepC_a, deepC_s, deepC_p,                              &
+               leaf_age, bm_to_litter, biomass, litter,                &
+               fuel_1hr, fuel_10hr, fuel_100hr, fuel_1000hr)
+  
+    IMPLICIT NONE
+
+    !! 0.1 Input variables
+
+    INTEGER, INTENT(in)                                  :: npts             !! Domain size - number of pixels (unitless)
+    REAL(r_std), INTENT(in)                              :: dt_days          !! Time step of vegetation dynamics for stomate
+    REAL(r_std), DIMENSION (npts,12),INTENT(in)        :: glccSecondShift     !! the land-cover-change (LCC) matrix in case a gross LCC is 
+                                                                              !! used.
+    REAL(r_std), DIMENSION (npts,nvmap),INTENT(in)       :: newvegfrac             !! 
+                                                                             !! 
+
+    REAL(r_std), DIMENSION(npts,nvm,nlitt,nelements), INTENT(in)                 :: def_fuel_1hr_remain
+    REAL(r_std), DIMENSION(npts,nvm,nlitt,nelements), INTENT(in)                 :: def_fuel_10hr_remain
+    REAL(r_std), DIMENSION(npts,nvm,nlitt,nelements), INTENT(in)                 :: def_fuel_100hr_remain
+    REAL(r_std), DIMENSION(npts,nvm,nlitt,nelements), INTENT(in)                 :: def_fuel_1000hr_remain
+    REAL(r_std), DIMENSION(npts,nlitt,nvm,nlevs,nelements), INTENT(in) :: deforest_litter_remain   !! Vegetmax-weighted remaining litter on the ground for 
+                                                                                                      !! deforestation region.
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(in)      :: deforest_biomass_remain  !! Vegetmax-weighted remaining biomass on the ground for 
+                                                                                                      !! deforestation region.
+
+
+    !! 0.2 Output variables
+    REAL(r_std), DIMENSION(npts,nwp), INTENT(out)            :: convflux         !! release during first year following land cover
+                                                                             !! change
+    REAL(r_std), DIMENSION(npts,nwp), INTENT(out)            :: cflux_prod10     !! total annual release from the 10 year-turnover
+                                                                             !! pool @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(npts,nwp), INTENT(out)            :: cflux_prod100    !! total annual release from the 100 year-
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)      :: glcc_pft         !! Loss of fraction in each PFT
+    REAL(r_std), DIMENSION(npts,nvm,nvmap), INTENT(inout):: glcc_pftmtc      !! a temporary variable to hold the fractions each PFT is going to lose
+                                                                             !! i.e., the contribution of each PFT to the youngest age-class of MTC
+
+    !! 0.3 Modified variables
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)      :: veget_max        !! "maximal" coverage fraction of a PFT (LAI ->
+                                                                             !! infinity) on ground (unitless) 
+    REAL(r_std), DIMENSION(npts,0:10,nwp), INTENT(inout)     :: prod10           !! products remaining in the 10 year-turnover
+                                                                             !! pool after the annual release for each 
+                                                                             !! compartment (10 + 1 : input from year of land
+                                                                             !! cover change)
+    REAL(r_std), DIMENSION(npts,0:100,nwp), INTENT(inout)    :: prod100          !! products remaining in the 100 year-turnover
+                                                                             !! pool after the annual release for each 
+                                                                             !! compartment (100 + 1 : input from year of land
+                                                                             !! cover change)
+    REAL(r_std), DIMENSION(npts,10,nwp), INTENT(inout)       :: flux10           !! annual release from the 10/100 year-turnover 
+                                                                             !! pool compartments
+    REAL(r_std), DIMENSION(npts,100,nwp), INTENT(inout)      :: flux100          !! annual release from the 10/100 year-turnover
+                                                                             !! pool compartments
+    LOGICAL, DIMENSION(:,:), INTENT(inout)               :: PFTpresent       !! Tab indicating which PFTs are present in 
+                                                                             !! each pixel
+    LOGICAL, DIMENSION(:,:), INTENT(inout)               :: senescence       !! Flag for setting senescence stage (only 
+                                                                             !! for deciduous trees)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: moiavail_month   !! "Monthly" moisture availability (0 to 1, 
+                                                                             !! unitless) 
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: moiavail_week    !! "Weekly" moisture availability 
+                                                                             !! (0 to 1, unitless)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: gpp_week         !! Mean weekly gross primary productivity 
+                                                                             !! @tex $(gC m^{-2} day^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: ngd_minus5       !! Number of growing days (days), threshold 
+                                                                             !! -5 deg C (for phenology)   
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: resp_maint       !! Maintenance respiration  
+                                                                             !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: resp_growth      !! Growth respiration  
+                                                                             !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: resp_hetero      !! Heterotrophic respiration  
+                                                                             !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: npp_daily        !! Net primary productivity 
+                                                                             !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: when_growthinit  !! How many days ago was the beginning of 
+                                                                             !! the growing season (days)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: npp_longterm     !! "Long term" mean yearly primary productivity 
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: ind              !! Number of individuals at the stand level
+                                                                             !! @tex $(m^{-2})$ @endtex 
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: lm_lastyearmax   !! last year's maximum leaf mass for each PFT 
+                                                                             !! @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: everywhere       !! is the PFT everywhere in the grid box or 
+                                                                             !! very localized (after its introduction) (?)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: age              !! mean age (years)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: co2_to_bm        !! CO2 taken from the atmosphere to get C to create  
+                                                                             !! the seedlings @tex (gC.m^{-2}dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: gpp_daily        !! Daily gross primary productivity  
+                                                                             !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: co2_fire         !! Fire carbon emissions
+                                                                             !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: time_hum_min     !! Time elapsed since strongest moisture 
+                                                                             !! availability (days) 
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: gdd_midwinter    !! Growing degree days (K), since midwinter 
+                                                                             !! (for phenology) - this is written to the
+                                                                             !!  history files 
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: gdd_from_growthinit !! growing degree days, since growthinit 
+                                                                             !! for crops
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: gdd_m5_dormance  !! Growing degree days (K), threshold -5 deg 
+                                                                             !! C (for phenology)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: ncd_dormance     !! Number of chilling days (days), since 
+                                                                             !! leaves were lost (for phenology) 
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)         :: lignin_struc     !! ratio Lignine/Carbon in structural litter,
+                                                                             !! above and below ground
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)         :: carbon           !! carbon pool: active, slow, or passive 
+                                                                             !! @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)         :: deepC_a          !! Permafrost soil carbon (g/m**3) active
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)         :: deepC_s          !! Permafrost soil carbon (g/m**3) slow
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)         :: deepC_p          !! Permafrost soil carbon (g/m**3) passive
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)         :: leaf_frac        !! fraction of leaves in leaf age class (unitless;0-1)
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)         :: leaf_age         !! Leaf age (days)
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout)       :: bm_to_litter     !! Transfer of biomass to litter 
+                                                                             !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout)       :: biomass          !! Stand level biomass @tex $(gC.m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(:,:,:,:,:), INTENT(inout)     :: litter           !! metabolic and structural litter, above and 
+                                                                             !! below ground @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout)       :: fuel_1hr
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout)       :: fuel_10hr
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout)       :: fuel_100hr
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout)       :: fuel_1000hr
+
+    !! 0.4 Local variables
+    REAL(r_std), DIMENSION(nvmap,nparts,nelements)             :: bm_to_litter_pro !! conversion of biomass to litter 
+                                                                             !! @tex ($gC m^{-2} day^{-1}$) @endtex
+    REAL(r_std), DIMENSION(nvmap,nparts,nelements)             :: biomass_pro      !! biomass @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(nvmap)                        :: veget_max_pro    !! "maximal" coverage fraction of a PFT (LAI ->
+                                                                             !! infinity) on ground (unitless) 
+    REAL(r_std), DIMENSION(nvmap,ncarb)                        :: carbon_pro       !! carbon pool: active, slow, or passive 
+                                                                             !! @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(nvmap,ndeep)                        :: deepC_a_pro      !! Permafrost carbon pool: active, slow, or passive 
+                                                                             !! @tex ($gC m^{-3}$) @endtex
+    REAL(r_std), DIMENSION(nvmap,ndeep)                        :: deepC_s_pro      !! Permafrost carbon pool: active, slow, or passive 
+                                                                             !! @tex ($gC m^{-3}$) @endtex
+    REAL(r_std), DIMENSION(nvmap,ndeep)                        :: deepC_p_pro      !! Permafrost carbon pool: active, slow, or passive 
+                                                                             !! @tex ($gC m^{-3}$) @endtex
+    REAL(r_std), DIMENSION(nvmap,nlitt,nlevs,nelements)        :: litter_pro       !! metabolic and structural litter, above and 
+                                                                             !! below ground @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(nvmap,nlitt,nelements)              :: fuel_1hr_pro
+    REAL(r_std), DIMENSION(nvmap,nlitt,nelements)              :: fuel_10hr_pro
+    REAL(r_std), DIMENSION(nvmap,nlitt,nelements)              :: fuel_100hr_pro
+    REAL(r_std), DIMENSION(nvmap,nlitt,nelements)              :: fuel_1000hr_pro
+    REAL(r_std), DIMENSION(nvmap,nlevs)                        :: lignin_struc_pro !! ratio Lignine/Carbon in structural litter
+                                                                             !! above and below ground
+    REAL(r_std), DIMENSION(nvmap,nleafages)                    :: leaf_frac_pro    !! fraction of leaves in leaf age class 
+    REAL(r_std), DIMENSION(nvmap,nleafages)                    :: leaf_age_pro     !! fraction of leaves in leaf age class 
+    LOGICAL, DIMENSION(nvmap)                :: PFTpresent_pro, senescence_pro                 !! Is pft there (unitless)
+    REAL(r_std), DIMENSION(nvmap)            :: ind_pro, age_pro, lm_lastyearmax_pro, npp_longterm_pro
+    REAL(r_std), DIMENSION(nvmap)            :: everywhere_pro
+    REAL(r_std), DIMENSION(nvmap)            :: gpp_daily_pro, npp_daily_pro, co2_to_bm_pro
+    REAL(r_std), DIMENSION(nvmap)            :: resp_maint_pro, resp_growth_pro
+    REAL(r_std), DIMENSION(nvmap)            :: resp_hetero_pro, co2_fire_pro
+  
+    INTEGER                :: ipts,ivm,ivma,l,m,ipft_young_agec
+    CHARACTER(LEN=10)      :: part_str                               !! string suffix indicating an index
+
+    REAL(r_std), DIMENSION(npts,nvmap)       :: glcc_mtc             !! Increase in fraction of each MTC in its youngest age-class
+    REAL(r_std), DIMENSION(npts,nvm)         :: glccReal_tmp         !! A temporary variable
+
+    WRITE(numout,*) 'Entering glcc_MulAgeC'
+    glccReal_tmp(:,:) = zero
+
+    CALL glcc_bioe1_firstday(npts,veget_max,newvegfrac,   &
+                          glccSecondShift,glcc_pft,glcc_pftmtc)
+
+    glcc_mtc(:,:) = SUM(glcc_pftmtc,DIM=2)
+
+    DO ipts=1,npts
+
+      !! Initialize the _pro variables
+      bm_to_litter_pro(:,:,:)=zero                                                
+      biomass_pro(:,:,:)=zero
+      veget_max_pro(:)=zero                                                       
+      carbon_pro(:,:)=zero                                                        
+      deepC_a_pro(:,:)=zero                                                       
+      deepC_s_pro(:,:)=zero                                                       
+      deepC_p_pro(:,:)=zero                                                       
+      litter_pro(:,:,:,:)=zero                                                    
+      fuel_1hr_pro(:,:,:)=zero                                                    
+      fuel_10hr_pro(:,:,:)=zero                                                   
+      fuel_100hr_pro(:,:,:)=zero                                                  
+      fuel_1000hr_pro(:,:,:)=zero                                                 
+      lignin_struc_pro(:,:)=zero                                                  
+
+      leaf_frac_pro = zero
+      leaf_age_pro = zero
+      PFTpresent_pro(:) = .FALSE.
+      senescence_pro(:) = .TRUE.
+      ind_pro = zero
+      age_pro = zero
+      lm_lastyearmax_pro = zero
+      npp_longterm_pro = zero
+      everywhere_pro = zero
+      
+      gpp_daily_pro=zero                                                       
+      npp_daily_pro=zero                                                       
+      co2_to_bm_pro=zero                                                       
+      resp_maint_pro=zero                                                      
+      resp_growth_pro=zero                                                     
+      resp_hetero_pro=zero                                                     
+      co2_fire_pro=zero                                                        
+
+      ! Note that we assume people don't intentionally change baresoil to 
+      ! vegetated land.
+      DO ivma = 2,nvmap
+
+        ! here we set glcc_mtc(ipts,ivma) > min_stomate as a condition,
+        ! this is necessary because later on in the subroutine of 
+        ! add_incoming_proxy_pft we have to merge the newly established
+        ! youngest proxy with potentially exisiting youngest receiving MTC,
+        ! thus have to devide a new fraction of (frac_proxy + frac_exist),
+        ! but in case frac_exist = zero, we risk deviding by a very small value
+        ! of frac_proxy and thus we want it to be bigger than min_stomate.
+        IF ( glcc_mtc(ipts,ivma) .GT. min_stomate ) THEN
+
+          ! 1. we accumulate the scalar variables that will be inherited.
+          !    note that in the subroutine of `collect_legacy_pft`, all
+          !    zero transitions will be automatically skipped. 
+          CALL collect_legacy_pft(npts, ipts, ivma, glcc_pftmtc,    &
+                  biomass, bm_to_litter, carbon, litter,            &
+                  deepC_a, deepC_s, deepC_p,                        &
+                  fuel_1hr, fuel_10hr, fuel_100hr, fuel_1000hr,     &
+                  lignin_struc, co2_to_bm, gpp_daily, npp_daily,    &
+                  resp_maint, resp_growth, resp_hetero, co2_fire,   &
+                  def_fuel_1hr_remain, def_fuel_10hr_remain,        &
+                  def_fuel_100hr_remain, def_fuel_1000hr_remain,    &
+                  deforest_litter_remain, deforest_biomass_remain,  &
+                  veget_max_pro(ivma), carbon_pro(ivma,:),          &
+                  lignin_struc_pro(ivma,:), litter_pro(ivma,:,:,:), &
+                  deepC_a_pro(ivma,:), deepC_s_pro(ivma,:), deepC_p_pro(ivma,:), &
+                  fuel_1hr_pro(ivma,:,:), fuel_10hr_pro(ivma,:,:),  &
+                  fuel_100hr_pro(ivma,:,:), fuel_1000hr_pro(ivma,:,:), &
+                  bm_to_litter_pro(ivma,:,:), co2_to_bm_pro(ivma),  &
+                  gpp_daily_pro(ivma), npp_daily_pro(ivma),         &
+                  resp_maint_pro(ivma), resp_growth_pro(ivma),      &
+                  resp_hetero_pro(ivma), co2_fire_pro(ivma),        &
+                  convflux,prod10,prod100)
+
+          !++TEMP++
+          ! Here we substract the outgoing fraction from the source PFT.
+          ! If a too small fraction remains in this source PFT, then it is
+          ! exhausted, we empty it. The subroutine 'empty_pft' might be 
+          ! combined with 'collect_legacy_pft', but now we just put it here.
+          DO ivm = 1,nvm
+            IF( glcc_pftmtc(ipts,ivm,ivma)>zero ) THEN
+              veget_max(ipts,ivm) = veget_max(ipts,ivm)-glcc_pftmtc(ipts,ivm,ivma)
+              IF ( veget_max(ipts,ivm)<min_stomate ) THEN
+                CALL empty_pft(ipts, ivm, veget_max, biomass, ind,       &
+                       carbon, litter, lignin_struc, bm_to_litter,       &
+                       deepC_a, deepC_s, deepC_p,                        &
+                       fuel_1hr, fuel_10hr, fuel_100hr, fuel_1000hr,     &
+                       gpp_daily, npp_daily, gpp_week, npp_longterm,     &
+                       co2_to_bm, resp_maint, resp_growth, resp_hetero,  &
+                       lm_lastyearmax, leaf_frac, leaf_age, age,         &
+                       everywhere, PFTpresent, when_growthinit,          &
+                       senescence, gdd_from_growthinit, gdd_midwinter,   &
+                       time_hum_min, gdd_m5_dormance, ncd_dormance,      &
+                       moiavail_month, moiavail_week, ngd_minus5)
+              ENDIF
+            ENDIF
+          ENDDO
+
+        ENDIF !IF ( glcc_mtc(ipts,ivma) .GT. min_stomate )
+      ENDDO ! (DO ivma = 2,nvmap)
+
+      ! We can only establish new youngest proxy and add it to the 
+      ! existing youngest-age PFT after all wood product extraction is done, to 
+      ! avoid the dilution of extractable biomass by the young proxy
+      ! and ensure consistency. Therefore now we have to loop again
+      ! over nvmap.
+      DO ivma = 2,nvmap
+        !IF ( glcc_mtc(ipts,ivma) .GT. min_stomate ) THEN
+
+          ipft_young_agec = start_index(ivma)
+
+          ! 2. we establish a proxy PFT with the fraction of veget_max_pro,
+          !    which is going to be either merged with existing target 
+          !    `ipft_young_agec` PFT, or fill the place if no existing target PFT
+          !    exits.
+          CALL initialize_proxy_pft(ipts,ipft_young_agec,veget_max_pro(ivma), &
+                 biomass_pro(ivma,:,:), co2_to_bm_pro(ivma), ind_pro(ivma),   &
+                 age_pro(ivma),                                               & 
+                 senescence_pro(ivma), PFTpresent_pro(ivma),                  &
+                 lm_lastyearmax_pro(ivma), everywhere_pro(ivma),              &
+                 npp_longterm_pro(ivma),                                      &
+                 leaf_frac_pro(ivma,:),leaf_age_pro(ivma,:))
+
+          CALL sap_take (ipts,ivma,veget_max,biomass_pro(ivma,:,:), &
+                         biomass,co2_to_bm_pro(ivma))
+
+          ! 3. we merge the newly initiazlized proxy PFT into existing one
+          !    or use it to fill an empty PFT slot.
+          CALL add_incoming_proxy_pft(npts, ipts, ipft_young_agec, veget_max_pro(ivma),&
+                 carbon_pro(ivma,:), litter_pro(ivma,:,:,:), lignin_struc_pro(ivma,:), &
+                 bm_to_litter_pro(ivma,:,:),    &
+                 deepC_a_pro(ivma,:), deepC_s_pro(ivma,:), deepC_p_pro(ivma,:), &
+                 fuel_1hr_pro(ivma,:,:), fuel_10hr_pro(ivma,:,:),               &
+                 fuel_100hr_pro(ivma,:,:), fuel_1000hr_pro(ivma,:,:),           &
+                 biomass_pro(ivma,:,:), co2_to_bm_pro(ivma),                    &
+                 npp_longterm_pro(ivma), ind_pro(ivma),                         &
+                 lm_lastyearmax_pro(ivma), age_pro(ivma), everywhere_pro(ivma), &  
+                 leaf_frac_pro(ivma,:), leaf_age_pro(ivma,:),                   &
+                 PFTpresent_pro(ivma), senescence_pro(ivma),                &
+                 gpp_daily_pro(ivma), npp_daily_pro(ivma),                      &
+                 resp_maint_pro(ivma), resp_growth_pro(ivma),                   &
+                 resp_hetero_pro(ivma), co2_fire_pro(ivma),                     &
+                 veget_max, carbon, litter, lignin_struc, bm_to_litter,         &
+                 deepC_a, deepC_s, deepC_p,                                     &
+                 fuel_1hr, fuel_10hr, fuel_100hr, fuel_1000hr,                  &
+                 biomass, co2_to_bm, npp_longterm, ind,                         &
+                 lm_lastyearmax, age, everywhere,                               &
+                 leaf_frac, leaf_age, PFTpresent, senescence,                   &
+                 gpp_daily, npp_daily, resp_maint, resp_growth,                 &
+                 resp_hetero, co2_fire)
+          
+        !ENDIF !IF ( glcc_mtc(ipts,ivma) .GT. min_stomate )
+      ENDDO !(DO ivma=1,nvmap)
+
+    ENDDO !(DO ipts=1,npts)
+
+    !! Update 10 year-turnover pool content following flux emission
+    !!     (linear decay (10%) of the initial carbon input)
+    DO  l = 0, 8
+      m = 10 - l
+      cflux_prod10(:,:) =  cflux_prod10(:,:) + flux10(:,m,:)
+      prod10(:,m,:)     =  prod10(:,m-1,:)   - flux10(:,m-1,:)
+      flux10(:,m,:)     =  flux10(:,m-1,:)
+    ENDDO
+    
+    cflux_prod10(:,:) = cflux_prod10(:,:) + flux10(:,1,:) 
+    flux10(:,1,:)     = 0.1 * prod10(:,0,:)
+    prod10(:,1,:)     = prod10(:,0,:)
+    
+    !! 2.4.3 update 100 year-turnover pool content following flux emission\n
+    DO l = 0, 98
+       m = 100 - l
+       cflux_prod100(:,:)  =  cflux_prod100(:,:) + flux100(:,m,:)
+       prod100(:,m,:)      =  prod100(:,m-1,:)   - flux100(:,m-1,:)
+       flux100(:,m,:)      =  flux100(:,m-1,:)
+    ENDDO
+    
+    cflux_prod100(:,:)  = cflux_prod100(:,:) + flux100(:,1,:) 
+    flux100(:,1,:)      = 0.01 * prod100(:,0,:)
+    prod100(:,1,:)      = prod100(:,0,:)
+    prod10(:,0,:)        = zero
+    prod100(:,0,:)       = zero 
+
+    ! Write out history files
+    CALL histwrite_p (hist_id_stomate, 'glcc_pft', itime, &
+         glcc_pft, npts*nvm, horipft_index)
+    CALL xios_orchidee_send_field ('glcc_pft', glcc_pft)
+
+    DO ivma = 1, nvmap
+      WRITE(part_str,'(I2)') ivma
+      IF (ivma < 10) part_str(1:1) = '0'
+      CALL histwrite_p (hist_id_stomate, 'glcc_pftmtc_'//part_str(1:LEN_TRIM(part_str)), &
+           itime, glcc_pftmtc(:,:,ivma), npts*nvm, horipft_index)
+    ENDDO
+    CALL xios_orchidee_send_field ('glcc_pftmtc', glcc_pftmtc) ! kjpindex,nvm,nvmap
+
+  END SUBROUTINE glcc_bioe1
+
+
+! ================================================================================================================================
+!! SUBROUTINE   : glcc_bioe1_firstday
+!!
+!>\BRIEF        : When necessary, adjust input glcc matrix, and allocate it
+!!                into different contributing age classes and receiving 
+!!                youngest age classes.
+!! \n
+!_ ================================================================================================================================
+
+  ! Note: it has this name because this subroutine will also be called
+  ! the first day of each year to precalculate the forest loss for the
+  ! deforestation fire module.
+  SUBROUTINE glcc_bioe1_firstday(npts,veget_max_org,newvegfrac, &
+                          glccSecondShift, glcc_pft, glcc_pftmtc)
+
+    IMPLICIT NONE
+
+    !! 0.1 Input variables
+
+    INTEGER, INTENT(in)                                     :: npts           !! Domain size - number of pixels (unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)            :: veget_max_org  !! "maximal" coverage fraction of a PFT on the ground
+                                                                              !! May sum to
+                                                                              !! less than unity if the pixel has
+                                                                              !! nobio area. (unitless, 0-1)
+    REAL(r_std), DIMENSION(npts,nvmap), INTENT(in)          :: newvegfrac     !! used to guid the allocation of new PFTs.
+                                                                              !! 
+    REAL(r_std), DIMENSION (npts,12),INTENT(in)        :: glccSecondShift     !! the land-cover-change (LCC) matrix in case a gross LCC is 
+                                                                              !! used.
+
+    !! 0.2 Output variables
+    REAL(r_std), DIMENSION(npts,nvm,nvmap), INTENT(inout)   :: glcc_pftmtc    !! a temporary variable to hold the fractions each PFT is going to lose
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)         :: glcc_pft       !! Loss of fraction in each PFT
+
+    !! 0.3 Modified variables
+    
+    !! 0.4 Local variables
+    REAL(r_std), DIMENSION(npts,nvmap)              :: veget_mtc           !! "maximal" coverage fraction of a PFT on the ground
+    REAL(r_std), DIMENSION(npts,nvmap)              :: veget_mtc_begin     !! "maximal" coverage fraction of a PFT on the ground
+    REAL(r_std), DIMENSION(npts,nagec_tree)         :: vegagec_tree        !! fraction of tree age-class groups, in sequence of old->young
+    REAL(r_std), DIMENSION(npts,nagec_herb)         :: vegagec_grass       !! fraction of grass age-class groups, in sequence of old->young 
+    REAL(r_std), DIMENSION(npts,nagec_herb)         :: vegagec_pasture     !! fraction of pasture age-class groups, in sequence of old->young
+    REAL(r_std), DIMENSION(npts,nagec_herb)         :: vegagec_crop        !! fraction of crop age-class groups, in sequence of old->young
+    REAL(r_std), DIMENSION(npts,nagec_bioe1)        :: vegagec_bioe1       !! fraction of crop age-class groups, in sequence of old->young
+
+    
+    REAL(r_std), DIMENSION(npts,4)                  :: veget_4veg      !! "maximal" coverage fraction of a PFT on the ground
+    REAL(r_std), DIMENSION(npts)                    :: veget_tree      !! "maximal" coverage fraction of a PFT on the ground
+    REAL(r_std), DIMENSION(npts)                    :: veget_grass     !! "maximal" coverage fraction of a PFT on the ground
+    REAL(r_std), DIMENSION(npts)                    :: veget_pasture   !! "maximal" coverage fraction of a PFT on the ground
+    REAL(r_std), DIMENSION(npts)                    :: veget_crop      !! "maximal" coverage fraction of a PFT on the ground
+    REAL(r_std), DIMENSION(npts)                    :: veget_bioe1     !! "maximal" coverage fraction of a PFT on the ground
+
+    REAL(r_std), DIMENSION(npts,nvm)         :: veget_max              !! "maximal" coverage fraction of a PFT on the ground
+    REAL(r_std), DIMENSION(npts,nvm)         :: veget_max_old          !! "maximal" coverage fraction of a PFT on the ground
+    REAL(r_std), DIMENSION(npts,nvm)         :: glcc_pft_tmp           !! Loss of fraction in each PFT
+
+    REAL(r_std), DIMENSION(npts,nvm,nvmap)  :: glcc_pftmtc_SecShift   !! a temporary variable to hold the fractions each PFT is going to lose
+    REAL(r_std), DIMENSION(npts,12)      :: glccRealSecShift   !! real matrix applied for secondary shifting cultivation.
+    REAL(r_std), DIMENSION(npts,12)      :: glccDefSecShift    !! deficit for the glccSecondShift
+    REAL(r_std), DIMENSION(npts,12)         :: glccRemain      !! 
+    REAL(r_std), DIMENSION(npts,12)         :: glccSecondShift_remain      !! 
+
+    REAL(r_std), DIMENSION(npts,nvm)         :: glccReal_tmp         !! A temporary variable 
+
+    LOGICAL, SAVE  :: glcc_bioe1_firstday_done = .FALSE.
+
+    ! Different indexes for convenient local uses
+    INTEGER :: f_to_bioe1=1, g_to_bioe1=2, p_to_bioe1=3, c_to_bioe1=4, & 
+               bioe1_to_f=5, bioe1_to_g=6, bioe1_to_p=7, bioe1_to_c=8
+
+    INTEGER :: ivma
+
+    INTEGER :: ipts,IndStart_f,IndEnd_f
+    CHARACTER(LEN=10)      :: part_str                               !! string suffix indicating an index
+
+    !Some more local configurations
+    LOGICAL                                 :: allow_youngest_forest_convert = .TRUE.
+    
+    ! Initialization
+    glcc_pftmtc = zero
+    glcc_pft = zero
+    glcc_pft_tmp = zero
+
+    !!! ** Land cover change processes start here ** !!!
+    ! we make copies of original input veget_max (which is veget_max_org
+    ! in the subroutine parameter list).
+    ! veget_max will be modified through different operations in order to 
+    ! check various purposes, e.g., whether input glcc matrix 
+    ! is compatible with existing veget_max and how to allocate it etc.
+    ! veget_max_old will not be modified
+    veget_max(:,:) = veget_max_org(:,:)
+    veget_max_old(:,:) = veget_max_org(:,:)
+
+    !! 3. Treat secondary-agriculture shifting cultivation transition matrix
+    !! [The primary-agriculture shifting cultivation will be treated together
+    !!  with the netLCC transitions, with the conversion sequence of oldest->
+    !!  youngest is applied.]
+    ! When we prepare the driving data, secondary-agriculture shifting cultivation
+    ! is intended to include the "constant transitions" over time. Ideally, we
+    ! should start applying this secondary-agriculture shifting cultivation with
+    ! the "secondary forest" in the model. Here we tentatively start with the 3rd
+    ! youngest age class and move to the 2ne youngest age class. But if the prescribed
+    ! transition fraction is not met, we then move further to 4th youngest age class
+    ! and then move to the oldest age class sequentially.
+
+    CALL calc_cover_bioe1(npts,veget_max,veget_mtc_begin,vegagec_tree,vegagec_grass, &
+           vegagec_pasture,vegagec_crop,vegagec_bioe1)
+    veget_mtc = veget_mtc_begin
+ 
+    !! 3.1 We start treating secondary-agriculture cultivation from the 3rd youngest 
+    !! age class and then move to the younger age class. 
+    ! Because it's rather complicated to calculate which transtion fraction between
+    ! which vegetation types should occur in case there is deficit occuring
+    ! for the overall donation vegetation type, we will just start from some 
+    ! priority and leave the unrealized parts into the latter section.
+
+    ! For this purpose, we should first make a copy of glccSecondShift into 
+    ! glccRemain. glccRemain will tell us the transition fractions that have to
+    ! be treated starting from `IndStart_f+1` oldest age class and moving torward older
+    ! age class.
+    glccRemain(:,:) = glccSecondShift(:,:)
+
+    ! Now we will call type_conversion for each of the 12 transitions, starting
+    ! from `IndStart_f` age class moving to the 2nd youngest age class. We use glccRemain
+    ! to track the transtion fractions we should leave for the second case. 
+    ! To make the code more flexible, we will store the start and end indecies
+    ! in variables.
+
+    !*[Note: we do above process only for forest now, as we assume the conversion
+    !  of crop/pasture/grass to other types will start always from the oldest
+    !  age class]
+
+    IndStart_f = nagec_tree-1  ! note the indecies and vegetfrac for tree age class
+                               ! is from old to young
+    IndEnd_f = nagec_tree    ! nagec_tree-2: The 3rd youngest age class
+                               ! nagec_tree-1: The 2nd youngest age class
+                               ! nagec_tree: The youngest age class
+
+    IF (IndStart_f .LE. 0 .OR. IndEnd_f .LE. 0) THEN
+      write(numout,*) 'glcc_bioe1_firstday: Age class index cannot be negative or zero!'
+      STOP
+    ENDIF
+
+    DO ipts=1,npts
+      !f_to_bioe1
+      CALL type_conversion(ipts,f_to_bioe1,glccSecondShift,veget_mtc,newvegfrac,       &
+                       indold_tree,indagec_tree,indagec_bioe1,num_bioe1_mulagec,     &
+                       IndEnd_f,nagec_bioe1,                    &
+                       vegagec_tree,veget_max,glcc_pft,glcc_pftmtc,glcc_pft_tmp, &
+                       glccRemain, &
+                       .TRUE., iagec_start=IndStart_f)
+      !g_to_bioe1
+      CALL type_conversion(ipts,g_to_bioe1,glccSecondShift,veget_mtc,newvegfrac,       &
+                       indold_grass,indagec_grass,indagec_bioe1,num_bioe1_mulagec,     &
+                       nagec_herb,nagec_bioe1,                    &
+                       vegagec_grass,veget_max,glcc_pft,glcc_pftmtc,glcc_pft_tmp,&
+                       glccRemain, &
+                       .TRUE.)
+      !p_to_bioe1
+      CALL type_conversion(ipts,p_to_bioe1,glccSecondShift,veget_mtc,newvegfrac,       &
+                       indold_pasture,indagec_pasture,indagec_bioe1,num_bioe1_mulagec,     &
+                       nagec_herb,nagec_bioe1,                    &
+                       vegagec_pasture,veget_max,glcc_pft,glcc_pftmtc,glcc_pft_tmp,&
+                       glccRemain, &
+                       .TRUE.)
+      !c_to_bioe1
+      CALL type_conversion(ipts,c_to_bioe1,glccSecondShift,veget_mtc,newvegfrac,       &
+                       indold_crop,indagec_crop,indagec_bioe1,num_bioe1_mulagec,     &
+                       nagec_herb,nagec_bioe1,                    &
+                       vegagec_crop,veget_max,glcc_pft,glcc_pftmtc,glcc_pft_tmp,&
+                       glccRemain, &
+                       .TRUE.)
+      !bioe1_to_f
+      CALL type_conversion(ipts,bioe1_to_f,glccSecondShift,veget_mtc,newvegfrac,       &
+                       indold_bioe1,indagec_bioe1,indagec_tree,num_tree_mulagec,     &
+                       nagec_bioe1,nagec_tree,                    &
+                       vegagec_bioe1,veget_max,glcc_pft,glcc_pftmtc,glcc_pft_tmp,&
+                       glccRemain, &
+                       .TRUE.)
+      !bioe1_to_g
+      CALL type_conversion(ipts,bioe1_to_g,glccSecondShift,veget_mtc,newvegfrac,       &
+                       indold_bioe1,indagec_bioe1,indagec_grass,num_grass_mulagec,     &
+                       nagec_bioe1,nagec_herb,                    &
+                       vegagec_bioe1,veget_max,glcc_pft,glcc_pftmtc,glcc_pft_tmp,&
+                       glccRemain, &
+                       .TRUE.)
+      !bioe1_to_p
+      CALL type_conversion(ipts,bioe1_to_p,glccSecondShift,veget_mtc,newvegfrac,       &
+                       indold_bioe1,indagec_bioe1,indagec_pasture,num_pasture_mulagec,     &
+                       nagec_bioe1,nagec_herb,                    &
+                       vegagec_bioe1,veget_max,glcc_pft,glcc_pftmtc,glcc_pft_tmp,&
+                       glccRemain, &
+                       .TRUE.)
+      !bioe1_to_c
+      CALL type_conversion(ipts,bioe1_to_c,glccSecondShift,veget_mtc,newvegfrac,       &
+                       indold_bioe1,indagec_bioe1,indagec_crop,num_crop_mulagec,     &
+                       nagec_bioe1,nagec_herb,                    &
+                       vegagec_bioe1,veget_max,glcc_pft,glcc_pftmtc,glcc_pft_tmp,&
+                       glccRemain, &
+                       .TRUE.)
+    ENDDO
+    glccSecondShift_remain(:,:) = glccRemain(:,:)
+
+    !! 3.2 We treat the remaing unrealized transtions from forest. Now we will
+    !! start with the 3rd oldest age class and then move to the oldest age class. 
+
+    CALL calc_cover_bioe1(npts,veget_max,veget_mtc,vegagec_tree,vegagec_grass, &
+           vegagec_pasture,vegagec_crop,vegagec_bioe1)
+    veget_mtc = veget_mtc_begin
+ 
+    IndStart_f = nagec_tree  ! note the indecies and vegetfrac for tree age class
+                               ! is from old to young. 
+                               ! nagec_tree -3: The 4th youngest age class.
+
+    IndEnd_f = 1               ! oldest-age class forest.
+
+    IF (IndStart_f .LE. 0 .OR. IndEnd_f .LE. 0) THEN
+      write(numout,*) 'glcc_bioe1_firstday: Age class index cannot be negative or zero!'
+      STOP
+    ENDIF
+
+    ! we start with the 3rd youngest age class and move up to the oldest age
+    ! class in the sequence of young->old, as indicated by the .FALSE. parameter
+    ! when calling the subroutine type_conversion.
+    DO ipts=1,npts
+      !f_to_bioe1
+      CALL type_conversion(ipts,f_to_bioe1,glccSecondShift_remain,veget_mtc,newvegfrac,       &
+                       indold_tree,indagec_tree,indagec_bioe1,num_bioe1_mulagec,     &
+                       IndEnd_f,nagec_bioe1,                    &
+                       vegagec_tree,veget_max,glcc_pft,glcc_pftmtc,glcc_pft_tmp, &
+                       glccRemain, &
+                       .FALSE., iagec_start=IndStart_f)
+    ENDDO
+
+    IF (allow_youngest_forest_convert) THEN
+      !!++Temp++!!
+      !! this block of 3.3 could be commented to remove this process as desribed
+      !! below.
+
+      ! [2016-04-20] This is temporarily added: Normally we assume the youngest
+      ! forest age cohort will not be cut because in a shifting cultivation, they
+      ! are grown to let the land recover from agricultural process. (Or at least)
+      ! we can set the threshold of youngest age cohort to be very small. But there
+      ! are two reasons we allow the youngest forest cohort to be cut for shifting
+      ! cultivation purpose: a). Farmers may decide to harvest the wood of a forest
+      ! and then convert to crop. We don't simulate explicitly this process because 
+      ! this will depend on input land change matrix and land use data assumptions.
+      ! However,we can implicitly account for this by assuming "farmers plant young
+      ! trees after harvesting the wood, and immediately convert this young trees
+      ! to crops. b). For the sake of conserving the total sum of veget_max before
+      ! and after the transition as one, we need to allow the youngest forest cohort
+      ! eligible for cutting.
+
+      !! 3.3 We treat the remaing unrealized transtions from forest, allowing 
+      !! the youngest forest cohort to be cut. For this purpose, we will
+      !! start with the 2nd youngest age class and then move to the youngest one. 
+
+      glccSecondShift_remain(:,:) = glccRemain(:,:)
+
+      CALL calc_cover_bioe1(npts,veget_max,veget_mtc,vegagec_tree,vegagec_grass, &
+           vegagec_pasture,vegagec_crop,vegagec_bioe1)
+      veget_mtc = veget_mtc_begin
+ 
+      ! Note: the setting of index here must be consistent with those of 3.1 and 3.2
+      IndStart_f = nagec_tree-1  ! note the indecies and vegetfrac for tree age class
+                                 ! is from old to young. 
+                                 ! nagec_tree -1: The 2nd youngest age class.
+
+      IndEnd_f = nagec_tree      ! youngest class forest.
+
+      IF (IndStart_f .LE. 0 .OR. IndEnd_f .LE. 0) THEN
+        write(numout,*) 'glcc_bioe1_firstday: Age class index cannot be negative or zero!'
+        STOP
+      ENDIF
+
+      ! we start with the 3rd youngest age class and move up to the oldest age
+      ! class in the sequence of young->old, as indicated by the .FALSE. parameter
+      ! when calling the subroutine type_conversion.
+      DO ipts=1,npts
+        !f_to_bioe1
+        CALL type_conversion(ipts,f_to_bioe1,glccSecondShift_remain,veget_mtc,newvegfrac,       &
+                         indold_tree,indagec_tree,indagec_bioe1,num_bioe1_mulagec,     &
+                         IndEnd_f,nagec_bioe1,                    &
+                         vegagec_tree,veget_max,glcc_pft,glcc_pftmtc,glcc_pft_tmp, &
+                         glccRemain, &
+                         .FALSE., iagec_start=IndStart_f)
+      ENDDO
+      !! End of ++Temp++ Section 3.3
+    ENDIF
+
+    ! Final handling of some output variables.
+    ! we separate the glcc_pftmtc_SecShift
+    glcc_pftmtc_SecShift = glcc_pftmtc
+
+    ! we put the remaining glccRemain into the deficit
+    glccDefSecShift = -1 * glccRemain
+    glccRealSecShift = glccSecondShift - glccRemain
+
+    !*****end block to handle glcc involving bioenergy vegtation type *******
+
+    IF (.NOT. glcc_bioe1_firstday_done) THEN
+
+      glccReal_tmp = zero
+
+      glccReal_tmp(:,1:12) = glccRealSecShift
+      CALL histwrite_p (hist_id_stomate, 'glccRealSecShift', itime, &
+           glccReal_tmp, npts*nvm, horipft_index)
+      CALL xios_orchidee_send_field ('glccRealSecShift', glccReal_tmp) ! kjpindex,nvm
+
+      glccReal_tmp(:,1:12) = glccDefSecShift
+      CALL histwrite_p (hist_id_stomate, 'glccDefSecShift', itime, &
+           glccReal_tmp, npts*nvm, horipft_index)
+      CALL xios_orchidee_send_field ('glccDefSecShift', glccReal_tmp) ! kjpindex,nvm
+
+      DO ivma = 1, nvmap
+        WRITE(part_str,'(I2)') ivma
+        IF (ivma < 10) part_str(1:1) = '0'
+        CALL histwrite_p (hist_id_stomate, 'glcc_pftmtc_SF_'//part_str(1:LEN_TRIM(part_str)), &
+             itime, glcc_pftmtc_SecShift(:,:,ivma), npts*nvm, horipft_index)
+      ENDDO
+      CALL xios_orchidee_send_field ('glcc_pftmtc_SecShift', glcc_pftmtc_SecShift) ! kjpindex,nvm,nvmap
+
+      glcc_bioe1_firstday_done = .TRUE.
+    ENDIF
+
+  END SUBROUTINE glcc_bioe1_firstday
+
+  SUBROUTINE calc_cover_bioe1(npts,veget_max,veget_mtc,vegagec_tree,vegagec_grass, &
+                 vegagec_pasture,vegagec_crop,vegagec_bioe1)
+
+   
+    IMPLICIT NONE
+
+    !! Input variables
+    INTEGER, INTENT(in)                                       :: npts             !! Domain size - number of pixels (unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)         :: veget_max           !! "maximal" coverage fraction of a PFT on the ground
+
+    !! Output variables
+    REAL(r_std), DIMENSION(npts,nvmap), INTENT(inout)         :: veget_mtc        !! "maximal" coverage fraction of a PFT on the ground
+    REAL(r_std), DIMENSION(npts,nagec_tree), INTENT(inout)    :: vegagec_tree     !! fraction of tree age-class groups, in sequence of old->young
+    REAL(r_std), DIMENSION(npts,nagec_herb), INTENT(inout)    :: vegagec_grass    !! fraction of grass age-class groups, in sequence of old->young
+    REAL(r_std), DIMENSION(npts,nagec_herb), INTENT(inout)    :: vegagec_pasture  !! fraction of pasture age-class groups, in sequence of old->young
+    REAL(r_std), DIMENSION(npts,nagec_herb), INTENT(inout)    :: vegagec_crop     !! fraction of crop age-class groups, in sequence of old->young
+    REAL(r_std), DIMENSION(npts,nagec_bioe1), INTENT(inout)    :: vegagec_bioe1     !! fraction of bioenergy tree age-class groups, in sequence of old->young
+
+    !! Local variables
+    INTEGER(i_std)                                          :: ivma,staind,endind,j    !! indices (unitless)
+
+    veget_mtc(:,:) = 0.
+    vegagec_tree(:,:) = 0.
+    vegagec_grass(:,:) = 0.
+    vegagec_pasture(:,:) = 0.
+    vegagec_crop(:,:) = 0.
+    vegagec_bioe1(:,:) = 0.
+
+    ! Calculate veget_max for MTCs
+    DO ivma = 1,nvmap
+      staind = start_index(ivma)
+      IF (nagec_pft(ivma) == 1) THEN
+        veget_mtc(:,ivma) = veget_max(:,staind)
+      ELSE
+        veget_mtc(:,ivma) = \
+          SUM(veget_max(:,staind:staind+nagec_pft(ivma)-1),DIM=2)
+      ENDIF
+    ENDDO
+
+    ! Calculate veget_max for each age class
+    DO ivma = 2,nvmap  !here we start with 2 to exclude baresoil (always PFT1)
+      staind = start_index(ivma)
+      endind = staind+nagec_pft(ivma)-1
+
+      ! Single-age-class MTC goest to oldest age class.
+      IF (nagec_pft(ivma) == 1) THEN
+        WRITE(numout,*) "Error: metaclass has only a single age group: ",ivma
+        STOP
+      ELSE
+        IF (is_tree(staind)) THEN
+          DO j=1,nagec_tree
+            vegagec_tree(:,j) = vegagec_tree(:,j)+veget_max(:,endind-j+1)
+          ENDDO
+        ELSE IF (is_bioe1(staind)) THEN
+          DO j=1,nagec_bioe1
+            vegagec_bioe1(:,j) = vegagec_bioe1(:,j)+veget_max(:,endind-j+1)
+          ENDDO
+        ELSE IF (is_grassland_manag(staind)) THEN
+          DO j=1,nagec_herb
+            vegagec_pasture(:,j) = vegagec_pasture(:,j)+veget_max(:,endind-j+1)
+          ENDDO
+        ELSE IF (natural(staind)) THEN
+          DO j=1,nagec_herb
+            vegagec_grass(:,j) = vegagec_grass(:,j)+veget_max(:,endind-j+1)
+          ENDDO
+        ELSE
+          DO j=1,nagec_herb
+            vegagec_crop(:,j) = vegagec_crop(:,j)+veget_max(:,endind-j+1)
+          ENDDO
+        ENDIF
+      ENDIF
+    ENDDO
+
+  END SUBROUTINE calc_cover_bioe1
+
+END MODULE stomate_glcc_bioe1
Index: /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_stomate/stomate_glcchange_MulAgeC.f90
===================================================================
--- /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_stomate/stomate_glcchange_MulAgeC.f90	(revision 6940)
+++ /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_stomate/stomate_glcchange_MulAgeC.f90	(revision 6940)
@@ -0,0 +1,2086 @@
+! =================================================================================================================================
+! MODULE       : stomate_glcchange_MulAgeC
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF       This module implements gross land use change with age classes.
+!!
+!!\n DESCRIPTION: None
+!!
+!! RECENT CHANGE(S): Including permafrost carbon
+!!
+!! REFERENCE(S)	: None
+!!
+!! SVN          :
+!! $HeadURL: svn://forge.ipsl.jussieu.fr/orchidee/perso/albert.jornet/ORCHIDEE-MICT/src_stomate/stomate_lcchange.f90 $
+!! $Date: 2015-07-30 15:38:45 +0200 (Thu, 30 Jul 2015) $
+!! $Revision: 2847 $
+!! \n
+!_ ================================================================================================================================
+
+
+MODULE stomate_glcchange_MulAgeC
+
+  ! modules used:
+  
+  USE ioipsl_para
+  USE stomate_data
+  USE pft_parameters
+  USE constantes
+  USE constantes_soil_var
+  USE stomate_gluc_common
+  USE stomate_gluc_constants
+  USE xios_orchidee
+
+  IMPLICIT NONE
+  
+  PRIVATE
+  PUBLIC glcc_MulAgeC_firstday, glcc_MulAgeC, age_class_distr, type_conversion
+  
+CONTAINS
+
+! ================================================================================================================================
+!! SUBROUTINE   : age_class_distr
+!!
+!>\BRIEF        Redistribute biomass, litter, soilcarbon and water across
+!!              the age classes
+!!
+!! DESCRIPTION  : Following growth, the trees from an age class may have become
+!! too big to belong to this age class. The biomass, litter, soilcarbon and
+!! soil water then need to be moved from one age class to the next age class.
+!!
+!! RECENT CHANGE(S) : 
+!!
+!! MAIN OUTPUT VARIABLE(S) :  
+!!
+!! REFERENCES   : None
+!!
+!! FLOWCHART    : 
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE age_class_distr(npts, lalo, resolution, bound_spa, &  
+       biomass, veget_max, ind, &
+       lm_lastyearmax, leaf_frac, co2_to_bm, &
+       fuel_1hr, fuel_10hr, fuel_100hr, fuel_1000hr, &
+       everywhere, litter, carbon, lignin_struc, &
+       deepC_a, deepC_s, deepC_p, &
+       bm_to_litter, PFTpresent, when_growthinit,&
+       senescence, npp_longterm, gpp_daily, leaf_age, age, &
+       gdd_from_growthinit, gdd_midwinter, time_hum_min, hum_min_dormance, &
+       gdd_m5_dormance, &
+       ncd_dormance, moiavail_month, moiavail_week, ngd_minus5, &
+       gpp_week, resp_maint, resp_growth, npp_daily, resp_hetero)
+
+    IMPLICIT NONE
+    
+  !! 0. Variable and parameter declaration 
+    
+    !! 0.1 Input variables
+
+    INTEGER, INTENT(in)                                :: npts                !! Domain size - number of pixels (unitless)
+    REAL(r_std),DIMENSION(npts,2),INTENT(in)                   :: lalo                 !! Geographical coordinates (latitude,longitude)
+                                                                                       !! for pixels (degrees)
+    REAL(r_std), DIMENSION(npts,2), INTENT(in)                 :: resolution           !! Resolution at each grid point (m)  
+                                                                                       !! [1=E-W, 2=N-S] 
+
+    !! 0.2 Output variables
+
+
+    !! 0.3 Modified variables
+
+    LOGICAL, DIMENSION(:,:), INTENT(inout)             :: PFTpresent          !! Tab indicating which PFTs are present in 
+                                                                              !! each pixel
+    LOGICAL, DIMENSION(:,:), INTENT(inout)             :: senescence          !! Flag for setting senescence stage (only 
+                                                                              !! for deciduous trees)
+     REAL(r_std), DIMENSION(:,:), INTENT(inout)        :: moiavail_month      !! "Monthly" moisture availability (0 to 1, 
+                                                                              !! unitless) 
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: moiavail_week       !! "Weekly" moisture availability 
+                                                                              !! (0 to 1, unitless)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: gpp_week            !! Mean weekly gross primary productivity 
+                                                                              !! @tex $(gC m^{-2} day^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: ngd_minus5          !! Number of growing days (days), threshold 
+                                                                              !! -5 deg C (for phenology)   
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: resp_maint          !! Maintenance respiration  
+                                                                              !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: resp_growth         !! Growth respiration  
+                                                                              !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: npp_daily           !! Net primary productivity 
+                                                                              !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: resp_hetero           !! Net primary productivity 
+                                                                              !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: when_growthinit     !! How many days ago was the beginning of 
+                                                                              !! the growing season (days)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: npp_longterm        !! "Long term" mean yearly primary productivity 
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: ind                 !! Number of individuals at the stand level
+                                                                              !! @tex $(m^{-2})$ @endtex 
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: veget_max           !! "maximal" coverage fraction of a PFT on the ground
+                                                                              !! May sum to
+                                                                              !! less than unity if the pixel has
+                                                                              !! nobio area. (unitless, 0-1)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: lm_lastyearmax      !! last year's maximum leaf mass for each PFT 
+                                                                              !! @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: everywhere          !! is the PFT everywhere in the grid box or 
+                                                                              !! very localized (after its introduction) (?)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: co2_to_bm           !! CO2 taken from the atmosphere to get C to create  
+                                                                              !! the seedlings @tex (gC.m^{-2}dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: gpp_daily           !! Daily gross primary productivity  
+                                                                              !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: time_hum_min        !! Time elapsed since strongest moisture 
+                                                                              !! availability (days) 
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: hum_min_dormance    !! minimum moisture during dormance 
+                                                                              !! (0-1, unitless)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: gdd_midwinter       !! Growing degree days (K), since midwinter 
+                                                                              !! (for phenology) - this is written to the
+                                                                              !!  history files 
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: gdd_from_growthinit !! growing degree days, since growthinit 
+                                                                              !! for crops
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: gdd_m5_dormance     !! Growing degree days (K), threshold -5 deg 
+                                                                              !! C (for phenology)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: ncd_dormance        !! Number of chilling days (days), since 
+                                                                              !! leaves were lost (for phenology) 
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)       :: lignin_struc        !! ratio Lignine/Carbon in structural litter,
+                                                                              !! above and below ground
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)       :: carbon              !! carbon pool: active, slow, or passive 
+                                                                              !! @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)       :: deepC_a             !! Permafrost soil carbon (g/m**3) active
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)       :: deepC_s             !! Permafrost soil carbon (g/m**3) slow
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)       :: deepC_p             !! Permafrost soil carbon (g/m**3) passive
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: age                 !! Age (years)    
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)       :: leaf_frac           !! fraction of leaves in leaf age class (unitless;0-1)
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)       :: leaf_age            !! Leaf age (days)
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout)     :: bm_to_litter        !! Transfer of biomass to litter 
+                                                                              !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout)     :: biomass             !! Stand level biomass @tex $(gC.m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(:,:,:,:,:), INTENT(inout)   :: litter              !! metabolic and structural litter, above and 
+                                                                              !! below ground @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout)     :: fuel_1hr
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout)     :: fuel_10hr
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout)     :: fuel_100hr
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout)     :: fuel_1000hr
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: bound_spa           !! Spatial age class boundaries.
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                     :: ipts,ivm,igroup     !! Indeces(unitless)
+    INTEGER(i_std)                                     :: iele,ipar,ipft      !! Indeces(unitless)
+    INTEGER(i_std)                                     :: iagec,imbc,icirc    !! Indeces(unitless)
+    INTEGER(i_std)                                     :: ilit,ilev,icarb     !! Indeces(unitless)
+    INTEGER(i_std)                                     :: ivma                !! Indeces(unitless)
+    REAL(r_std)                                        :: share_expanded      !! Share of the veget_max of the existing vegetation
+                                                                              !! within a PFT over the total veget_max following 
+                                                                              !! expansion of that PFT (unitless, 0-1)
+                                                                              !! @tex $(ind m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nmbcomp,nelements) :: check_intern        !! Contains the components of the internal
+                                                                              !! mass balance chech for this routine
+                                                                              !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nelements)         :: closure_intern      !! Check closure of internal mass balance
+                                                                              !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nelements)         :: pool_start          !! Start and end pool of this routine 
+                                                                              !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm,nelements)         :: pool_end            !! Start and end pool of this routine 
+                                                                              !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(nelements)                  :: temp_start          !! Start and end pool of this routine 
+                                                                              !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(nelements)                  :: temp_end            !! Start and end pool of this routine 
+                                                                              !! @tex $(gC pixel^{-1} dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(nlitt,nlevs)                :: litter_weight_expanded !! The fraction of litter on the expanded
+                                                                              !! PFT.
+                                                                              !! @tex $-$ @endtex
+    REAL(r_std), DIMENSION(npts,nvm)                   :: woodmass            !! Woodmass of individuals (gC) 
+    REAL(r_std), DIMENSION(npts,nvm)                   :: reverse_soilcarbon          !! 
+    REAL(r_std), DIMENSION(npts,nvm)                   :: agec_indicator      !! 
+    CHARACTER(LEN=80)                                  :: data_filename
+
+!_ ================================================================================================================================
+  
+    IF (printlev.GE.3) WRITE(numout,*) 'Entering age class distribution'
+
+    !CALL getin_p('AgeC_Threshold_File',data_filename)
+    !CALL slowproc_read_data(npts, lalo, resolution, bound_spa, data_filename, 'matrix')
+
+    IF (.NOT. use_bound_spa) THEN
+      DO ipts = 1,npts
+        bound_spa(ipts,:) = age_class_bound(:)
+      ENDDO
+    ENDIF
+
+ !! 1. Initialize
+
+    woodmass(:,:) = biomass(:,:,isapabove,icarbon)+biomass(:,:,isapbelow,icarbon) &
+                    +biomass(:,:,iheartabove,icarbon)+biomass(:,:,iheartbelow,icarbon) 
+    reverse_soilcarbon(:,:) = -1 *(SUM(carbon(:,:,:),DIM=2) + &
+                      SUM(SUM(litter(:,:,:,:,icarbon),DIM=2),DIM=3))
+
+    !! 1.2 Initialize check for mass balance closure
+    !  The mass balance is calculated at the end of this routine
+    !  in section 3. Initial biomass and wood product pool all other
+    !  relevant pools were just set to zero.
+    pool_start(:,:,:) = zero
+    DO iele = 1,nelements
+       
+       ! co2_to_bm
+       pool_start(:,:,iele) = pool_start(:,:,iele) + co2_to_bm(:,:)
+
+       ! Biomass pool + bm_to_litter
+       DO ipar = 1,nparts
+          pool_start(:,:,iele) = pool_start(:,:,iele) + &
+               (biomass(:,:,ipar,iele) + bm_to_litter(:,:,ipar,iele)) * &
+               veget_max(:,:)
+       ENDDO
+
+       ! Litter pool (gC m-2) *  (m2 m-2) 
+       DO ilit = 1,nlitt
+          DO ilev = 1,nlevs
+             pool_start(:,:,iele) = pool_start(:,:,iele) + &
+                  litter(:,ilit,:,ilev,iele) * veget_max(:,:)
+          ENDDO
+       ENDDO
+
+       ! Soil carbon (gC m-2) *  (m2 m-2)
+       DO icarb = 1,ncarb
+          pool_start(:,:,iele) = pool_start(:,:,iele) + &
+               carbon(:,icarb,:) * veget_max(:,:)
+       ENDDO
+
+    ENDDO
+
+
+ !! 2. Handle the merge of PFTs when one age class moves to the next one.
+
+    !  Following growth, the value of age-class indicator variable 
+    !  from an age class may have become too big to stay
+    !  in this age class. The biomass, litter, reverse_soilcarbon and soil
+    !  water then need to be moved from one age class to the next age class.
+    DO ipts = 1,npts
+      ! This loops over all the MTCs that we have ignoring age classes
+      DO ivma=1,nvmap
+        ivm=start_index(ivma)
+
+        ! If we only have a single age class for this
+        ! PFT, we can skip it.
+        IF(nagec_pft(ivma) .EQ. 1)CYCLE
+
+        IF(is_tree(ivm)) THEN
+          agec_indicator(:,:) = woodmass(:,:)
+        ELSE
+          agec_indicator(:,:) = reverse_soilcarbon(:,:)
+        ENDIF ! is_tree(ivm)
+
+        CALL check_merge_same_MTC(ipts, ivma, agec_indicator, bound_spa, &
+                biomass, veget_max, ind, &
+                lm_lastyearmax, leaf_frac, co2_to_bm, &
+                fuel_1hr, fuel_10hr, fuel_100hr, fuel_1000hr, &
+                everywhere, litter, carbon, lignin_struc, &
+                deepC_a, deepC_s, deepC_p, &
+                bm_to_litter, PFTpresent, when_growthinit,&
+                senescence, npp_longterm, gpp_daily, leaf_age, age, &
+                gdd_from_growthinit, gdd_midwinter, time_hum_min, hum_min_dormance, &
+                gdd_m5_dormance, &
+                ncd_dormance, moiavail_month, moiavail_week, ngd_minus5, &
+                gpp_week, resp_maint, resp_growth, npp_daily, resp_hetero)
+
+      ENDDO ! Looping over MTCs
+    ENDDO ! loop over #pixels - domain size
+
+
+!! 3. Mass balance closure
+    
+    !! 3.1 Calculate components of the mass balance
+    pool_end(:,:,:) = zero
+    DO iele = 1,nelements
+
+       ! co2_to_bm
+       pool_end(:,:,iele) = pool_end(:,:,iele) + co2_to_bm(:,:)
+
+       ! Biomass pool + bm_to_litter
+       DO ipar = 1,nparts
+          pool_end(:,:,iele) = pool_end(:,:,iele) + &
+               (biomass(:,:,ipar,iele) + bm_to_litter(:,:,ipar,iele)) * &
+               veget_max(:,:)
+       ENDDO
+
+       ! Litter pool (gC m-2) *  (m2 m-2) 
+       DO ilit = 1,nlitt
+          DO ilev = 1,nlevs
+             pool_end(:,:,iele) = pool_end(:,:,iele) + &
+                  litter(:,ilit,:,ilev,iele) * veget_max(:,:)
+          ENDDO
+       ENDDO
+
+       ! Soil carbon (gC m-2) *  (m2 m-2)
+       DO icarb = 1,ncarb
+          pool_end(:,:,iele) = pool_end(:,:,iele) + &
+               carbon(:,icarb,:) * veget_max(:,:)
+       ENDDO
+    ENDDO
+
+    !! 3.2 Calculate mass balance
+    check_intern(:,:,iatm2land,icarbon) = zero 
+    check_intern(:,:,iland2atm,icarbon) = -un * zero
+    check_intern(:,:,ilat2out,icarbon) = zero
+    check_intern(:,:,ilat2in,icarbon) = -un * zero
+    check_intern(:,:,ipoolchange,icarbon) = -un * (pool_end(:,:,icarbon) - pool_start(:,:,icarbon))
+    closure_intern = zero
+    DO imbc = 1,nmbcomp
+       closure_intern(:,:,icarbon) = closure_intern(:,:,icarbon) + check_intern(:,:,imbc,icarbon)
+    ENDDO
+
+    !! 3.3 Write outcome of the check
+    !  Sum over ivm because of age class redistribution
+    DO ipts = 1,npts
+       IF (SUM(closure_intern(ipts,:,icarbon)) .LT. min_stomate .AND. &
+            SUM(closure_intern(ipts,:,icarbon)) .GT. -min_stomate) THEN
+          IF (ld_massbal) WRITE(numout,*) 'Mass balance closure: age_class_distr', ipts
+       ELSE
+          WRITE(numout,*) 'Error: mass balance is not closed in age_class_distr'
+          WRITE(numout,*) '   Difference, ipts, ', ipts, SUM(closure_intern(ipts,:,icarbon)) 
+       ENDIF
+    ENDDO
+
+    IF (printlev.GE.4) WRITE(numout,*) 'Leaving age class distribution'
+    
+  END SUBROUTINE age_class_distr
+
+
+  SUBROUTINE check_merge_same_MTC(ipts, ivma, woodmass, bound_spa, &
+       biomass, veget_max, ind, &
+       lm_lastyearmax, leaf_frac, co2_to_bm, &
+       fuel_1hr, fuel_10hr, fuel_100hr, fuel_1000hr, &
+       everywhere, litter, carbon, lignin_struc, &
+       deepC_a, deepC_s, deepC_p, &
+       bm_to_litter, PFTpresent, when_growthinit,&
+       senescence, npp_longterm, gpp_daily, leaf_age, age, &
+       gdd_from_growthinit, gdd_midwinter, time_hum_min,hum_min_dormance, &
+       gdd_m5_dormance, &
+       ncd_dormance, moiavail_month, moiavail_week, ngd_minus5, &
+       gpp_week, resp_maint, resp_growth, npp_daily, resp_hetero)
+
+    IMPLICIT NONE
+    
+  !! 0. Variable and parameter declaration 
+    
+    !! 0.1 Input variables
+
+    INTEGER, INTENT(in)                                :: ipts                !! Domain size - number of pixels (unitless)
+    INTEGER, INTENT(in)                                :: ivma                !! 
+    REAL(r_std), DIMENSION(:,:), INTENT(in)            :: woodmass            !! Woodmass of individuals (gC) 
+    REAL(r_std), DIMENSION(:,:), INTENT(in)            :: bound_spa           !!
+
+    !! 0.2 Output variables
+
+
+    !! 0.3 Modified variables
+
+    LOGICAL, DIMENSION(:,:), INTENT(inout)             :: PFTpresent          !! Tab indicating which PFTs are present in 
+                                                                              !! each pixel
+    LOGICAL, DIMENSION(:,:), INTENT(inout)             :: senescence          !! Flag for setting senescence stage (only 
+                                                                              !! for deciduous trees)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)        :: moiavail_month       !! "Monthly" moisture availability (0 to 1, 
+                                                                              !! unitless) 
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: moiavail_week       !! "Weekly" moisture availability 
+                                                                              !! (0 to 1, unitless)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: gpp_week            !! Mean weekly gross primary productivity 
+                                                                              !! @tex $(gC m^{-2} day^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: ngd_minus5          !! Number of growing days (days), threshold 
+                                                                              !! -5 deg C (for phenology)   
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: resp_maint          !! Maintenance respiration  
+                                                                              !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: resp_growth         !! Growth respiration  
+                                                                              !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: npp_daily           !! Net primary productivity 
+                                                                              !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: resp_hetero         !! Net primary productivity 
+                                                                              !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: when_growthinit     !! How many days ago was the beginning of 
+                                                                              !! the growing season (days)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: npp_longterm        !! "Long term" mean yearly primary productivity 
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: ind                 !! Number of individuals at the stand level
+                                                                              !! @tex $(m^{-2})$ @endtex 
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: veget_max           !! "maximal" coverage fraction of a PFT on the ground
+                                                                              !! May sum to
+                                                                              !! less than unity if the pixel has
+                                                                              !! nobio area. (unitless, 0-1)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: lm_lastyearmax      !! last year's maximum leaf mass for each PFT 
+                                                                              !! @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: everywhere          !! is the PFT everywhere in the grid box or 
+                                                                              !! very localized (after its introduction) (?)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: co2_to_bm           !! CO2 taken from the atmosphere to get C to create  
+                                                                              !! the seedlings @tex (gC.m^{-2}dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: gpp_daily           !! Daily gross primary productivity  
+                                                                              !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: time_hum_min        !! Time elapsed since strongest moisture 
+                                                                              !! availability (days) 
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: hum_min_dormance    !! minimum moisture during dormance 
+                                                                              !! (0-1, unitless)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: gdd_midwinter       !! Growing degree days (K), since midwinter 
+                                                                              !! (for phenology) - this is written to the
+                                                                              !!  history files 
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: gdd_from_growthinit !! growing degree days, since growthinit 
+                                                                              !! for crops
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: gdd_m5_dormance     !! Growing degree days (K), threshold -5 deg 
+                                                                              !! C (for phenology)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: ncd_dormance        !! Number of chilling days (days), since 
+                                                                              !! leaves were lost (for phenology) 
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)       :: lignin_struc        !! ratio Lignine/Carbon in structural litter,
+                                                                              !! above and below ground
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)       :: carbon              !! carbon pool: active, slow, or passive 
+                                                                              !! @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)       :: deepC_a             !! Permafrost soil carbon (g/m**3) active
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)       :: deepC_s             !! Permafrost soil carbon (g/m**3) slow
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)       :: deepC_p             !! Permafrost soil carbon (g/m**3) passive
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: age                 !! Age (years)    
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)       :: leaf_frac           !! fraction of leaves in leaf age class (unitless;0-1)
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)       :: leaf_age            !! Leaf age (days)
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout)     :: bm_to_litter        !! Transfer of biomass to litter 
+                                                                              !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout)     :: biomass             !! Stand level biomass @tex $(gC.m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(:,:,:,:,:), INTENT(inout)   :: litter              !! metabolic and structural litter, above and 
+                                                                              !! below ground @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout)     :: fuel_1hr
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout)     :: fuel_10hr
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout)     :: fuel_100hr
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout)     :: fuel_1000hr
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                     :: iele,ipar,ipft      !! Indeces(unitless)
+    INTEGER(i_std)                                     :: iagec,imbc,icirc    !! Indeces(unitless)
+    INTEGER(i_std)                                     :: ilit,ilev,icarb     !! Indeces(unitless)
+    REAL(r_std)                                        :: share_expanded      !! Share of the veget_max of the existing vegetation
+                                                                              !! within a PFT over the total veget_max following 
+                                                                              !! expansion of that PFT (unitless, 0-1)
+                                                                              !! @tex $(ind m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(nlitt,nlevs)                :: litter_weight_expanded !! The fraction of litter on the expanded
+                                                                              !! PFT.
+
+
+!_ ================================================================================================================================
+
+    !! 1 Check if the trees still belong to this age class
+    !  Note that the term age class is used but that the classes used in the
+    !  code are not defined on an age criterion. Instead the biomass or
+    !  or soil carbon pool is used.
+  IF (is_tree(start_index(ivma))) THEN
+    DO iagec = nagec_pft(ivma),1,-1
+
+       !start from oldest age class and then move to younger age classes.
+       ipft = start_index(ivma)+iagec-1
+
+       !  Check whether woodmass exceeds boundaries of
+       !  the age class. For forest PFTs, bound_spa stores the upper boundary
+       !  value .
+       IF(ld_agec)THEN
+          WRITE(numout,*) 'Checking to merge for: '
+          WRITE(numout,*) 'ipft,iagec,ipts: ',ipft,iagec,ipts
+          WRITE(numout,*) 'nagec_pft,woodmass,age_class_bound: ',nagec_pft(ivma),&
+               woodmass(ipts,ipft),bound_spa(ipts,ipft)
+       ENDIF
+
+       IF ( (iagec .EQ. nagec_pft(ivma)) .AND. &
+            woodmass(ipts,ipft) .GT. bound_spa(ipts,ipft) ) THEN
+        
+          ! If these conditions are satisfied our woodmass is
+          ! very unrealist
+          WRITE(numout,*) 'WARNING: age class indicator exceeds: ', &
+               bound_spa(ipts,ipft) 
+  
+       ELSEIF ( iagec .NE. nagec_pft(ivma) .AND. iagec .NE. nagec_pft(ivma)-1 .AND. &
+            woodmass(ipts,ipft) .GT. bound_spa(ipts,ipft) ) THEN
+
+          IF(ld_agec)THEN
+             WRITE(numout,*) 'Merging biomass'
+             WRITE(numout,*) 'ipts,ipft,iagec: ',ipts,ipft,iagec
+             WRITE(numout,*) 'age_class_bound: ',bound_spa(ipts,ipft)
+             WRITE(numout,*) 'woodmass: ',woodmass(ipts,ipft)
+
+          ENDIF
+
+          !! 2 Merge biomass
+          !  Biomass of two age classes needs to be merged. The established
+          !  vegetation is stored in ipft+1, the new vegetation is stored in
+          !  ipft
+          share_expanded = veget_max(ipts,ipft+1) / &
+               ( veget_max(ipts,ipft+1) + veget_max(ipts,ipft) )
+          ! We also need a scaling factor which includes the litter
+          DO ilev=1,nlevs
+             DO ilit=1,nlitt
+                IF(litter(ipts,ilit,ipft,ilev,icarbon) .GE. min_stomate)THEN
+                   litter_weight_expanded(ilit,ilev)=litter(ipts,ilit,ipft+1,ilev,icarbon) * veget_max(ipts,ipft+1)/ &
+                        (litter(ipts,ilit,ipft+1,ilev,icarbon) * veget_max(ipts,ipft+1) + &
+                        litter(ipts,ilit,ipft,ilev,icarbon) * veget_max(ipts,ipft))
+                ELSE
+                   litter_weight_expanded(ilit,ilev)=zero
+                ENDIF
+             END DO
+          ENDDO
+
+          
+
+          ! Merge the biomass and ind of the two age classes
+          biomass(ipts,ipft+1,:,:) = share_expanded * biomass(ipts,ipft+1,:,:) + &
+               (un - share_expanded) * biomass(ipts,ipft,:,:)
+          ind(ipts,ipft+1) = share_expanded * ind(ipts,ipft+1) + &
+               (un - share_expanded) * ind(ipts,ipft)
+          
+          !! 3 Empty the age class that was merged and update veget_max
+          ind(ipts,ipft) = zero
+          biomass(ipts,ipft,:,:) = zero
+          veget_max(ipts,ipft+1) = veget_max(ipts,ipft+1) + veget_max(ipts,ipft)
+          veget_max(ipts,ipft) = zero
+ 
+          !! 4 Calculate the PFT characteristics of the merged PFT
+          !  Take the weighted mean of the existing vegetation and the new 
+          !  vegetation joining this PFT. 
+          !  Note that co2_to_bm is in gC. m-2 dt-1 ,
+          !  so we should also take the weighted mean (rather than sum if
+          !  this where absolute values).
+
+          lm_lastyearmax(ipts,ipft+1) = share_expanded * lm_lastyearmax(ipts,ipft+1) + &
+               (un - share_expanded) * lm_lastyearmax(ipts,ipft)
+          lm_lastyearmax(ipts,ipft) = zero
+          age(ipts,ipft+1) = share_expanded * age(ipts,ipft+1) + &
+               (un - share_expanded) * age(ipts,ipft)
+          age(ipts,ipft) = zero
+
+          !CHECK: more strictly this should be considered together with leaf mass
+          leaf_frac(ipts,ipft+1,:) = share_expanded * leaf_frac(ipts,ipft+1,:) + &
+               (un - share_expanded) * leaf_frac(ipts,ipft,:)
+          leaf_frac(ipts,ipft,:) = zero
+          leaf_age(ipts,ipft+1,:) = share_expanded * leaf_age(ipts,ipft+1,:) + &
+               (un - share_expanded) * leaf_age(ipts,ipft,:)
+          leaf_age(ipts,ipft,:) = zero
+          co2_to_bm(ipts,ipft+1) = share_expanded * co2_to_bm(ipts,ipft+1) + &
+               (un - share_expanded) * co2_to_bm(ipts,ipft)
+          co2_to_bm(ipts,ipft) = zero
+
+          ! Everywhere deals with the migration of vegetation. Copy the
+          ! status of the most migrated vegetation for the whole PFT
+          everywhere(ipts,ipft+1) = MAX(everywhere(ipts,ipft), everywhere(ipts,ipft+1))
+          everywhere(ipts,ipft) = zero
+
+          ! The new soil&litter pools are the weighted mean of the newly 
+          ! established vegetation for that PFT and the soil&litter pools
+          ! of the original vegetation that already exists in that PFT.
+          ! Since it is not only the amount of vegetation present (veget_max) but also
+          ! the amount of structural litter (litter) that is important, we have to 
+          ! weight by both items here.
+          DO ilev=1,nlevs
+             lignin_struc(ipts,ipft+1,ilev) = litter_weight_expanded(istructural,ilev) * lignin_struc(ipts,ipft+1,ilev) + &
+                  (un - litter_weight_expanded(istructural,ilev)) * lignin_struc(ipts,ipft,ilev) 
+             lignin_struc(ipts,ipft,ilev) = zero
+          ENDDO
+          litter(ipts,:,ipft+1,:,:) = share_expanded * litter(ipts,:,ipft+1,:,:) + &
+               (un - share_expanded) * litter(ipts,:,ipft,:,:)
+          litter(ipts,:,ipft,:,:) = zero
+
+          fuel_1hr(ipts,ipft+1,:,:) = share_expanded * fuel_1hr(ipts,ipft+1,:,:) + &
+               (un - share_expanded) * fuel_1hr(ipts,ipft,:,:)
+          fuel_1hr(ipts,ipft,:,:) = zero
+
+          fuel_10hr(ipts,ipft+1,:,:) = share_expanded * fuel_10hr(ipts,ipft+1,:,:) + &
+               (un - share_expanded) * fuel_10hr(ipts,ipft,:,:)
+          fuel_10hr(ipts,ipft,:,:) = zero
+
+          fuel_100hr(ipts,ipft+1,:,:) = share_expanded * fuel_100hr(ipts,ipft+1,:,:) + &
+               (un - share_expanded) * fuel_100hr(ipts,ipft,:,:)
+          fuel_100hr(ipts,ipft,:,:) = zero
+
+          fuel_1000hr(ipts,ipft+1,:,:) = share_expanded * fuel_1000hr(ipts,ipft+1,:,:) + &
+               (un - share_expanded) * fuel_1000hr(ipts,ipft,:,:)
+          fuel_1000hr(ipts,ipft,:,:) = zero
+
+          carbon(ipts,:,ipft+1) =  share_expanded * carbon(ipts,:,ipft+1) + &
+               (un - share_expanded) * carbon(ipts,:,ipft)
+          carbon(ipts,:,ipft) = zero 
+
+          deepC_a(ipts,:,ipft+1) =  share_expanded * deepC_a(ipts,:,ipft+1) + &
+               (un - share_expanded) * deepC_a(ipts,:,ipft)
+          deepC_a(ipts,:,ipft) = zero 
+
+          deepC_s(ipts,:,ipft+1) =  share_expanded * deepC_s(ipts,:,ipft+1) + &
+               (un - share_expanded) * deepC_s(ipts,:,ipft)
+          deepC_s(ipts,:,ipft) = zero 
+
+          deepC_p(ipts,:,ipft+1) =  share_expanded * deepC_p(ipts,:,ipft+1) + &
+               (un - share_expanded) * deepC_p(ipts,:,ipft)
+          deepC_p(ipts,:,ipft) = zero 
+
+          bm_to_litter(ipts,ipft+1,:,:) = share_expanded * bm_to_litter(ipts,ipft+1,:,:) + & 
+               (un - share_expanded) * bm_to_litter(ipts,ipft,:,:)
+          bm_to_litter(ipts,ipft,:,:) = zero
+
+          ! Copy variables that depend on veget_max 
+          when_growthinit(ipts,ipft+1) = share_expanded * when_growthinit(ipts,ipft+1) + &
+               (un - share_expanded) * when_growthinit(ipts,ipft)
+          when_growthinit(ipts,ipft) = zero
+          gdd_from_growthinit(ipts,ipft+1) = share_expanded * &
+               gdd_from_growthinit(ipts,ipft+1) + &
+               (un - share_expanded) * gdd_from_growthinit(ipts,ipft)
+          gdd_from_growthinit(ipts,ipft) = zero
+          gdd_midwinter(ipts,ipft+1) = share_expanded * gdd_midwinter(ipts,ipft+1) + &
+               (un - share_expanded) * gdd_midwinter(ipts,ipft)
+          gdd_midwinter(ipts,ipft) = zero
+          time_hum_min(ipts,ipft+1) = share_expanded * time_hum_min(ipts,ipft+1) + &
+               (un - share_expanded) * time_hum_min(ipts,ipft)
+          time_hum_min(ipts,ipft) = zero
+          hum_min_dormance(ipts,ipft+1) = share_expanded * hum_min_dormance(ipts,ipft+1) + &
+               (un - share_expanded) * hum_min_dormance(ipts,ipft)
+          hum_min_dormance(ipts,ipft) = zero
+          gdd_m5_dormance(ipts,ipft+1) = share_expanded * gdd_m5_dormance(ipts,ipft+1) + &
+               (un - share_expanded) * gdd_m5_dormance(ipts,ipft)
+          gdd_m5_dormance(ipts,ipft) = zero
+          ncd_dormance(ipts,ipft+1) = share_expanded * ncd_dormance(ipts,ipft+1) + &
+               (un - share_expanded) * ncd_dormance(ipts,ipft)
+          ncd_dormance(ipts,ipft) = zero
+          moiavail_month(ipts,ipft+1) = share_expanded * moiavail_month(ipts,ipft+1) + &
+               (un - share_expanded) * moiavail_month(ipts,ipft)
+          moiavail_month(ipts,ipft) = zero
+          moiavail_week(ipts,ipft+1) = share_expanded * moiavail_week(ipts,ipft+1) + &
+               (un - share_expanded) * moiavail_week(ipts,ipft)
+          moiavail_week(ipts,ipft) = zero
+          ngd_minus5(ipts,ipft+1) = share_expanded * ngd_minus5(ipts,ipft+1) + &
+               (un - share_expanded) * ngd_minus5(ipts,ipft)
+          ngd_minus5(ipts,ipft) = zero
+    
+          ! Copy remaining properties 
+          PFTpresent(ipts,ipft+1) = PFTpresent(ipts,ipft)
+          PFTpresent(ipts,ipft) = .FALSE.
+          senescence(ipts,ipft+1) = senescence(ipts,ipft)
+          senescence(ipts,ipft) = .FALSE.
+          npp_longterm(ipts,ipft+1) = share_expanded * npp_longterm(ipts,ipft+1) + &
+               (un - share_expanded) * npp_longterm(ipts,ipft)
+          npp_longterm(ipts,ipft) = zero
+          gpp_daily(ipts,ipft+1) = share_expanded * gpp_daily(ipts,ipft+1) + &
+               (un - share_expanded) * gpp_daily(ipts,ipft)
+          gpp_daily(ipts,ipft) = zero 
+          gpp_week(ipts,ipft+1) = share_expanded * gpp_week(ipts,ipft+1) + &
+               (un - share_expanded) * gpp_week(ipts,ipft)
+          gpp_week(ipts,ipft) = zero
+          resp_maint(ipts,ipft+1) = share_expanded * resp_maint(ipts,ipft+1) + &
+               (un - share_expanded) * resp_maint(ipts,ipft) 
+          resp_maint(ipts,ipft) = zero
+          resp_growth(ipts,ipft+1) = share_expanded * resp_growth(ipts,ipft+1) + &
+               (un - share_expanded) * resp_growth(ipts,ipft) 
+          resp_growth(ipts,ipft) = zero
+          npp_daily(ipts,ipft+1) = share_expanded * npp_daily(ipts,ipft+1) + &
+               (un - share_expanded) * npp_daily(ipts,ipft) 
+          npp_daily(ipts,ipft) = zero
+          resp_hetero(ipts,ipft+1) = share_expanded * resp_hetero(ipts,ipft+1) + &
+               (un - share_expanded) * resp_hetero(ipts,ipft) 
+          resp_hetero(ipts,ipft) = zero
+
+       ENDIF
+    ENDDO
+  ENDIF
+  ! ! concerned MTC is grass/pasture/crop
+  ! ELSE
+  !   DO iagec = 1,nagec_pft(ivma),1
+
+  !      ! As the soil C gets smaller when forest-generating crop gets older,
+  !      ! we start from young age class and then move to older age classes.
+  !      ! If the soil C of ipft is smaller than the threshold, then it should 
+  !      ! go to the next age class.
+  !      ipft = start_index(ivma)+iagec-1
+
+  !      !  Check whether woodmass exceeds boundaries of
+  !      !  the age class.
+  !      IF(ld_agec)THEN
+  !         WRITE(numout,*) 'Checking to merge for: '
+  !         WRITE(numout,*) 'ipft,iagec,ipts: ',ipft,iagec,ipts
+  !         WRITE(numout,*) 'nagec_pft,woodmass,age_class_bound: ',nagec_pft(ivma),&
+  !              woodmass(ipts,ipft),bound_spa(ipts,ipft)
+  !      ENDIF
+
+  !      !IF ( (iagec .EQ. 1) .AND. &
+  !      !     woodmass(ipts,ipft) .GT. bound_spa(ipts,ipft) ) THEN
+  !      ! 
+  !      !   ! If this is satisfied than we're having a quite large
+  !      !   ! soil C in the newly initiated crop
+  !      !   WRITE(numout,*) 'WARNING: age class indicator exceeds: ', &
+  !      !        bound_spa(ipts,ipft) 
+  ! 
+  !      !ELSEIF ( (iagec .NE. nagec_pft(ivma)) .AND. &
+  !      !     woodmass(ipts,ipft) .LT. bound_spa(ipts,ipft)) THEN
+
+  !      ! If the soil C is smaller than the threshold and the concerned
+  !      ! ipft is not the oldest age class, then it should move to the
+  !      ! next (older) age class. So we have to set the soil C threshold
+  !      ! for crop as:
+
+  !      ! youngest:   0.9 of maximum end-spinup forest soil C
+  !      ! 2nd young:  0.75 of maximum end-spniup forest soil C
+  !      ! old:        0.55 of maximum end-spniup forest soil C
+  !      ! oldest:     the oldest one should not be less than zero. 
+  !      IF ( (iagec .NE. nagec_pft(ivma)) .AND. &
+  !           woodmass(ipts,ipft) .LT. bound_spa(ipts,ipft) .AND. veget_max(ipts,ipft) .GT. min_stomate) THEN
+  !         IF(ld_agec)THEN
+  !            WRITE(numout,*) 'Merging biomass'
+  !            WRITE(numout,*) 'ipts,ipft,iagec: ',ipts,ipft,iagec
+  !            WRITE(numout,*) 'age_class_bound: ',bound_spa(ipts,ipft)
+  !            WRITE(numout,*) 'woodmass: ',woodmass(ipts,ipft)
+
+  !         ENDIF
+
+  !         !! 2 Merge biomass
+  !         !  Biomass of two age classes needs to be merged. The established
+  !         !  vegetation is stored in ipft+1, the new vegetation is stored in
+  !         !  ipft
+  !         share_expanded = veget_max(ipts,ipft+1) / &
+  !              ( veget_max(ipts,ipft+1) + veget_max(ipts,ipft) )
+  !         ! We also need a scaling factor which includes the litter
+  !         DO ilev=1,nlevs
+  !            DO ilit=1,nlitt
+  !               IF(litter(ipts,ilit,ipft,ilev,icarbon) .GE. min_stomate)THEN
+  !                  litter_weight_expanded(ilit,ilev)=litter(ipts,ilit,ipft+1,ilev,icarbon) * veget_max(ipts,ipft+1)/ &
+  !                       (litter(ipts,ilit,ipft+1,ilev,icarbon) * veget_max(ipts,ipft+1) + &
+  !                       litter(ipts,ilit,ipft,ilev,icarbon) * veget_max(ipts,ipft))
+  !               ELSE
+  !                  litter_weight_expanded(ilit,ilev)=zero
+  !               ENDIF
+  !            END DO
+  !         ENDDO
+
+  !         ! Merge the biomass and ind of the two age classes
+  !         biomass(ipts,ipft+1,:,:) = share_expanded * biomass(ipts,ipft+1,:,:) + &
+  !              (un - share_expanded) * biomass(ipts,ipft,:,:)
+  !         ind(ipts,ipft+1) = share_expanded * ind(ipts,ipft+1) + &
+  !              (un - share_expanded) * ind(ipts,ipft)
+  !         
+  !         !! 3 Empty the age class that was merged and update veget_max
+  !         ind(ipts,ipft) = zero
+  !         biomass(ipts,ipft,:,:) = zero
+  !         veget_max(ipts,ipft+1) = veget_max(ipts,ipft+1) + veget_max(ipts,ipft)
+  !         veget_max(ipts,ipft) = zero
+ 
+  !         !! 4 Calculate the PFT characteristics of the merged PFT
+  !         !  Take the weighted mean of the existing vegetation and the new 
+  !         !  vegetation joining this PFT. 
+  !         !  Note that co2_to_bm is in gC. m-2 dt-1 ,
+  !         !  so we should also take the weighted mean (rather than sum if
+  !         !  this where absolute values).
+  !         lm_lastyearmax(ipts,ipft+1) = share_expanded * lm_lastyearmax(ipts,ipft+1) + &
+  !              (un - share_expanded) * lm_lastyearmax(ipts,ipft)
+  !         lm_lastyearmax(ipts,ipft) = zero
+  !         !age(ipts,ipft+1) = share_expanded * age(ipts,ipft+1) + &
+  !         !     (un - share_expanded) * age(ipts,ipft)
+  !         !age(ipts,ipft) = zero
+
+  !         !CHECK: more strictly this should be considered together with leaf mass
+  !         leaf_frac(ipts,ipft+1,:) = share_expanded * leaf_frac(ipts,ipft+1,:) + &
+  !              (un - share_expanded) * leaf_frac(ipts,ipft,:)
+  !         leaf_frac(ipts,ipft,:) = zero
+  !         leaf_age(ipts,ipft+1,:) = share_expanded * leaf_age(ipts,ipft+1,:) + &
+  !              (un - share_expanded) * leaf_age(ipts,ipft,:)
+  !         leaf_age(ipts,ipft,:) = zero
+  !         co2_to_bm(ipts,ipft+1) = share_expanded * co2_to_bm(ipts,ipft+1) + &
+  !              (un - share_expanded) * co2_to_bm(ipts,ipft)
+  !         co2_to_bm(ipts,ipft) = zero
+
+  !         ! Everywhere deals with the migration of vegetation. Copy the
+  !         ! status of the most migrated vegetation for the whole PFT
+  !         everywhere(ipts,ipft+1) = MAX(everywhere(ipts,ipft), everywhere(ipts,ipft+1))
+  !         everywhere(ipts,ipft) = zero
+
+  !         ! The new soil&litter pools are the weighted mean of the newly 
+  !         ! established vegetation for that PFT and the soil&litter pools
+  !         ! of the original vegetation that already exists in that PFT.
+  !         ! Since it is not only the amount of vegetation present (veget_max) but also
+  !         ! the amount of structural litter (litter) that is important, we have to 
+  !         ! weight by both items here.
+  !         DO ilev=1,nlevs
+  !            lignin_struc(ipts,ipft+1,ilev) = litter_weight_expanded(istructural,ilev) * lignin_struc(ipts,ipft+1,ilev) + &
+  !                 (un - litter_weight_expanded(istructural,ilev)) * lignin_struc(ipts,ipft,ilev) 
+  !            lignin_struc(ipts,ipft,ilev) = zero
+  !         ENDDO
+  !         litter(ipts,:,ipft+1,:,:) = share_expanded * litter(ipts,:,ipft+1,:,:) + &
+  !              (un - share_expanded) * litter(ipts,:,ipft,:,:)
+  !         litter(ipts,:,ipft,:,:) = zero
+
+  !         fuel_1hr(ipts,ipft+1,:,:) = share_expanded * fuel_1hr(ipts,ipft+1,:,:) + &
+  !              (un - share_expanded) * fuel_1hr(ipts,ipft,:,:)
+  !         fuel_1hr(ipts,ipft,:,:) = zero
+
+  !         fuel_10hr(ipts,ipft+1,:,:) = share_expanded * fuel_10hr(ipts,ipft+1,:,:) + &
+  !              (un - share_expanded) * fuel_10hr(ipts,ipft,:,:)
+  !         fuel_10hr(ipts,ipft,:,:) = zero
+
+  !         fuel_100hr(ipts,ipft+1,:,:) = share_expanded * fuel_100hr(ipts,ipft+1,:,:) + &
+  !              (un - share_expanded) * fuel_100hr(ipts,ipft,:,:)
+  !         fuel_100hr(ipts,ipft,:,:) = zero
+
+  !         fuel_1000hr(ipts,ipft+1,:,:) = share_expanded * fuel_1000hr(ipts,ipft+1,:,:) + &
+  !              (un - share_expanded) * fuel_1000hr(ipts,ipft,:,:)
+  !         fuel_1000hr(ipts,ipft,:,:) = zero
+
+  !         carbon(ipts,:,ipft+1) =  share_expanded * carbon(ipts,:,ipft+1) + &
+  !              (un - share_expanded) * carbon(ipts,:,ipft)
+  !         carbon(ipts,:,ipft) = zero 
+
+  !         deepC_a(ipts,:,ipft+1) =  share_expanded * deepC_a(ipts,:,ipft+1) + &
+  !              (un - share_expanded) * deepC_a(ipts,:,ipft)
+  !         deepC_a(ipts,:,ipft) = zero 
+
+  !         deepC_s(ipts,:,ipft+1) =  share_expanded * deepC_s(ipts,:,ipft+1) + &
+  !              (un - share_expanded) * deepC_s(ipts,:,ipft)
+  !         deepC_s(ipts,:,ipft) = zero 
+
+  !         deepC_p(ipts,:,ipft+1) =  share_expanded * deepC_p(ipts,:,ipft+1) + &
+  !              (un - share_expanded) * deepC_p(ipts,:,ipft)
+  !         deepC_p(ipts,:,ipft) = zero 
+
+  !         bm_to_litter(ipts,ipft+1,:,:) = share_expanded * bm_to_litter(ipts,ipft+1,:,:) + & 
+  !              (un - share_expanded) * bm_to_litter(ipts,ipft,:,:)
+  !         bm_to_litter(ipts,ipft,:,:) = zero
+
+  !         ! Copy variables that depend on veget_max 
+  !         when_growthinit(ipts,ipft+1) = share_expanded * when_growthinit(ipts,ipft+1) + &
+  !              (un - share_expanded) * when_growthinit(ipts,ipft)
+  !         when_growthinit(ipts,ipft) = zero
+  !         gdd_from_growthinit(ipts,ipft+1) = share_expanded * &
+  !              gdd_from_growthinit(ipts,ipft+1) + &
+  !              (un - share_expanded) * gdd_from_growthinit(ipts,ipft)
+  !         gdd_from_growthinit(ipts,ipft) = zero
+  !         gdd_midwinter(ipts,ipft+1) = share_expanded * gdd_midwinter(ipts,ipft+1) + &
+  !              (un - share_expanded) * gdd_midwinter(ipts,ipft)
+  !         gdd_midwinter(ipts,ipft) = zero
+  !         time_hum_min(ipts,ipft+1) = share_expanded * time_hum_min(ipts,ipft+1) + &
+  !              (un - share_expanded) * time_hum_min(ipts,ipft)
+  !         time_hum_min(ipts,ipft) = zero
+  !         hum_min_dormance(ipts,ipft+1) = share_expanded * hum_min_dormance(ipts,ipft+1) + &
+  !              (un - share_expanded) * hum_min_dormance(ipts,ipft)
+  !         hum_min_dormance(ipts,ipft) = zero
+  !         gdd_m5_dormance(ipts,ipft+1) = share_expanded * gdd_m5_dormance(ipts,ipft+1) + &
+  !              (un - share_expanded) * gdd_m5_dormance(ipts,ipft)
+  !         gdd_m5_dormance(ipts,ipft) = zero
+  !         ncd_dormance(ipts,ipft+1) = share_expanded * ncd_dormance(ipts,ipft+1) + &
+  !              (un - share_expanded) * ncd_dormance(ipts,ipft)
+  !         ncd_dormance(ipts,ipft) = zero
+  !         moiavail_month(ipts,ipft+1) = share_expanded * moiavail_month(ipts,ipft+1) + &
+  !              (un - share_expanded) * moiavail_month(ipts,ipft)
+  !         moiavail_month(ipts,ipft) = zero
+  !         moiavail_week(ipts,ipft+1) = share_expanded * moiavail_week(ipts,ipft+1) + &
+  !              (un - share_expanded) * moiavail_week(ipts,ipft)
+  !         moiavail_week(ipts,ipft) = zero
+  !         ngd_minus5(ipts,ipft+1) = share_expanded * ngd_minus5(ipts,ipft+1) + &
+  !              (un - share_expanded) * ngd_minus5(ipts,ipft)
+  !         ngd_minus5(ipts,ipft) = zero
+  !   
+  !         ! Copy remaining properties 
+  !         PFTpresent(ipts,ipft+1) = PFTpresent(ipts,ipft)
+  !         PFTpresent(ipts,ipft) = .FALSE.
+  !         senescence(ipts,ipft+1) = senescence(ipts,ipft)
+  !         senescence(ipts,ipft) = .FALSE.
+  !         npp_longterm(ipts,ipft+1) = share_expanded * npp_longterm(ipts,ipft+1) + &
+  !              (un - share_expanded) * npp_longterm(ipts,ipft)
+  !         npp_longterm(ipts,ipft) = zero
+  !         gpp_daily(ipts,ipft+1) = share_expanded * gpp_daily(ipts,ipft+1) + &
+  !              (un - share_expanded) * gpp_daily(ipts,ipft)
+  !         gpp_daily(ipts,ipft) = zero 
+  !         gpp_week(ipts,ipft+1) = share_expanded * gpp_week(ipts,ipft+1) + &
+  !              (un - share_expanded) * gpp_week(ipts,ipft)
+  !         gpp_week(ipts,ipft) = zero
+  !         resp_maint(ipts,ipft+1) = share_expanded * resp_maint(ipts,ipft+1) + &
+  !              (un - share_expanded) * resp_maint(ipts,ipft) 
+  !         resp_maint(ipts,ipft) = zero
+  !         resp_growth(ipts,ipft+1) = share_expanded * resp_growth(ipts,ipft+1) + &
+  !              (un - share_expanded) * resp_growth(ipts,ipft) 
+  !         resp_growth(ipts,ipft) = zero
+  !         npp_daily(ipts,ipft+1) = share_expanded * npp_daily(ipts,ipft+1) + &
+  !              (un - share_expanded) * npp_daily(ipts,ipft) 
+  !         npp_daily(ipts,ipft) = zero
+  !         resp_hetero(ipts,ipft+1) = share_expanded * resp_hetero(ipts,ipft+1) + &
+  !              (un - share_expanded) * resp_hetero(ipts,ipft) 
+  !         resp_hetero(ipts,ipft) = zero
+
+  !      ENDIF
+  !   ENDDO
+
+  ! ENDIF
+
+  END SUBROUTINE check_merge_same_MTC
+
+
+
+! ================================================================================================================================
+!! SUBROUTINE   gross_lcchange
+!!
+!>\BRIEF       : Apply gross land cover change.
+!!
+!>\DESCRIPTION  
+!_ ================================================================================================================================
+  SUBROUTINE glcc_MulAgeC (npts, dt_days, newvegfrac,  &
+               glccSecondShift,glccPrimaryShift,glccNetLCC,&
+               def_fuel_1hr_remain, def_fuel_10hr_remain,        &
+               def_fuel_100hr_remain, def_fuel_1000hr_remain,    &
+               deforest_litter_remain, deforest_biomass_remain,  &
+               convflux,                    &
+               glccReal, IncreDeficit, glcc_pft, glcc_pftmtc,          &
+               veget_max, prod10, prod100,             &
+               PFTpresent, senescence, moiavail_month, moiavail_week,  &
+               gpp_week, ngd_minus5, resp_maint, resp_growth,          & 
+               resp_hetero, npp_daily, when_growthinit, npp_longterm,  &
+               ind, lm_lastyearmax, everywhere, age,                   &
+               co2_to_bm, gpp_daily, co2_fire,                         &
+               time_hum_min, gdd_midwinter, gdd_from_growthinit,       &
+               gdd_m5_dormance, ncd_dormance,                          &
+               lignin_struc, carbon, leaf_frac,                        &
+               deepC_a, deepC_s, deepC_p,                              &
+               leaf_age, bm_to_litter, biomass, litter,                &
+               fuel_1hr, fuel_10hr, fuel_100hr, fuel_1000hr)
+  
+    IMPLICIT NONE
+
+    !! 0.1 Input variables
+
+    INTEGER, INTENT(in)                                  :: npts             !! Domain size - number of pixels (unitless)
+    REAL(r_std), INTENT(in)                              :: dt_days          !! Time step of vegetation dynamics for stomate
+    REAL(r_std), DIMENSION (npts,12),INTENT(in)          :: glccSecondShift  !! the land-cover-change (LCC) matrix in case a gross LCC is 
+                                                                             !! used.
+    REAL(r_std), DIMENSION (npts,12),INTENT(in)          :: glccPrimaryShift !! the land-cover-change (LCC) matrix in case a gross LCC is 
+                                                                             !! used.
+    REAL(r_std), DIMENSION (npts,12),INTENT(in)          :: glccNetLCC       !! the land-cover-change (LCC) matrix in case a gross LCC is 
+                                                                             !! used.
+    REAL(r_std), DIMENSION (npts,nvmap),INTENT(in)       :: newvegfrac       !! veget max fraction matrix to guide the allocation of newly
+                                                                             !! created lands of a given vegetation type.
+
+    REAL(r_std), DIMENSION(npts,nvm,nlitt,nelements), INTENT(in)       :: def_fuel_1hr_remain
+    REAL(r_std), DIMENSION(npts,nvm,nlitt,nelements), INTENT(in)       :: def_fuel_10hr_remain
+    REAL(r_std), DIMENSION(npts,nvm,nlitt,nelements), INTENT(in)       :: def_fuel_100hr_remain
+    REAL(r_std), DIMENSION(npts,nvm,nlitt,nelements), INTENT(in)       :: def_fuel_1000hr_remain
+    REAL(r_std), DIMENSION(npts,nlitt,nvm,nlevs,nelements), INTENT(in) :: deforest_litter_remain   !! Vegetmax-weighted remaining litter on the ground for 
+                                                                                                      !! deforestation region.
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(in)      :: deforest_biomass_remain  !! Vegetmax-weighted remaining biomass on the ground for 
+                                                                                                      !! deforestation region.
+
+
+    !! 0.2 Output variables
+    REAL(r_std), DIMENSION(npts,nwp), INTENT(inout)         :: convflux         !! release during first year following land cover
+                                                                              !! change
+    REAL(r_std), DIMENSION(npts,12), INTENT(inout)        :: glccReal         !! The "real" glcc matrix that we apply in the model
+                                                                              !! after considering the consistency between presribed
+                                                                              !! glcc matrix and existing vegetation fractions.
+    REAL(r_std), DIMENSION(npts,12), INTENT(inout)        :: IncreDeficit     !! Originally "Increment" deficits, negative values mean that 
+                                                                              !! there are not enough fractions in the source PFTs
+                                                                              !! /vegetations to target PFTs/vegetations. I.e., these
+                                                                              !! fraction transfers are presribed in LCC matrix but
+                                                                              !! not realized. Now the glccDeficit for all land cover changes
+                                                                              !! except forestry harvest.
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)       :: glcc_pft         !! Loss of fraction in each PFT
+    REAL(r_std), DIMENSION(npts,nvm,nvmap), INTENT(inout) :: glcc_pftmtc      !! a temporary variable to hold the fractions each PFT is going to lose
+                                                                              !! i.e., the contribution of each PFT to the youngest age-class of MTC
+
+    !! 0.3 Modified variables
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)       :: veget_max        !! "maximal" coverage fraction of a PFT (LAI ->
+                                                                              !! infinity) on ground (unitless) 
+    REAL(r_std), DIMENSION(npts,0:10,nwp), INTENT(inout)  :: prod10           !! products remaining in the 10 year-turnover
+                                                                              !! pool after the annual release for each 
+                                                                              !! compartment (10 + 1 : input from year of land
+                                                                              !! cover change)
+    REAL(r_std), DIMENSION(npts,0:100,nwp), INTENT(inout) :: prod100              !! products remaining in the 100 year-turnover
+                                                                              !! pool after the annual release for each 
+                                                                              !! compartment (100 + 1 : input from year of land
+                                                                              !! cover change)
+    LOGICAL, DIMENSION(:,:), INTENT(inout)                :: PFTpresent       !! Tab indicating which PFTs are present in 
+                                                                              !! each pixel
+    LOGICAL, DIMENSION(:,:), INTENT(inout)                :: senescence       !! Flag for setting senescence stage (only 
+                                                                              !! for deciduous trees)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)            :: moiavail_month   !! "Monthly" moisture availability (0 to 1, 
+                                                                              !! unitless) 
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)            :: moiavail_week    !! "Weekly" moisture availability 
+                                                                              !! (0 to 1, unitless)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)            :: gpp_week         !! Mean weekly gross primary productivity 
+                                                                              !! @tex $(gC m^{-2} day^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)            :: ngd_minus5       !! Number of growing days (days), threshold 
+                                                                              !! -5 deg C (for phenology)   
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)            :: resp_maint       !! Maintenance respiration  
+                                                                              !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)            :: resp_growth      !! Growth respiration  
+                                                                              !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)            :: resp_hetero      !! Heterotrophic respiration  
+                                                                              !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)            :: npp_daily        !! Net primary productivity 
+                                                                              !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)            :: when_growthinit  !! How many days ago was the beginning of 
+                                                                              !! the growing season (days)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)            :: npp_longterm     !! "Long term" mean yearly primary productivity 
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)            :: ind              !! Number of individuals at the stand level
+                                                                              !! @tex $(m^{-2})$ @endtex 
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)            :: lm_lastyearmax   !! last year's maximum leaf mass for each PFT 
+                                                                              !! @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)            :: everywhere       !! is the PFT everywhere in the grid box or 
+                                                                              !! very localized (after its introduction) (?)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)            :: age              !! mean age (years)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)            :: co2_to_bm        !! CO2 taken from the atmosphere to get C to create  
+                                                                              !! the seedlings @tex (gC.m^{-2}dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)            :: gpp_daily        !! Daily gross primary productivity  
+                                                                              !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)            :: co2_fire         !! Fire carbon emissions
+                                                                              !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)            :: time_hum_min     !! Time elapsed since strongest moisture 
+                                                                              !! availability (days) 
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)            :: gdd_midwinter    !! Growing degree days (K), since midwinter 
+                                                                              !! (for phenology) - this is written to the
+                                                                              !!  history files 
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)            :: gdd_from_growthinit !! growing degree days, since growthinit 
+                                                                              !! for crops
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)            :: gdd_m5_dormance  !! Growing degree days (K), threshold -5 deg 
+                                                                              !! C (for phenology)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)            :: ncd_dormance     !! Number of chilling days (days), since 
+                                                                              !! leaves were lost (for phenology) 
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)          :: lignin_struc     !! ratio Lignine/Carbon in structural litter,
+                                                                              !! above and below ground
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)          :: carbon           !! carbon pool: active, slow, or passive 
+                                                                              !! @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)          :: deepC_a          !! Permafrost soil carbon (g/m**3) active
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)          :: deepC_s          !! Permafrost soil carbon (g/m**3) slow
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)          :: deepC_p          !! Permafrost soil carbon (g/m**3) passive
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)          :: leaf_frac        !! fraction of leaves in leaf age class (unitless;0-1)
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)          :: leaf_age         !! Leaf age (days)
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout)        :: bm_to_litter     !! Transfer of biomass to litter 
+                                                                              !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout)        :: biomass          !! Stand level biomass @tex $(gC.m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(:,:,:,:,:), INTENT(inout)      :: litter           !! metabolic and structural litter, above and 
+                                                                              !! below ground @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout)        :: fuel_1hr
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout)        :: fuel_10hr
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout)        :: fuel_100hr
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout)        :: fuel_1000hr
+
+    !! 0.4 Local variables
+    REAL(r_std), DIMENSION(nvmap,nparts,nelements)        :: bm_to_litter_pro !! conversion of biomass to litter 
+                                                                              !! @tex ($gC m^{-2} day^{-1}$) @endtex
+    REAL(r_std), DIMENSION(nvmap,nparts,nelements)        :: biomass_pro      !! biomass @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(nvmap)                         :: veget_max_pro    !! "maximal" coverage fraction of a PFT (LAI ->
+                                                                              !! infinity) on ground (unitless) 
+    REAL(r_std), DIMENSION(nvmap,ncarb)                   :: carbon_pro       !! carbon pool: active, slow, or passive 
+                                                                              !! @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(nvmap,ndeep)                   :: deepC_a_pro      !! Permafrost carbon pool: active, slow, or passive 
+                                                                              !! @tex ($gC m^{-3}$) @endtex
+    REAL(r_std), DIMENSION(nvmap,ndeep)                   :: deepC_s_pro      !! Permafrost carbon pool: active, slow, or passive 
+                                                                              !! @tex ($gC m^{-3}$) @endtex
+    REAL(r_std), DIMENSION(nvmap,ndeep)                   :: deepC_p_pro      !! Permafrost carbon pool: active, slow, or passive 
+                                                                              !! @tex ($gC m^{-3}$) @endtex
+    REAL(r_std), DIMENSION(nvmap,nlitt,nlevs,nelements)   :: litter_pro       !! metabolic and structural litter, above and 
+                                                                              !! below ground @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(nvmap,nlitt,nelements)         :: fuel_1hr_pro
+    REAL(r_std), DIMENSION(nvmap,nlitt,nelements)         :: fuel_10hr_pro
+    REAL(r_std), DIMENSION(nvmap,nlitt,nelements)         :: fuel_100hr_pro
+    REAL(r_std), DIMENSION(nvmap,nlitt,nelements)         :: fuel_1000hr_pro
+    REAL(r_std), DIMENSION(nvmap,nlevs)                   :: lignin_struc_pro !! ratio Lignine/Carbon in structural litter
+                                                                              !! above and below ground
+    REAL(r_std), DIMENSION(nvmap,nleafages)               :: leaf_frac_pro    !! fraction of leaves in leaf age class 
+    REAL(r_std), DIMENSION(nvmap,nleafages)               :: leaf_age_pro     !! fraction of leaves in leaf age class 
+    LOGICAL, DIMENSION(nvmap)                :: PFTpresent_pro, senescence_pro                 !! Is pft there (unitless)
+    REAL(r_std), DIMENSION(nvmap)            :: ind_pro, age_pro, lm_lastyearmax_pro, npp_longterm_pro
+    REAL(r_std), DIMENSION(nvmap)            :: everywhere_pro
+    REAL(r_std), DIMENSION(nvmap)            :: gpp_daily_pro, npp_daily_pro, co2_to_bm_pro
+    REAL(r_std), DIMENSION(nvmap)            :: resp_maint_pro, resp_growth_pro
+    REAL(r_std), DIMENSION(nvmap)            :: resp_hetero_pro, co2_fire_pro
+  
+    INTEGER                :: ipts,ivm,ivma,l,m,ipft_young_agec
+    CHARACTER(LEN=10)      :: part_str                               !! string suffix indicating an index
+
+    REAL(r_std), DIMENSION(npts,nvmap)       :: glcc_mtc             !! Increase in fraction of each MTC in its youngest age-class
+    REAL(r_std), DIMENSION(npts,nvm)         :: glccReal_tmp         !! A temporary variable to hold glccReal
+
+    WRITE(numout,*) 'Entering glcc_MulAgeC'
+    glccReal_tmp(:,:) = zero
+
+    CALL glcc_MulAgeC_firstday(npts,veget_max,newvegfrac,   &
+                          glccSecondShift,glccPrimaryShift,glccNetLCC,&
+                          glccReal,glcc_pft,glcc_pftmtc,IncreDeficit)
+
+    glcc_mtc(:,:) = SUM(glcc_pftmtc,DIM=2)
+
+    DO ipts=1,npts
+
+      !! Initialize the _pro variables
+      bm_to_litter_pro(:,:,:)=zero                                                
+      biomass_pro(:,:,:)=zero
+      veget_max_pro(:)=zero                                                       
+      carbon_pro(:,:)=zero                                                        
+      deepC_a_pro(:,:)=zero                                                       
+      deepC_s_pro(:,:)=zero                                                       
+      deepC_p_pro(:,:)=zero                                                       
+      litter_pro(:,:,:,:)=zero                                                    
+      fuel_1hr_pro(:,:,:)=zero                                                    
+      fuel_10hr_pro(:,:,:)=zero                                                   
+      fuel_100hr_pro(:,:,:)=zero                                                  
+      fuel_1000hr_pro(:,:,:)=zero                                                 
+      lignin_struc_pro(:,:)=zero                                                  
+
+      leaf_frac_pro = zero
+      leaf_age_pro = zero
+      PFTpresent_pro(:) = .FALSE.
+      senescence_pro(:) = .TRUE.
+      ind_pro = zero
+      age_pro = zero
+      lm_lastyearmax_pro = zero
+      npp_longterm_pro = zero
+      everywhere_pro = zero
+      
+      gpp_daily_pro=zero                                                       
+      npp_daily_pro=zero                                                       
+      co2_to_bm_pro=zero                                                       
+      resp_maint_pro=zero                                                      
+      resp_growth_pro=zero                                                     
+      resp_hetero_pro=zero                                                     
+      co2_fire_pro=zero                                                        
+
+      ! Note that we assume people don't intentionally change baresoil to 
+      ! vegetated land.
+      DO ivma = 2,nvmap
+
+        ! here we set (glcc_mtc(ipts,ivma) GT. min_stomate) as a condition,
+        ! this is necessary because later on in the subroutine of 
+        ! `add_incoming_proxy_pft` we have to merge the newly established
+        ! youngest proxy with potentially exisiting youngest receiving MTC,
+        ! thus have to devide a new fraction of (frac_proxy + frac_exist),
+        ! but in case frac_exist = zero, we risk deviding by a very small value
+        ! of frac_proxy and thus we want it to be bigger than min_stomate.
+        IF ( glcc_mtc(ipts,ivma) .GT. min_stomate ) THEN
+
+          ! 1. we accumulate the scalar variables that will be inherited.
+          !    note that in the subroutine of `collect_legacy_pft`, all
+          !    zero transitions will be automatically skipped. 
+          CALL collect_legacy_pft(npts, ipts, ivma, glcc_pftmtc,    &
+                  biomass, bm_to_litter, carbon, litter,            &
+                  deepC_a, deepC_s, deepC_p,                        &
+                  fuel_1hr, fuel_10hr, fuel_100hr, fuel_1000hr,     &
+                  lignin_struc, co2_to_bm, gpp_daily, npp_daily,    &
+                  resp_maint, resp_growth, resp_hetero, co2_fire,   &
+                  def_fuel_1hr_remain, def_fuel_10hr_remain,        &
+                  def_fuel_100hr_remain, def_fuel_1000hr_remain,    &
+                  deforest_litter_remain, deforest_biomass_remain,  &
+                  veget_max_pro(ivma), carbon_pro(ivma,:),          &
+                  lignin_struc_pro(ivma,:), litter_pro(ivma,:,:,:), &
+                  deepC_a_pro(ivma,:), deepC_s_pro(ivma,:), deepC_p_pro(ivma,:), &
+                  fuel_1hr_pro(ivma,:,:), fuel_10hr_pro(ivma,:,:),  &
+                  fuel_100hr_pro(ivma,:,:), fuel_1000hr_pro(ivma,:,:), &
+                  bm_to_litter_pro(ivma,:,:), co2_to_bm_pro(ivma),  &
+                  gpp_daily_pro(ivma), npp_daily_pro(ivma),         &
+                  resp_maint_pro(ivma), resp_growth_pro(ivma),      &
+                  resp_hetero_pro(ivma), co2_fire_pro(ivma),        &
+                  convflux,prod10,prod100)
+
+          ! Here we substract the outgoing fraction from the source PFT.
+          ! If a too small fraction remains in this source PFT, then it is
+          ! considered exhausted and we empty it. The subroutine `empty_pft`
+          ! might be combined with `collect_legacy_pft` later.
+          DO ivm = 1,nvm
+            ! In the above we limit the collection of legacy pools to
+            ! (glcc_mtc(ipts,ivma) GT. min_stomate). Here we tentatively use
+            ! a lower threshold of `min_stomate*0.1`.
+            IF( glcc_pftmtc(ipts,ivm,ivma)>min_stomate*0.1 ) THEN
+              ! this is the key line to implement reduction of fraction of source
+              ! PFT.
+              veget_max(ipts,ivm) = veget_max(ipts,ivm)-glcc_pftmtc(ipts,ivm,ivma)
+              IF ( veget_max(ipts,ivm)<min_stomate ) THEN
+                CALL empty_pft(ipts, ivm, veget_max, biomass, ind,       &
+                       carbon, litter, lignin_struc, bm_to_litter,       &
+                       deepC_a, deepC_s, deepC_p,                        &
+                       fuel_1hr, fuel_10hr, fuel_100hr, fuel_1000hr,     &
+                       gpp_daily, npp_daily, gpp_week, npp_longterm,     &
+                       co2_to_bm, resp_maint, resp_growth, resp_hetero,  &
+                       lm_lastyearmax, leaf_frac, leaf_age, age,         &
+                       everywhere, PFTpresent, when_growthinit,          &
+                       senescence, gdd_from_growthinit, gdd_midwinter,   &
+                       time_hum_min, gdd_m5_dormance, ncd_dormance,      &
+                       moiavail_month, moiavail_week, ngd_minus5)
+              ENDIF
+            ENDIF
+          ENDDO
+
+        ENDIF !IF ( glcc_mtc(ipts,ivma) .GT. min_stomate )
+      ENDDO ! (DO ivma = 2,nvmap)
+
+      ! We establish new youngest proxy and add it to the 
+      ! existing youngest-age PFT. 
+      DO ivma = 2,nvmap
+        ipft_young_agec = start_index(ivma)
+
+        ! 2. we establish a proxy PFT with the fraction of veget_max_pro,
+        !    which is going to be either merged with existing target 
+        !    `ipft_young_agec` PFT, or fill the place if no existing target PFT
+        !    exits.
+        CALL initialize_proxy_pft(ipts,ipft_young_agec,veget_max_pro(ivma), &
+               biomass_pro(ivma,:,:), co2_to_bm_pro(ivma), ind_pro(ivma),   &
+               age_pro(ivma),                                               & 
+               senescence_pro(ivma), PFTpresent_pro(ivma),                  &
+               lm_lastyearmax_pro(ivma), everywhere_pro(ivma),              &
+               npp_longterm_pro(ivma),                                      &
+               leaf_frac_pro(ivma,:),leaf_age_pro(ivma,:))
+
+        ! we take as a priority from exsiting PFTs of the same meta-class
+        ! the sapling biomass needed to initialize the youngest-age-class
+        ! PFT, to avoid a too much high amount of CO2 dragged down from
+        ! the air.
+        CALL sap_take (ipts,ivma,veget_max,biomass_pro(ivma,:,:), &
+                       biomass,co2_to_bm_pro(ivma))
+
+        ! 3. we merge the newly initiazlized proxy PFT into existing one
+        !    or use it to fill an empty PFT slot.
+        CALL add_incoming_proxy_pft(npts, ipts, ipft_young_agec, veget_max_pro(ivma),&
+               carbon_pro(ivma,:), litter_pro(ivma,:,:,:), lignin_struc_pro(ivma,:), &
+               bm_to_litter_pro(ivma,:,:),    &
+               deepC_a_pro(ivma,:), deepC_s_pro(ivma,:), deepC_p_pro(ivma,:), &
+               fuel_1hr_pro(ivma,:,:), fuel_10hr_pro(ivma,:,:),               &
+               fuel_100hr_pro(ivma,:,:), fuel_1000hr_pro(ivma,:,:),           &
+               biomass_pro(ivma,:,:), co2_to_bm_pro(ivma),                    &
+               npp_longterm_pro(ivma), ind_pro(ivma),                         &
+               lm_lastyearmax_pro(ivma), age_pro(ivma), everywhere_pro(ivma), &  
+               leaf_frac_pro(ivma,:), leaf_age_pro(ivma,:),                   &
+               PFTpresent_pro(ivma), senescence_pro(ivma),                &
+               gpp_daily_pro(ivma), npp_daily_pro(ivma),                      &
+               resp_maint_pro(ivma), resp_growth_pro(ivma),                   &
+               resp_hetero_pro(ivma), co2_fire_pro(ivma),                     &
+               veget_max, carbon, litter, lignin_struc, bm_to_litter,         &
+               deepC_a, deepC_s, deepC_p,                                     &
+               fuel_1hr, fuel_10hr, fuel_100hr, fuel_1000hr,                  &
+               biomass, co2_to_bm, npp_longterm, ind,                         &
+               lm_lastyearmax, age, everywhere,                               &
+               leaf_frac, leaf_age, PFTpresent, senescence,                   &
+               gpp_daily, npp_daily, resp_maint, resp_growth,                 &
+               resp_hetero, co2_fire)
+        
+      ENDDO !(DO ivma=1,nvmap)
+
+    ENDDO !(DO ipts=1,npts)
+
+    ! Write out history files
+    CALL histwrite_p (hist_id_stomate, 'glcc_pft', itime, &
+         glcc_pft, npts*nvm, horipft_index)
+    CALL xios_orchidee_send_field ('glcc_pft', glcc_pft) ! kjpindex,nvm
+
+    glccReal_tmp(:,1:12) = glccReal
+    CALL histwrite_p (hist_id_stomate, 'glccReal', itime, &
+         glccReal_tmp, npts*nvm, horipft_index)
+    CALL xios_orchidee_send_field ('glccReal', glccReal_tmp) ! kjpindex,nvm
+
+    glccReal_tmp(:,:) = zero
+    glccReal_tmp(:,1:12) = IncreDeficit
+    CALL histwrite_p (hist_id_stomate, 'IncreDeficit', itime, &
+         glccReal_tmp, npts*nvm, horipft_index)
+    CALL xios_orchidee_send_field ('IncreDeficit', glccReal_tmp) ! kjpindex,nvm
+
+    DO ivma = 1, nvmap
+      WRITE(part_str,'(I2)') ivma
+      IF (ivma < 10) part_str(1:1) = '0'
+      CALL histwrite_p (hist_id_stomate, 'glcc_pftmtc_'//part_str(1:LEN_TRIM(part_str)), &
+           itime, glcc_pftmtc(:,:,ivma), npts*nvm, horipft_index)
+    ENDDO
+    CALL xios_orchidee_send_field ('glcc_pftmtc', glcc_pftmtc) ! kjpindex,nvm,nvmap
+
+  END SUBROUTINE glcc_MulAgeC
+
+
+! ================================================================================================================================
+!! SUBROUTINE   : glcc_MulAgeC_firstday
+!!
+!>\BRIEF        : When necessary, adjust input glcc matrix, and allocate it
+!!                into different contributing age classes and receiving 
+!!                youngest age classes.
+!! \n
+!_ ================================================================================================================================
+
+  ! Note: it has this name because this subroutine will also be called
+  ! the first day of each year to precalculate the forest loss for the
+  ! deforestation fire module.
+  SUBROUTINE glcc_MulAgeC_firstday(npts,veget_max_org,newvegfrac, &
+                          glccSecondShift,glccPrimaryShift,glccNetLCC,&
+                          glccReal,glcc_pft,glcc_pftmtc,IncreDeficit)
+
+    IMPLICIT NONE
+
+    !! 0.1 Input variables
+
+    INTEGER, INTENT(in)                                    :: npts             !! Domain size - number of pixels (unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)           :: veget_max_org    !! "maximal" coverage fraction of a PFT on the ground
+                                                                               !! May sum to
+                                                                               !! less than unity if the pixel has
+                                                                               !! nobio area. (unitless, 0-1)
+    REAL(r_std), DIMENSION(npts,nvmap), INTENT(in)         :: newvegfrac       !! used to guid the allocation of new PFTs.
+                                                                               !! 
+    REAL(r_std), DIMENSION (npts,12),INTENT(in)            :: glccSecondShift  !! the land-cover-change (LCC) matrix in case a gross LCC is 
+                                                                               !! used.
+    REAL(r_std), DIMENSION (npts,12),INTENT(in)            :: glccPrimaryShift !! the land-cover-change (LCC) matrix in case a gross LCC is 
+                                                                               !! used.
+    REAL(r_std), DIMENSION (npts,12),INTENT(in)            :: glccNetLCC       !! the land-cover-change (LCC) matrix in case a gross LCC is 
+                                                                               !! used.
+
+    !! 0.2 Output variables
+    REAL(r_std), DIMENSION(npts,nvm,nvmap), INTENT(inout)  :: glcc_pftmtc      !! a temporary variable to hold the fractions each PFT is going to lose
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)        :: glcc_pft         !! Loss of fraction in each PFT
+
+    REAL(r_std), DIMENSION(npts,12), INTENT(inout)         :: glccReal         !! Originally the "real" glcc matrix that we apply in the model
+                                                                               !! after considering the consistency between presribed
+                                                                               !! glcc matrix and existing vegetation fractions. Now the glcc
+                                                                               !! by summing SecShift,NetLCC and PriShift
+    REAL(r_std), DIMENSION(npts,12), INTENT(inout)         :: IncreDeficit     !! Originally "Increment" deficits, negative values mean that 
+                                                                               !! there are not enough fractions in the source PFTs
+                                                                               !! /vegetations to target PFTs/vegetations. I.e., these
+                                                                               !! fraction transfers are presribed in LCC matrix but
+                                                                               !! not realized. Now the glccDeficit for all land cover changes
+                                                                               !! except forestry harvest.
+
+    !! 0.3 Modified variables
+    
+    !! 0.4 Local variables
+    REAL(r_std), DIMENSION(npts,nvmap)              :: veget_mtc           !! "maximal" coverage fraction of a PFT on the ground
+    REAL(r_std), DIMENSION(npts,nvmap)              :: veget_mtc_begin     !! "maximal" coverage fraction of a PFT on the ground
+    REAL(r_std), DIMENSION(npts,nagec_tree)         :: vegagec_tree        !! fraction of tree age-class groups, in sequence of old->young
+    REAL(r_std), DIMENSION(npts,nagec_herb)         :: vegagec_grass       !! fraction of grass age-class groups, in sequence of old->young 
+    REAL(r_std), DIMENSION(npts,nagec_herb)         :: vegagec_pasture     !! fraction of pasture age-class groups, in sequence of old->young
+    REAL(r_std), DIMENSION(npts,nagec_herb)         :: vegagec_crop        !! fraction of crop age-class groups, in sequence of old->young
+
+    
+    REAL(r_std), DIMENSION(npts,4)                  :: veget_4veg          !! "maximal" coverage fraction of a PFT on the ground
+    REAL(r_std), DIMENSION(npts)                    :: veget_tree          !! "maximal" coverage fraction of a PFT on the ground
+    REAL(r_std), DIMENSION(npts)                    :: veget_grass         !! "maximal" coverage fraction of a PFT on the ground
+    REAL(r_std), DIMENSION(npts)                    :: veget_pasture       !! "maximal" coverage fraction of a PFT on the ground
+    REAL(r_std), DIMENSION(npts)                    :: veget_crop          !! "maximal" coverage fraction of a PFT on the ground
+
+    REAL(r_std), DIMENSION(npts,nvm)                :: veget_max           !! "maximal" coverage fraction of a PFT on the ground
+    REAL(r_std), DIMENSION(npts,nvm)                :: veget_max_tmp       !! "maximal" coverage fraction of a PFT on the ground
+    REAL(r_std), DIMENSION(npts,nvm)                :: veget_max_old       !! "maximal" coverage fraction of a PFT on the ground
+    REAL(r_std), DIMENSION(npts,nvm)                :: glcc_pft_tmp        !! Loss of fraction in each PFT
+
+    REAL(r_std), DIMENSION(npts,nvm,nvmap)          :: glcc_pftmtc_SecShift   !! a temporary variable to hold the fractions each PFT is going to lose
+    REAL(r_std), DIMENSION(npts,nvm,nvmap)          :: glcc_pftmtc_NetPri     !! a temporary variable to hold the fractions each PFT is going to lose
+
+    REAL(r_std), DIMENSION(npts,12)                 :: glccRealSecShift       !! real matrix applied for secondary shifting cultivation.
+    REAL(r_std), DIMENSION(npts,12)                 :: glccRealNetPriShift    !! real matrix applied for NetLCC+primary shifting cultivation.    
+
+    REAL(r_std), DIMENSION(npts,12)                 :: glccDefSecShift        !! deficit for the glccSecondShift
+    REAL(r_std), DIMENSION(npts,12)                 :: glccDefNetPriShift     !! deficit for the glccNetLCC + glccPriShift
+
+    REAL(r_std), DIMENSION(npts,nvm)                :: glccReal_tmp           !! A temporary variable to hold glccReal
+
+    LOGICAL, SAVE  :: glcc_MulAgeC_firstday_done = .FALSE.
+
+    ! Different indexes for convenient local uses
+    ! We define the rules for gross land cover change matrix:
+    ! 1 forest->grass
+    ! 2 forest->pasture 
+    ! 3 forest->crop
+    ! 4 grass->forest
+    ! 5 grass->pasture
+    ! 6 grass->crop
+    ! 7 pasture->forest
+    ! 8 pasture->grass
+    ! 9 pasture->crop
+    ! 10 crop->forest
+    ! 11 crop->grass
+    ! 12 crop->pasture
+    INTEGER :: f2g=1, f2p=2, f2c=3
+    INTEGER :: g2f=4, g2p=5, g2c=6, p2f=7, p2g=8, p2c=9, c2f=10, c2g=11, c2p=12
+
+    INTEGER :: ivma
+
+    REAL(r_std), DIMENSION(npts,12)         :: glccRemain      
+    REAL(r_std), DIMENSION(npts,12)         :: glccSecondShift_remain      
+
+    INTEGER :: ipts,IndStart_f,IndEnd_f
+    CHARACTER(LEN=10)      :: part_str                               !! string suffix indicating an index
+
+    !Some more local configurations
+    LOGICAL                                 :: allow_youngest_forest_SecShift = .TRUE.
+    
+
+
+    ! check for equal bi-directional transition in glccSecondShift
+    DO ipts = 1,npts
+      IF (ABS(glccSecondShift(ipts,f2g)-glccSecondShift(ipts,g2f)) .GE. min_stomate*100) THEN
+        WRITE(numout,*) 'Error in input transition matrix for shifting cultivation'
+        WRITE(numout,*) 'transition between f2g and g2f is not equal !'
+        WRITE(numout,*) 'Grid cell number: ', ipts
+        STOP
+      ENDIF
+
+      IF (ABS(glccSecondShift(ipts,f2c)-glccSecondShift(ipts,c2f)) .GE. min_stomate*100) THEN
+        WRITE(numout,*) 'Error in input transition matrix for shifting cultivation'
+        WRITE(numout,*) 'transition between f2c and c2f is not equal !'
+        WRITE(numout,*) 'Grid cell number: ', ipts
+        STOP
+      ENDIF
+
+      IF (ABS(glccSecondShift(ipts,f2p)-glccSecondShift(ipts,p2f)) .GE. min_stomate*100) THEN
+        WRITE(numout,*) 'Error in input transition matrix for shifting cultivation'
+        WRITE(numout,*) 'transition between f2p and p2f is not equal !'
+        WRITE(numout,*) 'Grid cell number: ', ipts
+        STOP
+      ENDIF
+
+      IF (ABS(glccSecondShift(ipts,g2p)-glccSecondShift(ipts,p2g)) .GE. min_stomate*100) THEN
+        WRITE(numout,*) 'Error in input transition matrix for shifting cultivation'
+        WRITE(numout,*) 'transition between g2p and p2g is not equal !'
+        WRITE(numout,*) 'Grid cell number: ', ipts
+        STOP
+      ENDIF
+
+      IF (ABS(glccSecondShift(ipts,g2c)-glccSecondShift(ipts,c2g)) .GE. min_stomate*100) THEN
+        WRITE(numout,*) 'Error in input transition matrix for shifting cultivation'
+        WRITE(numout,*) 'transition between g2c and c2g is not equal !'
+        WRITE(numout,*) 'Grid cell number: ', ipts
+        STOP
+      ENDIF
+
+      IF (ABS(glccSecondShift(ipts,p2c)-glccSecondShift(ipts,c2p)) .GE. min_stomate*100) THEN
+        WRITE(numout,*) 'Error in input transition matrix for shifting cultivation'
+        WRITE(numout,*) 'transition between p2c and c2p is not equal !'
+        WRITE(numout,*) 'Grid cell number: ', ipts
+        STOP
+      ENDIF
+    ENDDO
+
+    ! check for equal bi-directional transition in glccPrimaryShift
+    DO ipts = 1,npts
+      IF (ABS(glccPrimaryShift(ipts,f2g)-glccPrimaryShift(ipts,g2f)) .GE. min_stomate*100) THEN
+        WRITE(numout,*) 'Error in input transition matrix for shifting cultivation'
+        WRITE(numout,*) 'transition between f2g and g2f is not equal !'
+        WRITE(numout,*) 'Grid cell number: ', ipts
+        STOP
+      ENDIF
+
+      IF (ABS(glccPrimaryShift(ipts,f2c)-glccPrimaryShift(ipts,c2f)) .GE. min_stomate*100) THEN
+        WRITE(numout,*) 'Error in input transition matrix for shifting cultivation'
+        WRITE(numout,*) 'transition between f2c and c2f is not equal !'
+        WRITE(numout,*) 'Grid cell number: ', ipts
+        STOP
+      ENDIF
+
+      IF (ABS(glccPrimaryShift(ipts,f2p)-glccPrimaryShift(ipts,p2f)) .GE. min_stomate*100) THEN
+        WRITE(numout,*) 'Error in input transition matrix for shifting cultivation'
+        WRITE(numout,*) 'transition between f2p and p2f is not equal !'
+        WRITE(numout,*) 'Grid cell number: ', ipts
+        STOP
+      ENDIF
+
+      IF (ABS(glccPrimaryShift(ipts,g2p)-glccPrimaryShift(ipts,p2g)) .GE. min_stomate*100) THEN
+        WRITE(numout,*) 'Error in input transition matrix for shifting cultivation'
+        WRITE(numout,*) 'transition between g2p and p2g is not equal !'
+        WRITE(numout,*) 'Grid cell number: ', ipts
+        STOP
+      ENDIF
+
+      IF (ABS(glccPrimaryShift(ipts,g2c)-glccPrimaryShift(ipts,c2g)) .GE. min_stomate*100) THEN
+        WRITE(numout,*) 'Error in input transition matrix for shifting cultivation'
+        WRITE(numout,*) 'transition between g2c and c2g is not equal !'
+        WRITE(numout,*) 'Grid cell number: ', ipts
+        STOP
+      ENDIF
+
+      IF (ABS(glccPrimaryShift(ipts,p2c)-glccPrimaryShift(ipts,c2p)) .GE. min_stomate*100) THEN
+        WRITE(numout,*) 'Error in input transition matrix for shifting cultivation'
+        WRITE(numout,*) 'transition between p2c and c2p is not equal !'
+        WRITE(numout,*) 'Grid cell number: ', ipts
+        STOP
+      ENDIF
+    ENDDO
+
+    ! Initialization
+    glccReal = zero
+    glcc_pftmtc = zero
+    glcc_pft = zero
+    glcc_pft_tmp = zero
+
+    !!! ** Land cover change processes start here ** !!!
+    ! we make copies of original input veget_max (which is veget_max_org
+    ! in the subroutine parameter list).
+    ! veget_max will be modified through different operations in order to 
+    ! check for various purposes, e.g., whether input glcc matrix 
+    ! is compatible with existing veget_max and how to allocate it etc.
+    ! veget_max_old will not be modified
+    veget_max(:,:) = veget_max_org(:,:)
+    veget_max_old(:,:) = veget_max_org(:,:)
+
+    !! 3. Treat secondary-agriculture shifting cultivation transition matrix.
+    !! The primary-agriculture shifting cultivation will be treated together
+    !! with the netLCC transitions, with the conversion sequence of oldest->
+    !! youngest is applied.
+
+    ! When we prepare the driving data, secondary-agriculture shifting cultivation
+    ! is intended to include the "constant transitions" over time. Ideally, we
+    ! should start applying this secondary-agriculture shifting cultivation with
+    ! the "secondary forest" in the model. Here we tentatively start with the 3rd
+    ! youngest age class and move to the 2ne youngest age class. But if the prescribed
+    ! transition fraction is not met, we then move further to 4th youngest age class
+    ! and then move to the oldest age class sequentially.
+
+    ! Note for the first call, we have to pass veget_mtc_begin instead of veget_mtc
+    ! in order to keep the original veget_mtc before any convserion is made. The
+    ! veget_mtc is used to in type_conversion to guide the allocation of newly
+    ! created fraction of a certain mtc to its componenet youngest PFTs.
+    CALL calc_cover(npts,veget_max,veget_mtc_begin,vegagec_tree,vegagec_grass, &
+           vegagec_pasture,vegagec_crop)
+    veget_mtc = veget_mtc_begin
+ 
+    !! 3.1 We start treating secondary-agriculture cultivation from the 3rd youngest 
+    !! age class and then move to the younger age class. 
+    ! Because it's rather complicated to calculate which transtion fraction between
+    ! which vegetation types should occur in case there is deficit occuring
+    ! for the overall donation vegetation type, we will just start from some 
+    ! priority and leave the unrealized parts into the latter section.
+
+    ! For this purpose, we should first make a copy of glccSecondShift into 
+    ! glccRemain. glccRemain will tell us the transition fractions that have to
+    ! be treated starting from `IndStart_f+1` oldest age class and moving torward older
+    ! age class.
+    glccRemain(:,:) = glccSecondShift(:,:)
+
+    ! Now we will call type_conversion for each of the 12 transitions, starting
+    ! from `IndStart_f` age class moving to the 2nd youngest age class. We use glccRemain
+    ! to track the transtion fractions we should leave for the second case. 
+    ! To make the code more flexible, we will store the start and end indecies
+    ! in variables.
+
+    !*[Note: we do above process only for forest now, as we assume the conversion
+    !  of crop/pasture/grass to other types will start always from the oldest
+    !  age class]
+
+    IndStart_f = nagec_tree-1  ! note the indecies and vegetfrac for tree age class
+                               ! is from old to young
+    IndEnd_f = nagec_tree    ! nagec_tree-2: The 3rd youngest age class
+                               ! nagec_tree-1: The 2nd youngest age class
+                               ! nagec_tree: The youngest age class
+
+    IF (IndStart_f .LE. 0 .OR. IndEnd_f .LE. 0) THEN
+      write(numout,*) 'glcc_MulAgeC: Age class index cannot be negative or zero!'
+      STOP
+    ENDIF
+
+    DO ipts=1,npts
+      !f2c
+      CALL type_conversion(ipts,f2c,glccSecondShift,veget_mtc,newvegfrac,       &
+                       indold_tree,indagec_tree,indagec_crop,num_crop_mulagec,     &
+                       IndEnd_f,nagec_herb,                    &
+                       vegagec_tree,veget_max,glcc_pft,glcc_pftmtc,glcc_pft_tmp, &
+                       glccRemain, &
+                       .TRUE., iagec_start=IndStart_f)
+      !f2p
+      CALL type_conversion(ipts,f2p,glccSecondShift,veget_mtc,newvegfrac,       &
+                       indold_tree,indagec_tree,indagec_pasture,num_pasture_mulagec,     &
+                       IndEnd_f,nagec_herb,                    &
+                       vegagec_tree,veget_max,glcc_pft,glcc_pftmtc,glcc_pft_tmp, &
+                       glccRemain, &
+                       .TRUE., iagec_start=IndStart_f)
+      !f2g
+      CALL type_conversion(ipts,f2g,glccSecondShift,veget_mtc,newvegfrac,       &
+                       indold_tree,indagec_tree,indagec_grass,num_grass_mulagec,     &
+                       IndEnd_f,nagec_herb,                    &
+                       vegagec_tree,veget_max,glcc_pft,glcc_pftmtc,glcc_pft_tmp,&
+                       glccRemain, &
+                       .TRUE., iagec_start=IndStart_f)
+      !g2c
+      CALL type_conversion(ipts,g2c,glccSecondShift,veget_mtc,newvegfrac,       &
+                       indold_grass,indagec_grass,indagec_crop,num_crop_mulagec,     &
+                       nagec_herb,nagec_herb,                    &
+                       vegagec_grass,veget_max,glcc_pft,glcc_pftmtc,glcc_pft_tmp,&
+                       glccRemain, &
+                       .TRUE.)
+      !g2p
+      CALL type_conversion(ipts,g2p,glccSecondShift,veget_mtc,newvegfrac,       &
+                       indold_grass,indagec_grass,indagec_pasture,num_pasture_mulagec,     &
+                       nagec_herb,nagec_herb,                    &
+                       vegagec_grass,veget_max,glcc_pft,glcc_pftmtc,glcc_pft_tmp,&
+                       glccRemain, &
+                       .TRUE.)
+      !g2f
+      CALL type_conversion(ipts,g2f,glccSecondShift,veget_mtc,newvegfrac,       &
+                       indold_grass,indagec_grass,indagec_tree,num_tree_mulagec,     &
+                       nagec_herb,nagec_tree,                    &
+                       vegagec_grass,veget_max,glcc_pft,glcc_pftmtc,glcc_pft_tmp,&
+                       glccRemain, &
+                       .TRUE.)
+      !p2c
+      CALL type_conversion(ipts,p2c,glccSecondShift,veget_mtc,newvegfrac,       &
+                       indold_pasture,indagec_pasture,indagec_crop,num_crop_mulagec,     &
+                       nagec_herb,nagec_herb,                    &
+                       vegagec_pasture,veget_max,glcc_pft,glcc_pftmtc,glcc_pft_tmp,&
+                       glccRemain, &
+                       .TRUE.)
+      !p2g
+      CALL type_conversion(ipts,p2g,glccSecondShift,veget_mtc,newvegfrac,       &
+                       indold_pasture,indagec_pasture,indagec_grass,num_grass_mulagec,     &
+                       nagec_herb,nagec_herb,                    &
+                       vegagec_pasture,veget_max,glcc_pft,glcc_pftmtc,glcc_pft_tmp,&
+                       glccRemain, &
+                       .TRUE.)
+      !p2f
+      CALL type_conversion(ipts,p2f,glccSecondShift,veget_mtc,newvegfrac,       &
+                       indold_pasture,indagec_pasture,indagec_tree,num_tree_mulagec,     &
+                       nagec_herb,nagec_tree,                    &
+                       vegagec_pasture,veget_max,glcc_pft,glcc_pftmtc,glcc_pft_tmp,&
+                       glccRemain, &
+                       .TRUE.)
+      !c2p
+      CALL type_conversion(ipts,c2p,glccSecondShift,veget_mtc,newvegfrac,       &
+                       indold_crop,indagec_crop,indagec_pasture,num_pasture_mulagec,     &
+                       nagec_herb,nagec_herb,                    &
+                       vegagec_crop,veget_max,glcc_pft,glcc_pftmtc,glcc_pft_tmp,&
+                       glccRemain, &
+                       .TRUE.)
+      !c2g
+      CALL type_conversion(ipts,c2g,glccSecondShift,veget_mtc,newvegfrac,       &
+                       indold_crop,indagec_crop,indagec_grass,num_grass_mulagec,     &
+                       nagec_herb,nagec_herb,                    &
+                       vegagec_crop,veget_max,glcc_pft,glcc_pftmtc,glcc_pft_tmp,&
+                       glccRemain, &
+                       .TRUE.)
+      !c2f
+      CALL type_conversion(ipts,c2f,glccSecondShift,veget_mtc,newvegfrac,       &
+                       indold_crop,indagec_crop,indagec_tree,num_tree_mulagec,     &
+                       nagec_herb,nagec_tree,                    &
+                       vegagec_crop,veget_max,glcc_pft,glcc_pftmtc,glcc_pft_tmp,&
+                       glccRemain, &
+                       .TRUE.)
+    ENDDO
+    glccSecondShift_remain(:,:) = glccRemain(:,:)
+
+    !! 3.2 We treat the remaing unrealized transtions from forest. Now we will
+    !! start with the 3rd oldest age class and then move to the oldest age class. 
+
+    CALL calc_cover(npts,veget_max,veget_mtc,vegagec_tree,vegagec_grass, &
+           vegagec_pasture,vegagec_crop)
+    veget_mtc = veget_mtc_begin
+ 
+    IndStart_f = nagec_tree  ! note the indecies and vegetfrac for tree age class
+                               ! is from old to young. 
+                               ! nagec_tree -3: The 4th youngest age class.
+
+    IndEnd_f = 1               ! oldest-age class forest.
+
+    IF (IndStart_f .LE. 0 .OR. IndEnd_f .LE. 0) THEN
+      write(numout,*) 'glcc_MulAgeC: Age class index cannot be negative or zero!'
+      STOP
+    ENDIF
+
+    ! we start with the 3rd youngest age class and move up to the oldest age
+    ! class in the sequence of young->old, as indicated by the .FALSE. parameter
+    ! when calling the subroutine type_conversion.
+    DO ipts=1,npts
+      !f2c
+      CALL type_conversion(ipts,f2c,glccSecondShift_remain,veget_mtc,newvegfrac,       &
+                       indold_tree,indagec_tree,indagec_crop,num_crop_mulagec,     &
+                       IndEnd_f,nagec_herb,                    &
+                       vegagec_tree,veget_max,glcc_pft,glcc_pftmtc,glcc_pft_tmp, &
+                       glccRemain, &
+                       .FALSE., iagec_start=IndStart_f)
+      !f2p
+      CALL type_conversion(ipts,f2p,glccSecondShift_remain,veget_mtc,newvegfrac,       &
+                       indold_tree,indagec_tree,indagec_pasture,num_pasture_mulagec,     &
+                       IndEnd_f,nagec_herb,                    &
+                       vegagec_tree,veget_max,glcc_pft,glcc_pftmtc,glcc_pft_tmp, &
+                       glccRemain, &
+                       .FALSE., iagec_start=IndStart_f)
+      !f2g
+      CALL type_conversion(ipts,f2g,glccSecondShift_remain,veget_mtc,newvegfrac,       &
+                       indold_tree,indagec_tree,indagec_grass,num_grass_mulagec,     &
+                       IndEnd_f,nagec_herb,                    &
+                       vegagec_tree,veget_max,glcc_pft,glcc_pftmtc,glcc_pft_tmp,&
+                       glccRemain, &
+                       .FALSE., iagec_start=IndStart_f)
+    ENDDO
+
+    IF (allow_youngest_forest_SecShift) THEN
+      !!++Temp++!!
+      !! this block of 3.3 could be commented to remove this process as desribed
+      !! below.
+
+      ! [2016-04-20] This is temporarily added: Normally we assume the youngest
+      ! forest age cohort will not be cut because in a shifting cultivation, they
+      ! are grown to let the land recover from agricultural process. (Or at least)
+      ! we can set the threshold of youngest age cohort to be very small. But there
+      ! are two reasons we allow the youngest forest cohort to be cut for shifting
+      ! cultivation purpose: a). Farmers may decide to harvest the wood of a forest
+      ! and then convert to crop. We don't simulate explicitly this process because 
+      ! this will depend on input land change matrix and land use data assumptions.
+      ! However,we can implicitly account for this by assuming "farmers plant young
+      ! trees after harvesting the wood, and immediately convert this young trees
+      ! to crops. b). For the sake of conserving the total sum of veget_max before
+      ! and after the transition as one, we need to allow the youngest forest cohort
+      ! eligible for cutting.
+
+      !! 3.3 We treat the remaing unrealized transtions from forest, allowing 
+      !! the youngest forest cohort to be cut. For this purpose, we will
+      !! start with the 2nd youngest age class and then move to the youngest one. 
+
+      glccSecondShift_remain(:,:) = glccRemain(:,:)
+
+      CALL calc_cover(npts,veget_max,veget_mtc,vegagec_tree,vegagec_grass, &
+             vegagec_pasture,vegagec_crop)
+      veget_mtc = veget_mtc_begin
+ 
+      ! Note: the setting of index here must be consistent with those of 3.1 and 3.2
+      IndStart_f = nagec_tree-1  ! note the indecies and vegetfrac for tree age class
+                                 ! is from old to young. 
+                                 ! nagec_tree -1: The 2nd youngest age class.
+
+      IndEnd_f = nagec_tree      ! youngest class forest.
+
+      IF (IndStart_f .LE. 0 .OR. IndEnd_f .LE. 0) THEN
+        write(numout,*) 'glcc_MulAgeC: Age class index cannot be negative or zero!'
+        STOP
+      ENDIF
+
+      ! we start with the 3rd youngest age class and move up to the oldest age
+      ! class in the sequence of young->old, as indicated by the .FALSE. parameter
+      ! when calling the subroutine type_conversion.
+      DO ipts=1,npts
+        !f2c
+        CALL type_conversion(ipts,f2c,glccSecondShift_remain,veget_mtc,newvegfrac,       &
+                         indold_tree,indagec_tree,indagec_crop,num_crop_mulagec,     &
+                         IndEnd_f,nagec_herb,                    &
+                         vegagec_tree,veget_max,glcc_pft,glcc_pftmtc,glcc_pft_tmp, &
+                         glccRemain, &
+                         .TRUE., iagec_start=IndStart_f)
+        !f2p
+        CALL type_conversion(ipts,f2p,glccSecondShift_remain,veget_mtc,newvegfrac,       &
+                         indold_tree,indagec_tree,indagec_pasture,num_pasture_mulagec,     &
+                         IndEnd_f,nagec_herb,                    &
+                         vegagec_tree,veget_max,glcc_pft,glcc_pftmtc,glcc_pft_tmp, &
+                         glccRemain, &
+                         .TRUE., iagec_start=IndStart_f)
+        !f2g
+        CALL type_conversion(ipts,f2g,glccSecondShift_remain,veget_mtc,newvegfrac,       &
+                         indold_tree,indagec_tree,indagec_grass,num_grass_mulagec,     &
+                         IndEnd_f,nagec_herb,                    &
+                         vegagec_tree,veget_max,glcc_pft,glcc_pftmtc,glcc_pft_tmp,&
+                         glccRemain, &
+                         .TRUE., iagec_start=IndStart_f)
+      ENDDO
+      !! End of ++Temp++ Section 3.3
+    ENDIF
+
+    ! Final handling of some output variables.
+    ! we separate the glcc_pftmtc_SecShift
+    glcc_pftmtc_SecShift = glcc_pftmtc
+
+    ! we put the remaining glccRemain into the deficit
+    glccDefSecShift = -1 * glccRemain
+    glccRealSecShift = glccSecondShift - glccRemain
+
+    !*****end block to handle secondary-agriculture shifting cultivation *******
+
+
+    !! 4. Treat the transtions involving the oldest age classes, which include
+    !!    the first-time primary-agriculture cultivation and the net land cover
+    !!    transtions
+
+    CALL calc_cover(npts,veget_max,veget_mtc,vegagec_tree,vegagec_grass, &
+           vegagec_pasture,vegagec_crop)
+    veget_mtc = veget_mtc_begin
+ 
+
+    ! the variable "glccReal" is originally for storing the realized maxtrix
+    ! after considering the constraining and compensation of existing vegetation
+    ! fractions. But as this case is not allowed at the moment, we will just
+    ! simply put it as the sum of glccPrimaryShift and glccNetLCC
+    glccReal(:,:) = glccPrimaryShift+glccNetLCC
+
+    ! We copy the glccReal to glccRemain in order to track the remaining
+    ! prescribed transtion fraction after applying each transition by calling
+    ! the subroutine "type_conversion". For the moment this is mainly to fufill
+    ! the parameter requirement of the type_conversion subroutine.
+    glccRemain(:,:) = glccReal(:,:)
+
+    ! We allocate in the sequences of old->young. Within the same age-class
+    ! group, we allocate in proportion with existing PFT fractions.
+    DO ipts=1,npts
+      !f2c
+      CALL type_conversion(ipts,f2c,glccReal,veget_mtc,newvegfrac,       &
+                       indold_tree,indagec_tree,indagec_crop,num_crop_mulagec,     &
+                       nagec_tree,nagec_herb,                    &
+                       vegagec_tree,veget_max,glcc_pft,glcc_pftmtc,glcc_pft_tmp, &
+                       glccRemain, &
+                       .TRUE.)
+      !f2p
+      CALL type_conversion(ipts,f2p,glccReal,veget_mtc,newvegfrac,       &
+                       indold_tree,indagec_tree,indagec_pasture,num_pasture_mulagec,     &
+                       nagec_tree,nagec_herb,                    &
+                       vegagec_tree,veget_max,glcc_pft,glcc_pftmtc,glcc_pft_tmp, &
+                       glccRemain, &
+                       .TRUE.)
+      !f2g
+      CALL type_conversion(ipts,f2g,glccReal,veget_mtc,newvegfrac,       &
+                       indold_tree,indagec_tree,indagec_grass,num_grass_mulagec,     &
+                       nagec_tree,nagec_herb,                    &
+                       vegagec_tree,veget_max,glcc_pft,glcc_pftmtc,glcc_pft_tmp,&
+                       glccRemain, &
+                       .TRUE.)
+      !g2c
+      CALL type_conversion(ipts,g2c,glccReal,veget_mtc,newvegfrac,       &
+                       indold_grass,indagec_grass,indagec_crop,num_crop_mulagec,     &
+                       1,nagec_herb,                    &
+                       vegagec_grass,veget_max,glcc_pft,glcc_pftmtc,glcc_pft_tmp,&
+                       glccRemain, &
+                       .FALSE., iagec_start=nagec_herb)
+      !g2p
+      CALL type_conversion(ipts,g2p,glccReal,veget_mtc,newvegfrac,       &
+                       indold_grass,indagec_grass,indagec_pasture,num_pasture_mulagec,     &
+                       1,nagec_herb,                    &
+                       vegagec_grass,veget_max,glcc_pft,glcc_pftmtc,glcc_pft_tmp,&
+                       glccRemain, &
+                       .FALSE., iagec_start=nagec_herb)
+      !g2f
+      CALL type_conversion(ipts,g2f,glccReal,veget_mtc,newvegfrac,       &
+                       indold_grass,indagec_grass,indagec_tree,num_tree_mulagec,     &
+                       1,nagec_tree,                    &
+                       vegagec_grass,veget_max,glcc_pft,glcc_pftmtc,glcc_pft_tmp,&
+                       glccRemain, &
+                       .FALSE., iagec_start=nagec_herb)
+      !p2c
+      CALL type_conversion(ipts,p2c,glccReal,veget_mtc,newvegfrac,       &
+                       indold_pasture,indagec_pasture,indagec_crop,num_crop_mulagec,     &
+                       1,nagec_herb,                    &
+                       vegagec_pasture,veget_max,glcc_pft,glcc_pftmtc,glcc_pft_tmp,&
+                       glccRemain, &
+                       .FALSE., iagec_start=nagec_herb)
+      !p2g
+      CALL type_conversion(ipts,p2g,glccReal,veget_mtc,newvegfrac,       &
+                       indold_pasture,indagec_pasture,indagec_grass,num_grass_mulagec,     &
+                       1,nagec_herb,                    &
+                       vegagec_pasture,veget_max,glcc_pft,glcc_pftmtc,glcc_pft_tmp,&
+                       glccRemain, &
+                       .FALSE., iagec_start=nagec_herb)
+      !p2f
+      CALL type_conversion(ipts,p2f,glccReal,veget_mtc,newvegfrac,       &
+                       indold_pasture,indagec_pasture,indagec_tree,num_tree_mulagec,     &
+                       1,nagec_tree,                    &
+                       vegagec_pasture,veget_max,glcc_pft,glcc_pftmtc,glcc_pft_tmp,&
+                       glccRemain, &
+                       .FALSE., iagec_start=nagec_herb)
+      !c2p
+      CALL type_conversion(ipts,c2p,glccReal,veget_mtc,newvegfrac,       &
+                       indold_crop,indagec_crop,indagec_pasture,num_pasture_mulagec,     &
+                       1,nagec_herb,                    &
+                       vegagec_crop,veget_max,glcc_pft,glcc_pftmtc,glcc_pft_tmp,&
+                       glccRemain, &
+                       .FALSE., iagec_start=nagec_herb)
+      !c2g
+      CALL type_conversion(ipts,c2g,glccReal,veget_mtc,newvegfrac,       &
+                       indold_crop,indagec_crop,indagec_grass,num_grass_mulagec,     &
+                       1,nagec_herb,                    &
+                       vegagec_crop,veget_max,glcc_pft,glcc_pftmtc,glcc_pft_tmp,&
+                       glccRemain, &
+                       .FALSE., iagec_start=nagec_herb)
+      !c2f
+      CALL type_conversion(ipts,c2f,glccReal,veget_mtc,newvegfrac,       &
+                       indold_crop,indagec_crop,indagec_tree,num_tree_mulagec,     &
+                       1,nagec_tree,                    &
+                       vegagec_crop,veget_max,glcc_pft,glcc_pftmtc,glcc_pft_tmp,&
+                       glccRemain, &
+                       .FALSE., iagec_start=nagec_herb)
+    ENDDO
+
+    glccDefNetPriShift = -1 * glccRemain
+    glccRealNetPriShift = glccPrimaryShift + glccNetLCC - glccRemain
+    glcc_pftmtc_NetPri = glcc_pftmtc - glcc_pftmtc_SecShift
+    glccReal = glccRealSecShift + glccRealNetPriShift
+    ! Note here IncreDeficit  includes the deficit from secondary<->agriculgure shifting
+    ! cultivation and the primary<->agriculture+NetLCC transitions.
+    IncreDeficit = glccDefSecShift + glccDefNetPriShift
+
+    IF (.NOT. glcc_MulAgeC_firstday_done) THEN
+
+      glccReal_tmp = zero
+
+      glccReal_tmp(:,1:12) = glccRealSecShift
+      CALL histwrite_p (hist_id_stomate, 'glccRealSecShift', itime, &
+           glccReal_tmp, npts*nvm, horipft_index)
+      CALL xios_orchidee_send_field ('glccRealSecShift', glccReal_tmp) ! kjpindex,nvm
+
+      glccReal_tmp(:,1:12) = glccRealNetPriShift
+      CALL histwrite_p (hist_id_stomate, 'glccRealNetPriShift', itime, &
+           glccReal_tmp, npts*nvm, horipft_index)
+      CALL xios_orchidee_send_field ('glccRealNetPriShift', glccReal_tmp) ! kjpindex,nvm
+
+      glccReal_tmp(:,1:12) = glccDefSecShift
+      CALL histwrite_p (hist_id_stomate, 'glccDefSecShift', itime, &
+           glccReal_tmp, npts*nvm, horipft_index)
+      CALL xios_orchidee_send_field ('glccDefSecShift', glccReal_tmp) ! kjpindex,nvm
+
+      glccReal_tmp(:,1:12) = glccDefNetPriShift
+      CALL histwrite_p (hist_id_stomate, 'glccDefNetPriShift', itime, &
+           glccReal_tmp, npts*nvm, horipft_index)
+      CALL xios_orchidee_send_field ('glccDefNetPriShift', glccReal_tmp) ! kjpindex,nvm
+
+      DO ivma = 1, nvmap
+        WRITE(part_str,'(I2)') ivma
+        IF (ivma < 10) part_str(1:1) = '0'
+        CALL histwrite_p (hist_id_stomate, 'glcc_pftmtc_SF_'//part_str(1:LEN_TRIM(part_str)), &
+             itime, glcc_pftmtc_SecShift(:,:,ivma), npts*nvm, horipft_index)
+      ENDDO
+      CALL xios_orchidee_send_field ('glcc_pftmtc_SF', glcc_pftmtc_SecShift) ! kjpindex,nvm,nvmap
+
+      DO ivma = 1, nvmap
+        WRITE(part_str,'(I2)') ivma
+        IF (ivma < 10) part_str(1:1) = '0'
+        CALL histwrite_p (hist_id_stomate, 'glcc_pftmtc_NPF_'//part_str(1:LEN_TRIM(part_str)), &
+             itime, glcc_pftmtc_NetPri(:,:,ivma), npts*nvm, horipft_index)
+      ENDDO
+      CALL xios_orchidee_send_field ('glcc_pftmtc_NPF', glcc_pftmtc_NetPri) ! kjpindex,nvm,nvmap
+     
+      glcc_MulAgeC_firstday_done = .TRUE.
+    ENDIF
+
+  END SUBROUTINE glcc_MulAgeC_firstday
+
+
+
+! ================================================================================================================================
+!! SUBROUTINE   : type_conversion
+!>\BRIEF        : Allocate outgoing into different age classes and incoming into
+!!                yongest age-class of receiving MTCs.
+!!
+!! REMARK       : The current dummy variables give an example of converting forests
+!!                to crops.
+!! \n
+!_ ================================================================================================================================
+  SUBROUTINE type_conversion(ipts,f2c,glccReal,veget_mtc,newvegfrac,       &
+                     indold_tree,indagec_tree,indagec_crop,num_crop_mulagec,     &
+                     iagec_tree_end,nagec_receive,                    &
+                     vegagec_tree,veget_max,glcc_pft,glcc_pftmtc,glcc_pft_tmp, &
+                     glccRemain, &
+                     old_to_young, iagec_start)
+
+    IMPLICIT NONE
+
+    !! Input variables
+    INTEGER, INTENT(in)                             :: ipts,f2c
+    REAL(r_std), DIMENSION(:,:), INTENT(in)         :: glccReal             !! The "real" glcc matrix that we apply in the model
+                                                                            !! after considering the consistency between presribed
+                                                                            !! glcc matrix and existing vegetation fractions.
+    REAL(r_std), DIMENSION(:,:), INTENT(in)          :: newvegfrac
+    REAL(r_std), DIMENSION(:,:), INTENT(in)         :: veget_mtc            !! "maximal" coverage fraction of a PFT on the ground
+    INTEGER, DIMENSION(:), INTENT(in)               :: indold_tree          !! Indices for PFTs giving out fractions; 
+                                                                            !! here use old tree cohort as an example. When iagec_start and 
+                                                                            !! a 'old_to_young' or 'young_to_old' sequence is prescribed,
+                                                                            !! this index can be possibly skipped.
+    INTEGER, DIMENSION(:,:), INTENT(in)             :: indagec_tree         !! Indices for other cohorts except the oldest one giving out fractions; 
+                                                                            !! here we use an example of other forest chorts except the oldest one.
+    INTEGER, DIMENSION(:,:), INTENT(in)             :: indagec_crop         !! Indices for secondary basic-vegetation cohorts; The youngest age classes
+                                                                            !! of these vegetations are going to receive fractions. 
+                                                                            !! here we use crop cohorts as an example
+    INTEGER, INTENT(in)                             :: num_crop_mulagec     !! number of crop MTCs with more than one age classes
+    INTEGER, INTENT(in)                             :: iagec_tree_end       !! End index of age classes in the giving basic types
+                                                                            !! (i.e., tree, grass, pasture, crop)
+    INTEGER, INTENT(in)                             :: nagec_receive        !! number of age classes in the receiving basic types
+                                                                            !! (i.e., tree, grass, pasture, crop), here we can use crop
+                                                                            !! as an example, nagec=nagec_herb
+    LOGICAL, INTENT(in)                             :: old_to_young         !! an logical variable indicating whether we should handle donation 
+                                                                            !! vegetation in a sequence of old->young or young->old. TRUE is for
+                                                                            !! old->young. If TRUE, the index will be in increasing sequence of 
+                                                                            !! (iagec_start,iagec_tree_end).
+    INTEGER, OPTIONAL, INTENT(in)                   :: iagec_start          !! starting index for iagec, this is added in order to handle
+                                                                            !! the case of secondary forest clearing.
+
+    !! 1. Modified variables
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)      :: vegagec_tree         !! fraction of tree age-class groups, in sequence of old->young
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)      :: veget_max            !! "maximal" coverage fraction of a PFT on the ground
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)      :: glcc_pft             !! a temporary variable to hold the fractions each PFT is going to lose
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)    :: glcc_pftmtc          !! a temporary variable to hold the fraction of ipft->ivma, i.e., from 
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)      :: glcc_pft_tmp         !! Loss of fraction in each PFT
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)      :: glccRemain           !! The remaining glcc matrix after applying the conversion. I.e., it will
+                                                                            !! record the remaining unrealized transition fraction in case the donation
+                                                                            !! vegetation is not enough compared with prescribed transition fraction.
+                                                                            !! This variable should be initialized the same as glccReal before it's fed
+                                                                            !! into this function.
+
+    !! Local vriables
+    INTEGER  :: j,iagec,iagec_start_proxy
+    REAL(r_std) :: frac_begin,frac_used
+                                                                            !! PFT_{ipft} to the youngest age class of MTC_{ivma}
+    IF (.NOT. PRESENT(iagec_start)) THEN
+      iagec_start_proxy=1
+    ELSE
+      iagec_start_proxy=iagec_start
+    ENDIF
+ 
+    ! This subroutine handles the conversion from one basic-vegetation type
+    ! to another, by calling the subroutine cross_give_receive, which handles
+    ! allocation of giving-receiving fraction among the giving age classes
+    ! and receiving basic-vegetation young age classes.
+    ! We allocate in the sequences of old->young. Within the same age-class
+    ! group, we allocate in proportion with existing PFT fractions. The same
+    ! also applies in the receiving youngest-age-class PFTs, i.e., the receiving
+    ! total fraction is allocated according to existing fractions of 
+    ! MTCs of the same basic vegetation type, otherwise it will be equally
+    ! distributed.
+
+    frac_begin = glccReal(ipts,f2c)
+    !DO WHILE (frac_begin>min_stomate)
+      IF (old_to_young) THEN
+        ! note that both indagec_tree and vegagec_tree are in sequence of old->young
+        ! thus iagec_start_proxy must be smaller than iagec_tree_end
+        DO iagec=iagec_start_proxy,iagec_tree_end,1
+          IF (vegagec_tree(ipts,iagec)>frac_begin) THEN
+            frac_used = frac_begin
+          ELSE IF (vegagec_tree(ipts,iagec)>min_stomate) THEN
+            frac_used = vegagec_tree(ipts,iagec)
+          ELSE
+            frac_used = 0.
+          ENDIF
+          
+          IF (frac_used>min_stomate) THEN
+            IF (iagec==1) THEN
+              ! Note that vegagec_tree is fractions of tree age-class groups in the 
+              ! the sequence of old->young, so iagec==1 means that we're handling 
+              ! first the oldest-age-group tree PFTs.
+              CALL cross_give_receive(ipts,frac_used,veget_mtc,newvegfrac,              &
+                       indold_tree,indagec_crop,nagec_receive,num_crop_mulagec, &
+                        veget_max,glcc_pft,glcc_pftmtc,glcc_pft_tmp)
+            ELSE
+              ! Note also the sequence of indagec_tree is from old->young, so by
+              ! increasing iagec, we're handling progressively the old to young
+              ! tree age-class PFTs.
+              CALL cross_give_receive(ipts,frac_used,veget_mtc,newvegfrac,              &
+                       indagec_tree(:,iagec-1),indagec_crop,nagec_receive,num_crop_mulagec, &
+                        veget_max,glcc_pft,glcc_pftmtc,glcc_pft_tmp)
+            ENDIF
+            frac_begin = frac_begin-frac_used
+            vegagec_tree(ipts,iagec)=vegagec_tree(ipts,iagec)-frac_used
+            glccRemain(ipts,f2c) = glccRemain(ipts,f2c) - frac_used
+          ENDIF
+        ENDDO
+      ELSE ! in the sequence of young->old
+        DO iagec=iagec_start_proxy,iagec_tree_end,-1
+          IF (vegagec_tree(ipts,iagec)>frac_begin) THEN
+            frac_used = frac_begin
+          ELSE IF (vegagec_tree(ipts,iagec)>min_stomate) THEN
+            frac_used = vegagec_tree(ipts,iagec)
+          ELSE
+            frac_used = 0.
+          ENDIF
+          
+          IF (frac_used>min_stomate) THEN
+            IF (iagec==1) THEN
+              ! Note that vegagec_tree is fractions of tree age-class groups in the 
+              ! the sequence of old->young, so iagec==1 means that we're handling 
+              ! first the oldest-age-group tree PFTs.
+              CALL cross_give_receive(ipts,frac_used,veget_mtc,newvegfrac,              &
+                       indold_tree,indagec_crop,nagec_receive,num_crop_mulagec, &
+                        veget_max,glcc_pft,glcc_pftmtc,glcc_pft_tmp)
+            ELSE
+              ! Note also the sequence of indagec_tree is from old->young, so by
+              ! increasing iagec, we're handling progressively the old to young
+              ! tree age-class PFTs.
+              CALL cross_give_receive(ipts,frac_used,veget_mtc,newvegfrac,              &
+                       indagec_tree(:,iagec-1),indagec_crop,nagec_receive,num_crop_mulagec, &
+                        veget_max,glcc_pft,glcc_pftmtc,glcc_pft_tmp)
+            ENDIF
+            frac_begin = frac_begin-frac_used
+            vegagec_tree(ipts,iagec)=vegagec_tree(ipts,iagec)-frac_used
+            glccRemain(ipts,f2c) = glccRemain(ipts,f2c) - frac_used
+          ENDIF
+        ENDDO
+      ENDIF
+    !ENDDO
+
+  END SUBROUTINE type_conversion
+
+END MODULE stomate_glcchange_MulAgeC
Index: /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_stomate/stomate_glcchange_SinAgeC.f90
===================================================================
--- /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_stomate/stomate_glcchange_SinAgeC.f90	(revision 6940)
+++ /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_stomate/stomate_glcchange_SinAgeC.f90	(revision 6940)
@@ -0,0 +1,1238 @@
+! =================================================================================================================================
+! MODULE       : stomate_lcchange_fh
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF       This module is a copy of stomate_lcchange. It includes the forestry 
+!              harvest.
+!!
+!!\n DESCRIPTION: None
+!!
+!! RECENT CHANGE(S): Including permafrost carbon
+!!
+!! REFERENCE(S)	: None
+!!
+!! SVN          :
+!! $HeadURL: svn://forge.ipsl.jussieu.fr/orchidee/perso/albert.jornet/ORCHIDEE-MICT/src_stomate/stomate_lcchange.f90 $
+!! $Date: 2015-07-30 15:38:45 +0200 (Thu, 30 Jul 2015) $
+!! $Revision: 2847 $
+!! \n
+!_ ================================================================================================================================
+
+
+MODULE stomate_glcchange_SinAgeC
+
+  ! modules used:
+  
+  USE ioipsl_para
+  USE stomate_data
+  USE pft_parameters
+  USE constantes
+  USE constantes_soil_var
+  USE stomate_gluc_common
+  USE xios_orchidee
+  
+  IMPLICIT NONE
+  
+  PRIVATE
+  PUBLIC glcc_SinAgeC_firstday, glcc_SinAgeC, type_conversion
+  
+CONTAINS
+
+! ================================================================================================================================
+!! SUBROUTINE   gross_lcchange
+!!
+!>\BRIEF       : Apply gross land cover change.
+!!
+!>\DESCRIPTION  
+!_ ================================================================================================================================
+  SUBROUTINE glcc_SinAgeC (npts, dt_days, harvest_matrix,newvegfrac,   &
+               glccSecondShift,glccPrimaryShift,glccNetLCC,&
+               def_fuel_1hr_remain, def_fuel_10hr_remain,        &
+               def_fuel_100hr_remain, def_fuel_1000hr_remain,    &
+               deforest_litter_remain, deforest_biomass_remain,  &
+               convflux, cflux_prod10, cflux_prod100,                  &
+               glccReal, IncreDeficit, glcc_pft, glcc_pftmtc,          &
+               veget_max, prod10, prod100, flux10, flux100,            &
+               PFTpresent, senescence, moiavail_month, moiavail_week,  &
+               gpp_week, ngd_minus5, resp_maint, resp_growth,          & 
+               resp_hetero, npp_daily, when_growthinit, npp_longterm,  &
+               ind, lm_lastyearmax, everywhere, age,                   &
+               co2_to_bm, gpp_daily, co2_fire,                         &
+               time_hum_min, gdd_midwinter, gdd_from_growthinit,       &
+               gdd_m5_dormance, ncd_dormance,                          &
+               lignin_struc, carbon, leaf_frac,                        &
+               deepC_a, deepC_s, deepC_p,                              &
+               leaf_age, bm_to_litter, biomass, litter,                &
+               fuel_1hr, fuel_10hr, fuel_100hr, fuel_1000hr)
+  
+    IMPLICIT NONE
+
+    !! 0.1 Input variables
+
+    INTEGER, INTENT(in)                                  :: npts             !! Domain size - number of pixels (unitless)
+    REAL(r_std), INTENT(in)                              :: dt_days          !! Time step of vegetation dynamics for stomate
+    REAL(r_std), DIMENSION (npts,12),INTENT(in)        :: glccSecondShift     !! the land-cover-change (LCC) matrix in case a gross LCC is 
+                                                                              !! used.
+    REAL(r_std), DIMENSION (npts,12),INTENT(in)        :: glccPrimaryShift    !! the land-cover-change (LCC) matrix in case a gross LCC is 
+                                                                              !! used.
+    REAL(r_std), DIMENSION (npts,12),INTENT(in)        :: glccNetLCC          !! the land-cover-change (LCC) matrix in case a gross LCC is 
+                                                                              !! used.
+    REAL(r_std), DIMENSION (npts,12),INTENT(in)          :: harvest_matrix             !! 
+                                                                             !! 
+
+    REAL(r_std), DIMENSION (npts,nvmap),INTENT(in)        :: newvegfrac             !! 
+    REAL(r_std), DIMENSION(npts,nvm,nlitt,nelements), INTENT(in)                 :: def_fuel_1hr_remain
+    REAL(r_std), DIMENSION(npts,nvm,nlitt,nelements), INTENT(in)                 :: def_fuel_10hr_remain
+    REAL(r_std), DIMENSION(npts,nvm,nlitt,nelements), INTENT(in)                 :: def_fuel_100hr_remain
+    REAL(r_std), DIMENSION(npts,nvm,nlitt,nelements), INTENT(in)                 :: def_fuel_1000hr_remain
+    REAL(r_std), DIMENSION(npts,nlitt,nvm,nlevs,nelements), INTENT(in) :: deforest_litter_remain   !! Vegetmax-weighted remaining litter on the ground for 
+                                                                                                      !! deforestation region.
+    REAL(r_std), DIMENSION(npts,nvm,nparts,nelements), INTENT(in)      :: deforest_biomass_remain  !! Vegetmax-weighted remaining biomass on the ground for 
+                                                                                                      !! deforestation region.
+
+
+    !! 0.2 Output variables
+    REAL(r_std), DIMENSION(npts,nwp), INTENT(out)            :: convflux         !! release during first year following land cover
+                                                                             !! change
+    REAL(r_std), DIMENSION(npts,nwp), INTENT(out)            :: cflux_prod10     !! total annual release from the 10 year-turnover
+                                                                             !! pool @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(npts,nwp), INTENT(out)            :: cflux_prod100    !! total annual release from the 100 year-
+    REAL(r_std), DIMENSION(npts,12), INTENT(inout)       :: glccReal         !! The "real" glcc matrix that we apply in the model
+                                                                             !! after considering the consistency between presribed
+                                                                             !! glcc matrix and existing vegetation fractions.
+    REAL(r_std), DIMENSION(npts,12), INTENT(inout)        :: IncreDeficit     !! "Increment" deficits, negative values mean that 
+                                                                             !! there are not enough fractions in the source PFTs
+                                                                             !! /vegetations to target PFTs/vegetations. I.e., these
+                                                                             !! fraction transfers are presribed in LCC matrix but
+                                                                             !! not realized.
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)      :: glcc_pft         !! Loss of fraction in each PFT
+    REAL(r_std), DIMENSION(npts,nvm,nvmap), INTENT(inout):: glcc_pftmtc      !! a temporary variable to hold the fractions each PFT is going to lose
+                                                                             !! i.e., the contribution of each PFT to the youngest age-class of MTC
+
+    !! 0.3 Modified variables
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)      :: veget_max        !! "maximal" coverage fraction of a PFT (LAI ->
+                                                                             !! infinity) on ground (unitless) 
+    REAL(r_std), DIMENSION(npts,0:10,nwp), INTENT(inout)     :: prod10           !! products remaining in the 10 year-turnover
+                                                                             !! pool after the annual release for each 
+                                                                             !! compartment (10 + 1 : input from year of land
+                                                                             !! cover change)
+    REAL(r_std), DIMENSION(npts,0:100,nwp), INTENT(inout)    :: prod100          !! products remaining in the 100 year-turnover
+                                                                             !! pool after the annual release for each 
+                                                                             !! compartment (100 + 1 : input from year of land
+                                                                             !! cover change)
+    REAL(r_std), DIMENSION(npts,10,nwp), INTENT(inout)       :: flux10           !! annual release from the 10/100 year-turnover 
+                                                                             !! pool compartments
+    REAL(r_std), DIMENSION(npts,100,nwp), INTENT(inout)      :: flux100          !! annual release from the 10/100 year-turnover
+                                                                             !! pool compartments
+    LOGICAL, DIMENSION(:,:), INTENT(inout)               :: PFTpresent       !! Tab indicating which PFTs are present in 
+                                                                             !! each pixel
+    LOGICAL, DIMENSION(:,:), INTENT(inout)               :: senescence       !! Flag for setting senescence stage (only 
+                                                                             !! for deciduous trees)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: moiavail_month   !! "Monthly" moisture availability (0 to 1, 
+                                                                             !! unitless) 
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: moiavail_week    !! "Weekly" moisture availability 
+                                                                             !! (0 to 1, unitless)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: gpp_week         !! Mean weekly gross primary productivity 
+                                                                             !! @tex $(gC m^{-2} day^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: ngd_minus5       !! Number of growing days (days), threshold 
+                                                                             !! -5 deg C (for phenology)   
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: resp_maint       !! Maintenance respiration  
+                                                                             !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: resp_growth      !! Growth respiration  
+                                                                             !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: resp_hetero      !! Heterotrophic respiration  
+                                                                             !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: npp_daily        !! Net primary productivity 
+                                                                             !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: when_growthinit  !! How many days ago was the beginning of 
+                                                                             !! the growing season (days)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: npp_longterm     !! "Long term" mean yearly primary productivity 
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: ind              !! Number of individuals at the stand level
+                                                                             !! @tex $(m^{-2})$ @endtex 
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: lm_lastyearmax   !! last year's maximum leaf mass for each PFT 
+                                                                             !! @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: everywhere       !! is the PFT everywhere in the grid box or 
+                                                                             !! very localized (after its introduction) (?)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: age              !! mean age (years)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: co2_to_bm        !! CO2 taken from the atmosphere to get C to create  
+                                                                             !! the seedlings @tex (gC.m^{-2}dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: gpp_daily        !! Daily gross primary productivity  
+                                                                             !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: co2_fire         !! Fire carbon emissions
+                                                                             !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: time_hum_min     !! Time elapsed since strongest moisture 
+                                                                             !! availability (days) 
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: gdd_midwinter    !! Growing degree days (K), since midwinter 
+                                                                             !! (for phenology) - this is written to the
+                                                                             !!  history files 
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: gdd_from_growthinit !! growing degree days, since growthinit 
+                                                                             !! for crops
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: gdd_m5_dormance  !! Growing degree days (K), threshold -5 deg 
+                                                                             !! C (for phenology)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)           :: ncd_dormance     !! Number of chilling days (days), since 
+                                                                             !! leaves were lost (for phenology) 
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)         :: lignin_struc     !! ratio Lignine/Carbon in structural litter,
+                                                                             !! above and below ground
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)         :: carbon           !! carbon pool: active, slow, or passive 
+                                                                             !! @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)         :: deepC_a          !! Permafrost soil carbon (g/m**3) active
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)         :: deepC_s          !! Permafrost soil carbon (g/m**3) slow
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)         :: deepC_p          !! Permafrost soil carbon (g/m**3) passive
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)         :: leaf_frac        !! fraction of leaves in leaf age class (unitless;0-1)
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)         :: leaf_age         !! Leaf age (days)
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout)       :: bm_to_litter     !! Transfer of biomass to litter 
+                                                                             !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout)       :: biomass          !! Stand level biomass @tex $(gC.m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(:,:,:,:,:), INTENT(inout)     :: litter           !! metabolic and structural litter, above and 
+                                                                             !! below ground @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout)       :: fuel_1hr
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout)       :: fuel_10hr
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout)       :: fuel_100hr
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout)       :: fuel_1000hr
+
+    !! 0.4 Local variables
+    REAL(r_std), DIMENSION(nvmap,nparts,nelements)             :: bm_to_litter_pro !! conversion of biomass to litter 
+                                                                             !! @tex ($gC m^{-2} day^{-1}$) @endtex
+    REAL(r_std), DIMENSION(nvmap,nparts,nelements)             :: biomass_pro      !! biomass @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(nvmap)                        :: veget_max_pro    !! "maximal" coverage fraction of a PFT (LAI ->
+                                                                             !! infinity) on ground (unitless) 
+    REAL(r_std), DIMENSION(nvmap,ncarb)                        :: carbon_pro       !! carbon pool: active, slow, or passive 
+                                                                             !! @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(nvmap,ndeep)                        :: deepC_a_pro      !! Permafrost carbon pool: active, slow, or passive 
+                                                                             !! @tex ($gC m^{-3}$) @endtex
+    REAL(r_std), DIMENSION(nvmap,ndeep)                        :: deepC_s_pro      !! Permafrost carbon pool: active, slow, or passive 
+                                                                             !! @tex ($gC m^{-3}$) @endtex
+    REAL(r_std), DIMENSION(nvmap,ndeep)                        :: deepC_p_pro      !! Permafrost carbon pool: active, slow, or passive 
+                                                                             !! @tex ($gC m^{-3}$) @endtex
+    REAL(r_std), DIMENSION(nvmap,nlitt,nlevs,nelements)        :: litter_pro       !! metabolic and structural litter, above and 
+                                                                             !! below ground @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(nvmap,nlitt,nelements)              :: fuel_1hr_pro
+    REAL(r_std), DIMENSION(nvmap,nlitt,nelements)              :: fuel_10hr_pro
+    REAL(r_std), DIMENSION(nvmap,nlitt,nelements)              :: fuel_100hr_pro
+    REAL(r_std), DIMENSION(nvmap,nlitt,nelements)              :: fuel_1000hr_pro
+    REAL(r_std), DIMENSION(nvmap,nlevs)                        :: lignin_struc_pro !! ratio Lignine/Carbon in structural litter
+                                                                             !! above and below ground
+    REAL(r_std), DIMENSION(nvmap,nleafages)                    :: leaf_frac_pro    !! fraction of leaves in leaf age class 
+    REAL(r_std), DIMENSION(nvmap,nleafages)                    :: leaf_age_pro     !! fraction of leaves in leaf age class 
+    LOGICAL, DIMENSION(nvmap)                :: PFTpresent_pro, senescence_pro                 !! Is pft there (unitless)
+    REAL(r_std), DIMENSION(nvmap)            :: ind_pro, age_pro, lm_lastyearmax_pro, npp_longterm_pro
+    REAL(r_std), DIMENSION(nvmap)            :: everywhere_pro
+    REAL(r_std), DIMENSION(nvmap)            :: gpp_daily_pro, npp_daily_pro, co2_to_bm_pro
+    REAL(r_std), DIMENSION(nvmap)            :: resp_maint_pro, resp_growth_pro
+    REAL(r_std), DIMENSION(nvmap)            :: resp_hetero_pro, co2_fire_pro
+  
+    INTEGER                :: ipts,ivm,ivma,l,m,ipft_young_agec
+    CHARACTER(LEN=10)      :: part_str                               !! string suffix indicating an index
+
+    REAL(r_std), DIMENSION(npts,nvmap)       :: glcc_mtc             !! Increase in fraction of each MTC in its youngest age-class
+    REAL(r_std), DIMENSION(npts,nvm)         :: glccReal_tmp         !! A temporary variable to hold glccReal
+    REAL(r_std), DIMENSION(npts)             :: Deficit_pf2yf_final     !! 
+    REAL(r_std), DIMENSION(npts)             :: Deficit_sf2yf_final     !! 
+    REAL(r_std), DIMENSION(npts)             :: pf2yf_compen_sf2yf      !! 
+    REAL(r_std), DIMENSION(npts)             :: sf2yf_compen_pf2yf      !!
+    REAL(r_std), DIMENSION(npts,nvm)         :: glcc_harvest            !! Loss of fraction due to forestry harvest
+
+    WRITE(numout,*) 'Entering glcc_SinAgeC'
+    glcc_harvest(:,:) = zero
+    glccReal_tmp(:,:) = zero
+
+    CALL glcc_SinAgeC_firstday(npts,veget_max,newvegfrac,harvest_matrix,  &
+                          glccSecondShift,glccPrimaryShift,glccNetLCC,&
+                          glccReal,glcc_pft,glcc_pftmtc,IncreDeficit,  &
+                          Deficit_pf2yf_final, Deficit_sf2yf_final,   &
+                          pf2yf_compen_sf2yf, sf2yf_compen_pf2yf)
+
+    glcc_mtc(:,:) = SUM(glcc_pftmtc,DIM=2)
+    DO ipts=1,npts
+
+      !! Initialize the _pro variables
+      bm_to_litter_pro(:,:,:)=zero                                                
+      biomass_pro(:,:,:)=zero
+      veget_max_pro(:)=zero                                                       
+      carbon_pro(:,:)=zero                                                        
+      deepC_a_pro(:,:)=zero                                                       
+      deepC_s_pro(:,:)=zero                                                       
+      deepC_p_pro(:,:)=zero                                                       
+      litter_pro(:,:,:,:)=zero                                                    
+      fuel_1hr_pro(:,:,:)=zero                                                    
+      fuel_10hr_pro(:,:,:)=zero                                                   
+      fuel_100hr_pro(:,:,:)=zero                                                  
+      fuel_1000hr_pro(:,:,:)=zero                                                 
+      lignin_struc_pro(:,:)=zero                                                  
+
+      leaf_frac_pro = zero
+      leaf_age_pro = zero
+      PFTpresent_pro(:) = .FALSE.
+      senescence_pro(:) = .TRUE.
+      ind_pro = zero
+      age_pro = zero
+      lm_lastyearmax_pro = zero
+      npp_longterm_pro = zero
+      everywhere_pro = zero
+      
+      gpp_daily_pro=zero                                                       
+      npp_daily_pro=zero                                                       
+      co2_to_bm_pro=zero                                                       
+      resp_maint_pro=zero                                                      
+      resp_growth_pro=zero                                                     
+      resp_hetero_pro=zero                                                     
+      co2_fire_pro=zero                                                        
+
+      ! Note that we assume people don't intentionally change baresoil to 
+      ! vegetated land.
+      DO ivma = 2,nvmap
+        ! we assume only the youngest age class receives the incoming PFT
+        ! [chaoyuejoy@gmail.com 2015-08-04] This line is commented to allow
+        ! the case of only single age class being handled.
+
+        ! here we set glcc_mtc(ipts,ivma) > min_stomate as a condition,
+        ! this is necessary because later on in the subroutine of 
+        ! add_incoming_proxy_pft we have to merge the newly established
+        ! youngest proxy with potentially exisiting youngest receiving MTC,
+        ! thus have to devide a new fraction of (frac_proxy + frac_exist),
+        ! but in case frac_exist = zero, we risk deviding by a very small value
+        ! of frac_proxy and thus we want it to be bigger than min_stomate.
+        IF ( glcc_mtc(ipts,ivma) .GT. min_stomate ) THEN
+
+          ! 1. we accumulate the scalar variables that will be inherited
+          !    note we don't handle the case of harvesting forest because
+          !    we assume glcc_pftmtc(forest->forest) would be zero and this
+          !    case won't occur as it's filtered by the condition of
+          !    (frac>min_stomate)
+          CALL collect_legacy_pft(npts, ipts, ivma, glcc_pftmtc,    &
+                  biomass, bm_to_litter, carbon, litter,            &
+                  deepC_a, deepC_s, deepC_p,                        &
+                  fuel_1hr, fuel_10hr, fuel_100hr, fuel_1000hr,     &
+                  lignin_struc, co2_to_bm, gpp_daily, npp_daily,    &
+                  resp_maint, resp_growth, resp_hetero, co2_fire,   &
+                  def_fuel_1hr_remain, def_fuel_10hr_remain,        &
+                  def_fuel_100hr_remain, def_fuel_1000hr_remain,    &
+                  deforest_litter_remain, deforest_biomass_remain,  &
+                  veget_max_pro(ivma), carbon_pro(ivma,:),          &
+                  lignin_struc_pro(ivma,:), litter_pro(ivma,:,:,:), &
+                  deepC_a_pro(ivma,:), deepC_s_pro(ivma,:), deepC_p_pro(ivma,:), &
+                  fuel_1hr_pro(ivma,:,:), fuel_10hr_pro(ivma,:,:),  &
+                  fuel_100hr_pro(ivma,:,:), fuel_1000hr_pro(ivma,:,:), &
+                  bm_to_litter_pro(ivma,:,:), co2_to_bm_pro(ivma),  &
+                  gpp_daily_pro(ivma), npp_daily_pro(ivma),         &
+                  resp_maint_pro(ivma), resp_growth_pro(ivma),      &
+                  resp_hetero_pro(ivma), co2_fire_pro(ivma),        &
+                  convflux,prod10,prod100)
+
+          !++TEMP++
+          ! Here we substract the outgoing fraction from the source PFT.
+          ! If a too small fraction remains in this source PFT, then it is
+          ! exhausted, we empty it. The subroutine 'empty_pft' might be 
+          ! combined with 'collect_legacy_pft', but now we just put it here.
+          DO ivm = 1,nvm
+            IF( glcc_pftmtc(ipts,ivm,ivma)>zero ) THEN
+              veget_max(ipts,ivm) = veget_max(ipts,ivm)-glcc_pftmtc(ipts,ivm,ivma)
+              IF ( veget_max(ipts,ivm)<min_stomate ) THEN
+                CALL empty_pft(ipts, ivm, veget_max, biomass, ind,       &
+                       carbon, litter, lignin_struc, bm_to_litter,       &
+                       deepC_a, deepC_s, deepC_p,                        &
+                       fuel_1hr, fuel_10hr, fuel_100hr, fuel_1000hr,     &
+                       gpp_daily, npp_daily, gpp_week, npp_longterm,     &
+                       co2_to_bm, resp_maint, resp_growth, resp_hetero,  &
+                       lm_lastyearmax, leaf_frac, leaf_age, age,         &
+                       everywhere, PFTpresent, when_growthinit,          &
+                       senescence, gdd_from_growthinit, gdd_midwinter,   &
+                       time_hum_min, gdd_m5_dormance, ncd_dormance,      &
+                       moiavail_month, moiavail_week, ngd_minus5)
+              ENDIF
+            ENDIF
+          ENDDO
+
+        ENDIF !IF ( glcc_mtc(ipts,ivma) .GT. min_stomate )
+      ENDDO !(DO ivma = 2,nvmap)
+
+      ! We can only establish new youngest proxy and add it to the 
+      ! existing youngest-age PFT after all the harvest is done, to 
+      ! avoid the dilution of harvestable biomass by the young proxy
+      ! and ensure consistency. Therefore now we have to loop again
+      ! over nvmap.
+      DO ivma = 2,nvmap
+        IF ( glcc_mtc(ipts,ivma) .GT. min_stomate ) THEN
+
+          ipft_young_agec = start_index(ivma)
+
+          ! 2. we establish a proxy PFT with the fraction of veget_max_pro,
+          !    which is going to be either merged with existing target 
+          !    `ipft_young_agec` PFT, or fill the place if no existing target PFT
+          !    exits.
+          CALL initialize_proxy_pft(ipts,ipft_young_agec,veget_max_pro(ivma), &
+                 biomass_pro(ivma,:,:), co2_to_bm_pro(ivma), ind_pro(ivma),   &
+                 age_pro(ivma),                                               & 
+                 senescence_pro(ivma), PFTpresent_pro(ivma),                  &
+                 lm_lastyearmax_pro(ivma), everywhere_pro(ivma),              &
+                 npp_longterm_pro(ivma),                                      &
+                 leaf_frac_pro(ivma,:),leaf_age_pro(ivma,:))
+
+          CALL sap_take (ipts,ivma,veget_max,biomass_pro(ivma,:,:), &
+                         biomass,co2_to_bm_pro(ivma))
+
+          ! 3. we merge the newly initiazlized proxy PFT into existing one
+          !    or use it to fill an empty PFT slot.
+          CALL add_incoming_proxy_pft(npts, ipts, ipft_young_agec, veget_max_pro(ivma),&
+                 carbon_pro(ivma,:), litter_pro(ivma,:,:,:), lignin_struc_pro(ivma,:), &
+                 bm_to_litter_pro(ivma,:,:),    &
+                 deepC_a_pro(ivma,:), deepC_s_pro(ivma,:), deepC_p_pro(ivma,:), &
+                 fuel_1hr_pro(ivma,:,:), fuel_10hr_pro(ivma,:,:),               &
+                 fuel_100hr_pro(ivma,:,:), fuel_1000hr_pro(ivma,:,:),           &
+                 biomass_pro(ivma,:,:), co2_to_bm_pro(ivma),                    &
+                 npp_longterm_pro(ivma), ind_pro(ivma),                         &
+                 lm_lastyearmax_pro(ivma), age_pro(ivma), everywhere_pro(ivma), &  
+                 leaf_frac_pro(ivma,:), leaf_age_pro(ivma,:),                   &
+                 PFTpresent_pro(ivma), senescence_pro(ivma),                &
+                 gpp_daily_pro(ivma), npp_daily_pro(ivma),                      &
+                 resp_maint_pro(ivma), resp_growth_pro(ivma),                   &
+                 resp_hetero_pro(ivma), co2_fire_pro(ivma),                     &
+                 veget_max, carbon, litter, lignin_struc, bm_to_litter,         &
+                 deepC_a, deepC_s, deepC_p,                                     &
+                 fuel_1hr, fuel_10hr, fuel_100hr, fuel_1000hr,                  &
+                 biomass, co2_to_bm, npp_longterm, ind,                         &
+                 lm_lastyearmax, age, everywhere,                               &
+                 leaf_frac, leaf_age, PFTpresent, senescence,                   &
+                 gpp_daily, npp_daily, resp_maint, resp_growth,                 &
+                 resp_hetero, co2_fire)
+          
+        ENDIF !IF ( glcc_mtc(ipts,ivma) .GT. min_stomate )
+      ENDDO !(DO ivma=1,nvmap)
+
+    ENDDO !(DO ipts=1,npts)
+
+    !! Update 10 year-turnover pool content following flux emission
+    !!     (linear decay (10%) of the initial carbon input)
+    DO  l = 0, 8
+      m = 10 - l
+      cflux_prod10(:,:) =  cflux_prod10(:,:) + flux10(:,m,:)
+      prod10(:,m,:)     =  prod10(:,m-1,:)   - flux10(:,m-1,:)
+      flux10(:,m,:)     =  flux10(:,m-1,:)
+    ENDDO
+    
+    cflux_prod10(:,:) = cflux_prod10(:,:) + flux10(:,1,:) 
+    flux10(:,1,:)     = 0.1 * prod10(:,0,:)
+    prod10(:,1,:)     = prod10(:,0,:)
+    
+    !! 2.4.3 update 100 year-turnover pool content following flux emission\n
+    DO l = 0, 98
+       m = 100 - l
+       cflux_prod100(:,:)  =  cflux_prod100(:,:) + flux100(:,m,:)
+       prod100(:,m,:)      =  prod100(:,m-1,:)   - flux100(:,m-1,:)
+       flux100(:,m,:)      =  flux100(:,m-1,:)
+    ENDDO
+    
+    cflux_prod100(:,:)  = cflux_prod100(:,:) + flux100(:,1,:) 
+    flux100(:,1,:)      = 0.01 * prod100(:,0,:)
+    prod100(:,1,:)      = prod100(:,0,:)
+    prod10(:,0,:)        = zero
+    prod100(:,0,:)       = zero 
+
+    !convflux        = convflux/one_year*dt_days
+    !cflux_prod10    = cflux_prod10/one_year*dt_days
+    !cflux_prod100   = cflux_prod100/one_year*dt_days
+
+    ! Write out history files
+    CALL histwrite_p (hist_id_stomate, 'glcc_pft', itime, &
+         glcc_pft, npts*nvm, horipft_index)
+    CALL xios_orchidee_send_field ('glcc_pft', glcc_pft) ! kjpindex,nvm
+
+    glccReal_tmp(:,1:12) = glccReal
+    CALL histwrite_p (hist_id_stomate, 'glccReal', itime, &
+         glccReal_tmp, npts*nvm, horipft_index)
+    CALL xios_orchidee_send_field ('glccReal', glccReal_tmp) ! kjpindex,nvm
+
+    ! ! Write out forestry harvest variables
+    ! DO ipts = 1,npts
+    !   DO ivm = 1,nvm
+    !     DO ivma = 1,nvmap
+    !       IF (is_tree(ivm) .AND. is_tree(start_index(ivma))) THEN
+    !         glcc_harvest(ipts,ivm) = glcc_harvest(ipts,ivm) + glcc_pftmtc(ipts,ivm,ivma)
+    !       ENDIF
+    !     ENDDO
+    !   ENDDO
+    ! ENDDO
+    ! CALL histwrite_p (hist_id_stomate, 'glcc_harvest', itime, &
+    !      glcc_harvest, npts*nvm, horipft_index)
+
+    glccReal_tmp(:,:) = zero
+    glccReal_tmp(:,1:12) = IncreDeficit
+    CALL histwrite_p (hist_id_stomate, 'IncreDeficit', itime, &
+         glccReal_tmp, npts*nvm, horipft_index)
+    CALL xios_orchidee_send_field ('IncreDeficit', glccReal_tmp) ! kjpindex,nvm
+
+    ! glccReal_tmp(:,:) = zero
+    ! glccReal_tmp(:,1) = Deficit_pf2yf_final
+    ! glccReal_tmp(:,2) = Deficit_sf2yf_final    ! is always zero in case of
+    !                                            ! single age class
+    ! glccReal_tmp(:,3) = pf2yf_compen_sf2yf     ! alawys zero for SinAgeC
+    ! glccReal_tmp(:,4) = sf2yf_compen_pf2yf     ! always zero for SinAgeC
+
+    ! CALL histwrite_p (hist_id_stomate, 'DefiComForHarvest', itime, &
+    !      glccReal_tmp, npts*nvm, horipft_index)
+
+    DO ivma = 1, nvmap
+      WRITE(part_str,'(I2)') ivma
+      IF (ivma < 10) part_str(1:1) = '0'
+      CALL histwrite_p (hist_id_stomate, 'glcc_pftmtc_'//part_str(1:LEN_TRIM(part_str)), &
+           itime, glcc_pftmtc(:,:,ivma), npts*nvm, horipft_index)
+    ENDDO
+    CALL xios_orchidee_send_field ('glcc_pftmtc', glcc_pftmtc) ! kjpindex,nvm,nvmap
+
+  END SUBROUTINE glcc_SinAgeC
+
+
+! ================================================================================================================================
+!! SUBROUTINE   : glcc_SinAgeC_firstday
+!!
+!>\BRIEF        : When necessary, adjust input glcc matrix, and allocate it
+!!                into different contributing age classes and receiving 
+!!                youngest age classes.
+!! \n
+!_ ================================================================================================================================
+
+  ! Note: it has this name because this subroutine will also be called
+  ! the first day of each year to precalculate the forest loss for the
+  ! deforestation fire module.
+  SUBROUTINE glcc_SinAgeC_firstday(npts,veget_max_org,newvegfrac,harvest_matrix,&
+                          glccSecondShift,glccPrimaryShift,glccNetLCC,&
+                          glccReal,glcc_pft,glcc_pftmtc,IncreDeficit, &
+                          Deficit_pf2yf_final, Deficit_sf2yf_final,   &
+                          pf2yf_compen_sf2yf, sf2yf_compen_pf2yf)
+
+    IMPLICIT NONE
+
+    !! 0.1 Input variables
+
+    INTEGER, INTENT(in)                                     :: npts           !! Domain size - number of pixels (unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)            :: veget_max_org  !! "maximal" coverage fraction of a PFT on the ground
+                                                                              !! May sum to
+                                                                              !! less than unity if the pixel has
+                                                                              !! nobio area. (unitless, 0-1)
+    REAL(r_std), DIMENSION(npts,12),INTENT(in)              :: harvest_matrix !! 
+                                                                              !! 
+    REAL(r_std), DIMENSION (npts,nvmap),INTENT(in)        :: newvegfrac             !! 
+    REAL(r_std), DIMENSION (npts,12),INTENT(in)        :: glccSecondShift     !! the land-cover-change (LCC) matrix in case a gross LCC is 
+                                                                              !! used.
+    REAL(r_std), DIMENSION (npts,12),INTENT(in)        :: glccPrimaryShift    !! the land-cover-change (LCC) matrix in case a gross LCC is 
+                                                                              !! used.
+    REAL(r_std), DIMENSION (npts,12),INTENT(in)        :: glccNetLCC          !! the land-cover-change (LCC) matrix in case a gross LCC is 
+                                                                              !! used.
+
+    !! 0.2 Output variables
+    REAL(r_std), DIMENSION(npts,nvm,nvmap), INTENT(inout)   :: glcc_pftmtc    !! a temporary variable to hold the fractions each PFT is going to lose
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(inout)         :: glcc_pft       !! Loss of fraction in each PFT
+    REAL(r_std), DIMENSION(npts,12), INTENT(inout)          :: glccReal       !! The "real" glcc matrix that we apply in the model
+                                                                              !! after considering the consistency between presribed
+                                                                              !! glcc matrix and existing vegetation fractions.
+    REAL(r_std), DIMENSION(npts,12), INTENT(inout)           :: IncreDeficit   !! "Increment" deficits, negative values mean that 
+                                                                              !! there are not enough fractions in the source PFTs
+                                                                              !! /vegetations to target PFTs/vegetations. I.e., these
+                                                                              !! fraction transfers are presribed in LCC matrix but
+                                                                              !! not realized.
+    REAL(r_std), DIMENSION(npts), INTENT(inout)    :: Deficit_pf2yf_final     !! 
+    REAL(r_std), DIMENSION(npts), INTENT(inout)    :: Deficit_sf2yf_final     !! 
+    REAL(r_std), DIMENSION(npts), INTENT(inout)    :: pf2yf_compen_sf2yf      !! 
+    REAL(r_std), DIMENSION(npts), INTENT(inout)    :: sf2yf_compen_pf2yf      !!
+     
+
+    !! 0.3 Modified variables
+    
+    !! 0.4 Local variables
+    REAL(r_std), DIMENSION (npts,12)                :: glcc                !! the land-cover-change (LCC) matrix in case a gross LCC is 
+                                                                           !! used.
+    REAL(r_std), DIMENSION(npts,nvmap)              :: veget_mtc           !! "maximal" coverage fraction of a PFT on the ground
+    REAL(r_std), DIMENSION(npts,nvmap)              :: veget_mtc_begin     !! "maximal" coverage fraction of a PFT on the ground
+    REAL(r_std), DIMENSION(npts,nagec_tree)         :: vegagec_tree        !! fraction of tree age-class groups, in sequence of old->young
+    REAL(r_std), DIMENSION(npts,nagec_herb)         :: vegagec_grass       !! fraction of grass age-class groups, in sequence of old->young 
+    REAL(r_std), DIMENSION(npts,nagec_herb)         :: vegagec_pasture     !! fraction of pasture age-class groups, in sequence of old->young
+    REAL(r_std), DIMENSION(npts,nagec_herb)         :: vegagec_crop        !! fraction of crop age-class groups, in sequence of old->young
+
+    
+    REAL(r_std), DIMENSION(npts,4)                  :: veget_4veg      !! "maximal" coverage fraction of a PFT on the ground
+    REAL(r_std), DIMENSION(npts)                    :: veget_tree      !! "maximal" coverage fraction of a PFT on the ground
+    REAL(r_std), DIMENSION(npts)                    :: veget_grass     !! "maximal" coverage fraction of a PFT on the ground
+    REAL(r_std), DIMENSION(npts)                    :: veget_pasture   !! "maximal" coverage fraction of a PFT on the ground
+    REAL(r_std), DIMENSION(npts)                    :: veget_crop      !! "maximal" coverage fraction of a PFT on the ground
+
+    REAL(r_std), DIMENSION(npts,nvm)         :: veget_max         !! "maximal" coverage fraction of a PFT on the ground
+    REAL(r_std), DIMENSION(npts,nvm)         :: veget_max_tmp     !! "maximal" coverage fraction of a PFT on the ground
+    REAL(r_std), DIMENSION(npts,nvm)         :: veget_max_old     !! "maximal" coverage fraction of a PFT on the ground
+    REAL(r_std), DIMENSION(npts,nvm)         :: glcc_pft_tmp      !! Loss of fraction in each PFT
+
+    ! Different indexes for convenient local uses
+    ! We define the rules for gross land cover change matrix:
+    ! 1 forest->grass
+    ! 2 forest->pasture 
+    ! 3 forest->crop
+    ! 4 grass->forest
+    ! 5 grass->pasture
+    ! 6 grass->crop
+    ! 7 pasture->forest
+    ! 8 pasture->grass
+    ! 9 pasture->crop
+    ! 10 crop->forest
+    ! 11 crop->grass
+    ! 12 crop->pasture
+    INTEGER :: f2g=1, f2p=2, f2c=3
+    INTEGER :: g2f=4, g2p=5, g2c=6, p2f=7, p2g=8, p2c=9, c2f=10, c2g=11, c2p=12
+
+    INTEGER, ALLOCATABLE                  :: indall_tree(:)       !! Indices for all tree PFTs
+    INTEGER, ALLOCATABLE                  :: indold_tree(:)       !! Indices for old tree cohort only
+    INTEGER, ALLOCATABLE                  :: indagec_tree(:,:)    !! Indices for secondary tree cohorts, 
+                                                                  !! note the sequence is old->young.
+    INTEGER, ALLOCATABLE                  :: indall_grass(:)      !! Indices for all grass PFTs
+    INTEGER, ALLOCATABLE                  :: indold_grass(:)      !! Indices for old grasses only
+    INTEGER, ALLOCATABLE                  :: indagec_grass(:,:)   !! Indices for secondary grass cohorts
+                                                                  !! note the sequence is old->young.
+    INTEGER, ALLOCATABLE                  :: indall_pasture(:)    !! Indices for all pasture PFTs
+    INTEGER, ALLOCATABLE                  :: indold_pasture(:)    !! Indices for old pasture only
+    INTEGER, ALLOCATABLE                  :: indagec_pasture(:,:) !! Indices for secondary pasture cohorts
+                                                                  !! note the sequence is old->young.
+    INTEGER, ALLOCATABLE                  :: indall_crop(:)       !! Indices for all crop PFTs
+    INTEGER, ALLOCATABLE                  :: indold_crop(:)       !! Indices for old crops only
+    INTEGER, ALLOCATABLE                  :: indagec_crop(:,:)    !! Indices for secondary crop cohorts
+                                                                  !! note the sequence is old->young.
+    INTEGER :: num_tree_sinagec,num_tree_mulagec,num_grass_sinagec,num_grass_mulagec,     &
+               num_pasture_sinagec,num_pasture_mulagec,num_crop_sinagec,num_crop_mulagec, &
+               itree,itree2,igrass,igrass2,ipasture,ipasture2,icrop,icrop2,pf2yf,sf2yf
+    INTEGER :: i,j,ivma,staind,endind,ivm
+
+
+    REAL(r_std), DIMENSION(npts,12)         :: glccDef            !! Gross LCC deficit, negative values mean that there
+                                                                  !! are not enough fractions in the source vegetations
+                                                                  !! to the target ones as presribed by the LCC matrix.
+    REAL(r_std), DIMENSION(npts)            :: Deficit_pf2yf      !! 
+    REAL(r_std), DIMENSION(npts)            :: Deficit_sf2yf      !! 
+    REAL(r_std), DIMENSION(npts)            :: Surplus_pf2yf      !! 
+    REAL(r_std), DIMENSION(npts)            :: Surplus_sf2yf      !! 
+    REAL(r_std), DIMENSION(npts,12)         :: glccRemain      !! 
+    REAL(r_std), DIMENSION(npts,12)         :: HmatrixReal        !! 
+    INTEGER :: ipts
+    
+
+    !! 1. We first build all different indices that we are going to use
+    !!    in handling the PFT exchanges, three types of indices are built:
+    !!     - for all age classes
+    !!     - include only oldest age classes
+    !!     - include all age classes excpet the oldest ones
+    ! We have to build these indices because we would like to extract from
+    ! donating PFTs in the sequnce of old->young age classes, and add in the
+    ! receving PFTs only in the youngest-age-class PFTs. These indicies allow
+    ! us to know where the different age classes are.
+
+    num_tree_sinagec=0          ! number of tree PFTs with only one single age class 
+                                ! considered as the oldest age class
+    num_tree_mulagec=0          ! number of tree PFTs having multiple age classes
+    num_grass_sinagec=0
+    num_grass_mulagec=0
+    num_pasture_sinagec=0
+    num_pasture_mulagec=0
+    num_crop_sinagec=0
+    num_crop_mulagec=0
+    
+    !! 1.1 Calculate the number of PFTs for different MTCs and allocate
+    !! the old and all indices arrays.
+
+    ! [Note here the sequence to identify tree,pasture,grass,crop] is
+    ! critical. The similar sequence is used in the subroutine "calc_cover".
+    ! Do not forget to change the sequence there if you modify here.
+    DO ivma =2,nvmap
+      staind=start_index(ivma)
+      IF (nagec_pft(ivma)==1) THEN
+        IF (is_tree(staind)) THEN
+          num_tree_sinagec = num_tree_sinagec+1
+        ELSE IF (is_grassland_manag(staind)) THEN
+          num_pasture_sinagec = num_pasture_sinagec+1
+        ELSE IF (natural(staind)) THEN
+          num_grass_sinagec = num_grass_sinagec+1
+        ELSE
+          num_crop_sinagec = num_crop_sinagec+1
+        ENDIF
+
+      ELSE
+        IF (is_tree(staind)) THEN
+          num_tree_mulagec = num_tree_mulagec+1
+        ELSE IF (is_grassland_manag(staind)) THEN
+          num_pasture_mulagec = num_pasture_mulagec+1
+        ELSE IF (natural(staind)) THEN
+          num_grass_mulagec = num_grass_mulagec+1
+        ELSE
+          num_crop_mulagec = num_crop_mulagec+1
+        ENDIF
+      ENDIF
+    ENDDO
+    
+    !! Allocate index array
+    ! allocate all index
+    ALLOCATE(indall_tree(num_tree_sinagec+num_tree_mulagec*nagec_tree))     
+    ALLOCATE(indall_grass(num_grass_sinagec+num_grass_mulagec*nagec_herb))     
+    ALLOCATE(indall_pasture(num_pasture_sinagec+num_pasture_mulagec*nagec_herb))     
+    ALLOCATE(indall_crop(num_crop_sinagec+num_crop_mulagec*nagec_herb))     
+
+    ! allocate old-ageclass index
+    ALLOCATE(indold_tree(num_tree_sinagec+num_tree_mulagec))     
+    ALLOCATE(indold_grass(num_grass_sinagec+num_grass_mulagec))     
+    ALLOCATE(indold_pasture(num_pasture_sinagec+num_pasture_mulagec))     
+    ALLOCATE(indold_crop(num_crop_sinagec+num_crop_mulagec))     
+
+    !! 1.2 Fill the oldest-age-class and all index arrays
+    itree=0
+    igrass=0
+    ipasture=0
+    icrop=0
+    itree2=1
+    igrass2=1
+    ipasture2=1
+    icrop2=1
+    DO ivma =2,nvmap
+      staind=start_index(ivma)
+      IF (is_tree(staind)) THEN
+        itree=itree+1
+        indold_tree(itree) = staind+nagec_pft(ivma)-1
+        DO j = 0,nagec_pft(ivma)-1
+          indall_tree(itree2+j) = staind+j
+        ENDDO
+        itree2=itree2+nagec_pft(ivma)
+      ELSE IF (natural(staind) .AND. .NOT. is_grassland_manag(staind)) THEN
+        igrass=igrass+1
+        indold_grass(igrass) = staind+nagec_pft(ivma)-1
+        DO j = 0,nagec_pft(ivma)-1
+          indall_grass(igrass2+j) = staind+j
+        ENDDO
+        igrass2=igrass2+nagec_pft(ivma)
+      ELSE IF (is_grassland_manag(staind)) THEN
+        ipasture = ipasture+1
+        indold_pasture(ipasture) = staind+nagec_pft(ivma)-1
+        DO j = 0,nagec_pft(ivma)-1
+          indall_pasture(ipasture2+j) = staind+j
+        ENDDO
+        ipasture2=ipasture2+nagec_pft(ivma)
+      ELSE
+        icrop = icrop+1
+        indold_crop(icrop) = staind+nagec_pft(ivma)-1
+        DO j = 0,nagec_pft(ivma)-1
+          indall_crop(icrop2+j) = staind+j
+        ENDDO
+        icrop2=icrop2+nagec_pft(ivma)
+      ENDIF
+    ENDDO
+    
+    !! 1.3 Allocate and fill other age class index
+
+    ! [chaoyuejoy@gmail.com 2015-08-05]
+    ! note that we treat the case of (num_tree_mulagec==0) differently. In this
+    ! case there is no distinction of age groups among tree PFTs. But we still
+    ! we want to use the "gross_lcchange" subroutine. In this case we consider 
+    ! them as having a single age group. In the subroutines
+    ! of "type_conversion" and "cross_give_receive", only the youngest-age-group
+    ! PFTs of a given MTC or vegetation type could receive the incoming fractions.
+    ! To be able to handle this case with least amount of code change, we assign the index 
+    ! of PFT between youngest and second-oldes (i.e., indagec_tree etc) the same as
+    ! those of oldest tree PFTs (or all tree PFTs because in this cases these two indices
+    ! are identical) . So that this case could be correctly handled in the subrountines
+    ! of "type_conversion" and "cross_give_receive". This treatment allows use
+    ! of gross land cover change subroutine with only one single age class. This single
+    ! age class is "simultanously the oldest and youngest age class". At the same
+    ! time, we also change the num_tree_mulagec as the same of num_crop_sinagec.
+    ! The similar case also applies in grass,pasture and crop.
+
+    IF (num_tree_mulagec .EQ. 0) THEN
+      ALLOCATE(indagec_tree(num_tree_sinagec,1))
+      indagec_tree(:,1) = indall_tree(:)
+      num_tree_mulagec = num_tree_sinagec
+    ELSE
+      ALLOCATE(indagec_tree(num_tree_mulagec,nagec_tree-1))     
+    END IF
+
+    IF (num_grass_mulagec .EQ. 0) THEN
+      ALLOCATE(indagec_grass(num_grass_sinagec,1))
+      indagec_grass(:,1) = indall_grass(:)
+      num_grass_mulagec = num_grass_sinagec
+    ELSE
+      ALLOCATE(indagec_grass(num_grass_mulagec,nagec_herb-1))     
+    END IF
+
+    IF (num_pasture_mulagec .EQ. 0) THEN
+      ALLOCATE(indagec_pasture(num_pasture_sinagec,1))
+      indagec_pasture(:,1) = indall_pasture(:)
+      num_pasture_mulagec = num_pasture_sinagec
+    ELSE
+      ALLOCATE(indagec_pasture(num_pasture_mulagec,nagec_herb-1))
+    END IF
+
+    IF (num_crop_mulagec .EQ. 0) THEN
+      ALLOCATE(indagec_crop(num_crop_sinagec,1))
+      indagec_crop(:,1) = indall_crop(:)
+      num_crop_mulagec = num_crop_sinagec
+    ELSE
+      ALLOCATE(indagec_crop(num_crop_mulagec,nagec_herb-1))
+    END IF
+
+    ! fill the non-oldest age class index arrays when number of age classes
+    ! is more than 1.
+    ! [chaoyuejoy@gmail.com, 2015-08-05]
+    ! Note the corresponding part of code  will be automatically skipped
+    ! when nagec_tree ==1 and/or nagec_herb ==1, i.e., the assginment
+    ! in above codes when original num_*_mulagec variables are zero will be retained.
+    itree=0
+    igrass=0
+    ipasture=0
+    icrop=0
+    DO ivma = 2,nvmap
+      staind=start_index(ivma)
+      IF (nagec_pft(ivma) > 1) THEN
+        IF (is_tree(staind)) THEN
+          itree=itree+1
+          DO j = 1,nagec_tree-1
+            indagec_tree(itree,j) = staind+nagec_tree-j-1
+          ENDDO
+        ELSE IF (natural(staind) .AND. .NOT. is_grassland_manag(staind)) THEN
+          igrass=igrass+1
+          DO j = 1,nagec_herb-1
+            indagec_grass(igrass,j) = staind+nagec_herb-j-1
+          ENDDO
+        ELSE IF (is_grassland_manag(staind)) THEN
+          ipasture=ipasture+1
+          DO j = 1,nagec_herb-1
+            indagec_pasture(ipasture,j) = staind+nagec_herb-j-1
+          ENDDO
+        ELSE
+          icrop=icrop+1
+          DO j = 1,nagec_herb-1
+            indagec_crop(icrop,j) = staind+nagec_herb-j-1
+          ENDDO
+        ENDIF
+      ENDIF
+    ENDDO
+
+
+    ! we make copies of original input veget_max
+    ! veget_max will be modified through different operations in order to 
+    ! check various purposes, e.g., whether input glcc is compatible with
+    ! existing veget_max and how to allocate it etc.
+    ! veget_max_old will not be modified
+    veget_max(:,:) = veget_max_org(:,:)
+    veget_max_old(:,:) = veget_max_org(:,:)
+
+    !! 2. Calcuate the fractions covered by tree, grass, pasture and crops
+    !!    for each age class
+
+    !************************************************************************!
+    !****block to calculate fractions for basic veg types and age classes ***!
+    ! Note:
+    ! 1. "calc_cover" subroutine does not depend on how many age classes
+    ! there are in each MTC.
+    ! 2. Fraction of baresoil is excluded here. This means transformation
+    ! of baresoil to a vegetated PFT is excluded in gross land cover change.
+    veget_mtc(:,:) = 0.
+    vegagec_tree(:,:) = 0.
+    vegagec_grass(:,:) = 0.
+    vegagec_pasture(:,:) = 0.
+    vegagec_crop(:,:) = 0.
+
+    CALL calc_cover(npts,veget_max,veget_mtc,vegagec_tree,vegagec_grass, &
+           vegagec_pasture,vegagec_crop)
+    ! In following call of calc_cover, veget_mtc will be updated each time,
+    ! but we don't want this, so we put its initial value into veget_mtc_begin
+    ! in order to retrieve this initial value later.
+    veget_mtc_begin = veget_mtc
+ 
+    veget_tree(:) = SUM(vegagec_tree(:,:),DIM=2)
+    veget_grass(:) = SUM(vegagec_grass(:,:),DIM=2)
+    veget_pasture(:) = SUM(vegagec_pasture(:,:),DIM=2)
+    veget_crop(:) = SUM(vegagec_crop(:,:),DIM=2)
+
+    !****end block to calculate fractions for basic veg types and age classes ***!
+    !****************************************************************************!
+
+    !********************** block to handle forestry harvest ****************
+    !! 2B. Here we handle the forestry wood harvest
+    ! Rules:
+    ! 1. We take first from second oldest forest, then oldest forest
+    
+    pf2yf=1   !primary to young forest conversion because of harvest
+    sf2yf=2   !old secondary to young forest conversion because of harvest
+    
+    !! Note that Deficit_pf2yf and Deficit_sf2yf are temporary, intermediate
+    !! variables. The final deficits after mutual compensation are stored in 
+    !! Deficit_pf2yf_final and Deficit_sf2yf_final.
+    Deficit_pf2yf(:) = zero 
+    Deficit_sf2yf(:) = zero
+    Deficit_pf2yf_final(:) = zero 
+    Deficit_sf2yf_final(:) = zero
+
+    !! Note that both Surplus_pf2yf and Surplus_sf2yf and temporary intermediate
+    !! variables, the final surplus after mutual compensation are not outputed.
+    Surplus_pf2yf(:) = zero
+    Surplus_sf2yf(:) = zero
+
+    !! Note in the naming of pf2yf_compen_sf2yf and sf2yf_compen_pf2yf, active
+    !! tense is used.
+    pf2yf_compen_sf2yf(:) = zero  !primary->young conversion that compensates 
+                               !the secondary->young conversion because of deficit
+                               !in the latter
+    sf2yf_compen_pf2yf(:) = zero  !seondary->young conversion that compensates
+                               !the primary->young conversion because of the deficit
+                               !in the latter
+    
+
+    !! Define the "real" harvest matrix after considering the mutual compenstation
+    !! between primary->young and secondary->young transitions.
+    HmatrixReal(:,:) = zero  !Harvest matrix real, used to hold the 
+                                       !harvest matrix after considering the mutual
+                                       !compensation between primary and old secondary
+                                       !forest
+
+    ! we sum together harvest from primary and secondary forest and consider 
+    ! as all happening on parimary forest.
+    HmatrixReal(:,1) = harvest_matrix(:,pf2yf) + harvest_matrix(:,sf2yf)
+
+    ! Check the availability of forest fractions for harvest
+    WHERE (veget_tree(:) .LE. HmatrixReal(:,1)) 
+      Deficit_pf2yf_final(:) = veget_tree(:)-HmatrixReal(:,1)
+      HmatrixReal(:,1) = veget_tree(:)
+    ENDWHERE
+
+    glccRemain(:,:) = HmatrixReal(:,:)
+    glcc_pft(:,:) = 0.
+    glcc_pft_tmp(:,:) = 0.
+    glcc_pftmtc(:,:,:) = 0.
+
+    !! Allocate harvest-caused out-going primary and secondary forest fraction
+    !! into different primary and secondary forest PFTs. 
+    ! [Note: here we need only glcc_pft, but not glcc_pft_tmp and glcc_pftmtc.
+    ! The latter two variables will be set to zero again when handling LCC in 
+    ! later sections.]
+    DO ipts=1,npts
+      !pf2yf
+      CALL type_conversion(ipts,pf2yf,HmatrixReal,veget_mtc,newvegfrac,  &
+                       indold_tree,indagec_tree,indagec_crop,num_crop_mulagec, &
+                       1,nagec_herb,               &
+                       vegagec_tree,veget_max,glcc_pft,glcc_pftmtc,glcc_pft_tmp,&
+                       glccRemain)
+    ENDDO
+
+    ! Because we use the container of type_conversion, now the glcc_pft_tmp
+    ! and glcc_pftmtc have wrong information (because harvest loss is assigned
+    ! on the newly created youngest-age-class pasture/crop MTCs). So they have 
+    ! to be re-initialized to zero. Only the information in glcc_pft is what
+    ! we need.
+    glcc_pft_tmp(:,:) = 0.
+    glcc_pftmtc(:,:,:) = 0.
+    !Here we need to put glcc_pft into glcc_pftmtc for forestry harvest.
+    !The same MTC will be maintained when forest is harvested.
+    DO ivm =1,nvm
+      IF (is_tree(ivm)) THEN
+        glcc_pftmtc(:,ivm,pft_to_mtc(ivm)) = glcc_pft(:,ivm)
+      ENDIF 
+    ENDDO
+    !****************** end block to handle forestry harvest ****************
+    veget_max_tmp(:,:) = veget_max(:,:)
+
+
+    !************************************************************************!
+    !****block to calculate fractions for basic veg types and age classes ***!
+    ! Note:
+    ! 1. "calc_cover" subroutine does not depend on how many age classes
+    ! there are in each MTC.
+    ! 2. Fraction of baresoil is excluded here. This means transformation
+    ! of baresoil to a vegetated PFT is excluded in gross land cover change.
+    veget_mtc(:,:) = 0.
+    vegagec_tree(:,:) = 0.
+    vegagec_grass(:,:) = 0.
+    vegagec_pasture(:,:) = 0.
+    vegagec_crop(:,:) = 0.
+
+
+    CALL calc_cover(npts,veget_max,veget_mtc,vegagec_tree,vegagec_grass, &
+           vegagec_pasture,vegagec_crop)
+    veget_mtc = veget_mtc_begin
+ 
+    veget_tree(:) = SUM(vegagec_tree(:,:),DIM=2)
+    veget_grass(:) = SUM(vegagec_grass(:,:),DIM=2)
+    veget_pasture(:) = SUM(vegagec_pasture(:,:),DIM=2)
+    veget_crop(:) = SUM(vegagec_crop(:,:),DIM=2)
+    itree=1
+    igrass=2
+    ipasture=3
+    icrop=4
+    veget_4veg(:,itree) = veget_tree(:)
+    veget_4veg(:,igrass) = veget_grass(:)
+    veget_4veg(:,ipasture) = veget_pasture(:)
+    veget_4veg(:,icrop) = veget_crop(:)
+    !****end block to calculate fractions for basic veg types and age classes ***!
+    !****************************************************************************!
+
+    !! 3. Decompose the LCC matrix to different PFTs
+    !! We do this through several steps:
+    !  3.1 Check whether input LCC matrix is feasible with current PFT fractions
+    !      (i.e., the fractions of forest,grass,pasture and crops)
+    !      and if not, adjust the transfer matrix by compensating the deficits
+    !      using the surpluses.
+    !  3.2 Allocate the decreasing fractions of tree/grass/pasture/crop to their
+    !      respective age classes, in the sequences of old->young.
+    !  3.3 Allocate the incoming fractions of tree/grass/pasture/crop to their
+    !      respective youngest age classes. The incoming fractions are distributed
+    !      according to the existing fractions of youngest-age-class PFTs of the
+    !      same receiving vegetation type. If none of them exists, the incoming
+    !      fraction is distributed equally.
+
+    !!  3.1 Adjust LCC matrix if it's not feasible with current PFT fractions
+
+    !++code freezing++
+    !codes below handle the mutual compenstation of transition matrices
+    !among different land cover types. This is desgined for consistency 
+    !with activated DGVM.    
+
+    ! glcc(:,:) = glccSecondShift+glccPrimaryShift+glccNetLCC
+    ! glccReal(:,:) = 0.
+    ! glccDef(:,:) = 0.
+
+    ! !to crop - sequence: p2c,g2c,f2c
+    ! CALL glcc_compensation_full(npts,veget_4veg,glcc,glccReal,glccDef, &
+    !                        p2c,ipasture,g2c,igrass,f2c,itree,icrop, &
+    !                        IncreDeficit)
+
+    ! !to pasture - sequence: g2p,c2p,f2p
+    ! CALL glcc_compensation_full(npts,veget_4veg,glcc,glccReal,glccDef, &
+    !                        g2p,igrass,c2p,icrop,f2p,itree,ipasture, &
+    !                        IncreDeficit)
+
+    ! !to grass - sequence: p2g,c2g,f2g
+    ! CALL glcc_compensation_full(npts,veget_4veg,glcc,glccReal,glccDef, &
+    !                        p2g,ipasture,c2g,icrop,f2g,itree,igrass, &
+    !                        IncreDeficit)
+
+    ! !to forest - sequence: c2f,p2f,g2f
+    ! CALL glcc_compensation_full(npts,veget_4veg,glcc,glccReal,glccDef, &
+    !                        c2f,icrop,p2f,ipasture,g2f,igrass,itree, &
+    !                        IncreDeficit)
+
+    ! !!  3.2 & 3.3 Allocate LCC matrix to different PFTs/age-classes
+
+    ! ! because we use veget_max as a proxy variable and it has been changed
+    ! ! when we derive the glccReal, so here we have to recover its original
+    ! ! values, which is veget_max_tmp after the forestry harvest.
+    ! veget_max(:,:) = veget_max_tmp(:,:)
+
+    ! ! Calculate again fractions for different age-classes.
+    ! veget_mtc(:,:) = 0.
+    ! vegagec_tree(:,:) = 0.
+    ! vegagec_grass(:,:) = 0.
+    ! vegagec_pasture(:,:) = 0.
+    ! vegagec_crop(:,:) = 0.
+
+    ! CALL calc_cover(npts,veget_max,veget_mtc,vegagec_tree,vegagec_grass, &
+    !        vegagec_pasture,vegagec_crop)
+
+
+    !++end codes freezing ++
+
+    IncreDeficit(:,:) = 0.
+    glcc(:,:) = glccSecondShift+glccPrimaryShift+glccNetLCC
+    glccReal(:,:) = glcc(:,:)
+    glccRemain(:,:) = glcc(:,:)
+
+    !  We allocate in the sequences of old->young. Within the same age-class
+    !  group, we allocate in proportion with existing PFT fractions.
+    DO ipts=1,npts
+      !f2c
+      CALL type_conversion(ipts,f2c,glccReal,veget_mtc,newvegfrac,       &
+                       indold_tree,indagec_tree,indagec_crop,num_crop_mulagec,     &
+                       nagec_tree,nagec_herb,                    &
+                       vegagec_tree,veget_max,glcc_pft,glcc_pftmtc,glcc_pft_tmp, &
+                       glccRemain)
+      !f2p
+      CALL type_conversion(ipts,f2p,glccReal,veget_mtc,newvegfrac,       &
+                       indold_tree,indagec_tree,indagec_pasture,num_pasture_mulagec,     &
+                       nagec_tree,nagec_herb,                    &
+                       vegagec_tree,veget_max,glcc_pft,glcc_pftmtc,glcc_pft_tmp,&
+                       glccRemain)
+      !f2g
+      CALL type_conversion(ipts,f2g,glccReal,veget_mtc,newvegfrac,       &
+                       indold_tree,indagec_tree,indagec_grass,num_grass_mulagec,     &
+                       nagec_tree,nagec_herb,                    &
+                       vegagec_tree,veget_max,glcc_pft,glcc_pftmtc,glcc_pft_tmp,&
+                       glccRemain)
+      !g2c
+      CALL type_conversion(ipts,g2c,glccReal,veget_mtc,newvegfrac,       &
+                       indold_grass,indagec_grass,indagec_crop,num_crop_mulagec,     &
+                       nagec_herb,nagec_herb,                    &
+                       vegagec_grass,veget_max,glcc_pft,glcc_pftmtc,glcc_pft_tmp,&
+                       glccRemain)
+      !g2p
+      CALL type_conversion(ipts,g2p,glccReal,veget_mtc,newvegfrac,       &
+                       indold_grass,indagec_grass,indagec_pasture,num_pasture_mulagec,     &
+                       nagec_herb,nagec_herb,                    &
+                       vegagec_grass,veget_max,glcc_pft,glcc_pftmtc,glcc_pft_tmp,&
+                       glccRemain)
+      !g2f
+      CALL type_conversion(ipts,g2f,glccReal,veget_mtc,newvegfrac,       &
+                       indold_grass,indagec_grass,indagec_tree,num_tree_mulagec,     &
+                       nagec_herb,nagec_tree,                    &
+                       vegagec_grass,veget_max,glcc_pft,glcc_pftmtc,glcc_pft_tmp,&
+                       glccRemain)
+      !p2c
+      CALL type_conversion(ipts,p2c,glccReal,veget_mtc,newvegfrac,       &
+                       indold_pasture,indagec_pasture,indagec_crop,num_crop_mulagec,     &
+                       nagec_herb,nagec_herb,                    &
+                       vegagec_pasture,veget_max,glcc_pft,glcc_pftmtc,glcc_pft_tmp,&
+                       glccRemain)
+      !p2g
+      CALL type_conversion(ipts,p2g,glccReal,veget_mtc,newvegfrac,       &
+                       indold_pasture,indagec_pasture,indagec_grass,num_grass_mulagec,     &
+                       nagec_herb,nagec_herb,                    &
+                       vegagec_pasture,veget_max,glcc_pft,glcc_pftmtc,glcc_pft_tmp,&
+                       glccRemain)
+      !p2f
+      CALL type_conversion(ipts,p2f,glccReal,veget_mtc,newvegfrac,       &
+                       indold_pasture,indagec_pasture,indagec_tree,num_tree_mulagec,     &
+                       nagec_herb,nagec_tree,                    &
+                       vegagec_pasture,veget_max,glcc_pft,glcc_pftmtc,glcc_pft_tmp,&
+                       glccRemain)
+      !c2p
+      CALL type_conversion(ipts,c2p,glccReal,veget_mtc,newvegfrac,       &
+                       indold_crop,indagec_crop,indagec_pasture,num_pasture_mulagec,     &
+                       nagec_herb,nagec_herb,                    &
+                       vegagec_crop,veget_max,glcc_pft,glcc_pftmtc,glcc_pft_tmp,&
+                       glccRemain)
+      !c2g
+      CALL type_conversion(ipts,c2g,glccReal,veget_mtc,newvegfrac,       &
+                       indold_crop,indagec_crop,indagec_grass,num_grass_mulagec,     &
+                       nagec_herb,nagec_herb,                    &
+                       vegagec_crop,veget_max,glcc_pft,glcc_pftmtc,glcc_pft_tmp,&
+                       glccRemain)
+      !c2f
+      CALL type_conversion(ipts,c2f,glccReal,veget_mtc,newvegfrac,       &
+                       indold_crop,indagec_crop,indagec_tree,num_tree_mulagec,     &
+                       nagec_herb,nagec_tree,                    &
+                       vegagec_crop,veget_max,glcc_pft,glcc_pftmtc,glcc_pft_tmp,&
+                       glccRemain)
+    ENDDO
+   
+    WHERE (glccRemain .GT. zero) 
+      glccReal = glcc - glccRemain
+      IncreDeficit = -1 * glccRemain
+    ENDWHERE 
+
+  END SUBROUTINE glcc_SinAgeC_firstday
+
+
+
+! ================================================================================================================================
+!! SUBROUTINE   : type_conversion
+!>\BRIEF        : Allocate outgoing into different age classes and incoming into
+!!                yongest age-class of receiving MTCs.
+!!
+!! REMARK       : The current dummy variables give an example of converting forests
+!!                to crops.
+!! \n
+!_ ================================================================================================================================
+  SUBROUTINE type_conversion(ipts,f2c,glccReal,veget_mtc,newvegfrac,       &
+                     indold_tree,indagec_tree,indagec_crop,num_crop_mulagec,     &
+                     nagec_giving,nagec_receive,                    &
+                     vegagec_tree,veget_max,glcc_pft,glcc_pftmtc,glcc_pft_tmp, &
+                     glccRemain, &
+                     iagec_start)
+
+    IMPLICIT NONE
+
+    !! Input variables
+    INTEGER, INTENT(in)                             :: ipts,f2c
+    REAL(r_std), DIMENSION(:,:), INTENT(in)         :: glccReal             !! The "real" glcc matrix that we apply in the model
+                                                                            !! after considering the consistency between presribed
+                                                                            !! glcc matrix and existing vegetation fractions.
+    REAL(r_std), DIMENSION(:,:), INTENT(in)         :: veget_mtc            !! "maximal" coverage fraction of a PFT on the ground
+    REAL(r_std), DIMENSION(:,:),INTENT(in)          :: newvegfrac           !! 
+    INTEGER, DIMENSION(:), INTENT(in)               :: indold_tree          !! Indices for PFTs giving out fractions; 
+                                                                            !! here use old tree cohort as an example
+    INTEGER, DIMENSION(:,:), INTENT(in)             :: indagec_tree         !! Indices for PFTs giving out fractions; 
+                                                                            !! here use old tree cohort as an example
+    INTEGER, DIMENSION(:,:), INTENT(in)             :: indagec_crop         !! Indices for secondary basic-vegetation cohorts; The youngest age classes
+                                                                            !! of these vegetations are going to receive fractions. 
+                                                                            !! here we use crop cohorts as an example
+    INTEGER, INTENT(in)                             :: num_crop_mulagec     !! number of crop MTCs with more than one age classes
+    INTEGER, INTENT(in)                             :: nagec_giving         !! number of age classes in the giving basic types
+                                                                            !! (i.e., tree, grass, pasture, crop), here we can use tree
+                                                                            !! as an example, nagec=nagec_tree
+    INTEGER, INTENT(in)                             :: nagec_receive        !! number of age classes in the receiving basic types
+                                                                            !! (i.e., tree, grass, pasture, crop), here we can use crop
+                                                                            !! as an example, nagec=nagec_herb
+    INTEGER, OPTIONAL, INTENT(in)                   :: iagec_start          !! starting index for iagec, this is added in order to handle
+                                                                            !! the case of secondary forest harvest.
+
+    !! 1. Modified variables
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)      :: vegagec_tree         !! fraction of tree age-class groups, in sequence of old->young
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)      :: veget_max            !! "maximal" coverage fraction of a PFT on the ground
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)      :: glcc_pft             !! a temporary variable to hold the fractions each PFT is going to lose
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)    :: glcc_pftmtc          !! a temporary variable to hold the fraction of ipft->ivma, i.e., from 
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)      :: glcc_pft_tmp         !! Loss of fraction in each PFT
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)      :: glccRemain           !! The remaining glcc matrix after applying the conversion. I.e., it will
+                                                                            !! record the remaining unrealized transition fraction in case the donation
+                                                                            !! vegetation is not enough compared with prescribed transition fraction.
+                                                                            !! This variable should be initialized the same as glccReal before it's fed
+                                                                            !! into this function.
+
+    !! Local vriables
+    INTEGER  :: j,iagec,iagec_start_proxy
+    REAL(r_std) :: frac_begin,frac_used
+                                                                            !! PFT_{ipft} to the youngest age class of MTC_{ivma}
+    IF (.NOT. PRESENT(iagec_start)) THEN
+      iagec_start_proxy=1
+    ELSE
+      iagec_start_proxy=iagec_start
+    ENDIF
+    
+    ! This subroutine handles the conversion from one basic-vegetation type
+    ! to another, by calling the subroutine cross_give_receive, which handles
+    ! allocation of giving-receiving fraction among the giving age classes
+    ! and receiving basic-vegetation young age classes.
+    ! We allocate in the sequences of old->young. Within the same age-class
+    ! group, we allocate in proportion with existing PFT fractions. The same
+    ! also applies in the receiving youngest-age-class PFTs, i.e., the receiving
+    ! total fraction is allocated according to existing fractions of 
+    ! MTCs of the same basic vegetation type, otherwise it will be equally
+    ! distributed.
+
+    frac_begin = glccReal(ipts,f2c)
+    !DO WHILE (frac_begin>min_stomate)
+      DO iagec=iagec_start_proxy,nagec_giving
+        IF (vegagec_tree(ipts,iagec)>frac_begin) THEN
+          frac_used = frac_begin
+        ELSE IF (vegagec_tree(ipts,iagec)>min_stomate) THEN
+          frac_used = vegagec_tree(ipts,iagec)
+        ELSE
+          frac_used = 0.
+        ENDIF
+        
+        IF (frac_used>min_stomate) THEN
+          IF (iagec==1) THEN
+            ! Note that vegagec_tree is fractions of tree age-class groups in the 
+            ! the sequence of old->young, so iagec==1 means that we're handling 
+            ! first the oldest-age-group tree PFTs.
+            CALL cross_give_receive(ipts,frac_used,veget_mtc,newvegfrac,      &
+                     indold_tree,indagec_crop,nagec_receive,num_crop_mulagec, &
+                      veget_max,glcc_pft,glcc_pftmtc,glcc_pft_tmp)
+          ELSE
+            ! Note also the sequence of indagec_tree is from old->young, so by
+            ! increasing iagec, we're handling progressively the old to young
+            ! tree age-class PFTs.
+            CALL cross_give_receive(ipts,frac_used,veget_mtc,newvegfrac,      &
+                     indagec_tree(:,iagec-1),indagec_crop,nagec_receive,num_crop_mulagec, &
+                      veget_max,glcc_pft,glcc_pftmtc,glcc_pft_tmp)
+          ENDIF
+          frac_begin = frac_begin-frac_used
+          vegagec_tree(ipts,iagec)=vegagec_tree(ipts,iagec)-frac_used
+          glccRemain(ipts,f2c) = glccRemain(ipts,f2c) - frac_used
+        ENDIF
+      ENDDO
+    !ENDDO
+
+  END SUBROUTINE type_conversion
+
+END MODULE stomate_glcchange_SinAgeC
Index: /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_stomate/stomate_gluc_common.f90
===================================================================
--- /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_stomate/stomate_gluc_common.f90	(revision 6940)
+++ /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_stomate/stomate_gluc_common.f90	(revision 6940)
@@ -0,0 +1,2254 @@
+! =================================================================================================================================
+! MODULE       : stomate_gluc_common
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF       This module contains common fuctions and subroutines used by
+!              gross land use change and forestry harvest modules.
+!!
+!!\n DESCRIPTION: None
+!!
+!! RECENT CHANGE(S): 
+!!
+!! REFERENCE(S)	: None
+!!
+!! SVN          :
+!! $HeadURL: svn://forge.ipsl.jussieu.fr/orchidee/perso/albert.jornet/ORCHIDEE-MICT/src_stomate/stomate_lcchange.f90 $
+!! $Date: 2015-07-30 15:38:45 +0200 (Thu, 30 Jul 2015) $
+!! $Revision: 2847 $
+!! \n
+!_ ================================================================================================================================
+
+
+MODULE stomate_gluc_common
+
+  ! modules used:
+  
+  USE ioipsl_para
+  USE stomate_data
+  USE pft_parameters
+  USE constantes
+  USE constantes_soil_var
+  
+  IMPLICIT NONE
+  
+  PRIVATE
+  PUBLIC calc_cover, cross_give_receive, &
+         initialize_proxy_pft, sap_take, collect_legacy_pft, &
+         collect_legacy_pft_forestry, &
+         add_incoming_proxy_pft, empty_pft, build_age_index, &
+         prepare_balance_check, luc_balance_check
+ 
+  
+CONTAINS
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: build_age_index
+!!
+!>\BRIEF        
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): None
+!!
+!! REFERENCES	: None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  
+  SUBROUTINE build_age_index
+
+    INTEGER, ALLOCATABLE, SAVE                  :: indall_tree(:)       !! Indices for all tree PFTs
+    INTEGER, ALLOCATABLE, SAVE                  :: indold_tree(:)       !! Indices for old tree cohort only
+    INTEGER, ALLOCATABLE, SAVE                  :: indagec_tree(:,:)    !! Indices for secondary tree cohorts, 
+                                                                        !! note the sequence is old->young.
+    INTEGER, ALLOCATABLE, SAVE                  :: indall_grass(:)      !! Indices for all grass PFTs
+    INTEGER, ALLOCATABLE, SAVE                  :: indold_grass(:)      !! Indices for old grasses only
+    INTEGER, ALLOCATABLE, SAVE                  :: indagec_grass(:,:)   !! Indices for secondary grass cohorts
+                                                                        !! note the sequence is old->young.
+    INTEGER, ALLOCATABLE, SAVE                  :: indall_pasture(:)    !! Indices for all pasture PFTs
+    INTEGER, ALLOCATABLE, SAVE                  :: indold_pasture(:)    !! Indices for old pasture only
+    INTEGER, ALLOCATABLE, SAVE                  :: indagec_pasture(:,:) !! Indices for secondary pasture cohorts
+                                                                        !! note the sequence is old->young.
+    INTEGER, ALLOCATABLE, SAVE                  :: indall_crop(:)       !! Indices for all crop PFTs
+    INTEGER, ALLOCATABLE, SAVE                  :: indold_crop(:)       !! Indices for old crops only
+    INTEGER, ALLOCATABLE, SAVE                  :: indagec_crop(:,:)    !! Indices for secondary crop cohorts
+                                                                        !! note the sequence is old->young.
+    INTEGER :: num_tree_mulagec,num_grass_mulagec,     &
+               num_pasture_mulagec,num_crop_mulagec, &
+               itree,itree2,igrass,igrass2,ipasture,ipasture2,icrop,icrop2
+    INTEGER :: i,j,ivma,staind,endind,ivm
+
+
+    !! 1. We first build all different indices that we are going to use
+    !!    in handling the PFT exchanges, three types of indices are built:
+    !!     - for all age classes
+    !!     - include only oldest age classes
+    !!     - include all age classes excpet the oldest ones
+    ! We have to build these indices because we would like to extract from
+    ! donating PFTs in the sequnce of old->young age classes or the revserse, 
+    ! and add in the receving PFTs only in the youngest-age-class PFTs. These 
+    ! indicies allow us to know where the different age classes are.
+
+    ! calculate the total number of MTCs for each vegetation type.
+    num_tree_mulagec=0          
+    num_grass_mulagec=0
+    num_pasture_mulagec=0
+    num_crop_mulagec=0
+    
+    !! 1.1 Calculate the number of PFTs for different MTCs and allocate
+    !! the old and all indices arrays.
+
+    ! [Note here the sequence to identify tree,pasture,grass,crop] is
+    ! critical. The similar sequence is used in the subroutine "calc_cover".
+    ! Do not forget to change the sequence there if you modify here.
+    DO ivma =2,nvmap
+      staind=start_index(ivma)
+      IF (nagec_pft(ivma)==1) THEN
+        WRITE(numout,*) "Error: metaclass has only a single age group: ",ivma
+        STOP
+      ELSE
+        IF (is_tree(staind)) THEN
+          num_tree_mulagec = num_tree_mulagec+1
+        ELSE IF (is_grassland_manag(staind)) THEN
+          num_pasture_mulagec = num_pasture_mulagec+1
+        ELSE IF (natural(staind)) THEN
+          num_grass_mulagec = num_grass_mulagec+1
+        ELSE
+          num_crop_mulagec = num_crop_mulagec+1
+        ENDIF
+      ENDIF
+    ENDDO
+    
+    !! Allocate index array
+    ! allocate all index
+    ALLOCATE(indall_tree(num_tree_mulagec*nagec_tree))     
+    ALLOCATE(indall_grass(num_grass_mulagec*nagec_herb))     
+    ALLOCATE(indall_pasture(num_pasture_mulagec*nagec_herb))     
+    ALLOCATE(indall_crop(num_crop_mulagec*nagec_herb))     
+
+    ! allocate old-ageclass index
+    ALLOCATE(indold_tree(num_tree_mulagec))     
+    ALLOCATE(indold_grass(num_grass_mulagec))     
+    ALLOCATE(indold_pasture(num_pasture_mulagec))     
+    ALLOCATE(indold_crop(num_crop_mulagec))     
+
+    !! 1.2 Fill the oldest-age-class and all index arrays
+    itree=0
+    igrass=0
+    ipasture=0
+    icrop=0
+    itree2=1
+    igrass2=1
+    ipasture2=1
+    icrop2=1
+    DO ivma =2,nvmap
+      staind=start_index(ivma)
+      IF (is_tree(staind)) THEN
+        itree=itree+1
+        indold_tree(itree) = staind+nagec_pft(ivma)-1
+        DO j = 0,nagec_pft(ivma)-1
+          indall_tree(itree2+j) = staind+j
+        ENDDO
+        itree2=itree2+nagec_pft(ivma)
+      ELSE IF (natural(staind) .AND. .NOT. is_grassland_manag(staind)) THEN
+        igrass=igrass+1
+        indold_grass(igrass) = staind+nagec_pft(ivma)-1
+        DO j = 0,nagec_pft(ivma)-1
+          indall_grass(igrass2+j) = staind+j
+        ENDDO
+        igrass2=igrass2+nagec_pft(ivma)
+      ELSE IF (is_grassland_manag(staind)) THEN
+        ipasture = ipasture+1
+        indold_pasture(ipasture) = staind+nagec_pft(ivma)-1
+        DO j = 0,nagec_pft(ivma)-1
+          indall_pasture(ipasture2+j) = staind+j
+        ENDDO
+        ipasture2=ipasture2+nagec_pft(ivma)
+      ELSE
+        icrop = icrop+1
+        indold_crop(icrop) = staind+nagec_pft(ivma)-1
+        DO j = 0,nagec_pft(ivma)-1
+          indall_crop(icrop2+j) = staind+j
+        ENDDO
+        icrop2=icrop2+nagec_pft(ivma)
+      ENDIF
+    ENDDO
+    
+    !! 1.3 Allocate and fill other age class index
+
+    ALLOCATE(indagec_tree(num_tree_mulagec,nagec_tree-1))     
+    ALLOCATE(indagec_grass(num_grass_mulagec,nagec_herb-1))     
+    ALLOCATE(indagec_pasture(num_pasture_mulagec,nagec_herb-1))
+    ALLOCATE(indagec_crop(num_crop_mulagec,nagec_herb-1))
+
+    ! fill the non-oldest age class index arrays when number of age classes
+    ! is more than 1.
+    itree=0
+    igrass=0
+    ipasture=0
+    icrop=0
+    DO ivma = 2,nvmap
+      staind=start_index(ivma)
+      IF (nagec_pft(ivma) > 1) THEN
+        IF (is_tree(staind)) THEN
+          itree=itree+1
+          DO j = 1,nagec_tree-1
+            indagec_tree(itree,j) = staind+nagec_tree-j-1
+          ENDDO
+        ELSE IF (natural(staind) .AND. .NOT. is_grassland_manag(staind)) THEN
+          igrass=igrass+1
+          DO j = 1,nagec_herb-1
+            indagec_grass(igrass,j) = staind+nagec_herb-j-1
+          ENDDO
+        ELSE IF (is_grassland_manag(staind)) THEN
+          ipasture=ipasture+1
+          DO j = 1,nagec_herb-1
+            indagec_pasture(ipasture,j) = staind+nagec_herb-j-1
+          ENDDO
+        ELSE
+          icrop=icrop+1
+          DO j = 1,nagec_herb-1
+            indagec_crop(icrop,j) = staind+nagec_herb-j-1
+          ENDDO
+        ENDIF
+      ENDIF
+    ENDDO
+
+  END SUBROUTINE build_age_index
+
+! ================================================================================================================================
+!! SUBROUTINE   : calc_cover
+!!
+!>\BRIEF        Calculate coverage fraction for different age classes of forest,
+!!              grass, pasture and crops and also for each metaclass. Note baresoil is excluded. 
+!!              
+!! DESCRIPTION :
+!! Note:
+!! 1. "calc_cover" subroutine does not depend on how many age classes
+!! there are in each MTC.
+!! 2. Fraction of baresoil is excluded here. This means transformation
+!! of baresoil to a vegetated PFT is excluded in gross land cover change.
+!!  
+!!
+!! MAIN OUTPUT VARIABLE(S) :  
+!!
+!! \n
+!_ ================================================================================================================================
+  SUBROUTINE calc_cover(npts,veget_max,veget_mtc,vegagec_tree,vegagec_grass, &
+                 vegagec_pasture,vegagec_crop)
+
+   
+    IMPLICIT NONE
+
+    !! Input variables
+    INTEGER, INTENT(in)                                       :: npts             !! Domain size - number of pixels (unitless)
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)         :: veget_max           !! "maximal" coverage fraction of a PFT on the ground
+
+    !! Output variables
+    REAL(r_std), DIMENSION(npts,nvmap), INTENT(inout)         :: veget_mtc        !! "maximal" coverage fraction of a PFT on the ground
+    REAL(r_std), DIMENSION(npts,nagec_tree), INTENT(inout)    :: vegagec_tree     !! fraction of tree age-class groups, in sequence of old->young
+    REAL(r_std), DIMENSION(npts,nagec_herb), INTENT(inout)    :: vegagec_grass    !! fraction of grass age-class groups, in sequence of old->young
+    REAL(r_std), DIMENSION(npts,nagec_herb), INTENT(inout)    :: vegagec_pasture  !! fraction of pasture age-class groups, in sequence of old->young
+    REAL(r_std), DIMENSION(npts,nagec_herb), INTENT(inout)    :: vegagec_crop     !! fraction of crop age-class groups, in sequence of old->young
+
+    !! Local variables
+    INTEGER(i_std)                                          :: ivma,staind,endind,j    !! indices (unitless)
+
+    veget_mtc(:,:) = 0.
+    vegagec_tree(:,:) = 0.
+    vegagec_grass(:,:) = 0.
+    vegagec_pasture(:,:) = 0.
+    vegagec_crop(:,:) = 0.
+
+    ! Calculate veget_max for MTCs
+    DO ivma = 1,nvmap
+      staind = start_index(ivma)
+      IF (nagec_pft(ivma) == 1) THEN
+        veget_mtc(:,ivma) = veget_max(:,staind)
+      ELSE
+        veget_mtc(:,ivma) = \
+          SUM(veget_max(:,staind:staind+nagec_pft(ivma)-1),DIM=2)
+      ENDIF
+    ENDDO
+
+    ! Calculate veget_max for each age class
+    DO ivma = 2,nvmap  !here we start with 2 to exclude baresoil (always PFT1)
+      staind = start_index(ivma)
+      endind = staind+nagec_pft(ivma)-1
+
+      ! Single-age-class MTC goest to oldest age class.
+      IF (nagec_pft(ivma) == 1) THEN
+        IF (is_tree(staind)) THEN
+          vegagec_tree(:,1) = vegagec_tree(:,1)+veget_max(:,staind)
+        ELSE IF (is_grassland_manag(staind)) THEN
+          vegagec_pasture(:,1) = vegagec_pasture(:,1)+veget_max(:,staind)
+        ELSE IF (natural(staind)) THEN
+          vegagec_grass(:,1) = vegagec_grass(:,1)+veget_max(:,staind)
+        ELSE
+          vegagec_crop(:,1) = vegagec_crop(:,1)+veget_max(:,staind)
+        ENDIF
+
+      ELSE
+        IF (is_tree(staind)) THEN
+          DO j=1,nagec_tree
+            vegagec_tree(:,j) = vegagec_tree(:,j)+veget_max(:,endind-j+1)
+          ENDDO
+        ELSE IF (is_grassland_manag(staind)) THEN
+          DO j=1,nagec_herb
+            vegagec_pasture(:,j) = vegagec_pasture(:,j)+veget_max(:,endind-j+1)
+          ENDDO
+        ELSE IF (natural(staind)) THEN
+          DO j=1,nagec_herb
+            vegagec_grass(:,j) = vegagec_grass(:,j)+veget_max(:,endind-j+1)
+          ENDDO
+        ELSE
+          DO j=1,nagec_herb
+            vegagec_crop(:,j) = vegagec_crop(:,j)+veget_max(:,endind-j+1)
+          ENDDO
+        ENDIF
+      ENDIF
+    ENDDO
+
+  END SUBROUTINE calc_cover
+
+
+! ================================================================================================================================
+!! SUBROUTINE   : cross_give_receive
+!!
+!>\BRIEF        : Allocate the outgoing and receving fractions in respective
+!!                PFTs.
+!! \n
+!! Notes:
+!!  1. veget_max is subtracted when fractions are taken out, but newly added
+!!     fractions in the youngest age class is not added, to avoid this newly
+!!     created fractions being used again the following transitions. This is 
+!!     is reasonable because the newly created youngest-age-class PFT fractions
+!!     have nothing but small sapling biomass and it's unreasonable to use it
+!!     for any further land use conversion activities.
+!_ ================================================================================================================================
+  SUBROUTINE cross_give_receive(ipts,frac_used,veget_mtc,newvegfrac,           &
+                     indold_tree,indagec_crop,nagec_receive,num_crop_mulagec, &
+                     veget_max,glcc_pft,glcc_pftmtc,glcc_pft_tmp)
+
+
+    IMPLICIT NONE
+
+    !! 0. Input variables
+    INTEGER, INTENT(in)                             :: ipts
+    REAL(r_std), INTENT(in)                         :: frac_used                 !! fraction that the giving PFTs are going to collectively give
+    REAL(r_std), DIMENSION(:,:), INTENT(in)         :: veget_mtc            !! "maximal" coverage fraction of a PFT on the ground
+    INTEGER, DIMENSION(:), INTENT(in)               :: indold_tree          !! Indices for PFTs giving out fractions; 
+                                                                            !! here use old tree cohort as an example
+    INTEGER, DIMENSION(:,:), INTENT(in)             :: indagec_crop         !! Indices for secondary basic-vegetation cohorts; The youngest age classes
+                                                                            !! of these vegetations are going to receive fractions. 
+                                                                            !! here we use crop cohorts as an example
+    INTEGER, INTENT(in)                             :: num_crop_mulagec     !! number of crop MTCs with more than one age classes
+    INTEGER, INTENT(in)                             :: nagec_receive        !! number of age classes in the receiving basic types
+                                                                            !! (i.e., tree, grass, pasture, crop), here we can use crop
+                                                                            !! as an example, nagec_receive=nagec_herb
+    REAL(r_std), DIMENSION(:,:),INTENT(in)          :: newvegfrac           !! 
+
+    !! 1. Modified variables
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)      :: veget_max            !! "maximal" coverage fraction of a PFT on the ground
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)      :: glcc_pft             !! a temporary variable to hold the fractions each PFT is going to lose
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)    :: glcc_pftmtc          !! a temporary variable to hold the fraction of ipft->ivma, i.e., from 
+                                                                            !! PFT_{ipft} to the youngest age class of MTC_{ivma}
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)      :: glcc_pft_tmp         !! a temporary variable to hold the fractions each PFT is going to lose
+
+    !! Local vriables
+    INTEGER  :: j,ipft, iyoung
+    REAL(r_std) :: totalveg, tveg_now
+    LOGICAL :: guide_newfrac
+    
+    guide_newfrac = gluc_newfrac_guide
+
+    ! Out final objective is to know glcc_pftmtc, i.e., the fraction from each PFT
+    ! to the youngest age group of each MTC. We separate this task into two steps:
+    ! 1. we allocate the total outgoing fraction into the same age-class PFTs of 
+    ! the a basic-vegetation (for example, the same age-calss PFTs of forest);
+    ! 2. we further allocate the outgoing fraction of each age-class PFT to 
+    ! the different receiving youngest age-class PFTs of the same basic-vegetation
+    ! type, for example, the youngest age-calss PFTs of cropland.
+    
+    ! glcc_pft_tmp used only as a temporary variable to store the value
+    glcc_pft_tmp(ipts,indold_tree) = veget_max(ipts,indold_tree)/SUM(veget_max(ipts,indold_tree))*frac_used
+    glcc_pft(ipts,indold_tree) = glcc_pft(ipts,indold_tree) + glcc_pft_tmp(ipts,indold_tree)
+    !we have to remove the outgoing fraction from veget_max in order to use this information for next loop
+    veget_max(ipts,indold_tree) = veget_max(ipts,indold_tree) - glcc_pft_tmp(ipts,indold_tree)
+
+    ! when receiving basic-vegetation type has a single age group, it will be considered as
+    ! both old and young age group (thus recevie the fraction donation), otherwise the youngest
+    ! age group is always the final element of indagec_crop.
+    IF (nagec_receive == 1) THEN
+      iyoung = 1
+    ELSE
+      iyoung = nagec_receive - 1
+    ENDIF
+
+    ! [20160728] Here we have two options: 
+    ! 1. allocate the newly created young age class according to existing fractions
+    ! the MTCs.
+    ! 2. Use the fractions of MTCs from the current-day PFT map to guid the
+    ! allocation of newly created young-age-class MTCs.
+
+    totalveg = 0.   ! [20160130 note here totalveg is the total fraction 
+                    !  of all existing MTCs that are going to recieve newly
+                    ! convervted fractions.]
+    tveg_now = 0.   ! total vegetation fraction in the current-day MTC
+                    ! input map.
+    DO j=1,num_crop_mulagec
+      totalveg = totalveg + veget_mtc(ipts,agec_group(indagec_crop(j,iyoung))) 
+      tveg_now = tveg_now + newvegfrac(ipts,agec_group(indagec_crop(j,iyoung)))
+    ENDDO
+
+    IF (guide_newfrac) THEN
+      IF (tveg_now>min_stomate) THEN
+        DO j=1,num_crop_mulagec
+          ipft = indagec_crop(j,iyoung)
+          glcc_pftmtc(ipts,indold_tree,agec_group(ipft)) = &
+                 glcc_pftmtc(ipts,indold_tree,agec_group(ipft)) + &
+                 glcc_pft_tmp(ipts,indold_tree) * newvegfrac(ipts,agec_group(ipft))/tveg_now
+        ENDDO
+      ELSE
+        DO j=1,num_crop_mulagec
+          ipft = indagec_crop(j,iyoung)
+          glcc_pftmtc(ipts,indold_tree,agec_group(ipft)) = &
+                glcc_pftmtc(ipts,indold_tree,agec_group(ipft)) + glcc_pft_tmp(ipts,indold_tree)/num_crop_mulagec
+        ENDDO
+      ENDIF
+
+    ELSE
+      IF (totalveg>min_stomate) THEN
+        DO j=1,num_crop_mulagec
+          ipft = indagec_crop(j,iyoung)
+          glcc_pftmtc(ipts,indold_tree,agec_group(ipft)) = &
+                 glcc_pftmtc(ipts,indold_tree,agec_group(ipft)) + & 
+                 glcc_pft_tmp(ipts,indold_tree) * veget_mtc(ipts,agec_group(ipft))/totalveg
+        ENDDO
+      ELSE
+        DO j=1,num_crop_mulagec
+          ipft = indagec_crop(j,iyoung)
+          glcc_pftmtc(ipts,indold_tree,agec_group(ipft)) = &
+                glcc_pftmtc(ipts,indold_tree,agec_group(ipft)) + glcc_pft_tmp(ipts,indold_tree)/num_crop_mulagec
+        ENDDO
+      ENDIF
+
+    ENDIF
+
+  END SUBROUTINE cross_give_receive
+
+! ================================================================================================================================
+!! SUBROUTINE   : clear_forest
+!!
+!>\BRIEF        : Handle forest harvest before its legacy is transferred to 
+!                 newly initialized youngest-age-class PFT.
+!!
+!>\DESCRIPTION  
+!_ ================================================================================================================================
+  !!++TEMP++ biomass,veget_frac are not used because the remaining biomass to be 
+  !! harvested is calculated within the deforestation fire module.
+  SUBROUTINE clear_forest (npts,ipts,ivm,biomass,frac,    &
+                instant_loss, &
+                litter, deforest_biomass_remain,&
+                fuel_1hr,fuel_10hr,&
+                fuel_100hr,fuel_1000hr,&
+                lignin_struc,&
+                bm_to_litter_pro,convflux,prod10,prod100,&
+                litter_pro, fuel_1hr_pro, fuel_10hr_pro, fuel_100hr_pro, &
+                fuel_1000hr_pro, lignin_content_pro)
+
+
+    IMPLICIT NONE
+
+    !! 0.1 Input variables
+    INTEGER, INTENT(in)                                       :: npts
+    INTEGER, INTENT(in)                                       :: ipts
+    INTEGER, INTENT(in)                                       :: ivm
+    REAL(r_std), INTENT(in)                                   :: instant_loss
+    REAL(r_std), INTENT(in)                                   :: frac   !! the fraction of land covered by forest to be deforested
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(in)               :: biomass      !! biomass @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(in)               :: fuel_1hr
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(in)               :: fuel_10hr
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(in)               :: fuel_100hr
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(in)               :: fuel_1000hr
+    REAL(r_std), DIMENSION(:,:,:,:,:), INTENT(in)             :: litter   !! Vegetmax-weighted remaining litter on the ground for 
+                                                                                                      !! deforestation region.
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(in)               :: deforest_biomass_remain  !! Vegetmax-weighted remaining biomass on the ground for 
+                                                                                                      !! deforestation region.
+    REAL(r_std), DIMENSION(:,:,:), INTENT(in)         :: lignin_struc     !! ratio Lignine/Carbon in structural litter,
+                                                                             !! above and below ground
+
+    !! 0.2 Modified variables
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)               :: bm_to_litter_pro    !! conversion of biomass to litter 
+                                                                              !! @tex ($gC m^{-2} day^{-1}$) @endtex
+    REAL(r_std), DIMENSION(:), INTENT(inout)                 :: convflux         !! release during first year following land cover
+                                                                                  !! change
+
+    REAL(r_std), DIMENSION(npts,0:10), INTENT(inout)            :: prod10          !! products remaining in the 10 year-turnover
+                                                                              !! pool after the annual release for each 
+                                                                              !! compartment (10 + 1 : input from year of land
+                                                                              !! cover change)
+    REAL(r_std), DIMENSION(npts,0:100), INTENT(inout)           :: prod100         !! products remaining in the 100 year-turnover
+                                                                              !! pool after the annual release for each 
+                                                                              !! compartment (100 + 1 : input from year of land
+                                                                              !! cover change)
+
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)          :: litter_pro
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)            :: fuel_1hr_pro
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)            :: fuel_10hr_pro
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)            :: fuel_100hr_pro
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)            :: fuel_1000hr_pro
+    REAL(r_std), DIMENSION(:),INTENT(inout)               :: lignin_content_pro
+
+
+
+    !! 0.4 Local variables
+    REAL(r_std)                                              :: above
+      
+    ! harvest of aboveground sap- and heartwood biomass after taking into
+    ! account of deforestation fire
+    IF (allow_deforest_fire) THEN
+      above = deforest_biomass_remain(ipts,ivm,isapabove,icarbon)+ &
+            deforest_biomass_remain(ipts,ivm,iheartabove,icarbon)
+      convflux(ipts)  = convflux(ipts) + 0
+      prod10(ipts,0)  = prod10(ipts,0) + 0.4*above
+      prod100(ipts,0) = prod100(ipts,0) + 0.6*above
+    ELSE
+      above = (biomass(ipts,ivm,isapabove,icarbon)+ &
+          biomass(ipts,ivm,ileaf,icarbon) + &
+          biomass(ipts,ivm,ifruit,icarbon) + &  
+          biomass(ipts,ivm,iheartabove,icarbon))*frac
+      convflux(ipts)  = convflux(ipts) + instant_loss * above
+      !prod10(ipts,0)  = prod10(ipts,0) + coeff_lcchange_10(ivm) * above 
+      !prod100(ipts,0) = prod100(ipts,0) + coeff_lcchange_100(ivm) * above 
+    ENDIF
+  
+    ! the transfer of dead biomass to litter
+    
+    bm_to_litter_pro(isapabove,:) = bm_to_litter_pro(isapabove,:) +  &
+                      biomass(ipts,ivm,isapabove,:)*frac*(1-instant_loss)
+    bm_to_litter_pro(iheartabove,:) = bm_to_litter_pro(iheartabove,:) +  &
+                      biomass(ipts,ivm,iheartabove,:)*frac*(1-instant_loss)
+
+    bm_to_litter_pro(isapbelow,:) = bm_to_litter_pro(isapbelow,:) +  &
+                      biomass(ipts,ivm,isapbelow,:)*frac
+    bm_to_litter_pro(iheartbelow,:) = bm_to_litter_pro(iheartbelow,:) + &
+                      biomass(ipts,ivm,iheartbelow,:)*frac
+    bm_to_litter_pro(iroot,:) = bm_to_litter_pro(iroot,:) + &
+                      biomass(ipts,ivm,iroot,:)*frac
+    bm_to_litter_pro(ifruit,:) = bm_to_litter_pro(ifruit,:) + &
+                      biomass(ipts,ivm,ifruit,:)*frac*(1-instant_loss)
+    bm_to_litter_pro(icarbres,:) = bm_to_litter_pro(icarbres,:) + &
+                      biomass(ipts,ivm,icarbres,:)*frac
+    bm_to_litter_pro(ileaf,:) = bm_to_litter_pro(ileaf,:) + &
+                      biomass(ipts,ivm,ileaf,:)*frac*(1-instant_loss)
+
+    !update litter_pro
+    litter_pro(:,:,:) = litter_pro(:,:,:) + litter(ipts,:,ivm,:,:)*frac
+    fuel_1hr_pro(:,:) = fuel_1hr_pro(:,:) + fuel_1hr(ipts,ivm,:,:)*frac
+    fuel_10hr_pro(:,:) = fuel_10hr_pro(:,:) + fuel_10hr(ipts,ivm,:,:)*frac 
+    fuel_100hr_pro(:,:) = fuel_100hr_pro(:,:) + fuel_100hr(ipts,ivm,:,:)*frac
+    fuel_1000hr_pro(:,:) = fuel_1000hr_pro(:,:) + fuel_1000hr(ipts,ivm,:,:)*frac
+    !don't forget to hanle litter lignin content
+    lignin_content_pro(:)= lignin_content_pro(:) + &
+      litter(ipts,istructural,ivm,:,icarbon)*frac*lignin_struc(ipts,ivm,:)
+
+  END SUBROUTINE clear_forest
+
+! ================================================================================================================================
+!! SUBROUTINE   : harvest_industrial
+!!
+!>\BRIEF        : Handle forest harvest before its legacy is transferred to 
+!                 newly initialized youngest-age-class PFT.
+!!
+!>\DESCRIPTION  
+!_ ================================================================================================================================
+  !!++TEMP++ biomass,veget_frac are not used because the remaining biomass to be 
+  !! harvested is calculated within the deforestation fire module.
+  SUBROUTINE harvest_industrial (npts,ipts,ivm,biomass,frac,    &
+                litter, deforest_biomass_remain,&
+                fuel_1hr,fuel_10hr,&
+                fuel_100hr,fuel_1000hr,&
+                lignin_struc,&
+                bm_to_litter_pro,convflux,prod10,prod100,&
+                litter_pro, fuel_1hr_pro, fuel_10hr_pro, fuel_100hr_pro, &
+                fuel_1000hr_pro, lignin_content_pro)
+
+
+    IMPLICIT NONE
+
+    !! 0.1 Input variables
+    INTEGER, INTENT(in)                                       :: npts
+    INTEGER, INTENT(in)                                       :: ipts
+    INTEGER, INTENT(in)                                       :: ivm
+    REAL(r_std), INTENT(in)                                   :: frac   !! the fraction of land covered by forest to be deforested
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(in)               :: biomass      !! biomass @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(in)               :: fuel_1hr
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(in)               :: fuel_10hr
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(in)               :: fuel_100hr
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(in)               :: fuel_1000hr
+    REAL(r_std), DIMENSION(:,:,:,:,:), INTENT(in)             :: litter   !! Vegetmax-weighted remaining litter on the ground for 
+                                                                                                      !! deforestation region.
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(in)               :: deforest_biomass_remain  !! Vegetmax-weighted remaining biomass on the ground for 
+                                                                                                      !! deforestation region.
+    REAL(r_std), DIMENSION(:,:,:), INTENT(in)         :: lignin_struc     !! ratio Lignine/Carbon in structural litter,
+                                                                             !! above and below ground
+
+    !! 0.2 Modified variables
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)               :: bm_to_litter_pro    !! conversion of biomass to litter 
+                                                                              !! @tex ($gC m^{-2} day^{-1}$) @endtex
+    REAL(r_std), DIMENSION(:), INTENT(inout)                 :: convflux         !! release during first year following land cover
+                                                                                  !! change
+
+    REAL(r_std), DIMENSION(npts,0:10), INTENT(inout)            :: prod10          !! products remaining in the 10 year-turnover
+                                                                              !! pool after the annual release for each 
+                                                                              !! compartment (10 + 1 : input from year of land
+                                                                              !! cover change)
+    REAL(r_std), DIMENSION(npts,0:100), INTENT(inout)           :: prod100         !! products remaining in the 100 year-turnover
+                                                                              !! pool after the annual release for each 
+                                                                              !! compartment (100 + 1 : input from year of land
+                                                                              !! cover change)
+
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)          :: litter_pro
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)            :: fuel_1hr_pro
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)            :: fuel_10hr_pro
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)            :: fuel_100hr_pro
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)            :: fuel_1000hr_pro
+    REAL(r_std), DIMENSION(:),INTENT(inout)               :: lignin_content_pro
+
+
+
+    !! 0.4 Local variables
+    REAL(r_std)                                              :: above
+    REAL(r_std)                                              :: slash_frac
+    REAL(r_std)                                              :: harvest_efficiency
+
+    ! harvest_efficiency indicates the percentage of the gross area that 
+    ! are effetively harvested to reach the target. 
+    harvest_efficiency = 0.667
+    ! harvest of aboveground sap- and heartwood biomass after taking into
+    ! account of deforestation fire
+    IF (allow_deforest_fire) THEN
+      above = deforest_biomass_remain(ipts,ivm,isapabove,icarbon)+ &
+            deforest_biomass_remain(ipts,ivm,iheartabove,icarbon)
+      convflux(ipts)  = convflux(ipts) + 0
+      prod10(ipts,0)  = prod10(ipts,0) + 0.4*above
+      prod100(ipts,0) = prod100(ipts,0) + 0.6*above
+    ELSE
+      above = (biomass(ipts,ivm,isapabove,icarbon)+ &
+          biomass(ipts,ivm,iheartabove,icarbon))*frac
+      convflux(ipts)  = convflux(ipts) + harvest_efficiency * coeff_indwood_1(ivm) * above
+      prod10(ipts,0)  = prod10(ipts,0) + harvest_efficiency * coeff_indwood_10(ivm) * above 
+      prod100(ipts,0) = prod100(ipts,0) + harvest_efficiency * coeff_indwood_100(ivm) * above 
+    ENDIF
+  
+    slash_frac = 1 - (coeff_indwood_10(ivm) + coeff_indwood_100(ivm) &
+                   + coeff_indwood_1(ivm)) * harvest_efficiency
+    ! the transfer of dead biomass to litter
+    bm_to_litter_pro(isapabove,:) = bm_to_litter_pro(isapabove,:) +  &
+                      biomass(ipts,ivm,isapabove,:)*frac*slash_frac
+    bm_to_litter_pro(iheartabove,:) = bm_to_litter_pro(iheartabove,:) +  &
+                      biomass(ipts,ivm,iheartabove,:)*frac*slash_frac
+    bm_to_litter_pro(isapbelow,:) = bm_to_litter_pro(isapbelow,:) +  &
+                      biomass(ipts,ivm,isapbelow,:)*frac
+    bm_to_litter_pro(iheartbelow,:) = bm_to_litter_pro(iheartbelow,:) + &
+                      biomass(ipts,ivm,iheartbelow,:)*frac
+    bm_to_litter_pro(iroot,:) = bm_to_litter_pro(iroot,:) + &
+                      biomass(ipts,ivm,iroot,:)*frac
+    bm_to_litter_pro(ifruit,:) = bm_to_litter_pro(ifruit,:) + &
+                      biomass(ipts,ivm,ifruit,:)*frac
+    bm_to_litter_pro(icarbres,:) = bm_to_litter_pro(icarbres,:) + &
+                      biomass(ipts,ivm,icarbres,:)*frac
+    bm_to_litter_pro(ileaf,:) = bm_to_litter_pro(ileaf,:) + &
+                      biomass(ipts,ivm,ileaf,:)*frac
+
+    !update litter_pro
+    litter_pro(:,:,:) = litter_pro(:,:,:) + litter(ipts,:,ivm,:,:)*frac
+    fuel_1hr_pro(:,:) = fuel_1hr_pro(:,:) + fuel_1hr(ipts,ivm,:,:)*frac
+    fuel_10hr_pro(:,:) = fuel_10hr_pro(:,:) + fuel_10hr(ipts,ivm,:,:)*frac 
+    fuel_100hr_pro(:,:) = fuel_100hr_pro(:,:) + fuel_100hr(ipts,ivm,:,:)*frac
+    fuel_1000hr_pro(:,:) = fuel_1000hr_pro(:,:) + fuel_1000hr(ipts,ivm,:,:)*frac
+    !don't forget to hanle litter lignin content
+    lignin_content_pro(:)= lignin_content_pro(:) + &
+      litter(ipts,istructural,ivm,:,icarbon)*frac*lignin_struc(ipts,ivm,:)
+
+  END SUBROUTINE harvest_industrial
+
+! ================================================================================================================================
+!! SUBROUTINE   : harvest_fuelwood
+!!
+!>\BRIEF        : Handle forest harvest before its legacy is transferred to 
+!                 newly initialized youngest-age-class PFT.
+!!
+!>\DESCRIPTION  
+!_ ================================================================================================================================
+  !!++TEMP++ biomass,veget_frac are not used because the remaining biomass to be 
+  !! harvested is calculated within the deforestation fire module.
+  SUBROUTINE harvest_fuelwood (npts,ipts,ivm,biomass,frac,    &
+                litter, deforest_biomass_remain,&
+                fuel_1hr,fuel_10hr,&
+                fuel_100hr,fuel_1000hr,&
+                lignin_struc,&
+                bm_to_litter_pro,convflux,prod10,prod100,&
+                litter_pro, fuel_1hr_pro, fuel_10hr_pro, fuel_100hr_pro, &
+                fuel_1000hr_pro, lignin_content_pro)
+
+
+    IMPLICIT NONE
+
+    !! 0.1 Input variables
+    INTEGER, INTENT(in)                                       :: npts
+    INTEGER, INTENT(in)                                       :: ipts
+    INTEGER, INTENT(in)                                       :: ivm
+    REAL(r_std), INTENT(in)                                   :: frac   !! the fraction of land covered by forest to be deforested
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(in)               :: biomass      !! biomass @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(in)               :: fuel_1hr
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(in)               :: fuel_10hr
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(in)               :: fuel_100hr
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(in)               :: fuel_1000hr
+    REAL(r_std), DIMENSION(:,:,:,:,:), INTENT(in)             :: litter   !! Vegetmax-weighted remaining litter on the ground for 
+                                                                                                      !! deforestation region.
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(in)               :: deforest_biomass_remain  !! Vegetmax-weighted remaining biomass on the ground for 
+                                                                                                      !! deforestation region.
+    REAL(r_std), DIMENSION(:,:,:), INTENT(in)         :: lignin_struc     !! ratio Lignine/Carbon in structural litter,
+                                                                             !! above and below ground
+
+    !! 0.2 Modified variables
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)               :: bm_to_litter_pro    !! conversion of biomass to litter 
+                                                                              !! @tex ($gC m^{-2} day^{-1}$) @endtex
+    REAL(r_std), DIMENSION(:), INTENT(inout)                 :: convflux         !! release during first year following land cover
+                                                                                  !! change
+
+    REAL(r_std), DIMENSION(npts,0:10), INTENT(inout)            :: prod10          !! products remaining in the 10 year-turnover
+                                                                              !! pool after the annual release for each 
+                                                                              !! compartment (10 + 1 : input from year of land
+                                                                              !! cover change)
+    REAL(r_std), DIMENSION(npts,0:100), INTENT(inout)           :: prod100         !! products remaining in the 100 year-turnover
+                                                                              !! pool after the annual release for each 
+                                                                              !! compartment (100 + 1 : input from year of land
+                                                                              !! cover change)
+
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)          :: litter_pro
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)            :: fuel_1hr_pro
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)            :: fuel_10hr_pro
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)            :: fuel_100hr_pro
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)            :: fuel_1000hr_pro
+    REAL(r_std), DIMENSION(:),INTENT(inout)               :: lignin_content_pro
+
+
+
+    !! 0.4 Local variables
+    REAL(r_std)                                              :: above
+      
+    ! harvest of aboveground sap- and heartwood biomass after taking into
+    ! account of deforestation fire
+    IF (allow_deforest_fire) THEN
+      above = deforest_biomass_remain(ipts,ivm,isapabove,icarbon)+ &
+            deforest_biomass_remain(ipts,ivm,iheartabove,icarbon)
+      convflux(ipts)  = convflux(ipts) + 0
+      prod10(ipts,0)  = prod10(ipts,0) + 0.4*above
+      prod100(ipts,0) = prod100(ipts,0) + 0.6*above
+    ELSE
+      above = (biomass(ipts,ivm,isapabove,icarbon)+ &
+          biomass(ipts,ivm,iheartabove,icarbon))*frac
+      ! we assume no wood goes to 10-year and 100-year pool in fuelwood collection.
+      convflux(ipts)  = convflux(ipts) + above
+    ENDIF
+  
+    ! the transfer of dead biomass to litter
+    bm_to_litter_pro(isapbelow,:) = bm_to_litter_pro(isapbelow,:) +  &
+                      biomass(ipts,ivm,isapbelow,:)*frac
+    bm_to_litter_pro(iheartbelow,:) = bm_to_litter_pro(iheartbelow,:) + &
+                      biomass(ipts,ivm,iheartbelow,:)*frac
+    bm_to_litter_pro(iroot,:) = bm_to_litter_pro(iroot,:) + &
+                      biomass(ipts,ivm,iroot,:)*frac
+    bm_to_litter_pro(ifruit,:) = bm_to_litter_pro(ifruit,:) + &
+                      biomass(ipts,ivm,ifruit,:)*frac
+    bm_to_litter_pro(icarbres,:) = bm_to_litter_pro(icarbres,:) + &
+                      biomass(ipts,ivm,icarbres,:)*frac
+    bm_to_litter_pro(ileaf,:) = bm_to_litter_pro(ileaf,:) + &
+                      biomass(ipts,ivm,ileaf,:)*frac
+
+    !update litter_pro
+    litter_pro(:,:,:) = litter_pro(:,:,:) + litter(ipts,:,ivm,:,:)*frac
+    fuel_1hr_pro(:,:) = fuel_1hr_pro(:,:) + fuel_1hr(ipts,ivm,:,:)*frac
+    fuel_10hr_pro(:,:) = fuel_10hr_pro(:,:) + fuel_10hr(ipts,ivm,:,:)*frac 
+    fuel_100hr_pro(:,:) = fuel_100hr_pro(:,:) + fuel_100hr(ipts,ivm,:,:)*frac
+    fuel_1000hr_pro(:,:) = fuel_1000hr_pro(:,:) + fuel_1000hr(ipts,ivm,:,:)*frac
+    !don't forget to hanle litter lignin content
+    lignin_content_pro(:)= lignin_content_pro(:) + &
+      litter(ipts,istructural,ivm,:,icarbon)*frac*lignin_struc(ipts,ivm,:)
+
+  END SUBROUTINE harvest_fuelwood
+  
+! ================================================================================================================================
+!! SUBROUTINE   : harvest_herb
+!!
+!>\BRIEF        : Handle herbaceous PFT clearing before its legacy is transferred to 
+!                 newly initialized youngest-age-class PFT.
+!!
+!>\DESCRIPTION  
+!_ ================================================================================================================================
+  SUBROUTINE harvest_herb (ipts,ivm,biomass,veget_frac,bm_to_litter_pro)
+
+    IMPLICIT NONE
+
+    !! 0.1 Input variables
+    INTEGER, INTENT(in)                                       :: ipts
+    INTEGER, INTENT(in)                                       :: ivm
+    REAL(r_std), INTENT(in)                                   :: veget_frac   !! the fraction of land covered by herbaceous PFT to be cleared
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(in)               :: biomass      !! biomass @tex ($gC m^{-2}$) @endtex
+
+    !! 0.2 Modified variables
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)                :: bm_to_litter_pro    
+
+
+    INTEGER :: ipart, num
+
+    ! the transfer of dead biomass to litter
+    DO ipart = 1,nparts
+      bm_to_litter_pro(ipart,:) = bm_to_litter_pro(ipart,:) + biomass(ipts,ivm,ipart,:)*veget_frac
+    ENDDO
+
+  END SUBROUTINE harvest_herb
+
+
+! ================================================================================================================================
+!! SUBROUTINE   : initialize_proxy_pft
+!!
+!>\BRIEF        Initialize a proxy new youngest age class PFT.
+!!
+!>\DESCRIPTION  Initialize a proxy new youngest age class PFT that will be 
+!!              merged with existing yongest age class, or fill the empty
+!!              niche of the youngest age class PFT.
+!_ ================================================================================================================================
+  SUBROUTINE initialize_proxy_pft(ipts,ipft_young_agec,veget_max_pro,       &
+                 biomass_pro, co2_to_bm_pro, ind_pro, age_pro,              & 
+                 senescence_pro, PFTpresent_pro,                            &
+                 lm_lastyearmax_pro, everywhere_pro, npp_longterm_pro,      &
+                 leaf_frac_pro,leaf_age_pro)
+
+    IMPLICIT NONE
+
+    !! 0.1 Input variables
+    INTEGER, INTENT(in)                                  :: ipts              !! 
+    INTEGER, INTENT(in)                                  :: ipft_young_agec   !! index of the concerned youngest-age-class PFT
+    REAL(r_std), INTENT(in)                              :: veget_max_pro     !! fraction of grid cell land area that's to be occupied
+
+    !! 0.2 Modified variables
+    REAL(r_std), INTENT(inout)                           :: co2_to_bm_pro
+
+    !! 0.3 Output variables
+    REAL(r_std), DIMENSION(:,:), INTENT(out)             :: biomass_pro     !! biomass @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(:), INTENT(out)               :: leaf_frac_pro   !! fraction of leaves in leaf age class 
+    REAL(r_std), DIMENSION(:), INTENT(out)               :: leaf_age_pro    !! fraction of leaves in leaf age class 
+    REAL(r_std), INTENT(out)     :: age_pro, ind_pro, lm_lastyearmax_pro
+    REAL(r_std), INTENT(out)                             :: npp_longterm_pro 
+    REAL(r_std), INTENT(out)                             :: everywhere_pro  !! is the PFT everywhere in the grid box or very 
+    LOGICAL, INTENT(out)                                 :: senescence_pro  !! plant senescent (only for deciduous trees) Set
+                                                                            !! to .FALSE. if PFT is introduced or killed
+    LOGICAL, INTENT(out)                                 :: PFTpresent_pro  !! Is pft there (unitless)
+
+    !! 0.4 Local variables
+    !REAL(r_std), DIMENSION(npts,nvm)                     :: when_growthinit !! how many days ago was the beginning of the 
+    !                                                                        !! growing season (days)
+
+    REAL(r_std), DIMENSION(nparts,nelements)               :: bm_new          !! biomass increase @tex ($gC m^{-2}$) @endtex
+    REAL(r_std) :: cn_ind,ind
+    INTEGER  :: i,j,k,l
+
+    ! -Note-
+    ! This part of codes are copied from the original lcchange_main subroutine
+    ! that initialize a new PFT.
+
+    i=ipts
+    j=ipft_young_agec
+
+    !! Initialization of some variables
+    leaf_frac_pro(:) = zero 
+    leaf_age_pro(:) = zero 
+    
+    !! Initial setting of new establishment
+    IF (is_tree(j)) THEN
+       ! cn_sapl(j)=0.5; stomate_data.f90
+       cn_ind = cn_sapl(j) 
+    ELSE
+       cn_ind = un
+    ENDIF
+    ind = veget_max_pro / cn_ind
+    ind_pro = ind*veget_max_pro
+    PFTpresent_pro = .TRUE.
+    senescence_pro = .FALSE.
+    everywhere_pro = 1.*veget_max_pro
+    age_pro = zero
+
+    ! large_value = 1.E33_r_std
+    ! when_growthinit(i,j) = large_value 
+    leaf_frac_pro(1) = 1.0 * veget_max_pro
+    leaf_age_pro(1) = 1.0 * veget_max_pro   !This was not included in original lcchange_main subroutine
+    npp_longterm_pro = npp_longterm_init * veget_max_pro
+    lm_lastyearmax_pro = bm_sapl(j,ileaf,icarbon) * ind * veget_max_pro
+    
+    !!  Update of biomass in each each carbon stock component (leaf, sapabove, sapbelow,
+    !>  heartabove, heartbelow, root, fruit, and carbres)\n
+    DO k = 1, nparts ! loop over # carbon stock components, nparts = 8; stomate_constant.f90 
+      DO l = 1,nelements ! loop over # elements
+        biomass_pro(k,l) = ind * bm_sapl(j,k,l)
+      END DO ! loop over # elements
+      co2_to_bm_pro = co2_to_bm_pro + ind * bm_sapl(j,k,icarbon)
+    ENDDO ! loop over # carbon stock components
+    
+  END SUBROUTINE initialize_proxy_pft
+
+! ================================================================================================================================
+!! SUBROUTINE   sap_take
+!!
+!>\BRIEF       : Take the sapling biomass of the new PFTs from the existing biomass, otherwise
+!                take from co2_to_bm
+!!
+!>\DESCRIPTION  
+!_ ================================================================================================================================
+  SUBROUTINE sap_take (ipts,ivma,veget_max,biomass_pro,biomass,co2_to_bm_pro)
+
+    INTEGER, INTENT(in)                                  :: ipts               !! 
+    INTEGER, INTENT(in)                                  :: ivma
+    REAL(r_std), DIMENSION(:,:), INTENT(in)              :: veget_max          !! "maximal" coverage fraction of a PFT (LAI ->
+    REAL(r_std), DIMENSION(:,:), INTENT(in)              :: biomass_pro        !! biomass @tex ($gC m^{-2}$) @endtex
+
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout)       :: biomass            !! biomass @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), INTENT(inout)                           :: co2_to_bm_pro
+
+    
+    REAL(r_std), DIMENSION(nparts,nelements)             :: biomass_total      !! biomass @tex ($gC m^{-2}$) @endtex
+    REAL(r_std)                             :: bm_org,bmpro_share
+    INTEGER                                 :: i,ivm,ipart
+    
+    biomass_total(:,:) = zero
+    bm_org = zero
+    bmpro_share = zero
+
+    DO i = 1,nagec_pft(ivma)
+      ivm = start_index(ivma)+i-1
+      IF (veget_max(ipts,ivm) .GT. min_stomate) THEN
+        biomass_total = biomass_total + biomass(ipts,ivm,:,:)*veget_max(ipts,ivm)
+      ENDIF
+    ENDDO
+  
+    DO ipart = 1, nparts
+      IF (biomass_total(ipart,icarbon) .GT. biomass_pro(ipart,icarbon)) THEN
+        co2_to_bm_pro = co2_to_bm_pro - biomass_pro(ipart,icarbon)
+        !treat each PFT of the MTC
+        DO i = 1,nagec_pft(ivma)
+          ivm = start_index(ivma)+i-1
+          IF (veget_max(ipts,ivm) .GT. min_stomate) THEN
+            bm_org = biomass(ipts,ivm,ipart,icarbon) * veget_max(ipts,ivm)
+            bmpro_share = bm_org/biomass_total(ipart,icarbon) * biomass_pro(ipart,icarbon)
+            biomass(ipts,ivm,ipart,icarbon) = (bm_org - bmpro_share)/veget_max(ipts,ivm)
+          ENDIF
+        ENDDO
+      ENDIF
+    ENDDO
+    
+  END SUBROUTINE sap_take
+
+! ================================================================================================================================
+!! SUBROUTINE   collect_legacy_pft
+!!
+!>\BRIEF       : Collect the legacy variables that are going to be included
+!                in the newly initialized PFT.
+!!
+!>\DESCRIPTION  
+!_ ================================================================================================================================
+  SUBROUTINE collect_legacy_pft(npts, ipts, ivma, glcc_pftmtc,    &
+                biomass, bm_to_litter, carbon, litter,            &
+                deepC_a, deepC_s, deepC_p,                        &
+                fuel_1hr, fuel_10hr, fuel_100hr, fuel_1000hr,     &
+                lignin_struc, co2_to_bm, gpp_daily, npp_daily,    &
+                resp_maint, resp_growth, resp_hetero, co2_fire,   &
+                def_fuel_1hr_remain, def_fuel_10hr_remain,        &
+                def_fuel_100hr_remain, def_fuel_1000hr_remain,    &
+                deforest_litter_remain, deforest_biomass_remain,  &
+                veget_max_pro, carbon_pro, lignin_struc_pro, litter_pro, &
+                deepC_a_pro, deepC_s_pro, deepC_p_pro,            &
+                fuel_1hr_pro, fuel_10hr_pro, fuel_100hr_pro, fuel_1000hr_pro, &
+                bm_to_litter_pro, co2_to_bm_pro, gpp_daily_pro,   &
+                npp_daily_pro, resp_maint_pro, resp_growth_pro,   &
+                resp_hetero_pro, co2_fire_pro,                    &
+                convflux,prod10,prod100)
+
+    IMPLICIT NONE
+
+    !! 0.1 Input variables
+    INTEGER, INTENT(in)                                 :: npts               !! Domain size - number of pixels (unitless)
+    INTEGER, INTENT(in)                                 :: ipts               !! Domain size - number of pixels (unitless)
+    INTEGER, INTENT(in)                                 :: ivma               !! Index for metaclass
+    REAL(r_std), DIMENSION(:,:,:), INTENT(in)           :: glcc_pftmtc        !! a temporary variable to hold the fractions each PFT is going to lose
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(in)         :: biomass            !! biomass @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(in)         :: bm_to_litter       !! Transfer of biomass to litter 
+                                                                              !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(:,:,:), INTENT(in)           :: carbon             !! carbon pool: active, slow, or passive 
+                                                                              !! @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(:,:,:), INTENT(in)           :: deepC_a            !! Permafrost soil carbon (g/m**3) active
+    REAL(r_std), DIMENSION(:,:,:), INTENT(in)           :: deepC_s            !! Permafrost soil carbon (g/m**3) slow
+    REAL(r_std), DIMENSION(:,:,:), INTENT(in)           :: deepC_p            !! Permafrost soil carbon (g/m**3) passive
+    REAL(r_std), DIMENSION(:,:,:,:,:), INTENT(in)       :: litter             !! metabolic and structural litter, above and 
+                                                                              !! below ground @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(in)         :: fuel_1hr
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(in)         :: fuel_10hr
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(in)         :: fuel_100hr
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(in)         :: fuel_1000hr
+    REAL(r_std), DIMENSION(:,:,:), INTENT(in)           :: lignin_struc       !! ratio Lignine/Carbon in structural litter,
+                                                                              !! above and below ground
+    REAL(r_std), DIMENSION(:,:), INTENT(in)             :: co2_to_bm          !! biomass uptaken 
+                                                                              !! @tex ($gC m^{-2} day^{-1}$) @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(in)             :: gpp_daily          !! Daily gross primary productivity  
+                                                                              !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(in)             :: npp_daily          !! Net primary productivity 
+                                                                              !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(in)             :: resp_maint         !! Maintenance respiration  
+                                                                              !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(:,:), INTENT(in)             :: resp_growth        !! Growth respiration  
+                                                                              !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(in)             :: resp_hetero        !! Heterotrophic respiration  
+                                                                              !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(:,:), INTENT(in)             :: co2_fire           !! Heterotrophic respiration  
+                                                                              !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(in)               :: def_fuel_1hr_remain
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(in)               :: def_fuel_10hr_remain
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(in)               :: def_fuel_100hr_remain
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(in)               :: def_fuel_1000hr_remain
+    REAL(r_std), DIMENSION(:,:,:,:,:), INTENT(in)             :: deforest_litter_remain   !! Vegetmax-weighted remaining litter on the ground for 
+                                                                                                      !! deforestation region.
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(in)               :: deforest_biomass_remain  !! Vegetmax-weighted remaining biomass on the ground for 
+                                                                                                      !! deforestation region.
+
+    !! 0.2 Output variables
+    REAL(r_std), DIMENSION(:), INTENT(inout)              :: carbon_pro
+    REAL(r_std), DIMENSION(:), INTENT(inout)              :: deepC_a_pro
+    REAL(r_std), DIMENSION(:), INTENT(inout)              :: deepC_s_pro
+    REAL(r_std), DIMENSION(:), INTENT(inout)              :: deepC_p_pro
+    REAL(r_std), DIMENSION(:), INTENT(inout)              :: lignin_struc_pro   !! ratio Lignine/Carbon in structural litter
+                                                                              !! above and below ground
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)          :: litter_pro
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)            :: fuel_1hr_pro
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)            :: fuel_10hr_pro
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)            :: fuel_100hr_pro
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)            :: fuel_1000hr_pro
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)            :: bm_to_litter_pro
+    REAL(r_std), INTENT(inout)     :: veget_max_pro, co2_to_bm_pro
+    REAL(r_std), INTENT(inout)     :: gpp_daily_pro, npp_daily_pro
+    REAL(r_std), INTENT(inout)     :: resp_maint_pro, resp_growth_pro
+    REAL(r_std), INTENT(inout)     :: resp_hetero_pro, co2_fire_pro
+
+    !! 0.3 Modified variables
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)                 :: convflux      !! release during first year following land cover
+                                                                              !! change
+
+    REAL(r_std), DIMENSION(npts,0:10,nwp), INTENT(inout)         :: prod10        !! products remaining in the 10 year-turnover
+                                                                              !! pool after the annual release for each 
+                                                                              !! compartment (10 + 1 : input from year of land
+                                                                              !! cover change)
+    REAL(r_std), DIMENSION(npts,0:100,nwp), INTENT(inout)        :: prod100       !! products remaining in the 100 year-turnover
+                                                                              !! pool after the annual release for each 
+                                                                              !! compartment (100 + 1 : input from year of land
+                                                                              !! cover change)
+
+    !! 0.4 Local variables
+    REAL(r_std), DIMENSION(nlevs)                  :: lignin_content_pro
+    REAL(r_std)                                    :: frac, instant_loss
+    INTEGER                                        :: ivm
+
+
+    ! All *_pro variables collect the legacy pools/fluxes of the ancestor
+    ! PFTs for the receiving youngest age class. All *_pro variables 
+    ! represent the quantity weighted by the fraction of ancestor contributing
+    ! PFTs.
+    ! Exceptions:
+    ! lignin_struc_pro:: the ratio of lignin content in structural litter.
+
+    lignin_content_pro(:)=zero
+
+    DO ivm = 1,nvm
+      frac = glcc_pftmtc(ipts,ivm,ivma)
+      IF (frac>zero) THEN
+        veget_max_pro = veget_max_pro+frac
+
+        IF (is_tree(ivm)) THEN
+          IF (.NOT. is_tree(start_index(ivma))) THEN
+
+            IF (is_grassland_manag(start_index(ivma))) THEN
+              instant_loss = 0.67  !forest to pasture
+            ELSE IF (.NOT. natural(start_index(ivma))) THEN
+              instant_loss = 0.5   !forest to crop
+            ELSE
+              instant_loss = 0.  !forest to natural grassland
+            ENDIF
+
+            CALL clear_forest (npts,ipts,ivm,biomass,frac,    &
+                instant_loss, &
+                litter, deforest_biomass_remain,&
+                fuel_1hr,fuel_10hr,&
+                fuel_100hr,fuel_1000hr,&
+                lignin_struc,&
+                bm_to_litter_pro,convflux(:,iwplcc),prod10(:,:,iwplcc),prod100(:,:,iwplcc),&
+                litter_pro, fuel_1hr_pro, fuel_10hr_pro, fuel_100hr_pro, &
+                fuel_1000hr_pro, lignin_content_pro)
+          ENDIF
+        ELSE
+          !CALL harvest_herb(ipts,ivm,biomass,frac,   &
+          !        bm_to_litter_pro)
+          ![2016-04-19] We put the transfer of biomass to litter for herbaceous
+          ! PFT directly here, because seprating them in a module harvest_herb
+          ! gives some error.
+          bm_to_litter_pro(:,:) = bm_to_litter_pro(:,:) + biomass(ipts,ivm,:,:)*frac
+
+          litter_pro(:,:,:) = litter_pro(:,:,:) + litter(ipts,:,ivm,:,:)*frac
+          fuel_1hr_pro(:,:) = fuel_1hr_pro(:,:) + fuel_1hr(ipts,ivm,:,:)*frac
+          fuel_10hr_pro(:,:) = fuel_10hr_pro(:,:) + fuel_10hr(ipts,ivm,:,:)*frac
+          fuel_100hr_pro(:,:) = fuel_100hr_pro(:,:) + fuel_100hr(ipts,ivm,:,:)*frac
+          fuel_1000hr_pro(:,:) = fuel_1000hr_pro(:,:) + fuel_1000hr(ipts,ivm,:,:)*frac
+          !don't forget to hanle litter lignin content
+          lignin_content_pro(:)= lignin_content_pro(:) + &
+            litter(ipts,istructural,ivm,:,icarbon)*lignin_struc(ipts,ivm,:)*frac
+        ENDIF
+
+        !! scalar variables to be accumulated and inherited
+        !! by the destination PFT
+        bm_to_litter_pro(:,:) = bm_to_litter_pro(:,:) + &
+              bm_to_litter(ipts,ivm,:,:)*frac
+        carbon_pro(:) = carbon_pro(:)+carbon(ipts,:,ivm)*frac
+        deepC_a_pro(:) = deepC_a_pro(:)+deepC_a(ipts,:,ivm)*frac
+        deepC_s_pro(:) = deepC_s_pro(:)+deepC_s(ipts,:,ivm)*frac
+        deepC_p_pro(:) = deepC_p_pro(:)+deepC_p(ipts,:,ivm)*frac
+        co2_to_bm_pro = co2_to_bm_pro + co2_to_bm(ipts,ivm)*frac
+
+        gpp_daily_pro = gpp_daily_pro + gpp_daily(ipts,ivm)*frac
+        npp_daily_pro = npp_daily_pro + npp_daily(ipts,ivm)*frac
+        resp_maint_pro = resp_maint_pro + resp_maint(ipts,ivm)*frac
+        resp_growth_pro = resp_growth_pro + resp_growth(ipts,ivm)*frac
+        resp_hetero_pro = resp_hetero_pro + resp_hetero(ipts,ivm)*frac
+        co2_fire_pro = co2_fire_pro + co2_fire(ipts,ivm)*frac
+      ENDIF
+    ENDDO
+
+    WHERE (litter_pro(istructural,:,icarbon) .GT. min_stomate)
+      lignin_struc_pro(:) = lignin_content_pro(:)/litter_pro(istructural,:,icarbon)
+    ELSEWHERE
+      lignin_struc_pro(:) = zero
+    ENDWHERE
+
+  END SUBROUTINE collect_legacy_pft
+
+! ================================================================================================================================
+!! SUBROUTINE   collect_legacy_pft_forestry
+!!
+!>\BRIEF       : Collect the legacy variables that are going to be included
+!                in the newly initialized PFT.
+!!
+!>\DESCRIPTION  
+!_ ================================================================================================================================
+  SUBROUTINE collect_legacy_pft_forestry(npts, ipts, ivma, glcc_pftmtc,    &
+                fuelfrac,                                         &
+                biomass, bm_to_litter, carbon, litter,            &
+                deepC_a, deepC_s, deepC_p,                        &
+                fuel_1hr, fuel_10hr, fuel_100hr, fuel_1000hr,     &
+                lignin_struc, co2_to_bm, gpp_daily, npp_daily,    &
+                resp_maint, resp_growth, resp_hetero, co2_fire,   &
+                def_fuel_1hr_remain, def_fuel_10hr_remain,        &
+                def_fuel_100hr_remain, def_fuel_1000hr_remain,    &
+                deforest_litter_remain, deforest_biomass_remain,  &
+                veget_max_pro, carbon_pro, lignin_struc_pro, litter_pro, &
+                deepC_a_pro, deepC_s_pro, deepC_p_pro,            &
+                fuel_1hr_pro, fuel_10hr_pro, fuel_100hr_pro, fuel_1000hr_pro, &
+                bm_to_litter_pro, co2_to_bm_pro, gpp_daily_pro,   &
+                npp_daily_pro, resp_maint_pro, resp_growth_pro,   &
+                resp_hetero_pro, co2_fire_pro,                    &
+                convflux,prod10,prod100)
+
+    IMPLICIT NONE
+
+    !! 0.1 Input variables
+    INTEGER, INTENT(in)                                 :: npts               !! Domain size - number of pixels (unitless)
+    INTEGER, INTENT(in)                                 :: ipts               !! Domain size - number of pixels (unitless)
+    INTEGER, INTENT(in)                                 :: ivma               !! Index for metaclass
+    REAL(r_std), DIMENSION(:,:,:), INTENT(in)           :: glcc_pftmtc        !! a temporary variable to hold the fractions each PFT is going to lose
+    REAL(r_std), DIMENSION(:), INTENT(in)               :: fuelfrac           !! 
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(in)         :: biomass            !! biomass @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(in)         :: bm_to_litter       !! Transfer of biomass to litter 
+                                                                              !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(:,:,:), INTENT(in)           :: carbon             !! carbon pool: active, slow, or passive 
+                                                                              !! @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(:,:,:), INTENT(in)           :: deepC_a            !! Permafrost soil carbon (g/m**3) active
+    REAL(r_std), DIMENSION(:,:,:), INTENT(in)           :: deepC_s            !! Permafrost soil carbon (g/m**3) slow
+    REAL(r_std), DIMENSION(:,:,:), INTENT(in)           :: deepC_p            !! Permafrost soil carbon (g/m**3) passive
+    REAL(r_std), DIMENSION(:,:,:,:,:), INTENT(in)       :: litter             !! metabolic and structural litter, above and 
+                                                                              !! below ground @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(in)         :: fuel_1hr
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(in)         :: fuel_10hr
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(in)         :: fuel_100hr
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(in)         :: fuel_1000hr
+    REAL(r_std), DIMENSION(:,:,:), INTENT(in)           :: lignin_struc       !! ratio Lignine/Carbon in structural litter,
+                                                                              !! above and below ground
+    REAL(r_std), DIMENSION(:,:), INTENT(in)             :: co2_to_bm          !! biomass uptaken 
+                                                                              !! @tex ($gC m^{-2} day^{-1}$) @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(in)             :: gpp_daily          !! Daily gross primary productivity  
+                                                                              !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(in)             :: npp_daily          !! Net primary productivity 
+                                                                              !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(in)             :: resp_maint         !! Maintenance respiration  
+                                                                              !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(:,:), INTENT(in)             :: resp_growth        !! Growth respiration  
+                                                                              !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(in)             :: resp_hetero        !! Heterotrophic respiration  
+                                                                              !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(:,:), INTENT(in)             :: co2_fire           !! Heterotrophic respiration  
+                                                                              !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(in)               :: def_fuel_1hr_remain
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(in)               :: def_fuel_10hr_remain
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(in)               :: def_fuel_100hr_remain
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(in)               :: def_fuel_1000hr_remain
+    REAL(r_std), DIMENSION(:,:,:,:,:), INTENT(in)             :: deforest_litter_remain   !! Vegetmax-weighted remaining litter on the ground for 
+                                                                                                      !! deforestation region.
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(in)               :: deforest_biomass_remain  !! Vegetmax-weighted remaining biomass on the ground for 
+                                                                                                      !! deforestation region.
+
+    !! 0.2 Output variables
+    REAL(r_std), DIMENSION(:), INTENT(inout)              :: carbon_pro
+    REAL(r_std), DIMENSION(:), INTENT(inout)              :: deepC_a_pro
+    REAL(r_std), DIMENSION(:), INTENT(inout)              :: deepC_s_pro
+    REAL(r_std), DIMENSION(:), INTENT(inout)              :: deepC_p_pro
+    REAL(r_std), DIMENSION(:), INTENT(inout)              :: lignin_struc_pro   !! ratio Lignine/Carbon in structural litter
+                                                                              !! above and below ground
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)          :: litter_pro
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)            :: fuel_1hr_pro
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)            :: fuel_10hr_pro
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)            :: fuel_100hr_pro
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)            :: fuel_1000hr_pro
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)            :: bm_to_litter_pro
+    REAL(r_std), INTENT(inout)     :: veget_max_pro, co2_to_bm_pro
+    REAL(r_std), INTENT(inout)     :: gpp_daily_pro, npp_daily_pro
+    REAL(r_std), INTENT(inout)     :: resp_maint_pro, resp_growth_pro
+    REAL(r_std), INTENT(inout)     :: resp_hetero_pro, co2_fire_pro
+
+    !! 0.3 Modified variables
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)                 :: convflux      !! release during first year following land cover
+                                                                              !! change
+
+    REAL(r_std), DIMENSION(npts,0:10,nwp), INTENT(inout)         :: prod10        !! products remaining in the 10 year-turnover
+                                                                              !! pool after the annual release for each 
+                                                                              !! compartment (10 + 1 : input from year of land
+                                                                              !! cover change)
+    REAL(r_std), DIMENSION(npts,0:100,nwp), INTENT(inout)        :: prod100       !! products remaining in the 100 year-turnover
+                                                                              !! pool after the annual release for each 
+                                                                              !! compartment (100 + 1 : input from year of land
+                                                                              !! cover change)
+
+    !! 0.4 Local variables
+    REAL(r_std), DIMENSION(nlevs)                  :: lignin_content_pro
+    REAL(r_std)                                    :: frac,pfuelfrac
+    INTEGER                                        :: ivm
+
+
+    ! All *_pro variables collect the legacy pools/fluxes of the ancestor
+    ! PFTs for the receiving youngest age class. All *_pro variables 
+    ! represent the quantity weighted by the fraction of ancestor contributing
+    ! PFTs.
+    ! Exceptions:
+    ! lignin_struc_pro:: the ratio of lignin content in structural litter.
+
+    lignin_content_pro(:)=zero
+    pfuelfrac = fuelfrac(ipts)
+
+    DO ivm = 1,nvm
+      frac = glcc_pftmtc(ipts,ivm,ivma)
+      IF (frac>zero) THEN
+        veget_max_pro = veget_max_pro+frac
+
+        IF (is_tree(ivm)) THEN
+          IF (is_tree(start_index(ivma))) THEN
+            CALL harvest_industrial (npts,ipts,ivm,biomass,frac*(1-pfuelfrac),    &
+                litter, deforest_biomass_remain,&
+                fuel_1hr,fuel_10hr,&
+                fuel_100hr,fuel_1000hr,&
+                lignin_struc,&
+                bm_to_litter_pro,convflux(:,iwphar),prod10(:,:,iwphar),prod100(:,:,iwphar),&
+                litter_pro, fuel_1hr_pro, fuel_10hr_pro, fuel_100hr_pro, &
+                fuel_1000hr_pro, lignin_content_pro)
+
+            CALL harvest_fuelwood (npts,ipts,ivm,biomass,frac*pfuelfrac,    &
+                litter, deforest_biomass_remain,&
+                fuel_1hr,fuel_10hr,&
+                fuel_100hr,fuel_1000hr,&
+                lignin_struc,&
+                bm_to_litter_pro,convflux(:,iwphar),prod10(:,:,iwphar),prod100(:,:,iwphar),&
+                litter_pro, fuel_1hr_pro, fuel_10hr_pro, fuel_100hr_pro, &
+                fuel_1000hr_pro, lignin_content_pro)
+          ENDIF
+        ELSE
+          !CALL harvest_herb(ipts,ivm,biomass,frac,   &
+          !        bm_to_litter_pro)
+          ![2016-04-19] We put the transfer of biomass to litter for herbaceous
+          ! PFT directly here, because seprating them in a module harvest_herb
+          ! gives some error.
+          bm_to_litter_pro(:,:) = bm_to_litter_pro(:,:) + biomass(ipts,ivm,:,:)*frac
+
+          litter_pro(:,:,:) = litter_pro(:,:,:) + litter(ipts,:,ivm,:,:)*frac
+          fuel_1hr_pro(:,:) = fuel_1hr_pro(:,:) + fuel_1hr(ipts,ivm,:,:)*frac
+          fuel_10hr_pro(:,:) = fuel_10hr_pro(:,:) + fuel_10hr(ipts,ivm,:,:)*frac
+          fuel_100hr_pro(:,:) = fuel_100hr_pro(:,:) + fuel_100hr(ipts,ivm,:,:)*frac
+          fuel_1000hr_pro(:,:) = fuel_1000hr_pro(:,:) + fuel_1000hr(ipts,ivm,:,:)*frac
+          !don't forget to hanle litter lignin content
+          lignin_content_pro(:)= lignin_content_pro(:) + &
+            litter(ipts,istructural,ivm,:,icarbon)*lignin_struc(ipts,ivm,:)*frac
+        ENDIF
+
+        !! scalar variables to be accumulated and inherited
+        !! by the destination PFT
+        bm_to_litter_pro(:,:) = bm_to_litter_pro(:,:) + &
+              bm_to_litter(ipts,ivm,:,:)*frac
+        carbon_pro(:) = carbon_pro(:)+carbon(ipts,:,ivm)*frac
+        deepC_a_pro(:) = deepC_a_pro(:)+deepC_a(ipts,:,ivm)*frac
+        deepC_s_pro(:) = deepC_s_pro(:)+deepC_s(ipts,:,ivm)*frac
+        deepC_p_pro(:) = deepC_p_pro(:)+deepC_p(ipts,:,ivm)*frac
+        co2_to_bm_pro = co2_to_bm_pro + co2_to_bm(ipts,ivm)*frac
+
+        gpp_daily_pro = gpp_daily_pro + gpp_daily(ipts,ivm)*frac
+        npp_daily_pro = npp_daily_pro + npp_daily(ipts,ivm)*frac
+        resp_maint_pro = resp_maint_pro + resp_maint(ipts,ivm)*frac
+        resp_growth_pro = resp_growth_pro + resp_growth(ipts,ivm)*frac
+        resp_hetero_pro = resp_hetero_pro + resp_hetero(ipts,ivm)*frac
+        co2_fire_pro = co2_fire_pro + co2_fire(ipts,ivm)*frac
+      ENDIF
+    ENDDO
+
+    WHERE (litter_pro(istructural,:,icarbon) .GT. min_stomate)
+      lignin_struc_pro(:) = lignin_content_pro(:)/litter_pro(istructural,:,icarbon)
+    ELSEWHERE
+      lignin_struc_pro(:) = zero
+    ENDWHERE
+
+  END SUBROUTINE collect_legacy_pft_forestry
+
+
+! ================================================================================================================================
+!! SUBROUTINE   : add_incoming_proxy_pft
+!!
+!>\BRIEF        : Merge the newly incoming proxy PFT cohort with the exisiting
+!!                cohort.
+!! \n
+!
+!_ ================================================================================================================================
+  SUBROUTINE add_incoming_proxy_pft(npts, ipts, ipft, veget_max_pro,  &
+       carbon_pro, litter_pro, lignin_struc_pro, bm_to_litter_pro,    &
+       deepC_a_pro, deepC_s_pro, deepC_p_pro,                         &
+       fuel_1hr_pro, fuel_10hr_pro, fuel_100hr_pro, fuel_1000hr_pro,  &
+       biomass_pro, co2_to_bm_pro, npp_longterm_pro, ind_pro,         &
+       lm_lastyearmax_pro, age_pro, everywhere_pro,                   &  
+       leaf_frac_pro, leaf_age_pro, PFTpresent_pro, senescence_pro,   &
+       gpp_daily_pro, npp_daily_pro, resp_maint_pro, resp_growth_pro, &
+       resp_hetero_pro, co2_fire_pro,                                 &
+       veget_max, carbon, litter, lignin_struc, bm_to_litter,         &
+       deepC_a, deepC_s, deepC_p,                                     &
+       fuel_1hr, fuel_10hr, fuel_100hr, fuel_1000hr,                  &
+       biomass, co2_to_bm, npp_longterm, ind,                         &
+       lm_lastyearmax, age, everywhere,                               &
+       leaf_frac, leaf_age, PFTpresent, senescence,                   &
+       gpp_daily, npp_daily, resp_maint, resp_growth,                 &
+       resp_hetero, co2_fire)
+    
+    IMPLICIT NONE
+
+    !! 0.1 Input variables
+    INTEGER, INTENT(in)                                :: npts                !! Domain size - number of pixels (unitless)
+    INTEGER, INTENT(in)                                :: ipts                !! Domain size - number of pixels (unitless)
+    INTEGER, INTENT(in)                                :: ipft
+    REAL(r_std), INTENT(in)                            :: veget_max_pro           !! The land fraction of incoming new PFTs that are 
+                                                                              !! the sum of all its ancestor PFTs
+    REAL(r_std), DIMENSION(:), INTENT(in)              :: carbon_pro
+    REAL(r_std), DIMENSION(:), INTENT(in)              :: deepC_a_pro
+    REAL(r_std), DIMENSION(:), INTENT(in)              :: deepC_s_pro
+    REAL(r_std), DIMENSION(:), INTENT(in)              :: deepC_p_pro
+    REAL(r_std), DIMENSION(:,:,:), INTENT(in)          :: litter_pro
+    REAL(r_std), DIMENSION(:,:), INTENT(in)            :: fuel_1hr_pro
+    REAL(r_std), DIMENSION(:,:), INTENT(in)            :: fuel_10hr_pro
+    REAL(r_std), DIMENSION(:,:), INTENT(in)            :: fuel_100hr_pro
+    REAL(r_std), DIMENSION(:,:), INTENT(in)            :: fuel_1000hr_pro
+    REAL(r_std), DIMENSION(:,:), INTENT(in)            :: bm_to_litter_pro
+    REAL(r_std), DIMENSION(:), INTENT(in)              :: lignin_struc_pro    !! ratio Lignine/Carbon in structural litter
+                                                                              !! above and below ground
+    REAL(r_std), DIMENSION(:,:), INTENT(in)            :: biomass_pro         !! biomass @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(:), INTENT(in)              :: leaf_frac_pro       !! fraction of leaves in leaf age class 
+    REAL(r_std), DIMENSION(:), INTENT(in)              :: leaf_age_pro        !! fraction of leaves in leaf age class 
+    REAL(r_std), INTENT(in)     :: ind_pro, age_pro, lm_lastyearmax_pro
+    REAL(r_std), INTENT(in)     :: npp_longterm_pro, co2_to_bm_pro 
+    REAL(r_std), INTENT(in)                            :: everywhere_pro      !! is the PFT everywhere in the grid box or very 
+    LOGICAL, INTENT(in)         :: PFTpresent_pro, senescence_pro             !! Is pft there (unitless)
+
+    REAL(r_std), INTENT(in)     :: gpp_daily_pro, npp_daily_pro
+    REAL(r_std), INTENT(in)     :: resp_maint_pro, resp_growth_pro
+    REAL(r_std), INTENT(in)     :: resp_hetero_pro, co2_fire_pro
+
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables
+
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: veget_max           !! "maximal" coverage fraction of a PFT on the ground
+                                                                              !! May sum to
+                                                                              !! less than unity if the pixel has
+                                                                              !! nobio area. (unitless, 0-1)
+   
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)       :: carbon              !! carbon pool: active, slow, or passive 
+                                                                              !! @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)       :: deepC_a             !! Permafrost soil carbon (g/m**3) active
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)       :: deepC_s             !! Permafrost soil carbon (g/m**3) slow
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)       :: deepC_p             !! Permafrost soil carbon (g/m**3) passive
+    REAL(r_std), DIMENSION(:,:,:,:,:), INTENT(inout)   :: litter              !! metabolic and structural litter, above and 
+                                                                              !! below ground @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout)     :: fuel_1hr
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout)     :: fuel_10hr
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout)     :: fuel_100hr
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout)     :: fuel_1000hr
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)       :: lignin_struc        !! ratio Lignine/Carbon in structural litter,
+                                                                              !! above and below ground
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout)     :: bm_to_litter        !! Transfer of biomass to litter 
+                                                                              !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout)     :: biomass             !! Stand level biomass @tex $(gC.m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: co2_to_bm           !! CO2 taken from the atmosphere to get C to create  
+                                                                              !! the seedlings @tex (gC.m^{-2}dt^{-1})$ @endtex
+
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: npp_longterm        !! "Long term" mean yearly primary productivity 
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: ind                 !! Number of individuals at the stand level
+                                                                              !! @tex $(m^{-2})$ @endtex 
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: age                 !! mean age (years)
+    LOGICAL, DIMENSION(:,:), INTENT(inout)             :: PFTpresent          !! Tab indicating which PFTs are present in 
+                                                                              !! each pixel
+    LOGICAL, DIMENSION(:,:), INTENT(inout)             :: senescence          !! Flag for setting senescence stage (only 
+                                                                              !! for deciduous trees)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: lm_lastyearmax      !! last year's maximum leaf mass for each PFT 
+                                                                              !! @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: everywhere          !! is the PFT everywhere in the grid box or 
+                                                                              !! very localized (after its introduction) (?)
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)       :: leaf_frac           !! fraction of leaves in leaf age class (unitless;0-1)
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)       :: leaf_age            !! Leaf age (days)
+
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: gpp_daily           !! Daily gross primary productivity  
+                                                                              !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: npp_daily           !! Net primary productivity 
+                                                                              !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: resp_maint          !! Maintenance respiration  
+                                                                              !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: resp_growth         !! Growth respiration  
+                                                                              !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: resp_hetero         !! Heterotrophic respiration  
+                                                                              !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: co2_fire            !! Heterotrophic respiration  
+                                                                              !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+
+    ! REAL(r_std), DIMENSION(:,:), INTENT(inout)        :: moiavail_month       !! "Monthly" moisture availability (0 to 1, 
+    !                                                                           !! unitless) 
+    ! REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: moiavail_week       !! "Weekly" moisture availability 
+    !                                                                           !! (0 to 1, unitless)
+    ! REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: gpp_week            !! Mean weekly gross primary productivity 
+    !                                                                           !! @tex $(gC m^{-2} day^{-1})$ @endtex
+    ! REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: ngd_minus5          !! Number of growing days (days), threshold 
+    !                                                                           !! -5 deg C (for phenology)   
+    ! REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: when_growthinit     !! How many days ago was the beginning of 
+    !                                                                           !! the growing season (days)
+    ! REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: time_hum_min        !! Time elapsed since strongest moisture 
+    !                                                                           !! availability (days) 
+    ! REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: gdd_midwinter       !! Growing degree days (K), since midwinter 
+    !                                                                           !! (for phenology) - this is written to the
+    !                                                                           !!  history files 
+    ! REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: gdd_from_growthinit !! growing degree days, since growthinit 
+    !                                                                           !! for crops
+    ! REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: gdd_m5_dormance     !! Growing degree days (K), threshold -5 deg 
+    !                                                                           !! C (for phenology)
+    ! REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: ncd_dormance        !! Number of chilling days (days), since 
+    !                                                                           !! leaves were lost (for phenology) 
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                     :: iele                !! Indeces(unitless)
+    INTEGER(i_std)                                     :: ilit,ilev,icarb     !! Indeces(unitless)
+    REAL(r_std), DIMENSION(npts,nlitt,nvm,nlevs,nelements) :: litter_old      !! metabolic and structural litter, above and 
+                                                                              !! below ground @tex ($gC m^{-2}$) @endtex
+    REAL(r_std) :: veget_old,veget_total
+  
+    
+    ! Back up some variables in case they're needed later
+    litter_old(:,:,:,:,:) = litter(:,:,:,:,:)
+
+    !! General idea
+    ! The established proxy vegetation has a fraction of 'veget_max_pro'; the
+    ! existing iPFT has a fraction of veget_max(ipts,ipft). 
+    ! Suppose we want to merge a scalar variable B, the value of B after merging
+    ! is (Bi*Vi+Bj*Vj)/(Vi+Vj), where Vi is the original veget_max, Vj is the
+    ! incoming veget_max. Note that in case Vi=0, this equation remains solid,
+    ! i.e. the veget_max after merging is Vj and B after merging is Bj. In other
+    ! words, the proxy vegetation "fills" up the empty niche of iPFT.
+    ! Also note that for many scalar variables our input value is Bj*Vj, which
+    ! is accumulated from multiple ancestor PFTs.
+    veget_old = veget_max(ipts,ipft)
+    veget_total = veget_old+veget_max_pro
+
+    !! Different ways of handling merging depending on nature of variables:
+
+    !! 1. Area-based scalar variables, use the equation above
+    !  biomass,carbon, litter, bm_to_litter, co2_to_bm, ind,
+    !  lm_lastyearmax, npp_longterm, lm_lastyearmax,
+    !  lignin_struc (ratio variable depending on area-based variable)
+     
+    !! 2. Variables are tentatively handled like area-based variables:
+    !   leaf_frac, leaf_age,
+
+    !! 3. Variables that are overwritten by the newly initialized PFT:
+    !   PFTpresent, senescence
+
+    !! 4. Variables whose operation is uncertain and are not handled currently:
+    !  when_growthinit :: how many days ago was the beginning of the growing season (days)
+    !  gdd_from_growthinit :: growing degree days, since growthinit 
+    !  gdd_midwinter, time_hum_min, gdd_m5_dormance, ncd_dormance, 
+    !  moiavail_month, moiavail_week, ngd_minus5
+
+    !! 5. Variables that concern with short-term fluxes that do not apply in
+    !  this case:
+    !  gpp_daily, npp_daily etc.
+
+    ! Add the coming veget_max_pro into existing veget_max
+    veget_max(ipts,ipft) = veget_total
+
+    IF (veget_total .GT. min_stomate) THEN
+      ! Merge scalar variables which are defined on area basis
+      carbon(ipts,:,ipft) =  (veget_old * carbon(ipts,:,ipft) + &
+           carbon_pro(:))/veget_total
+      deepC_a(ipts,:,ipft) =  (veget_old * deepC_a(ipts,:,ipft) + &
+           deepC_a_pro(:))/veget_total
+      deepC_s(ipts,:,ipft) =  (veget_old * deepC_s(ipts,:,ipft) + &
+           deepC_s_pro(:))/veget_total
+      deepC_p(ipts,:,ipft) =  (veget_old * deepC_p(ipts,:,ipft) + &
+           deepC_p_pro(:))/veget_total
+      litter(ipts,:,ipft,:,:) = (veget_old * litter(ipts,:,ipft,:,:) + &
+           litter_pro(:,:,:))/veget_total
+      fuel_1hr(ipts,ipft,:,:) = (veget_old * fuel_1hr(ipts,ipft,:,:) + &
+           fuel_1hr_pro(:,:))/veget_total
+      fuel_10hr(ipts,ipft,:,:) = (veget_old * fuel_10hr(ipts,ipft,:,:) + &
+           fuel_10hr_pro(:,:))/veget_total
+      fuel_100hr(ipts,ipft,:,:) = (veget_old * fuel_100hr(ipts,ipft,:,:) + &
+           fuel_100hr_pro(:,:))/veget_total
+      fuel_1000hr(ipts,ipft,:,:) = (veget_old * fuel_1000hr(ipts,ipft,:,:) + &
+           fuel_1000hr_pro(:,:))/veget_total
+
+      WHERE (litter(ipts,istructural,ipft,:,icarbon) .GT. min_stomate) 
+        lignin_struc(ipts,ipft,:) = (veget_old*litter_old(ipts,istructural,ipft,:,icarbon)* &
+            lignin_struc(ipts,ipft,:) + litter_pro(istructural,:,icarbon)* &
+            lignin_struc_pro(:))/(veget_total*litter(ipts,istructural,ipft,:,icarbon))
+      ENDWHERE
+      bm_to_litter(ipts,ipft,:,:) = (veget_old * bm_to_litter(ipts,ipft,:,:) + & 
+           bm_to_litter_pro(:,:))/veget_total
+
+      biomass(ipts,ipft,:,:) = (biomass(ipts,ipft,:,:)*veget_old + &
+           biomass_pro(:,:))/veget_total
+      co2_to_bm(ipts,ipft) = (veget_old*co2_to_bm(ipts,ipft) + &
+           co2_to_bm_pro)/veget_total
+      ind(ipts,ipft) = (ind(ipts,ipft)*veget_old + ind_pro)/veget_total
+      lm_lastyearmax(ipts,ipft) = (lm_lastyearmax(ipts,ipft)*veget_old + &
+           lm_lastyearmax_pro)/veget_total
+      npp_longterm(ipts,ipft) = (veget_old * npp_longterm(ipts,ipft) + &
+           npp_longterm_pro)/veget_total
+
+      !CHECK: Here follows the original idea in DOFOCO, more strictly,
+      ! leas mass should be considered together. The same also applies on
+      ! leaf age.
+      leaf_frac(ipts,ipft,:) = (leaf_frac(ipts,ipft,:)*veget_old + &
+           leaf_frac_pro(:))/veget_total
+      leaf_age(ipts,ipft,:) = (leaf_age(ipts,ipft,:)*veget_old + &
+           leaf_age_pro(:))/veget_total
+      age(ipts,ipft) = (veget_old * age(ipts,ipft) + &
+           age_pro)/veget_total
+
+      ! Everywhere deals with the migration of vegetation. Copy the
+      ! status of the most migrated vegetation for the whole PFT
+      everywhere(ipts,ipft) = MAX(everywhere(ipts,ipft), everywhere_pro)
+
+      ! Overwrite the original variables with that from newly initialized
+      ! proxy PFT
+      PFTpresent(ipts,ipft) = PFTpresent_pro
+      senescence(ipts,ipft) = senescence_pro
+
+      ! This is to close carbon loop when writing history variables.
+      gpp_daily(ipts,ipft) = (veget_old * gpp_daily(ipts,ipft) + &
+           gpp_daily_pro)/veget_total
+      npp_daily(ipts,ipft) = (veget_old * npp_daily(ipts,ipft) + &
+           npp_daily_pro)/veget_total
+      resp_maint(ipts,ipft) = (veget_old * resp_maint(ipts,ipft) + &
+           resp_maint_pro)/veget_total 
+      resp_growth(ipts,ipft) = (veget_old * resp_growth(ipts,ipft) + &
+           resp_growth_pro)/veget_total 
+      resp_hetero(ipts,ipft) = (veget_old * resp_hetero(ipts,ipft) + &
+           resp_hetero_pro)/veget_total 
+      co2_fire(ipts,ipft) = (veget_old * co2_fire(ipts,ipft) + &
+           co2_fire_pro)/veget_total 
+
+      ! Phenology- or time-related variables will be copied from original values if 
+      ! there is already youngest-age-class PFT there, otherwise they're left
+      ! untouched, because 1. to initiliaze all new PFTs here is wrong and 
+      ! phenology is not explicitly considered, so we cannot assign a value
+      ! to these variables. 2. We assume they will be correctly filled if 
+      ! other variables are in place (e.g., non-zero leaf mass will lead to
+      ! onset of growing season). In this case, merging a newly initialized PFT
+      ! to an existing one is not the same as merging PFTs when they grow 
+      ! old enough to exceed thresholds.
+      
+      ! gpp_week(ipts,ipft) = (veget_old * gpp_week(ipts,ipft) + &
+      !      gpp_week_pro)/veget_total
+      ! when_growthinit(ipts,ipft) = (veget_old * when_growthinit(ipts,ipft) + &
+      !      when_growthinit_pro)/veget_total
+      ! gdd_from_growthinit(ipts,ipft) = (veget_old * gdd_from_growthinit(ipts,ipft) + &
+      !      gdd_from_growthinit_pro)/veget_total
+      ! gdd_midwinter(ipts,ipft) = (veget_old * gdd_midwinter(ipts,ipft) + &
+      !      gdd_midwinter_pro)/veget_total
+      ! time_hum_min(ipts,ipft) = (veget_old * time_hum_min(ipts,ipft) + &
+      !      time_hum_min_pro)/veget_total
+      ! gdd_m5_dormance(ipts,ipft) = (veget_old * gdd_m5_dormance(ipts,ipft) + &
+      !      gdd_m5_dormance_pro)/veget_total
+      ! ncd_dormance(ipts,ipft) = (veget_old * ncd_dormance(ipts,ipft) + &
+      !      ncd_dormance_pro)/veget_total
+      ! moiavail_month(ipts,ipft) = (veget_old * moiavail_month(ipts,ipft) + &
+      !      moiavail_month_pro)/veget_total
+      ! moiavail_week(ipts,ipft) = (veget_old * moiavail_week(ipts,ipft) + &
+      !      moiavail_week_pro)/veget_total
+      ! ngd_minus5(ipts,ipft) = (veget_old * ngd_minus5(ipts,ipft) + &
+      !      ngd_minus5_pro)/veget_total
+    ENDIF
+    
+  
+  END SUBROUTINE add_incoming_proxy_pft
+
+! ================================================================================================================================
+!! SUBROUTINE   : empty_pft
+!!
+!>\BRIEF        : Empty a PFT when,
+!!                - it is exhausted because of land cover change.
+!!                - it moves to the next age class
+!! \n
+!_ ================================================================================================================================
+  SUBROUTINE empty_pft(ipts, ivm, veget_max, biomass, ind,       &
+               carbon, litter, lignin_struc, bm_to_litter,       &
+               deepC_a, deepC_s, deepC_p,                        &
+               fuel_1hr, fuel_10hr, fuel_100hr, fuel_1000hr,     &
+               gpp_daily, npp_daily, gpp_week, npp_longterm,     &
+               co2_to_bm, resp_maint, resp_growth, resp_hetero,  &
+               lm_lastyearmax, leaf_frac, leaf_age, age,         &
+               everywhere, PFTpresent, when_growthinit,          &
+               senescence, gdd_from_growthinit, gdd_midwinter,   &
+               time_hum_min, gdd_m5_dormance, ncd_dormance,      &
+               moiavail_month, moiavail_week, ngd_minus5)
+    
+    IMPLICIT NONE
+
+    !! 0.1 Input variables
+    INTEGER, INTENT(in)                                :: ipts               !! index for grid cell
+    INTEGER, INTENT(in)                                :: ivm                !! index for pft
+
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables
+
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: veget_max           !! "maximal" coverage fraction of a PFT on the ground
+                                                                              !! May sum to
+                                                                              !! less than unity if the pixel has
+                                                                              !! nobio area. (unitless, 0-1)
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout)     :: biomass             !! Stand level biomass @tex $(gC.m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: ind                 !! Number of individuals at the stand level
+                                                                              !! @tex $(m^{-2})$ @endtex 
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)       :: carbon              !! carbon pool: active, slow, or passive 
+                                                                              !! @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)       :: deepC_a             !! Permafrost soil carbon (g/m**3) active
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)       :: deepC_s             !! Permafrost soil carbon (g/m**3) slow
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)       :: deepC_p             !! Permafrost soil carbon (g/m**3) passive
+    REAL(r_std), DIMENSION(:,:,:,:,:), INTENT(inout)   :: litter              !! metabolic and structural litter, above and 
+                                                                              !! below ground @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout)     :: fuel_1hr
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout)     :: fuel_10hr
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout)     :: fuel_100hr
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout)     :: fuel_1000hr
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)       :: lignin_struc        !! ratio Lignine/Carbon in structural litter,
+                                                                              !! above and below ground
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(inout)     :: bm_to_litter        !! Transfer of biomass to litter 
+                                                                              !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: gpp_daily           !! Daily gross primary productivity  
+                                                                              !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: npp_daily           !! Net primary productivity 
+                                                                              !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: gpp_week            !! Mean weekly gross primary productivity 
+                                                                              !! @tex $(gC m^{-2} day^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: npp_longterm        !! "Long term" mean yearly primary productivity 
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: co2_to_bm           !! CO2 taken from the atmosphere to get C to create  
+                                                                              !! the seedlings @tex (gC.m^{-2}dt^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: resp_maint          !! Maintenance respiration  
+                                                                              !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: resp_growth         !! Growth respiration  
+                                                                              !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: resp_hetero         !! Heterotrophic respiration  
+                                                                              !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: lm_lastyearmax      !! last year's maximum leaf mass for each PFT 
+                                                                              !! @tex ($gC m^{-2}$) @endtex
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)       :: leaf_frac           !! fraction of leaves in leaf age class (unitless;0-1)
+    REAL(r_std), DIMENSION(:,:,:), INTENT(inout)       :: leaf_age            !! Leaf age (days)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: age                 !! mean age (years)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: everywhere          !! is the PFT everywhere in the grid box or 
+                                                                              !! very localized (after its introduction) (?)
+    LOGICAL, DIMENSION(:,:), INTENT(inout)             :: PFTpresent          !! Tab indicating which PFTs are present in 
+                                                                              !! each pixel
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: when_growthinit     !! How many days ago was the beginning of 
+                                                                              !! the growing season (days)
+    LOGICAL, DIMENSION(:,:), INTENT(inout)             :: senescence          !! Flag for setting senescence stage (only 
+                                                                              !! for deciduous trees)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: gdd_from_growthinit !! growing degree days, since growthinit 
+                                                                              !! for crops
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: gdd_midwinter       !! Growing degree days (K), since midwinter 
+                                                                              !! (for phenology) - this is written to the
+                                                                              !!  history files 
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: time_hum_min        !! Time elapsed since strongest moisture 
+                                                                              !! availability (days) 
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: gdd_m5_dormance     !! Growing degree days (K), threshold -5 deg 
+                                                                              !! C (for phenology)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: ncd_dormance        !! Number of chilling days (days), since 
+                                                                              !! leaves were lost (for phenology) 
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: moiavail_month      !! "Monthly" moisture availability (0 to 1, 
+                                                                              !! unitless) 
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: moiavail_week       !! "Weekly" moisture availability 
+                                                                              !! (0 to 1, unitless)
+    REAL(r_std), DIMENSION(:,:), INTENT(inout)         :: ngd_minus5          !! Number of growing days (days), threshold 
+                                                                              !! -5 deg C (for phenology)   
+
+    !! 0.4 Local variables
+    INTEGER(i_std)                                     :: iele                !! Indeces(unitless)
+    INTEGER(i_std)                                     :: ilit,ilev,icarb     !! Indeces(unitless)
+
+    veget_max(ipts,ivm) = zero
+    ind(ipts,ivm) = zero
+    biomass(ipts,ivm,:,:) = zero
+    litter(ipts,:,ivm,:,:) = zero
+    fuel_1hr(ipts,ivm,:,:) = zero
+    fuel_10hr(ipts,ivm,:,:) = zero
+    fuel_100hr(ipts,ivm,:,:) = zero
+    fuel_1000hr(ipts,ivm,:,:) = zero
+    carbon(ipts,:,ivm) = zero 
+    deepC_a(ipts,:,ivm) = zero 
+    deepC_s(ipts,:,ivm) = zero 
+    deepC_p(ipts,:,ivm) = zero 
+    bm_to_litter(ipts,ivm,:,:) = zero
+    DO ilev=1,nlevs
+       lignin_struc(ipts,ivm,ilev) = zero
+    ENDDO
+    npp_longterm(ipts,ivm) = zero
+    gpp_daily(ipts,ivm) = zero 
+    gpp_week(ipts,ivm) = zero
+    resp_maint(ipts,ivm) = zero
+    resp_growth(ipts,ivm) = zero
+    resp_hetero(ipts,ivm) = zero
+    npp_daily(ipts,ivm) = zero
+    co2_to_bm(ipts,ivm) = zero
+    lm_lastyearmax(ipts,ivm) = zero
+    age(ipts,ivm) = zero
+    leaf_frac(ipts,ivm,:) = zero
+    leaf_age(ipts,ivm,:) = zero
+    everywhere(ipts,ivm) = zero
+    when_growthinit(ipts,ivm) = zero
+    gdd_from_growthinit(ipts,ivm) = zero
+    gdd_midwinter(ipts,ivm) = zero
+    time_hum_min(ipts,ivm) = zero
+    gdd_m5_dormance(ipts,ivm) = zero
+    ncd_dormance(ipts,ivm) = zero
+    moiavail_month(ipts,ivm) = zero
+    moiavail_week(ipts,ivm) = zero
+    ngd_minus5(ipts,ivm) = zero
+    PFTpresent(ipts,ivm) = .FALSE.
+    senescence(ipts,ivm) = .FALSE.
+
+  END SUBROUTINE empty_pft
+
+  SUBROUTINE prepare_balance_check(outflux_sta,influx_sta,pool_sta,        &
+                 veget_cov_max,                                            &
+                 co2_to_bm,gpp_daily,npp_daily,                            &
+                 biomass,litter,carbon,prod10,prod100,                     &
+                 bm_to_litter,resp_maint,resp_growth,resp_hetero,          &
+                 convflux,cflux_prod10,cflux_prod100,co2_fire)
+
+    IMPLICIT NONE
+
+    !! 0.1 Input variables
+    REAL(r_std), DIMENSION(:,:), INTENT(in)            :: veget_cov_max        !! "Maximal" coverage fraction of a PFT (LAI 
+                                                                                       !! -> infinity) on ground 
+    REAL(r_std), DIMENSION(:,:), INTENT(in)              :: co2_to_bm            !! CO2 taken up from atmosphere when 
+                                                                                       !! introducing a new PFT (introduced for 
+                                                                                       !! carbon balance closure) 
+                                                                                       !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(:,:), INTENT(in)            :: gpp_daily            !! Daily gross primary productivity  
+                                                                                       !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(:,:), INTENT(in)              :: npp_daily            !! Net primary productivity 
+                                                                                       !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(in) :: biomass        !! Biomass @tex $(gC m^{-2})$ @endtex
+    REAL(r_std), DIMENSION(:,:,:,:,:), INTENT(in):: litter     !! Metabolic and structural litter, above 
+                                                                                       !! and below ground 
+    REAL(r_std), DIMENSION(:,:,:), INTENT(in)      :: carbon               !! Carbon pool: active, slow, or passive, 
+                                                                                       !! @tex $(gC m^{-2})$ @endtex  
+    REAL(r_std),DIMENSION(:,:,:), INTENT(in)            :: prod10               !! Products remaining in the 10
+                                                                                       !! year-turnover pool after the annual 
+                                                                                       !! release for each compartment (10
+                                                                                       !! + 1 : input from year of land cover 
+                                                                                       !! change) @tex $(gC m^{-2})$ @endtex 
+    REAL(r_std),DIMENSION(:,:,:), INTENT(in)           :: prod100              !! Products remaining in the 100 
+                                                                                       !! year-turnover pool after the annual 
+                                                                                       !! release for each compartment (100 
+                                                                                       !! + 1 : input from year of land cover 
+                                                                                       !! change) @tex $(gC m^{-2})$ @endtex 
+    REAL(r_std), DIMENSION(:,:,:,:), INTENT(in):: bm_to_litter      !! Conversion of biomass to litter 
+                                                                                       !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex
+    REAL(r_std), DIMENSION(:,:), INTENT(in)              :: resp_maint           !! Maintenance respiration  
+                                                                                       !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    
+    REAL(r_std), DIMENSION(:,:), INTENT(in)              :: resp_growth          !! Growth respiration  
+                                                                                       !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std), DIMENSION(:,:), INTENT(in)            :: resp_hetero          !! Heterotrophic respiration
+                                                                                       !! @tex $(gC m^{-2} dtslow^{-1})$ @endtex 
+    REAL(r_std),DIMENSION(:,:), INTENT(in)                 :: convflux             !! Release during first year following land 
+                                                                                       !! cover change @tex $(gC m^{-2})$ @endtex 
+    REAL(r_std),DIMENSION(:,:), INTENT(in)                 :: cflux_prod10         !! Total annual release from the 10 
+                                                                                       !! year-turnover pool 
+                                                                                       !! @tex $(gC m^{-2})$ @endtex 
+    REAL(r_std),DIMENSION(:,:), INTENT(in)                 :: cflux_prod100        !! Total annual release from the 100 
+                                                                                       !! year-turnover pool 
+                                                                                       !! @tex $(gC m^{-2})$ @endtex 
+    REAL(r_std), DIMENSION(:,:), INTENT(in)              :: co2_fire             !! Carbon emitted into the atmosphere by 
+                                                                                       !! fire (living and dead biomass)  
+
+
+    !! 0.2 Output variables
+    REAL(r_std), DIMENSION(:,:) :: outflux_sta
+    REAL(r_std), DIMENSION(:,:) :: influx_sta
+    REAL(r_std), DIMENSION(:,:) :: pool_sta
+
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+    INTEGER(i_std) :: ind_biomass,ind_litter,ind_soil,ind_prod,ind_co2tobm,ind_gpp,ind_npp,&
+                     ind_bm2lit,ind_resph,ind_respm,ind_respg,ind_convf,ind_cflux,ind_fire
+
+
+
+    ind_biomass = 1
+    ind_litter = 2
+    ind_soil = 3
+    ind_prod = 4
+    pool_sta(:,ind_biomass) = SUM(SUM(biomass(:,:,:,icarbon),DIM=3) * veget_cov_max,DIM=2)
+    pool_sta(:,ind_litter) = SUM(SUM(SUM(litter(:,:,:,:,icarbon),DIM=4),DIM=2) * veget_cov_max,DIM=2)
+    pool_sta(:,ind_soil) = SUM(SUM(carbon(:,:,:),DIM=2) * veget_cov_max,DIM=2)
+    pool_sta(:,ind_prod) = SUM(SUM(prod10,DIM=3),DIM=2) + SUM(SUM(prod100,DIM=3),DIM=2)
+
+    ind_co2tobm = 1
+    ind_gpp = 2
+    ind_npp = 3
+    influx_sta(:,ind_co2tobm) = SUM(co2_to_bm*veget_cov_max,DIM=2)
+    influx_sta(:,ind_gpp) = SUM(gpp_daily*veget_cov_max,DIM=2)
+    influx_sta(:,ind_npp) = SUM(npp_daily*veget_cov_max,DIM=2)
+
+    ind_bm2lit = 1
+    ind_respm = 2
+    ind_respg = 3
+    ind_resph = 4
+    ind_convf = 5
+    ind_cflux = 6
+    ind_fire = 7
+    outflux_sta(:,ind_bm2lit) = SUM(SUM(bm_to_litter(:,:,:,icarbon),DIM=3) * veget_cov_max,DIM=2)
+    outflux_sta(:,ind_respm) = SUM(resp_maint*veget_cov_max,DIM=2)
+    outflux_sta(:,ind_respg) = SUM(resp_growth*veget_cov_max,DIM=2)
+    outflux_sta(:,ind_resph) = SUM(resp_hetero*veget_cov_max,DIM=2)
+    outflux_sta(:,ind_convf) = SUM(convflux,DIM=2)
+    outflux_sta(:,ind_cflux) = SUM(cflux_prod10,DIM=2) + SUM(cflux_prod100,DIM=2)
+    outflux_sta(:,ind_fire) = SUM(co2_fire*veget_cov_max,DIM=2)
+
+  END SUBROUTINE prepare_balance_check
+
+
+  SUBROUTINE luc_balance_check(outflux_sta,influx_sta,pool_sta,            &
+                 outflux_end,influx_end,pool_end,                          &
+                 npts,lalo,identifier)
+
+    IMPLICIT NONE
+
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT(in)                                 :: npts                 !! Domain size (unitless)
+    REAL(r_std), DIMENSION(:,:), INTENT(in)                    :: outflux_sta
+    REAL(r_std), DIMENSION(:,:), INTENT(in)                    :: influx_sta
+    REAL(r_std), DIMENSION(:,:), INTENT(in)                    :: pool_sta
+    REAL(r_std), DIMENSION(:,:), INTENT(in)                    :: outflux_end
+    REAL(r_std), DIMENSION(:,:), INTENT(in)                    :: influx_end
+    REAL(r_std), DIMENSION(:,:), INTENT(in)                    :: pool_end
+    REAL(r_std), DIMENSION(:,:), INTENT(in)                    :: lalo                 !! Geographical coordinates (latitude,longitude)
+                                                                                       !! for pixels (degrees)
+    CHARACTER(LEN=*), INTENT(in), OPTIONAL                     ::  identifier  !! string with to identify where this routine was called form
+
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+    REAL(r_std), DIMENSION(npts,nelements)     :: mass_before_2rd    !! Temporary variable 
+    REAL(r_std), DIMENSION(npts,nelements)     :: mass_after_2rd    !! Temporary variable 
+    REAL(r_std), DIMENSION(npts,nelements)     :: mass_change_2rd   !! positive
+    REAL(r_std), DIMENSION(npts,nelements)     :: mass_balance_2rd    !! Temporary variable 
+    INTEGER(i_std) :: ipts
+
+
+    mass_before_2rd = zero
+    mass_after_2rd = zero
+    mass_change_2rd = zero
+    mass_balance_2rd = zero
+
+    mass_before_2rd(:,icarbon) = SUM(pool_sta(:,:),DIM=2)
+    mass_after_2rd(:,icarbon) = SUM(pool_end(:,:),dim=2)
+
+    ! mass_change_2rd is the mass increase
+    mass_change_2rd(:,icarbon) = SUM(influx_end(:,:),DIM=2) - SUM(influx_sta(:,:),DIM=2) + &
+                             + SUM(outflux_sta(:,:),DIM=2) - SUM(outflux_end(:,:),DIM=2)
+
+    mass_balance_2rd(:,icarbon) = mass_before_2rd(:,icarbon) - mass_after_2rd(:,icarbon) &
+                             + mass_change_2rd(:,icarbon)
+     
+    DO ipts = 1,npts
+      IF (ABS(mass_balance_2rd(ipts,icarbon)) .GE. 1e-2) THEN
+        WRITE (numout,*) ' FATAL Error'
+        WRITE (numout,*) ' Mass conservation failed after ',identifier
+        WRITE (numout,*) ' limit: '       , 1e-2
+        WRITE (numout,*) ' Mismatch :'    , mass_balance_2rd(ipts,icarbon) 
+        WRITE (numout,*) ' Coordinates :' , lalo(ipts,:) 
+        WRITE (numout,*) ' gridpoint: '   , ipts , ' of ngrids: ',npts
+        STOP
+      ENDIF
+    ENDDO
+    WRITE (numout,*) 'mass balance check successful after ',identifier
+
+  END SUBROUTINE luc_balance_check
+
+
+
+
+  ! Note this subroutine does not depend on how many age classes there are
+  ! in different MTCs.
+  SUBROUTINE glcc_compensation_full(npts,veget_4veg,glcc,glccReal,glccDef, &
+                               p2c,ipasture,g2c,igrass,f2c,itree,icrop,    &
+                               IncreDeficit)
+
+    IMPLICIT NONE
+
+    !! 0.1 Input variables
+    INTEGER, INTENT(in)                                         :: npts        !! Domain size - number of pixels (unitless)
+    INTEGER, INTENT(in)    :: p2c,ipasture,g2c,igrass,f2c,itree,icrop
+    REAL(r_std), DIMENSION (npts,12),INTENT(in)                 :: glcc        !! the land-cover-change (LCC) matrix in case a gross LCC is 
+                                                                               !! used.
+
+    !! 0.2 Output variables
+
+
+    !! 0.3 Modified variables
+    REAL(r_std), DIMENSION(npts,4), INTENT(inout)         :: veget_4veg        !! "maximal" coverage of tree/grass/pasture/crop
+    REAL(r_std), DIMENSION(npts,12), INTENT(inout)        :: glccDef           !! Gross LCC deficit, negative values mean that there
+                                                                               !! are not enough fractions in the source vegetations
+                                                                               !! to the target ones as presribed by the LCC matrix.
+    REAL(r_std), DIMENSION(npts,12), INTENT(inout)        :: glccReal          !! The "real" glcc matrix that we apply in the model
+                                                                               !! after considering the consistency between presribed
+                                                                               !! glcc matrix and existing vegetation fractions.
+    REAL(r_std), DIMENSION(npts,4), INTENT(inout)         :: IncreDeficit      !! "Increment" deficits, negative values mean that 
+                                                                               !! there are not enough fractions in the source PFTs
+                                                                               !! /vegetations to target PFTs/vegetations. I.e., these
+                                                                               !! fraction transfers are presribed in LCC matrix but
+                                                                               !! not realized.
+    
+    !! 0.4 Local variables
+    REAL(r_std), DIMENSION(npts)                          :: tmpdef            !! LCC deficits by summing up all the deficits to the
+                                                                               !! the same target vegetation.
+
+    !! 0. We first handle the cases where veget_4veg might be very small
+    !tree
+    WHERE(veget_4veg(:,itree) > min_stomate)
+      glccDef(:,f2c) = veget_4veg(:,itree)-glcc(:,f2c)
+      WHERE(veget_4veg(:,itree)>glcc(:,f2c))
+        glccReal(:,f2c) = glcc(:,f2c)
+      ELSEWHERE
+        glccReal(:,f2c) = veget_4veg(:,itree)
+      ENDWHERE
+    ELSEWHERE
+      glccReal(:,f2c) = 0.
+      glccDef(:,f2c) = -1*glcc(:,f2c)
+    ENDWHERE
+
+    !pasture
+    WHERE(veget_4veg(:,ipasture) > min_stomate)
+      glccDef(:,p2c) = veget_4veg(:,ipasture)-glcc(:,p2c)
+      WHERE(veget_4veg(:,ipasture)>glcc(:,p2c))
+        glccReal(:,p2c) = glcc(:,p2c)
+      ELSEWHERE
+        glccReal(:,p2c) = veget_4veg(:,ipasture)
+      ENDWHERE
+    ELSEWHERE
+      glccReal(:,p2c) = 0.
+      glccDef(:,p2c) = -1*glcc(:,p2c)
+    ENDWHERE
+
+    !grass
+    WHERE(veget_4veg(:,igrass) > min_stomate)
+      glccDef(:,g2c) = veget_4veg(:,igrass)-glcc(:,g2c)
+      WHERE(veget_4veg(:,igrass)>glcc(:,g2c))
+        glccReal(:,g2c) = glcc(:,g2c)
+      ELSEWHERE
+        glccReal(:,g2c) = veget_4veg(:,igrass)
+      ENDWHERE
+    ELSEWHERE
+      glccReal(:,g2c) = 0.
+      glccDef(:,g2c) = -1*glcc(:,g2c)
+    ENDWHERE
+
+    !! 1. Compensation sequence: pasture,grass,forest 
+    tmpdef(:) = glccDef(:,f2c)+glccDef(:,g2c)+glccDef(:,p2c)
+    WHERE(glccDef(:,p2c)<0)
+      WHERE(glccDef(:,g2c)<0)
+        WHERE(glccDef(:,f2c)<0) ! 1 (-,-,-)
+          IncreDeficit(:,icrop) = tmpdef(:)
+        ELSEWHERE ! 2 (-,-,+)
+          WHERE(tmpdef(:)>=min_stomate)
+            glccReal(:,f2c) = glccReal(:,f2c)-glccDef(:,g2c)-glccDef(:,p2c)
+          ELSEWHERE
+            glccReal(:,f2c) = veget_4veg(:,itree)
+            IncreDeficit(:,icrop) = tmpdef(:)
+          ENDWHERE
+        ENDWHERE
+      ELSEWHERE
+        WHERE(glccDef(:,f2c)<0) ! 3 (-,+,-)
+          WHERE(tmpdef(:)>=min_stomate)
+            glccReal(:,g2c) = glccReal(:,g2c)-glccDef(:,p2c)-glccDef(:,f2c)
+          ELSEWHERE
+            glccReal(:,g2c) = veget_4veg(:,igrass)
+            IncreDeficit(:,icrop) = tmpdef(:)
+          ENDWHERE
+        ELSEWHERE ! 4 (-,+,+)
+          WHERE(tmpdef(:)>=min_stomate)
+            WHERE((glccDef(:,g2c)+glccDef(:,p2c))>=min_stomate)
+              glccReal(:,g2c) = glccReal(:,g2c)-glccDef(:,p2c)
+            ELSEWHERE
+              glccReal(:,g2c) = veget_4veg(:,igrass)
+              glccReal(:,f2c) = glccReal(:,f2c)-(glccDef(:,p2c)+glccDef(:,g2c))
+            ENDWHERE
+          ELSEWHERE
+            glccReal(:,g2c) = veget_4veg(:,igrass)
+            glccReal(:,f2c) = veget_4veg(:,itree)
+            IncreDeficit(:,icrop) = tmpdef(:)
+          ENDWHERE
+        ENDWHERE
+      ENDWHERE
+    ELSEWHERE
+      WHERE(glccDef(:,g2c)<0)
+        WHERE(glccDef(:,f2c)<0) ! 5 (+,-,-)
+          WHERE(tmpdef(:)>=min_stomate)
+            glccReal(:,p2c) = glccReal(:,p2c)-glccDef(:,g2c)-glccDef(:,f2c)
+          ELSEWHERE
+            IncreDeficit(:,icrop) = tmpdef(:)
+            glccReal(:,p2c) = veget_4veg(:,ipasture)
+          ENDWHERE
+        ELSEWHERE ! 6 (+,-,+)
+          WHERE(tmpdef(:)>=min_stomate)
+            WHERE((glccDef(:,p2c)+glccDef(:,g2c))>=min_stomate)
+              glccReal(:,p2c) = glccReal(:,p2c)-glccDef(:,g2c)
+            ELSEWHERE
+              glccReal(:,p2c) = veget_4veg(:,ipasture)
+              glccReal(:,f2c) = glccReal(:,f2c)-(glccDef(:,g2c)+glccDef(:,p2c))
+            ENDWHERE
+          ELSEWHERE
+            IncreDeficit(:,icrop) = tmpdef(:)
+            glccReal(:,p2c) = veget_4veg(:,ipasture)
+            glccReal(:,f2c) = veget_4veg(:,itree)
+          ENDWHERE
+        ENDWHERE
+      ELSEWHERE
+        WHERE(glccDef(:,f2c)<0) ! 7 (+,+,-)
+          WHERE(tmpdef(:)>=min_stomate)
+            WHERE((glccDef(:,p2c)+glccDef(:,f2c))>=min_stomate)
+              glccReal(:,p2c) = glccReal(:,p2c)-glccDef(:,f2c)
+            ELSEWHERE
+              glccReal(:,p2c) = veget_4veg(:,ipasture)
+              glccReal(:,g2c) = glccReal(:,g2c)-(glccDef(:,f2c)+glccDef(:,p2c))
+            ENDWHERE
+          ELSEWHERE
+            IncreDeficit(:,icrop) = tmpdef(:)
+            glccReal(:,g2c) = veget_4veg(:,igrass)
+            glccReal(:,p2c) = veget_4veg(:,ipasture)
+          ENDWHERE
+        ELSEWHERE ! 8 (+,+,+)
+          !do nothing
+        ENDWHERE
+      ENDWHERE
+    ENDWHERE
+    veget_4veg(:,itree) = veget_4veg(:,itree) - glccReal(:,f2c)
+    veget_4veg(:,igrass) = veget_4veg(:,igrass) - glccReal(:,g2c)
+    veget_4veg(:,ipasture) = veget_4veg(:,ipasture) - glccReal(:,p2c)
+
+  END SUBROUTINE glcc_compensation_full
+
+
+
+  !! This subroutine implements non-full compensation, is currently
+  !! abandoned.
+  SUBROUTINE glcc_compensation(npts,veget_4veg,glcc,glccDef, &
+                               p2c,ipasture,g2c,igrass,f2c,itree,icrop, &
+                               IncreDeficit)
+
+    IMPLICIT NONE
+
+    !! 0.1 Input variables
+    INTEGER, INTENT(in)                                         :: npts        !! Domain size - number of pixels (unitless)
+    REAL(r_std), DIMENSION(npts,4), INTENT(in)                  :: veget_4veg  !! "maximal" coverage fraction of a PFT on the ground
+    INTEGER, INTENT(in)    :: p2c,ipasture,g2c,igrass,f2c,itree,icrop
+
+    !! 0.2 Output variables
+
+
+    !! 0.3 Modified variables
+    REAL(r_std), DIMENSION (npts,12),INTENT(inout)        :: glcc              !! the land-cover-change (LCC) matrix in case a gross LCC is 
+                                                                               !! used.
+    REAL(r_std), DIMENSION(npts,12), INTENT(inout)        :: glccDef           !! Gross LCC deficit, negative values mean that there
+                                                                               !! are not enough fractions in the source vegetations
+                                                                               !! to the target ones as presribed by the LCC matrix.
+    REAL(r_std), DIMENSION(npts,4), INTENT(inout)         :: IncreDeficit      !! "Increment" deficits, negative values mean that 
+                                                                               !! there are not enough fractions in the source PFTs
+                                                                               !! /vegetations to target PFTs/vegetations. I.e., these
+                                                                               !! fraction transfers are presribed in LCC matrix but
+                                                                               !! not realized.
+    
+    !! 0.4 Local variables
+    REAL(r_std), DIMENSION(npts)                          :: glccDef_all       !! LCC deficits by summing up all the deficits to the
+                                                                               !! the same target vegetation.
+
+
+    WHERE(veget_4veg(:,itree) > min_stomate)
+      glccDef(:,f2c) = veget_4veg(:,itree)-glcc(:,f2c)
+    ELSEWHERE
+      glccDef(:,f2c) = -1*glcc(:,f2c)
+      glcc(:,f2c) = 0.
+    ENDWHERE
+
+    WHERE(veget_4veg(:,ipasture) > min_stomate)
+      glccDef(:,p2c) = veget_4veg(:,ipasture)-glcc(:,p2c)
+    ELSEWHERE
+      glccDef(:,p2c) = -1*glcc(:,p2c)
+      glcc(:,p2c) = 0.
+    ENDWHERE
+
+    WHERE(veget_4veg(:,igrass) > min_stomate)
+      glccDef(:,g2c) = veget_4veg(:,igrass)-glcc(:,g2c)
+    ELSEWHERE
+      glccDef(:,g2c) = -1*glcc(:,g2c)
+      glcc(:,g2c) = 0.
+    ENDWHERE
+
+    glccDef_all(:) = glccDef(:,f2c)+glccDef(:,p2c)+glccDef(:,g2c)
+
+    ! We allow the surpluses/deficits in p2c and g2c mutually compensating 
+    ! for each other. If there are still deficits after this compensation,
+    ! they will be further compensated for by the surpluses from f2c (if there are any
+    ! surpluses). The ultimate deficits that cannot be compensated for 
+    ! will be recorded and dropped. 
+
+    ! Because we assume the "pasture rule" is used, i.e., the crops 
+    ! are supposed to come primarily from pastures and grasses, normally
+    ! we expect the deficits to occur in p2c or g2c rather than in f2c. But
+    ! if it happens that f2c has deficits while p2c or g2c has surpluse,
+    ! the surpluses will not be used to compensate for the f2c-deficits, 
+    ! instead, we will just record and drop the f2c-deficits.
+
+    ! In following codes for convenience we're not going to check
+    ! whether surpluses in f2c are enough to compensate for deficits 
+    ! in p2c or g2c or both. Instead, we just add their deficits on top
+    ! of f2c. The issues of not-enough surpluses in f2c will be left for
+    ! the codes after this section to handle.
+    WHERE (glccDef(:,p2c) < 0.)
+      glcc(:,p2c) = veget_4veg(:,ipasture)
+      WHERE (glccDef(:,g2c) < 0.)
+        glcc(:,g2c) = veget_4veg(:,igrass)
+      ELSEWHERE
+        WHERE (glccDef(:,g2c)+glccDef(:,p2c) > min_stomate)
+          glcc(:,g2c) = glcc(:,g2c)-glccDef(:,p2c)
+        ELSEWHERE
+          glcc(:,g2c) = veget_4veg(:,igrass)
+          ! whatever the case, we simply add the dificts to f2c
+          glcc(:,f2c) = glcc(:,f2c)-glccDef(:,p2c)-glccDef(:,g2c)
+        ENDWHERE
+      ENDWHERE
+
+    ELSEWHERE
+      WHERE(glccDef(:,g2c) < 0.)
+        glcc(:,g2c) = veget_4veg(:,igrass)
+        WHERE(glccDef(:,p2c)+glccDef(:,g2c) > min_stomate)
+          glcc(:,p2c) = glcc(:,p2c)-glccDef(:,g2c)
+        ELSEWHERE
+          glcc(:,p2c) = veget_4veg(:,ipasture)
+          ! whatever the case, we simply add the dificts to f2c
+          glcc(:,f2c) = glcc(:,f2c)-glccDef(:,p2c)-glccDef(:,g2c)
+        ENDWHERE
+      ELSEWHERE
+        !Here p2c and g2c both show surplus, we're not going to check whether
+        !glccDef(:,f2c) has negative values because we assume a "pasture rule"
+        !is applied when constructing the gross LCC matrix, so deficits in 
+        !f2c will just be dropped but not be compensated for by the surpluses in
+        !p2c or g2c.
+      ENDWHERE
+    ENDWHERE
+
+    ! 1. We calculate again the f2c-deficit because f2c-glcc is adjusted in the
+    ! codes above as we allocated the deficits of p2c and g2c into f2c. 
+    ! In cases where glccDef_all is less than zero, f2c-glcc will be larger
+    ! than available forest veget_max and we therefore limit the f2c-glcc to
+    ! available forest cover.
+    ! 2. There is (probably) a second case where glccDef_all is larger then zero, 
+    ! but f2c-glcc is higher than veget_tree, i.e., Originally f2c is given a 
+    ! high value that there is deficit in f2c but surpluses exist for p2c and g2c.
+    ! Normally we 
+    ! assume this won't happen as explained above, given that a "pasture rule" was 
+    ! used in constructing the gross LCC matrix. Nevertheless if this deos 
+    ! happen, we will just drop the f2c deficit without being compensated 
+    ! for by the surplus in p2c or g2c.
+   
+    ! we handle the 2nd case first
+    WHERE(veget_4veg(:,itree) > min_stomate )
+      WHERE(glccDef(:,f2c) < 0.)
+        glcc(:,f2c) = veget_4veg(:,itree)
+        WHERE (glccDef(:,p2c)+glccDef(:,g2c) > min_stomate)
+          IncreDeficit(:,icrop) = glccDef(:,f2c)
+        ELSEWHERE
+          IncreDeficit(:,icrop) = glccDef_all(:)
+        ENDWHERE
+      ELSEWHERE
+        WHERE(glccDef_all(:) < 0.) !handle the 1st case
+          glcc(:,f2c) = veget_4veg(:,itree)
+          IncreDeficit(:,icrop) = glccDef_all(:)
+        ENDWHERE
+      ENDWHERE
+    ELSEWHERE
+      WHERE(glccDef(:,p2c)+glccDef(:,g2c)>min_stomate)
+        IncreDeficit(:,icrop) = glccDef(:,f2c)
+      ELSEWHERE
+        IncreDeficit(:,icrop) = glccDef_all(:)
+      ENDWHERE
+    ENDWHERE
+
+  END SUBROUTINE glcc_compensation
+
+END MODULE stomate_gluc_common
Index: /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_stomate/stomate_gluc_constants.f90
===================================================================
--- /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_stomate/stomate_gluc_constants.f90	(revision 6940)
+++ /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_stomate/stomate_gluc_constants.f90	(revision 6940)
@@ -0,0 +1,355 @@
+! =================================================================================================================================
+! MODULE       : stomate_gluc_common
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF       This module contains common fuctions and subroutines used by
+!              gross land use change and forestry harvest modules.
+!!
+!!\n DESCRIPTION: None
+!!
+!! RECENT CHANGE(S): 
+!!
+!! REFERENCE(S)	: None
+!!
+!! SVN          :
+!! $HeadURL: svn://forge.ipsl.jussieu.fr/orchidee/perso/albert.jornet/ORCHIDEE-MICT/src_stomate/stomate_lcchange.f90 $
+!! $Date: 2015-07-30 15:38:45 +0200 (Thu, 30 Jul 2015) $
+!! $Revision: 2847 $
+!! \n
+!_ ================================================================================================================================
+
+
+MODULE stomate_gluc_constants
+
+  ! modules used:
+  
+  USE pft_parameters
+  USE constantes
+  USE constantes_soil_var
+  
+  IMPLICIT NONE
+  
+  PUBLIC
+  
+  INTEGER, ALLOCATABLE, SAVE                  :: indall_tree(:)       !! Indices for all tree PFTs
+  INTEGER, ALLOCATABLE, SAVE                  :: indold_tree(:)       !! Indices for old tree cohort only
+  INTEGER, ALLOCATABLE, SAVE                  :: indagec_tree(:,:)    !! Indices for secondary tree cohorts, 
+                                                                      !! note the sequence is old->young.
+  INTEGER, ALLOCATABLE, SAVE                  :: indall_grass(:)      !! Indices for all grass PFTs
+  INTEGER, ALLOCATABLE, SAVE                  :: indold_grass(:)      !! Indices for old grasses only
+  INTEGER, ALLOCATABLE, SAVE                  :: indagec_grass(:,:)   !! Indices for secondary grass cohorts
+                                                                      !! note the sequence is old->young.
+  INTEGER, ALLOCATABLE, SAVE                  :: indall_pasture(:)    !! Indices for all pasture PFTs
+  INTEGER, ALLOCATABLE, SAVE                  :: indold_pasture(:)    !! Indices for old pasture only
+  INTEGER, ALLOCATABLE, SAVE                  :: indagec_pasture(:,:) !! Indices for secondary pasture cohorts
+                                                                      !! note the sequence is old->young.
+  INTEGER, ALLOCATABLE, SAVE                  :: indall_crop(:)       !! Indices for all crop PFTs
+  INTEGER, ALLOCATABLE, SAVE                  :: indold_crop(:)       !! Indices for old crops only
+  INTEGER, ALLOCATABLE, SAVE                  :: indagec_crop(:,:)    !! Indices for secondary crop cohorts
+
+  INTEGER, ALLOCATABLE, SAVE                  :: indall_bioe1(:)       !! Indices for all bioe1 PFTs
+  INTEGER, ALLOCATABLE, SAVE                  :: indold_bioe1(:)       !! Indices for old bioe1 only
+  INTEGER, ALLOCATABLE, SAVE                  :: indagec_bioe1(:,:)    !! Indices for secondary bioe1 cohorts
+
+  INTEGER, SAVE :: num_tree_mulagec,num_grass_mulagec,     &
+                   num_pasture_mulagec,num_crop_mulagec,   &
+                   num_bioe1_mulagec
+  
+CONTAINS
+
+! ================================================================================================================================
+!! SUBROUTINE   : stomate_gluc_constants_init
+!!
+!>\BRIEF        Calculate coverage fraction for different age classes of forest,
+!!              grass, pasture and crops and also for each metaclass. Note baresoil is excluded. 
+!!              
+!! DESCRIPTION :
+!! Note:
+!! 1. "calc_cover" subroutine does not depend on how many age classes
+!! there are in each MTC.
+!! 2. Fraction of baresoil is excluded here. This means transformation
+!! of baresoil to a vegetated PFT is excluded in gross land cover change.
+!!  
+!!
+!! MAIN OUTPUT VARIABLE(S) :  
+!!
+!! \n
+!_ ================================================================================================================================
+
+  SUBROUTINE stomate_gluc_constants_init()
+
+    INTEGER(i_std) :: itree,itree2,igrass,igrass2,ipasture,ipasture2,icrop,icrop2, &
+                      ibioe1, ibioe12
+    INTEGER(i_std) :: i,j,ivma,staind,endind,ivm
+    INTEGER(i_std) :: ier               !! Check errors in netcdf call
+
+
+    !! 1. We first build all different indices that we are going to use
+    !!    in handling the PFT exchanges, three types of indices are built:
+    !!     - for all age classes
+    !!     - include only oldest age classes
+    !!     - include all age classes excpet the oldest ones
+    ! We have to build these indices because we would like to extract from
+    ! donating PFTs in the sequnce of old->young age classes or the revserse, 
+    ! and add in the receving PFTs only in the youngest-age-class PFTs. These 
+    ! indicies allow us to know where the different age classes are.
+
+    ! calculate the total number of MTCs for each vegetation type.
+    num_tree_mulagec=0          
+    num_grass_mulagec=0
+    num_pasture_mulagec=0
+    num_crop_mulagec=0
+    num_bioe1_mulagec=0
+    
+    !! 1.1 Calculate the number of PFTs for different MTCs and allocate
+    !! the old and all indices arrays.
+
+    ! [Note here the sequence to identify tree,pasture,grass,crop] is
+    ! critical. The similar sequence is used in the subroutine "calc_cover".
+    ! Do not forget to change the sequence there if you modify here.
+    DO ivma =2,nvmap
+      staind=start_index(ivma)
+      IF (nagec_pft(ivma)==1) THEN
+        WRITE(numout,*) "Error: metaclass has only a single age group: ",ivma
+        WRITE(numout,*) "stomate_gluc_constants_init"
+        STOP
+      ELSE
+        IF (is_tree(staind)) THEN
+          num_tree_mulagec = num_tree_mulagec+1
+        ELSE IF (is_grassland_manag(staind)) THEN
+          num_pasture_mulagec = num_pasture_mulagec+1
+        ELSE IF (is_bioe1(staind)) THEN
+          num_bioe1_mulagec = num_bioe1_mulagec+1
+        ELSE IF (natural(staind)) THEN
+          num_grass_mulagec = num_grass_mulagec+1
+        ELSE
+          num_crop_mulagec = num_crop_mulagec+1
+        ENDIF
+      ENDIF
+    ENDDO
+    
+    !! Allocate index array
+    ! allocate all index
+
+    ALLOCATE(indall_tree(num_tree_mulagec*nagec_tree),stat=ier)
+    IF (ier .NE. 0) THEN
+       WRITE(numout,*) 'Memory allocation error for indall_tree'
+       STOP 'stomate_gluc_constants_init'
+    ENDIF
+
+    ALLOCATE(indall_grass(num_grass_mulagec*nagec_herb),stat=ier)
+    IF (ier .NE. 0) THEN
+       WRITE(numout,*) 'Memory allocation error for indall_grass'
+       STOP 'stomate_gluc_constants_init'
+    ENDIF
+
+    ALLOCATE(indall_pasture(num_pasture_mulagec*nagec_herb),stat=ier)
+    IF (ier .NE. 0) THEN
+       WRITE(numout,*) 'Memory allocation error for indall_pasture'
+       STOP 'stomate_gluc_constants_init'
+    ENDIF
+
+    ALLOCATE(indall_crop(num_crop_mulagec*nagec_herb),stat=ier)
+    IF (ier .NE. 0) THEN
+       WRITE(numout,*) 'Memory allocation error for indall_crop'
+       STOP 'stomate_gluc_constants_init'
+    ENDIF
+
+    ! allocate old-ageclass index
+    ALLOCATE(indold_tree(num_tree_mulagec),stat=ier)
+    IF (ier .NE. 0) THEN
+       WRITE(numout,*) 'Memory allocation error for indold_tree'
+       STOP 'stomate_gluc_constants_init'
+    ENDIF
+
+    ALLOCATE(indold_grass(num_grass_mulagec),stat=ier)
+    IF (ier .NE. 0) THEN
+       WRITE(numout,*) 'Memory allocation error for indold_grass'
+       STOP 'stomate_gluc_constants_init'
+    ENDIF
+
+    ALLOCATE(indold_pasture(num_pasture_mulagec),stat=ier)
+    IF (ier .NE. 0) THEN
+       WRITE(numout,*) 'Memory allocation error for indold_pasture'
+       STOP 'stomate_gluc_constants_init'
+    ENDIF
+
+    ALLOCATE(indold_crop(num_crop_mulagec),stat=ier)
+    IF (ier .NE. 0) THEN
+       WRITE(numout,*) 'Memory allocation error for indold_crop'
+       STOP 'stomate_gluc_constants_init'
+    ENDIF
+
+    ! To to be able to go through the following code, when there are no bio1
+    ! meta-calsses, we set num_bioe1_mulagec as 1.
+    IF (num_bioe1_mulagec .EQ. 0) num_bioe1_mulagec = 1
+
+    ALLOCATE(indall_bioe1(num_bioe1_mulagec*nagec_bioe1),stat=ier)
+    IF (ier .NE. 0) THEN
+       WRITE(numout,*) 'Memory allocation error for indall_crop'
+       STOP 'stomate_gluc_constants_init'
+    ENDIF
+    indall_bioe1(:) = 0
+
+    ALLOCATE(indold_bioe1(num_bioe1_mulagec),stat=ier)
+    IF (ier .NE. 0) THEN
+       WRITE(numout,*) 'Memory allocation error for indold_crop'
+       STOP 'stomate_gluc_constants_init'
+    ENDIF
+    indold_bioe1(:) = 0
+
+    ALLOCATE(indagec_bioe1(num_bioe1_mulagec,nagec_bioe1-1))
+    IF (ier .NE. 0) THEN
+       WRITE(numout,*) 'Memory allocation error for indagec_crop'
+       STOP 'stomate_gluc_constants_init'
+    ENDIF
+    indagec_bioe1(:,:) = 0
+
+    !! 1.2 Fill the oldest-age-class and all index arrays
+    itree=0
+    igrass=0
+    ipasture=0
+    icrop=0
+    ibioe1=0
+    itree2=1
+    igrass2=1
+    ipasture2=1
+    icrop2=1
+    ibioe12=1
+    DO ivma =2,nvmap
+      staind=start_index(ivma)
+      IF (is_tree(staind)) THEN
+        itree=itree+1
+        indold_tree(itree) = staind+nagec_pft(ivma)-1
+        DO j = 0,nagec_pft(ivma)-1
+          indall_tree(itree2+j) = staind+j
+        ENDDO
+        itree2=itree2+nagec_pft(ivma)
+      ELSE IF (is_bioe1(staind)) THEN
+        ibioe1 = ibioe1+1
+        indold_bioe1(ipasture) = staind+nagec_pft(ivma)-1
+        DO j = 0,nagec_pft(ivma)-1
+          indall_bioe1(ibioe12+j) = staind+j
+        ENDDO
+        ibioe12=ibioe12+nagec_pft(ivma)
+      ELSE IF (natural(staind) .AND. .NOT. is_grassland_manag(staind)) THEN
+        igrass=igrass+1
+        indold_grass(igrass) = staind+nagec_pft(ivma)-1
+        DO j = 0,nagec_pft(ivma)-1
+          indall_grass(igrass2+j) = staind+j
+        ENDDO
+        igrass2=igrass2+nagec_pft(ivma)
+      ELSE IF (is_grassland_manag(staind)) THEN
+        ipasture = ipasture+1
+        indold_pasture(ipasture) = staind+nagec_pft(ivma)-1
+        DO j = 0,nagec_pft(ivma)-1
+          indall_pasture(ipasture2+j) = staind+j
+        ENDDO
+        ipasture2=ipasture2+nagec_pft(ivma)
+      ELSE
+        icrop = icrop+1
+        indold_crop(icrop) = staind+nagec_pft(ivma)-1
+        DO j = 0,nagec_pft(ivma)-1
+          indall_crop(icrop2+j) = staind+j
+        ENDDO
+        icrop2=icrop2+nagec_pft(ivma)
+      ENDIF
+    ENDDO
+    
+    !! 1.3 Allocate and fill other age class index
+
+    ! allocate old-ageclass index
+    ALLOCATE(indagec_tree(num_tree_mulagec,nagec_tree-1),stat=ier)     
+    IF (ier .NE. 0) THEN
+       WRITE(numout,*) 'Memory allocation error for indagec_tree'
+       STOP 'stomate_gluc_constants_init'
+    ENDIF
+
+    ALLOCATE(indagec_grass(num_grass_mulagec,nagec_herb-1),stat=ier)     
+    IF (ier .NE. 0) THEN
+       WRITE(numout,*) 'Memory allocation error for indagec_grass'
+       STOP 'stomate_gluc_constants_init'
+    ENDIF
+
+    ALLOCATE(indagec_pasture(num_pasture_mulagec,nagec_herb-1),stat=ier)
+    IF (ier .NE. 0) THEN
+       WRITE(numout,*) 'Memory allocation error for indagec_pasture'
+       STOP 'stomate_gluc_constants_init'
+    ENDIF
+
+    ALLOCATE(indagec_crop(num_crop_mulagec,nagec_herb-1),stat=ier)
+    IF (ier .NE. 0) THEN
+       WRITE(numout,*) 'Memory allocation error for indagec_crop'
+       STOP 'stomate_gluc_constants_init'
+    ENDIF
+
+    ! fill the non-oldest age class index arrays when number of age classes
+    ! is more than 1.
+    itree=0
+    igrass=0
+    ipasture=0
+    icrop=0
+    ibioe1=0
+    DO ivma = 2,nvmap
+      staind=start_index(ivma)
+      IF (nagec_pft(ivma) > 1) THEN
+        IF (is_tree(staind)) THEN
+          itree=itree+1
+          DO j = 1,nagec_tree-1
+            indagec_tree(itree,j) = staind+nagec_tree-j-1
+          ENDDO
+        ELSE IF (is_bioe1(staind)) THEN
+          ibioe1=ibioe1+1
+          DO j = 1,nagec_bioe1-1
+            indagec_bioe1(ibioe1,j) = staind+nagec_bioe1-j-1
+          ENDDO
+        ELSE IF (natural(staind) .AND. .NOT. is_grassland_manag(staind)) THEN
+          igrass=igrass+1
+          DO j = 1,nagec_herb-1
+            indagec_grass(igrass,j) = staind+nagec_herb-j-1
+          ENDDO
+        ELSE IF (is_grassland_manag(staind)) THEN
+          ipasture=ipasture+1
+          DO j = 1,nagec_herb-1
+            indagec_pasture(ipasture,j) = staind+nagec_herb-j-1
+          ENDDO
+        ELSE
+          icrop=icrop+1
+          DO j = 1,nagec_herb-1
+            indagec_crop(icrop,j) = staind+nagec_herb-j-1
+          ENDDO
+        ENDIF
+      ENDIF
+    ENDDO
+
+    write (numout,*) "indices calculated"
+  END SUBROUTINE stomate_gluc_constants_init
+
+  SUBROUTINE stomate_gluc_constants_init_clear()
+
+    IF (ALLOCATED(indall_tree)) DEALLOCATE(indall_tree)
+    IF (ALLOCATED(indall_grass)) DEALLOCATE(indall_grass)
+    IF (ALLOCATED(indall_pasture)) DEALLOCATE(indall_pasture)
+    IF (ALLOCATED(indall_crop)) DEALLOCATE(indall_crop)
+
+    IF (ALLOCATED(indold_tree)) DEALLOCATE(indold_tree)
+    IF (ALLOCATED(indold_grass)) DEALLOCATE(indold_grass)
+    IF (ALLOCATED(indold_pasture)) DEALLOCATE(indold_pasture)
+    IF (ALLOCATED(indold_crop)) DEALLOCATE(indold_crop)
+
+    IF (ALLOCATED(indagec_tree)) DEALLOCATE(indagec_tree)
+    IF (ALLOCATED(indagec_grass)) DEALLOCATE(indagec_grass)
+    IF (ALLOCATED(indagec_pasture)) DEALLOCATE(indagec_pasture)
+    IF (ALLOCATED(indagec_crop)) DEALLOCATE(indagec_crop)
+
+    IF (ALLOCATED(indall_bioe1)) DEALLOCATE(indall_bioe1)
+    IF (ALLOCATED(indold_bioe1)) DEALLOCATE(indold_bioe1)
+    IF (ALLOCATED(indagec_bioe1)) DEALLOCATE(indagec_bioe1)
+
+  END SUBROUTINE stomate_gluc_constants_init_clear
+
+END MODULE stomate_gluc_constants
Index: /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_stomate/stomate_io_carbon_permafrost.f90
===================================================================
--- /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_stomate/stomate_io_carbon_permafrost.f90	(revision 6940)
+++ /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_stomate/stomate_io_carbon_permafrost.f90	(revision 6940)
@@ -0,0 +1,393 @@
+!< $HeadURL: svn://forge.ipsl.jussieu.fr/orchidee/branches/ORCHIDEE-MICT/ORCHIDEE/src_stomate/stomate_io.f90 $ 
+!< $Date: 2016-06-17 13:26:43 +0200 (Fri, 17 Jun 2016) $
+!< $Author: albert.jornet $
+!< $Revision: 3564 $
+! IPSL (2006)
+!  This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+MODULE stomate_io_carbon_permafrost
+  !---------------------------------------------------------------------
+  !-
+  !- 
+  !-
+  !---------------------------------------------------------------------
+  USE netcdf
+  USE defprec
+  USE stomate_data
+  USE constantes
+  USE constantes_soil
+  USE mod_orchidee_para
+  USE ioipsl_para 
+  USE utils      ! nccheck
+#ifdef CPP_PARA
+  USE mpi
+#endif
+  !-
+  IMPLICIT NONE
+  !-
+  PRIVATE
+  PUBLIC stomate_io_carbon_permafrost_write, stomate_io_carbon_permafrost_read
+  !-
+  ! TO CHECK, stomate_finalize also uses this type of var
+  INTEGER,PARAMETER                              :: r_typ = NF90_REAL8   !! Specify data format (server dependent)
+  !-
+CONTAINS
+  !-
+  !===
+  !-
+  !! ================================================================================================================================
+  !! SUBROUTINE 	: stomate_io_carbon_permafrost_write 
+  !!
+  !>\BRIEF        Writes stomate permafrost carbon data into a netcdf file
+  !!
+  !! DESCRIPTION  : It writes into a netcdf files in parallel mode all necessary
+  !!                 variables required for spinup (forecesoil)
+  !!                
+  !!                
+  !! \n
+  !_ ================================================================================================================================
+  SUBROUTINE stomate_io_carbon_permafrost_write (Cforcing_permafrost_name, & 
+                        nbp_glo,            start_px,           length_px,      nparan,     nbyear, &
+                        index_g,            zz_deep,            zz_coef_deep, &
+                        clay,               depth_organic_soil, lalo, &
+                        snowdz_2pfcforcing, snowrho_2pfcforcing, soilcarbon_input_2pfcforcing, &
+                        tsurf_2pfcforcing,  pb_2pfcforcing,     snow_2pfcforcing, &
+                        tprof_2pfcforcing,  fbact_2pfcforcing,  veget_max_2pfcforcing, &
+                        rprof_2pfcforcing,  hslong_2pfcforcing )
+    
+    
+
+
+    CHARACTER(LEN=100), INTENT(in)              :: Cforcing_permafrost_name !! Name of permafrost forcing file
+    INTEGER(i_std), INTENT(in)                  :: nbp_glo !nbp_glo is the number of global continental points
+    INTEGER(i_std), INTENT(in)                  :: start_px ! Start land point/pixex respect to nbp_glo
+    INTEGER(i_std), INTENT(in)                  :: length_px ! Length of lands point/pixel to write
+    INTEGER(i_std), INTENT(in)                  :: nparan ! Number of forcesoil timesteps  
+    INTEGER(i_std), INTENT(in)                  :: nbyear ! Number of years saved for carbon spinup 
+    INTEGER(i_std),DIMENSION(:),INTENT(in)      :: index_g             !! Indices of the terrestrial pixels only (unitless)
+    REAL(r_std), DIMENSION(:),   INTENT (in)    :: zz_deep           !! deep vertical profile
+    REAL(r_std), DIMENSION(:),   INTENT (in)    :: zz_coef_deep      !! deep vertical profile
+    REAL(r_std), DIMENSION(:), INTENT(in)       :: clay                   !! Clay fraction of soil (0-1, unitless), parallel 
+    REAL(r_std), DIMENSION(:),   INTENT (in)    :: depth_organic_soil !! how deep is the organic soil?
+    REAL(r_std), DIMENSION(:,:),INTENT(in)      :: lalo              !! Geographical coordinates (latitude,longitude) 
+    REAL(r_std),DIMENSION(:,:,:), INTENT(in)    :: snowdz_2pfcforcing
+    REAL(r_std),DIMENSION(:,:,:), INTENT(in)    :: snowrho_2pfcforcing
+    REAL(r_std),DIMENSION(:,:,:,:), INTENT(in)  :: soilcarbon_input_2pfcforcing
+    REAL(r_std),DIMENSION(:,:), INTENT(in )     :: tsurf_2pfcforcing
+    REAL(r_std),DIMENSION(:,:), INTENT(in)      :: pb_2pfcforcing
+    REAL(r_std),DIMENSION(:,:), INTENT(in)      :: snow_2pfcforcing
+    REAL(r_std),DIMENSION(:,:,:,:), INTENT(in)  :: tprof_2pfcforcing
+    REAL(r_std),DIMENSION(:,:,:,:), INTENT(in)  :: fbact_2pfcforcing
+    REAL(r_std),DIMENSION(:,:,:,:), INTENT(in)  :: hslong_2pfcforcing
+    REAL(r_std),DIMENSION(:,:,:), INTENT(in)    :: veget_max_2pfcforcing
+    REAL(r_std),DIMENSION(:,:,:), INTENT(in)    :: rprof_2pfcforcing
+   
+    ! Local Variables
+    INTEGER(i_std)                              :: ier, n_directions, i
+    INTEGER(i_std)                              :: start(1), ncount(1), start_2d(2), ncount_2d(2), inival, endval 
+    INTEGER(i_std)                              :: start_4d(4), ncount_4d(4), start_3d(3), ncount_3d(3)
+    INTEGER(i_std),DIMENSION(10)                :: d_id                     !! List each netcdf dimension
+    INTEGER(i_std)                              :: vid                      !! Variable identifer of netCDF (unitless)
+    INTEGER(i_std)                              :: Cforcing_permafrost_id   !! Permafrost file identifer 
+   
+    ! Create file 
+#ifdef CPP_PARA
+    ier = NF90_CREATE (TRIM(Cforcing_permafrost_name),IOR(NF90_NETCDF4,NF90_MPIIO), &
+            Cforcing_permafrost_id, comm=MPI_COMM_ORCH, info=MPI_INFO_NULL)
+#else
+    ier = NF90_CREATE (TRIM(Cforcing_permafrost_name),NF90_NETCDF4, &
+            Cforcing_permafrost_id)
+#endif
+    IF (ier /= NF90_NOERR) THEN
+        CALL ipslerr_p (3,'stomate_finalize', &
+             &        'PROBLEM creating Cforcing_permafrost file', &
+             &        NF90_STRERROR(ier),'')
+     END IF
+
+
+     ! Add variable attribute
+     ! Note ::nbp_glo is the number of global continental points
+     CALL nccheck( NF90_PUT_ATT (Cforcing_permafrost_id,NF90_GLOBAL, &
+          &                           'kjpindex',REAL(nbp_glo,r_std)))
+     CALL nccheck( NF90_PUT_ATT (Cforcing_permafrost_id,NF90_GLOBAL, &
+          &                           'nparan',REAL(nparan,r_std)))
+     CALL nccheck( NF90_PUT_ATT (Cforcing_permafrost_id,NF90_GLOBAL, &
+          &                           'nbyear',REAL(nbyear,r_std)))
+
+     ! Add new dimension, variables values from USE
+     CALL nccheck( NF90_DEF_DIM (Cforcing_permafrost_id,'points',nbp_glo,d_id(1)))
+     CALL nccheck( NF90_DEF_DIM (Cforcing_permafrost_id,'carbtype',ncarb,d_id(2)))
+     CALL nccheck( NF90_DEF_DIM (Cforcing_permafrost_id,'vegtype',nvm,d_id(3)))
+     CALL nccheck( NF90_DEF_DIM (Cforcing_permafrost_id,'level',ndeep,d_id(4)))
+     CALL nccheck( NF90_DEF_DIM (Cforcing_permafrost_id,'time_step',nparan*nbyear,d_id(5)))
+     n_directions=2
+     CALL nccheck( NF90_DEF_DIM (Cforcing_permafrost_id,'direction',n_directions,d_id(6)))
+
+
+     ! Add new variable
+     CALL nccheck( NF90_DEF_VAR (Cforcing_permafrost_id,'points', r_typ,d_id(1),vid))
+     CALL nccheck( NF90_DEF_VAR (Cforcing_permafrost_id,'carbtype', r_typ,d_id(2),vid))
+     CALL nccheck( NF90_DEF_VAR (Cforcing_permafrost_id,'vegtype', r_typ,d_id(3),vid))
+     CALL nccheck( NF90_DEF_VAR (Cforcing_permafrost_id,'level', r_typ,d_id(4),vid))
+     CALL nccheck( NF90_DEF_VAR (Cforcing_permafrost_id,'time_step',r_typ,d_id(5),vid))
+     CALL nccheck( NF90_DEF_VAR (Cforcing_permafrost_id,'direction',r_typ,d_id(6),vid))
+     CALL nccheck( NF90_DEF_VAR (Cforcing_permafrost_id,'index',r_typ,d_id(1),vid))
+     CALL nccheck( NF90_DEF_VAR (Cforcing_permafrost_id,'clay',r_typ,d_id(1),vid))
+     CALL nccheck( NF90_DEF_VAR (Cforcing_permafrost_id,'lalo',      r_typ, &
+          (/ d_id(1), d_id(6) /),vid))
+     !--time-invariant
+     CALL nccheck( NF90_DEF_VAR (Cforcing_permafrost_id,'zz_deep',r_typ,d_id(4),vid))
+     CALL nccheck( NF90_DEF_VAR (Cforcing_permafrost_id,'zz_coef_deep',r_typ,d_id(4),vid))
+     CALL nccheck( NF90_DEF_VAR (Cforcing_permafrost_id,'z_organic',r_typ,d_id(1),vid))
+     !--3layers snow 
+     CALL nccheck( NF90_DEF_VAR(Cforcing_permafrost_id,'snowdz',r_typ,(/ d_id(1),d_id(2),d_id(5) /),vid))
+     CALL nccheck( NF90_DEF_VAR(Cforcing_permafrost_id,'snowrho',r_typ,(/ d_id(1),d_id(2),d_id(5) /),vid))
+     !--time-varying 
+     CALL nccheck( NF90_DEF_VAR (Cforcing_permafrost_id,'soilcarbon_input',r_typ, &
+          &                        (/ d_id(1),d_id(2),d_id(3),d_id(5) /),vid))
+     CALL nccheck( NF90_DEF_VAR (Cforcing_permafrost_id,'pb',r_typ, & 
+          &                        (/ d_id(1),d_id(5) /),vid))
+     CALL nccheck( NF90_DEF_VAR (Cforcing_permafrost_id,'snow',r_typ, &
+          &                        (/ d_id(1),d_id(5) /),vid))
+     CALL nccheck( NF90_DEF_VAR (Cforcing_permafrost_id,'tprof',r_typ, &
+          &                        (/ d_id(1),d_id(4),d_id(3),d_id(5) /),vid))
+     CALL nccheck( NF90_DEF_VAR (Cforcing_permafrost_id,'fbact',r_typ, &
+          &                        (/ d_id(1),d_id(4),d_id(3),d_id(5) /),vid))
+     CALL nccheck( NF90_DEF_VAR (Cforcing_permafrost_id,'hslong',r_typ, &
+          &                        (/ d_id(1),d_id(4),d_id(3),d_id(5) /),vid))
+     CALL nccheck( NF90_DEF_VAR (Cforcing_permafrost_id,'veget_max',r_typ, &
+          &                        (/ d_id(1),d_id(3),d_id(5) /),vid))
+     CALL nccheck( NF90_DEF_VAR (Cforcing_permafrost_id,'rprof',r_typ, &
+          &                        (/ d_id(1),d_id(3),d_id(5) /),vid))
+     CALL nccheck( NF90_DEF_VAR (Cforcing_permafrost_id,'tsurf',r_typ, &
+          &                        (/ d_id(1),d_id(5) /),vid))
+     CALL nccheck( NF90_ENDDEF (Cforcing_permafrost_id))
+
+     ! Write data
+     start=(/ start_px /)
+     ncount=(/ length_px /)
+     inival=start_px
+     endval=start_px + length_px !length_px_end(mpi_rank)
+     CALL nccheck( NF90_INQ_VARID (Cforcing_permafrost_id,'points',vid) )
+     CALL nccheck( NF90_VAR_PAR_ACCESS(Cforcing_permafrost_id, vid, NF90_COLLECTIVE))
+     CALL nccheck( NF90_PUT_VAR (Cforcing_permafrost_id,vid, &
+          &  (/(REAL(i,r_std),i=inival,endval)/), &
+          &  start=start, count=ncount) )
+
+     ! no point to make parallel calls
+     CALL nccheck( NF90_INQ_VARID (Cforcing_permafrost_id,'carbtype',vid))
+     CALL nccheck( NF90_VAR_PAR_ACCESS(Cforcing_permafrost_id, vid, NF90_COLLECTIVE))
+     CALL nccheck( NF90_PUT_VAR (Cforcing_permafrost_id,vid, &
+          &                        (/(REAL(i,r_std),i=1,ncarb)/)))
+     CALL nccheck( NF90_INQ_VARID (Cforcing_permafrost_id,'vegtype',vid))
+     CALL nccheck( NF90_VAR_PAR_ACCESS(Cforcing_permafrost_id, vid, NF90_COLLECTIVE))
+     CALL nccheck( NF90_PUT_VAR (Cforcing_permafrost_id,vid, &
+          &                            (/(REAL(i,r_std),i=1,nvm)/)))
+     CALL nccheck( NF90_INQ_VARID (Cforcing_permafrost_id,'level',vid))
+     CALL nccheck( NF90_VAR_PAR_ACCESS(Cforcing_permafrost_id, vid, NF90_COLLECTIVE))
+     CALL nccheck( NF90_PUT_VAR (Cforcing_permafrost_id,vid, &
+          &                        (/(REAL(i,r_std),i=1,ndeep)/)))
+     CALL nccheck( NF90_INQ_VARID (Cforcing_permafrost_id,'time_step',vid))
+     CALL nccheck( NF90_VAR_PAR_ACCESS(Cforcing_permafrost_id, vid, NF90_COLLECTIVE))
+     CALL nccheck( NF90_PUT_VAR (Cforcing_permafrost_id,vid, &
+          &                       (/(REAL(i,r_std),i=1,nparan*nbyear)/)))
+     CALL nccheck( NF90_INQ_VARID (Cforcing_permafrost_id,'index',vid))
+     CALL nccheck( NF90_VAR_PAR_ACCESS(Cforcing_permafrost_id, vid, NF90_COLLECTIVE))
+     CALL nccheck( NF90_PUT_VAR (Cforcing_permafrost_id,vid, REAL(index_g,r_std) ))
+
+     CALL nccheck( NF90_INQ_VARID (Cforcing_permafrost_id,'zz_deep',vid))
+     CALL nccheck( NF90_VAR_PAR_ACCESS(Cforcing_permafrost_id, vid, NF90_COLLECTIVE))
+     CALL nccheck( NF90_PUT_VAR (Cforcing_permafrost_id,vid, zz_deep ))
+
+     CALL nccheck( NF90_INQ_VARID (Cforcing_permafrost_id,'zz_coef_deep',vid))
+     CALL nccheck( NF90_VAR_PAR_ACCESS(Cforcing_permafrost_id, vid, NF90_COLLECTIVE))
+     CALL nccheck( NF90_PUT_VAR (Cforcing_permafrost_id,vid, zz_coef_deep ))
+
+     ! Parallel writes
+     start=(/ start_px /)
+     ncount=(/ length_px /)
+     CALL nccheck( NF90_INQ_VARID (Cforcing_permafrost_id,'clay',vid))
+     CALL nccheck( NF90_VAR_PAR_ACCESS(Cforcing_permafrost_id, vid, NF90_COLLECTIVE))
+     CALL nccheck( NF90_PUT_VAR (Cforcing_permafrost_id,vid, clay, start=start, count=ncount  ))
+
+     CALL nccheck( NF90_INQ_VARID (Cforcing_permafrost_id,'z_organic',vid))
+     CALL nccheck( NF90_VAR_PAR_ACCESS(Cforcing_permafrost_id, vid, NF90_COLLECTIVE))
+     CALL nccheck( NF90_PUT_VAR (Cforcing_permafrost_id,vid,depth_organic_soil, start=start, count=ncount))
+
+     start_2d=(/ start_px,1 /)
+     ncount_2d=(/ length_px,2 /)
+     CALL nccheck( NF90_INQ_VARID (Cforcing_permafrost_id,'lalo',vid))
+     CALL nccheck( NF90_VAR_PAR_ACCESS(Cforcing_permafrost_id, vid, NF90_COLLECTIVE))
+     CALL nccheck( NF90_PUT_VAR (Cforcing_permafrost_id,vid, lalo, start=start_2d, count=ncount_2d ))
+
+     ! putting 3 snow layers
+     start_3d=(/ start_px,1,1 /)
+     ncount_3d=(/ length_px,nsnow,nparan*nbyear /)
+     CALL nccheck( NF90_INQ_VARID(Cforcing_permafrost_id,'snowdz',vid))
+     CALL nccheck( NF90_VAR_PAR_ACCESS(Cforcing_permafrost_id, vid, NF90_COLLECTIVE))
+     CALL nccheck( NF90_PUT_VAR (Cforcing_permafrost_id,vid, snowdz_2pfcforcing, start=start_3d ,count=ncount_3d ))
+
+     CALL nccheck( NF90_INQ_VARID (Cforcing_permafrost_id,'snowrho',vid))
+     CALL nccheck( NF90_VAR_PAR_ACCESS(Cforcing_permafrost_id, vid, NF90_COLLECTIVE))
+     CALL nccheck( NF90_PUT_VAR (Cforcing_permafrost_id,vid, snowrho_2pfcforcing, &
+                    start=start_3d ,count=ncount_3d ))
+
+     start_4d=(/ start_px,1,1,1 /)
+     ncount_4d=(/ length_px,ncarb,nvm,nparan*nbyear /)
+     CALL nccheck( NF90_INQ_VARID (Cforcing_permafrost_id,'soilcarbon_input',vid))
+     CALL nccheck( NF90_VAR_PAR_ACCESS(Cforcing_permafrost_id, vid, NF90_COLLECTIVE))
+     CALL nccheck( NF90_PUT_VAR (Cforcing_permafrost_id,vid,soilcarbon_input_2pfcforcing, &
+                    start=start_4d ,count=ncount_4d ))
+
+     start_2d=(/ start_px,1 /)
+     ncount_2d=(/ length_px,nparan*nbyear /)
+     CALL nccheck( NF90_INQ_VARID (Cforcing_permafrost_id,'tsurf',vid))
+     CALL nccheck( NF90_VAR_PAR_ACCESS(Cforcing_permafrost_id, vid, NF90_COLLECTIVE))
+     CALL nccheck( NF90_PUT_VAR (Cforcing_permafrost_id,vid, tsurf_2pfcforcing, start=start_2d, count=ncount_2d ))
+
+     CALL nccheck( NF90_INQ_VARID (Cforcing_permafrost_id,'pb',vid))
+     CALL nccheck( NF90_VAR_PAR_ACCESS(Cforcing_permafrost_id, vid, NF90_COLLECTIVE))
+     CALL nccheck( NF90_PUT_VAR (Cforcing_permafrost_id,vid, pb_2pfcforcing, start=start_2d, count=ncount_2d ))
+
+     CALL nccheck( NF90_INQ_VARID (Cforcing_permafrost_id,'snow',vid))
+     CALL nccheck( NF90_VAR_PAR_ACCESS(Cforcing_permafrost_id, vid, NF90_COLLECTIVE))
+     CALL nccheck( NF90_PUT_VAR (Cforcing_permafrost_id,vid, snow_2pfcforcing, start=start_2d, count=ncount_2d ))
+
+     start_4d=(/ start_px,1,1,1 /)
+     ncount_4d=(/ length_px,ndeep,nvm,nparan*nbyear /)
+     CALL nccheck( NF90_INQ_VARID (Cforcing_permafrost_id,'tprof',vid))
+     CALL nccheck( NF90_VAR_PAR_ACCESS(Cforcing_permafrost_id, vid, NF90_COLLECTIVE))
+     CALL nccheck( NF90_PUT_VAR (Cforcing_permafrost_id,vid, tprof_2pfcforcing ,start=start_4d, count=ncount_4d))
+
+     CALL nccheck( NF90_INQ_VARID (Cforcing_permafrost_id,'fbact',vid))
+     CALL nccheck( NF90_VAR_PAR_ACCESS(Cforcing_permafrost_id, vid, NF90_COLLECTIVE))
+     CALL nccheck( NF90_PUT_VAR (Cforcing_permafrost_id,vid, fbact_2pfcforcing,start=start_4d, count=ncount_4d ))
+
+     CALL nccheck( NF90_INQ_VARID (Cforcing_permafrost_id,'hslong',vid))
+     CALL nccheck( NF90_VAR_PAR_ACCESS(Cforcing_permafrost_id, vid, NF90_COLLECTIVE))
+     CALL nccheck( NF90_PUT_VAR (Cforcing_permafrost_id,vid, hslong_2pfcforcing,start=start_4d, count=ncount_4d ))
+
+     start_3d=(/ start_px,1,1 /)
+     ncount_3d=(/ length_px,nvm,nparan*nbyear /)
+     CALL nccheck( NF90_INQ_VARID (Cforcing_permafrost_id,'veget_max',vid))
+     CALL nccheck( NF90_VAR_PAR_ACCESS(Cforcing_permafrost_id, vid, NF90_COLLECTIVE))
+     CALL nccheck( NF90_PUT_VAR (Cforcing_permafrost_id,vid,veget_max_2pfcforcing, start=start_3d, count=ncount_3d ))
+
+     CALL nccheck( NF90_INQ_VARID (Cforcing_permafrost_id,'rprof',vid))
+     CALL nccheck( NF90_VAR_PAR_ACCESS(Cforcing_permafrost_id, vid, NF90_COLLECTIVE))
+     CALL nccheck( NF90_PUT_VAR (Cforcing_permafrost_id,vid, rprof_2pfcforcing, start=start_3d, count=ncount_3d ))
+
+     ! Finish netcdf file management
+     CALL nccheck( NF90_CLOSE (Cforcing_permafrost_id) )
+
+  END SUBROUTINE stomate_io_carbon_permafrost_write
+  !-
+  !===
+  !-
+  SUBROUTINE stomate_io_carbon_permafrost_read (Cforcing_permafrost_name,   &
+                nparan,             nbyear,     start_px,   length_px,      &
+                soilcarbon_input,   pb,         snow,       tsurf,          & 
+                tprof,              fbact,      hslong,     rprof,          &
+                lalo,               snowdz,     snowrho,    veget_max )
+
+     ! Input Variables
+     CHARACTER(LEN=100), INTENT(in)               :: Cforcing_permafrost_name !! Name of permafrost forcing file
+     INTEGER(i_std), INTENT(in)                   :: start_px ! Start land point/pixex respect to nbp_glo
+     INTEGER(i_std), INTENT(in)                   :: length_px ! Length of lands point/pixel to write
+     INTEGER(i_std), INTENT(in)                   :: nparan, nbyear 
+
+     ! Output variables
+     REAL(r_std), DIMENSION(:,:,:,:), INTENT(out) :: soilcarbon_input
+     REAL(r_std), DIMENSION(:,:), INTENT(out)     :: pb 
+     REAL(r_std), DIMENSION(:,:), INTENT(out)     :: snow
+     REAL(r_std), DIMENSION(:,:), INTENT(out)     :: tsurf
+     REAL(r_std), DIMENSION(:,:,:,:), INTENT(out) :: tprof
+     REAL(r_std), DIMENSION(:,:,:,:), INTENT(out) :: fbact 
+     REAL(r_std), DIMENSION(:,:,:,:), INTENT(out) :: hslong
+     REAL(r_std), DIMENSION(:,:,:), INTENT(out)   :: rprof
+     REAL(r_std), DIMENSION(:,:), INTENT(out)     :: lalo
+     REAL(r_std), DIMENSION(:,:,:), INTENT(out)   :: snowdz
+     REAL(r_std), DIMENSION(:,:,:), INTENT(out)   :: snowrho 
+     REAL(r_std), DIMENSION(:,:,:), INTENT(out)   :: veget_max 
+
+     ! Local Variables
+     INTEGER(i_std)                               :: start_2d(2), count_2d(2) 
+     INTEGER(i_std)                               :: start_4d(4), count_4d(4), start_3d(3), count_3d(3)
+     INTEGER(i_std)                               :: v_id                      !! Variable identifer of netCDF (unitless)
+     INTEGER(i_std)                               :: Cforcing_permafrost_id   !! Permafrost file identifer 
+     !-
+     ! Open FORCESOIL's forcing file to read some basic info (dimensions, variable ID's)
+     ! and allocate variables.
+     !-
+#ifdef CPP_PARA
+     CALL nccheck( NF90_OPEN (TRIM(Cforcing_permafrost_name),IOR(NF90_NOWRITE, NF90_MPIIO),Cforcing_permafrost_id, &
+                 & comm = MPI_COMM_ORCH, info = MPI_INFO_NULL ))
+#else
+     CALL nccheck( NF90_OPEN (TRIM(Cforcing_permafrost_name),NF90_NOWRITE,Cforcing_permafrost_id))
+#endif
+    
+     start_4d = (/ start_px, 1, 1, 1 /)
+     count_4d = (/ length_px, ncarb, nvm, nparan*nbyear /)
+     CALL nccheck( NF90_INQ_VARID (Cforcing_permafrost_id,'soilcarbon_input',v_id))
+     CALL nccheck( NF90_GET_VAR   (Cforcing_permafrost_id,v_id,soilcarbon_input,  &
+                    &  start = start_4d, count = count_4d ))
+
+     start_2d=(/ start_px, 1 /)
+     count_2d=(/ length_px, nparan*nbyear /)
+     CALL nccheck( NF90_INQ_VARID (Cforcing_permafrost_id,'pb',v_id ))
+     CALL nccheck( NF90_GET_VAR (Cforcing_permafrost_id,v_id,pb, &
+                & start=start_2d, count=count_2d))
+
+     CALL nccheck( NF90_INQ_VARID (Cforcing_permafrost_id,'snow',v_id))
+     CALL nccheck( NF90_GET_VAR (Cforcing_permafrost_id,v_id,snow, &
+                & start=start_2d, count=count_2d))
+
+     CALL nccheck( NF90_INQ_VARID (Cforcing_permafrost_id,'tsurf',v_id))
+     CALL nccheck( NF90_GET_VAR (Cforcing_permafrost_id,v_id,tsurf, &
+                & start=start_2d, count=count_2d))
+
+     start_4d=(/ start_px,1,1,1 /)
+     count_4d=(/ length_px,ndeep,nvm,nparan*nbyear /)
+     CALL nccheck( NF90_INQ_VARID (Cforcing_permafrost_id,'tprof',v_id))
+     CALL nccheck( NF90_GET_VAR (Cforcing_permafrost_id,v_id,tprof, &
+                & start=start_4d, count=count_4d))
+
+     CALL nccheck( NF90_INQ_VARID (Cforcing_permafrost_id,'fbact',v_id))
+     CALL nccheck( NF90_GET_VAR (Cforcing_permafrost_id,v_id,fbact, &
+                & start=start_4d, count=count_4d))
+
+     CALL nccheck( NF90_INQ_VARID (Cforcing_permafrost_id,'hslong',v_id))
+     CALL nccheck( NF90_GET_VAR (Cforcing_permafrost_id,v_id,hslong, &
+                & start=start_4d, count=count_4d))
+
+     start_3d=(/ start_px,1,1 /)
+     count_3d=(/ length_px,nvm,nparan*nbyear /)
+     CALL nccheck( NF90_INQ_VARID (Cforcing_permafrost_id,'veget_max',v_id))
+     CALL nccheck( NF90_GET_VAR (Cforcing_permafrost_id,v_id,veget_max, &
+                & start=start_3d, count=count_3d))
+
+     CALL nccheck( NF90_INQ_VARID (Cforcing_permafrost_id,'rprof',v_id))
+     CALL nccheck( NF90_GET_VAR (Cforcing_permafrost_id,v_id,rprof, &
+                & start=start_3d, count=count_3d))
+
+     start_2d=(/ start_px, 1 /)
+     count_2d=(/ length_px, 2 /)
+     CALL nccheck( NF90_INQ_VARID (Cforcing_permafrost_id,'lalo',v_id))
+     CALL nccheck( NF90_GET_VAR (Cforcing_permafrost_id,v_id,lalo, &
+                & start=start_2d, count=count_2d))
+
+     start_3d=(/ start_px,1,1 /)
+     count_3d=(/ length_px,nsnow,nparan*nbyear /)
+     CALL nccheck( NF90_INQ_VARID (Cforcing_permafrost_id,'snowdz',v_id))
+     CALL nccheck( NF90_GET_VAR (Cforcing_permafrost_id,v_id,snowdz, &
+                & start=start_3d, count=count_3d))
+
+     CALL nccheck( NF90_INQ_VARID (Cforcing_permafrost_id,'snowrho',v_id))
+     CALL nccheck( NF90_GET_VAR (Cforcing_permafrost_id,v_id,snowrho, &
+                & start=start_3d, count=count_3d))
+     !- Close Netcdf carbon permafrost file reference
+     CALL nccheck( NF90_CLOSE (Cforcing_permafrost_id))
+
+  END SUBROUTINE stomate_io_carbon_permafrost_read
+
+END MODULE stomate_io_carbon_permafrost
Index: /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_stomate/stomate_lai.f90
===================================================================
--- /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_stomate/stomate_lai.f90	(revision 6940)
+++ /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_stomate/stomate_lai.f90	(revision 6940)
@@ -0,0 +1,91 @@
+! =================================================================================================================================
+! MODULE       : stomate_lai 
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+!                This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF       Calculate lai 
+!!
+!! \n DESCRIPTION : Calculate lai 
+!!
+!! REFERENCE(S) :
+!!
+!! SVN          :
+!! $HeadURL: svn://forge.ipsl.jussieu.fr/orchidee/branches/ORCHIDEE-MICT/ORCHIDEE/src_stomate/lpj_crown.f90 $
+!! $Date: 2015-11-16 14:26:03 +0100 (Mon, 16 Nov 2015) $
+!! $Revision: 3026 $
+!! \n
+!_ ================================================================================================================================
+
+MODULE stomate_lai 
+
+!  USE ioipsl_para
+!  USE stomate_data
+!  USE constantes
+  USE constantes_var
+!  USE pft_parameters
+  
+  IMPLICIT NONE
+  
+  ! private & public routines
+
+  PRIVATE
+  PUBLIC setlai 
+  
+CONTAINS
+  
+!! ================================================================================================================================
+!! SUBROUTINE 	: setlai
+!!
+!>\BRIEF        Routine to force the lai in STOMATE. The code in this routine
+!! simply CALCULATES lai and is therefore not functional. The routine should be 
+!! rewritten if one wants to force lai.
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): ::lai
+!!
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART : None
+!! \n
+!_ ================================================================================================================================
+  
+  SUBROUTINE setlai(biomass,sla_calc,lai)
+
+  !! 0 Variable and parameter declaration 
+  
+    !! 0.1 Input variables
+
+    REAL(r_std),DIMENSION(:,:,:,:),INTENT(in)    :: biomass !! biomass 
+    REAL(r_std),DIMENSION(:,:),INTENT(in)        :: sla_calc !!  sla_calc
+    
+    !! 0.2 Output variables
+
+    REAL(r_std),DIMENSION(:,:),INTENT(out)  :: lai  !! PFT leaf area index @tex $(m^{2} m^{-2})$ @endtex
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                               :: j    !! index (unitless)
+!_ ================================================================================================================================
+    
+    !! 1. Set lai for bare soil to zero
+
+    lai(:,ibare_sechiba) = zero
+
+    !! 2. Multiply foliage biomass by sla to calculate lai for all PFTs and pixels
+
+    DO j=2,SIZE(biomass,DIM=2)
+       lai(:,j) = biomass(:,j,ileaf,icarbon)*sla_calc(:,j)
+    ENDDO
+    
+  END SUBROUTINE setlai
+
+
+END MODULE stomate_lai 
Index: /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_stomate/stomate_permafrost_soilcarbon.f90
===================================================================
--- /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_stomate/stomate_permafrost_soilcarbon.f90	(revision 6940)
+++ /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_stomate/stomate_permafrost_soilcarbon.f90	(revision 6940)
@@ -0,0 +1,4277 @@
+! =================================================================================================================================
+! MODULE       : stomate_permafrost_soilcarbon
+!
+! CONTACT      : orchidee-help _at_ ipsl.jussieu.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see
+! ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF       Calculate permafrost soil carbon dynamics following POPCRAN by Dmitry Khvorstyanov
+!!      
+!!\n DESCRIPTION: None
+!!
+!! RECENT CHANGE(S): None
+!!
+!! SVN          :
+!! $HeadURL:
+!svn://forge.ipsl.jussieu.fr/orchidee/branches/ORCHIDEE-MICT/ORCHIDEE/src_stomate/stomate_soilcarbon.f90
+!$ 
+!! $Date: 2013-10-14 15:38:24 +0200 (Mon, 14 Oct 2013) $
+!! $Revision: 1536 $
+!! \n
+!_
+!================================================================================================================================
+
+MODULE stomate_permafrost_soilcarbon
+  
+  ! modules used:
+  USE ioipsl_para  
+  USE constantes_soil_var
+  USE constantes_soil
+  USE constantes_var
+  USE pft_parameters
+  USE stomate_data
+  USE grid
+  USE mod_orchidee_para
+  USE xios_orchidee
+
+  IMPLICIT NONE
+  PRIVATE
+  PUBLIC deep_carbcycle,permafrost_carbon_clear, microactem
+  
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)         :: zf_soil        !! depths of full levels (m)
+  !$OMP THREADPRIVATE(zf_soil)
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:)         :: zi_soil        !! depths of intermediate levels (m)
+  !$OMP THREADPRIVATE(zi_soil)
+  REAL(r_std), SAVE                                    :: mu_soil
+  !$OMP THREADPRIVATE(mu_soil)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:)     :: alphaO2_soil
+  !$OMP THREADPRIVATE(alphaO2_soil)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:)     :: betaO2_soil
+  !$OMP THREADPRIVATE(betaO2_soil)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:)     :: alphaCH4_soil
+  !$OMP THREADPRIVATE(alphaCH4_soil)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:)     :: betaCH4_soil
+  !$OMP THREADPRIVATE(betaCH4_soil)
+  
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:) 	:: heights_snow      !! total thickness of snow levels (m)
+  !$OMP THREADPRIVATE(heights_snow)
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:,:)     	:: zf_snow           !! depths of full levels (m)
+  !$OMP THREADPRIVATE(zf_snow)
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:,:)     	:: zi_snow           !! depths of intermediate levels (m)
+  !$OMP THREADPRIVATE(zi_snow)
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:)     	:: zf_snow_nopftdim  !! depths of full levels (m)
+  !$OMP THREADPRIVATE(zf_snow_nopftdim)
+  REAL(r_std), SAVE, ALLOCATABLE, DIMENSION(:,:)     	:: zi_snow_nopftdim  !! depths of intermediate levels (m)
+  !$OMP THREADPRIVATE(zi_snow_nopftdim)
+
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:)  :: zf_coeff_snow
+  !$OMP THREADPRIVATE(zf_coeff_snow)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:)  :: zi_coeff_snow
+  !$OMP THREADPRIVATE(zi_coeff_snow)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:)    :: mu_snow
+  !$OMP THREADPRIVATE(mu_snow)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:)  :: alphaO2_snow
+  !$OMP THREADPRIVATE(alphaO2_snow)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:)  :: betaO2_snow
+  !$OMP THREADPRIVATE(betaO2_snow)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:)  :: alphaCH4_snow
+  !$OMP THREADPRIVATE(alphaCH4_snow)
+  REAL(r_std), ALLOCATABLE, SAVE, DIMENSION(:,:,:)  :: betaCH4_snow
+  !$OMP THREADPRIVATE(betaCH4_snow)
+
+  real(r_std), allocatable, save, dimension(:,:,:)  :: deepC_pftmean        !! Deep soil carbon profiles, mean over all PFTs
+  !$OMP THREADPRIVATE(deepC_pftmean)
+  
+  INTEGER(i_std), SAVE                              :: yr_len = 360
+  !$OMP THREADPRIVATE(yr_len)
+  !! Arrays related to cryoturbation processes
+  REAL(r_std), DIMENSION(:,:,:), ALLOCATABLE, SAVE  :: diff_k        !! Diffusion constant (m^2/s)
+  !$OMP THREADPRIVATE(diff_k)
+  REAL(r_std), DIMENSION(:,:), ALLOCATABLE, SAVE    :: xe_a
+  !$OMP THREADPRIVATE(xe_a)
+  REAL(r_std), DIMENSION(:,:), ALLOCATABLE, SAVE    :: xe_s
+  !$OMP THREADPRIVATE(xe_s)
+  REAL(r_std), DIMENSION(:,:), ALLOCATABLE, SAVE    :: xe_p 
+  !$OMP THREADPRIVATE(xe_p)
+  REAL(r_std), DIMENSION(:,:,:), ALLOCATABLE, SAVE  :: xc_cryoturb
+  !$OMP THREADPRIVATE(xc_cryoturb)
+  REAL(r_std), DIMENSION(:,:,:), ALLOCATABLE, SAVE  :: xd_cryoturb
+  !$OMP THREADPRIVATE(xd_cryoturb)
+  REAL(r_std), DIMENSION(:,:,:), ALLOCATABLE, SAVE  :: alpha_a
+  !$OMP THREADPRIVATE(alpha_a)
+  REAL(r_std), DIMENSION(:,:,:), ALLOCATABLE, SAVE  :: alpha_s
+  !$OMP THREADPRIVATE(alpha_s)
+  REAL(r_std), DIMENSION(:,:,:), ALLOCATABLE, SAVE  :: alpha_p
+  !$OMP THREADPRIVATE(alpha_p)
+  REAL(r_std), DIMENSION(:,:),   ALLOCATABLE, SAVE  :: mu_soil_rev
+  !$OMP THREADPRIVATE(mu_soil_rev)
+
+  REAL(r_std), DIMENSION(:,:,:), ALLOCATABLE, SAVE  :: beta_a
+  !$OMP THREADPRIVATE(beta_a)
+  REAL(r_std), DIMENSION(:,:,:), ALLOCATABLE, SAVE  :: beta_s
+  !$OMP THREADPRIVATE(beta_s)
+  REAL(r_std), DIMENSION(:,:,:), ALLOCATABLE, SAVE  :: beta_p
+  !$OMP THREADPRIVATE(beta_p)
+  LOGICAL, DIMENSION(:,:), ALLOCATABLE, SAVE        :: cryoturb_location
+  !$OMP THREADPRIVATE(cryoturb_location)
+  LOGICAL, DIMENSION(:,:), ALLOCATABLE, SAVE        :: bioturb_location
+  !$OMP THREADPRIVATE(bioturb_location)
+  REAL(r_std), DIMENSION(:,:,:), ALLOCATABLE, SAVE      :: airvol_soil
+  !$OMP THREADPRIVATE(airvol_soil)
+  REAL(r_std), DIMENSION(:,:,:), ALLOCATABLE, SAVE      :: totporO2_soil              !! total oxygen porosity in the soil
+  !$OMP THREADPRIVATE(totporO2_soil)
+  REAL(r_std), DIMENSION(:,:,:), ALLOCATABLE, SAVE      :: totporCH4_soil             !! total methane porosity in the soil
+  !$OMP THREADPRIVATE(totporCH4_soil)
+  REAL(r_std), DIMENSION(:,:,:), ALLOCATABLE, SAVE      :: conduct_soil
+  !$OMP THREADPRIVATE(conduct_soil)
+  REAL(r_std), DIMENSION(:,:,:), ALLOCATABLE, SAVE      :: diffO2_soil                !! oxygen diffusivity in the soil (m**2/s)
+  !$OMP THREADPRIVATE(diffO2_soil)
+  REAL(r_std), DIMENSION(:,:,:), ALLOCATABLE, SAVE      :: diffCH4_soil               !! methane diffusivity in the soil (m**2/s)
+  !$OMP THREADPRIVATE(diffCH4_soil)
+  REAL(r_std), DIMENSION(:,:,:),ALLOCATABLE, SAVE       :: airvol_snow
+  !$OMP THREADPRIVATE(airvol_snow)
+  REAL(r_std), DIMENSION(:,:,:),ALLOCATABLE, SAVE       :: totporO2_snow              !! total oxygen porosity in the snow 
+  !$OMP THREADPRIVATE(totporO2_snow)
+  REAL(r_std), DIMENSION(:,:,:),ALLOCATABLE, SAVE       :: totporCH4_snow             !! total methane porosity in the snow
+  !$OMP THREADPRIVATE(totporCH4_snow)
+  REAL(r_std), DIMENSION(:,:,:),ALLOCATABLE, SAVE       :: conduct_snow
+  !$OMP THREADPRIVATE(conduct_snow)
+  REAL(r_std), DIMENSION(:,:,:), ALLOCATABLE, SAVE      :: diffCH4_snow               !! methane diffusivity in the snow (m**2/s)
+  !$OMP THREADPRIVATE(diffCH4_snow)
+  REAL(r_std), DIMENSION(:,:,:), ALLOCATABLE, SAVE      :: diffO2_snow                !! oxygen diffusivity in the snow (m**2/s)
+  !$OMP THREADPRIVATE(diffO2_snow)
+  REAL(r_std), DIMENSION(:,:), ALLOCATABLE, SAVE        :: altmax_lastyear            !! active layer thickness  
+  !$OMP THREADPRIVATE(altmax_lastyear)
+  REAL(r_std), DIMENSION(:,:), ALLOCATABLE, SAVE        :: alt
+  !$OMP THREADPRIVATE(alt)
+  INTEGER(i_std), DIMENSION(:,:), ALLOCATABLE, SAVE     :: alt_ind !! active layer thickness  
+  !$OMP THREADPRIVATE(alt_ind)
+  INTEGER(i_std), DIMENSION(:,:),ALLOCATABLE, SAVE      :: altmax_ind !! Maximum over the year active layer thickness
+  !$OMP THREADPRIVATE(altmax_ind)
+  INTEGER(i_std), DIMENSION(:,:),ALLOCATABLE, SAVE      :: altmax_ind_lastyear
+  !$OMP THREADPRIVATE(altmax_ind_lastyear)
+  REAL(r_std), DIMENSION(:,:),ALLOCATABLE, SAVE         :: z_root !! Rooting depth
+  !$OMP THREADPRIVATE(z_root)
+  INTEGER(i_std), DIMENSION(:,:),ALLOCATABLE, SAVE      :: rootlev !! The deepest model level within the rooting depth
+  !$OMP THREADPRIVATE(rootlev)
+  REAL(r_std),DIMENSION(:,:),ALLOCATABLE, SAVE          :: lalo_global        !! Geogr. coordinates (latitude,longitude) (degrees)
+  !$OMP THREADPRIVATE(lalo_global)
+  LOGICAL,DIMENSION(:,:),ALLOCATABLE,  SAVE             :: veget_mask_2d      !! whether there is vegetation 
+  !$OMP THREADPRIVATE(veget_mask_2d)
+  REAL(r_std), PARAMETER                        :: fslow = 37 !16.66667! 36.7785   !  37. Dmitry original   ! facteurs de vitesse pour reservoirs slow et passif
+  REAL(r_std), PARAMETER                        :: fpassive = 1617.45 !2372 represents 2000 years for passive at reference of 5 degrees!1617.45 !666.667 !1617.45 !1600. Dmitry original
+
+  REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:,:), SAVE    :: fc   !! flux fractions within carbon pools
+  !$OMP THREADPRIVATE(fc)
+  REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:), SAVE      :: fr   !! fraction of decomposed carbon that goes into the atmosphere
+  !$OMP THREADPRIVATE(fr)
+CONTAINS
+
+!!
+!================================================================================================================================
+!! SUBROUTINE     : deep_carbcycle
+!!
+!>\BRIEF          Recalculate vegetation cover and LAI
+!!
+!!\n DESCRIPTION : 
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): None 
+!!
+!! REFERENCE(S)   : None
+!! 
+!! FLOWCHART :
+!_
+!================================================================================================================================
+
+  SUBROUTINE deep_carbcycle(kjpindex, index, itau, time_step, lalo, clay, &
+       tsurf, tprof, hslong_in, snow, heat_Zimov, pb, &  
+       sfluxCH4_deep, sfluxCO2_deep, &
+       deepC_a, deepC_s, deepC_p, O2_soil, CH4_soil, O2_snow, CH4_snow, &
+       zz_deep, zz_coef_deep, z_organic, soilc_in, veget_max, &
+       rprof, altmax, carbon, carbon_surf, resp_hetero_soil, fbact, fixed_cryoturbation_depth, &
+       snowdz,snowrho)
+
+!! 0. Variable and parameter declaration    
+
+    !! 0.1 Input variables
+    INTEGER(i_std), INTENT(in)                            :: kjpindex
+    REAL(r_std), INTENT(in)                               :: time_step         !! time step in seconds
+    INTEGER(i_std), intent(in)                            :: itau              !! time step number
+    REAL(r_std),DIMENSION(kjpindex,2),INTENT(in)          :: lalo              !! Geogr. coordinates (latitude,longitude) (degrees)
+    REAL(r_std), DIMENSION(kjpindex), INTENT(in)          :: pb                !! surface pressure [pa]
+    REAL(r_std), DIMENSION(kjpindex), INTENT(in)          :: clay              !! clay content
+    INTEGER(i_std),DIMENSION(kjpindex),INTENT(in)         :: index             !! Indeces of the points on the map
+    REAL(r_std), DIMENSION(kjpindex), INTENT (in)         :: snow              !! Snow mass [Kg/m^2]
+    REAL(r_std), DIMENSION(kjpindex,nsnow), INTENT(in)    :: snowdz            !! Snow depth [m]
+    REAL(r_std), DIMENSION(kjpindex,nsnow), INTENT(in)    :: snowrho           !! snow density   
+    REAL(r_std), DIMENSION(ndeep),   INTENT (in)          :: zz_deep           !! deep vertical profile
+    REAL(r_std), DIMENSION(ndeep),   INTENT (in)          :: zz_coef_deep      !! deep vertical profile
+    REAL(r_std), DIMENSION(kjpindex),   INTENT (inout)    :: z_organic         !! depth to organic soil
+    REAL(r_std), DIMENSION(kjpindex,ndeep,nvm),INTENT (in):: tprof             !! deep temperature profile
+    REAL(r_std), DIMENSION(kjpindex,ndeep,nvm),INTENT (in):: hslong_in         !! deep long term soil humidity profile
+    REAL(r_std), DIMENSION(kjpindex,ncarb,nvm),INTENT(in) :: soilc_in          !! carbon going into carbon pools  [gC/(m**2 of ground)/day]
+    REAL(r_std), DIMENSION(kjpindex,nvm),INTENT(in)       :: veget_max         !! Maximum vegetation fraction
+    REAL(r_std), DIMENSION (kjpindex,nvm)                 :: veget_max_bg 
+    REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(in)      :: rprof             !! rooting depth (m)
+    REAL(r_std), DIMENSION(kjpindex), INTENT(in)          :: tsurf             !! skin temperature  [K]
+    REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(in):: fbact
+   
+    !! 0.2 Output variables
+    REAL(r_std), DIMENSION(kjpindex), INTENT(out)             :: sfluxCH4_deep              !! total CH4 flux [g CH4 / m**2 / s]
+    REAL(r_std), DIMENSION(kjpindex), INTENT(out)             :: sfluxCO2_deep              !! total CO2 flux [g C / m**2 / s]
+    REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(out)         :: resp_hetero_soil           !! soil heterotrophic respiration (first in gC/day/m**2 of ground )
+    REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT (out)  :: heat_Zimov                 !! Heating associated with decomposition  [W/m**3 soil]
+    REAL(r_std), DIMENSION(kjpindex,ncarb,nvm), INTENT (out)  :: carbon                     !! vertically-integrated (diagnostic) soil carbon pool: active, slow, or passive, (gC/(m**2 of ground))
+    REAL(r_std), DIMENSION(kjpindex,ncarb,nvm), INTENT (out)  :: carbon_surf                !! vertically-integrated (diagnostic) soil carbon pool: active, slow, or passive, (gC/(m**2 of ground))
+
+    !! 0.3 Modified variables
+    REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(inout) :: deepC_a                    !! Active soil carbon (g/m**3)
+    REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(inout) :: deepC_s                    !! Slow soil carbon (g/m**3) 
+    REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(inout) :: deepC_p                    !! Passive soil carbon (g/m**3)
+    REAL(r_std), DIMENSION(kjpindex,nsnow,nvm), INTENT(inout) :: O2_snow                    !! oxygen in the snow (g O2/m**3 air)
+    REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(inout) :: O2_soil                    !! oxygen in the soil (g O2/m**3 air)
+    REAL(r_std), DIMENSION(kjpindex,nsnow,nvm), INTENT(inout) :: CH4_snow                   !! methane in the snow (g CH4/m**3 air)
+    REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(inout) :: CH4_soil                   !! methane in the soil (g CH4/m**3 air)
+    REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(inout)       :: altmax                     !! active layer thickness (m)
+    REAL(r_std), DIMENSION(kjpindex,nvm),INTENT(inout)        :: fixed_cryoturbation_depth  !! depth to hold cryoturbation to for fixed runs
+
+    !! 0.4 Local variables
+
+    REAL(r_std), DIMENSION(kjpindex)                  :: overburden
+    REAL(r_std), DIMENSION(kjpindex,nvm)              :: fluxCH4,febul
+    REAL(r_std), DIMENSION(kjpindex,nvm)              :: sfluxCH4    
+    REAL(r_std), DIMENSION(kjpindex,nvm)              :: flupmt
+    REAL(r_std), DIMENSION(kjpindex,nvm)              :: MT                                 !! depth-integrated methane consumed in methanotrophy
+    REAL(r_std), DIMENSION(kjpindex,nvm)              :: MG                                 !! depth-integrated methane released in methanogenesis
+    REAL(r_std), DIMENSION(kjpindex,nvm)              :: CH4i                               !! depth-integrated methane
+    REAL(r_std), DIMENSION(kjpindex,nvm)              :: CH4ii                              !! depth-integrated initial methane
+    REAL(r_std), DIMENSION(kjpindex,nvm)              :: dC1i                               !! depth-integrated oxic decomposition carbon
+    REAL(r_std), DIMENSION(kjpindex,nvm)              :: dCi                                !! depth-integrated soil carbon
+
+    REAL(r_std), DIMENSION(kjpindex,nvm)              :: Tref                               !! Ref. temperature for growing season caluculation (C)	
+    REAL(r_std), DIMENSION(kjpindex,ndeep,nvm)        :: deltaCH4g, deltaCH4
+    REAL(r_std), DIMENSION(kjpindex,ndeep,nvm)        :: deltaC1_a,deltaC1_s,deltaC1_p,deltaC2,deltaC3
+    REAL(r_std), DIMENSION(kjpindex,ncarb,ndeep,nvm)  :: dc_litter_z
+    REAL(r_std), DIMENSION(kjpindex,ndeep,nvm)        :: CH4ini_soil
+    REAL(r_std), DIMENSION(kjpindex,ndeep,nvm)        :: hslong                             !! deep long term soil humidity profile
+    INTEGER(i_std)                   :: ip, il, itz, iz
+    REAL(r_std), SAVE, DIMENSION(3)  :: lhc                       !! specific heat of soil organic matter oxidation (J/kg carbon)
+  !$OMP THREADPRIVATE(lhc)
+    REAL(r_std), SAVE                :: O2m                       !! oxygen concentration [g/m3] below which there is anoxy 
+  !$OMP THREADPRIVATE(O2m)
+    LOGICAL, SAVE                    :: ok_methane                !! Is Methanogenesis and -trophy taken into account?
+  !$OMP THREADPRIVATE(ok_methane)
+    LOGICAL, SAVE                    :: ok_cryoturb               !! cryoturbate the carbon?
+  !$OMP THREADPRIVATE(ok_cryoturb)
+    REAL(r_std), SAVE                :: cryoturbation_diff_k_in   !! input time constant of cryoturbation (m^2/y)
+  !$OMP THREADPRIVATE(cryoturbation_diff_k_in)
+    REAL(r_std), SAVE                :: bioturbation_diff_k_in    !! input time constant of bioturbation (m^2/y)
+  !$OMP THREADPRIVATE(bioturbation_diff_k_in)
+    REAL(r_std), SAVE                :: tau_CH4troph              !! time constant of methanetrophy (s)
+  !$OMP THREADPRIVATE(tau_CH4troph)
+    REAL(r_std), SAVE                :: fbactratio                !! time constant of methanogenesis (ratio to that of oxic)
+  !$OMP THREADPRIVATE(fbactratio)
+    LOGICAL, SAVE                    :: firstcall = .TRUE.        !! first call?
+  !$OMP THREADPRIVATE(firstcall)
+    REAL(r_std), SAVE, DIMENSION(2)  :: lhCH4                     !! specific heat of methane transformation  (J/kg) (/ 3.1E6, 9.4E6 /)
+  !$OMP THREADPRIVATE(lhCH4)
+    LOGICAL, SAVE                    :: oxlim                     !! O2 limitation taken into account
+  !$OMP THREADPRIVATE(oxlim)
+    LOGICAL, SAVE                    :: no_pfrost_decomp = .FALSE.!! Whether this is a spinup run
+  !$OMP THREADPRIVATE(no_pfrost_decomp)
+    REAL(r_std), PARAMETER           :: refdep = 0.20_r_std       !! Depth to compute reference temperature for the growing season (m). WH2000 use 0.50
+    REAL(r_std), PARAMETER           :: Tgr  = 5.                 !! Temperature when plant growing starts and this becomes constant
+    INTEGER(i_std)                   :: month,year,dayno          !! current time parameters
+    REAL(r_std)                      :: scnd
+    REAL(r_std)                      :: organic_layer_thickness
+    INTEGER(i_std)                   :: ier, iv, m, jv
+    CHARACTER(80)                    :: yedoma_map_filename
+    REAL(r_std)                      :: yedoma_depth, yedoma_cinit_act, yedoma_cinit_slo, yedoma_cinit_pas
+    LOGICAL                          :: reset_yedoma_carbon
+    LOGICAL, SAVE                    :: MG_useallCpools = .true.  !! Do we allow all three C pools to feed methanogenesis?
+  !$OMP THREADPRIVATE(MG_useallCpools)
+    CHARACTER(LEN=10)                :: part_str                  !! string suffix indicating an index
+    REAL(r_std), SAVE                :: max_shum_value = 1.0      !! maximum saturation degree on the thermal axes
+  !$OMP THREADPRIVATE(max_shum_value)
+    REAL(r_std), DIMENSION(kjpindex) :: alt_pftmean, altmax_pftmean, tsurf_pftmean
+
+    IF (printlev>=3) WRITE(*,*) 'Entering  deep_carbcycle'
+    
+    !! 0. first call 
+    IF ( firstcall ) THEN                
+       
+       overburden(:)=1.
+       !
+       !Config Key   = organic_layer_thickness
+       !Config Desc  = The thickness of organic layer
+       !Config Def   = n
+       !Config If    = OK_PC
+       !Config Help  = This parameters allows the user to prescibe the organic
+       !Config         layer thickness 
+       !Config Units = [-]
+       !
+       organic_layer_thickness = 0.
+       CALL getin_p('organic_layer_thickness', organic_layer_thickness)
+       z_organic(:) = overburden(:)*organic_layer_thickness
+
+       !
+       !Config Key   = OK_METHANE
+       !Config Desc  = Is Methanogenesis and -trophy taken into account?
+       !Config Def   = n
+       !Config If    = OK_PC
+       !Config Help  = 
+       !Config         
+       !Config Units = [flag]
+       !
+       ok_methane = .FALSE.
+       CALL getin_p('OK_METHANE',ok_methane)
+       !
+       !Config Key   = HEAT_CO2_ACT
+       !Config Desc  = specific heat of soil organic matter oxidation for active carbon (J/kg carbon)
+       !Config Def   = 40.0E6 
+       !Config If    = OK_PC
+       !Config Help  = 
+       !Config         
+       !Config Units = [J/Kg]
+       !
+       lhc(iactive) = 40.0e6
+       CALL getin_p('HEAT_CO2_ACT',lhc(iactive))
+       !
+       !Config Key   = HEAT_CO2_SLO
+       !Config Desc  = specific heat of soil organic matter oxidation for slow
+       !Config         carbon pool (J/kg carbon)
+       !Config Def   = 30.0E6 
+       !Config If    = OK_PC
+       !Config Help  = 
+       !Config         
+       !Config Units = [J/Kg]
+       !
+       lhc(islow) = 30.0E6
+       CALL getin_p('HEAT_CO2_SLO',lhc(islow))
+       !
+       !Config Key   = HEAT_CO2_PAS
+       !Config Desc  = specific heat of soil organic matter oxidation for
+       !Config         passive carbon pool (J/kg carbon)
+       !Config Def   = 10.0E6 
+       !Config If    = OK_PC
+       !Config Help  = 
+       !Config         
+       !Config Units = [J/Kg]
+       !
+       lhc(ipassive) = 10.0e6
+       CALL getin_p('HEAT_CO2_PAS',lhc(ipassive))
+       !
+       !Config Key   = TAU_CH4_TROPH
+       !Config Desc  = time constant of methanetrophy
+       !Config Def   = 432000 
+       !Config If    = OK_PC
+       !Config Help  = 
+       !Config         
+       !Config Units = [s]
+       ! 
+       tau_CH4troph = 432000
+       CALL getin_p('TAU_CH4_TROPH',tau_CH4troph)
+       !
+       !Config Key   = TAU_CH4_GEN_RATIO
+       !Config Desc  = time constant of methanogenesis (ratio to that of oxic)
+       !Config Def   = 9.0 
+       !Config If    = OK_PC
+       !Config Help  = 
+       !Config         
+       !Config Units = [-]
+       !  
+       fbactratio = 9.0
+       CALL getin_p('TAU_CH4_GEN_RATIO',fbactratio)
+       !
+       !Config Key   = O2_SEUIL_MGEN
+       !Config Desc  = oxygen concentration below which there is anoxy 
+       !Config Def   = 3.0 
+       !Config If    = OK_PC
+       !Config Help  = 
+       !Config         
+       !Config Units = [g/m3]
+       !  
+       O2m = 3.0
+       CALL getin_p('O2_SEUIL_MGEN',O2m)
+       !
+       !Config Key   = HEAT_CH4_GEN
+       !Config Desc  = specific heat of methanogenesis 
+       !Config Def   = 0 
+       !Config If    = OK_PC
+       !Config Help  = 
+       !Config         
+       !Config Units = [J/kgC]
+       !  
+       lhCH4(1) = 0
+       CALL getin_p('HEAT_CH4_GEN',lhCH4(1))
+       !
+       !Config Key   = HEAT_CH4_TROPH
+       !Config Desc  = specific heat of methanotrophy 
+       !Config Def   = 0 
+       !Config If    = OK_PC
+       !Config Help  = 
+       !Config         
+       !Config Units = [J/kgC]
+       !  
+       lhCH4(2) = 0
+       CALL getin_p('HEAT_CH4_TROPH',lhCH4(2))
+       !
+       !Config Key   = O2_LIMIT
+       !Config Desc  = O2 limitation taken into account
+       !Config Def   = n
+       !Config If    = OK_PC
+       !Config Help  = 
+       !Config         
+       !Config Units = [flag]
+       ! 
+       oxlim=.FALSE. 
+       CALL getin_p('O2_LIMIT',oxlim)
+       !
+       !Config Key   = NO_PFROST_DECOMP
+       !Config Desc  = whether this is spin-up
+       !Config Def   = n 
+       !Config If    = OK_PC
+       !Config Help  = 
+       !Config         
+       !Config Units = [flag]
+       ! 
+       no_pfrost_decomp=.FALSE. 
+       CALL getin_p('NO_PFROST_DECOMP',no_pfrost_decomp)
+       !
+       !Config Key   = cryoturbate
+       !Config Desc  = Do we allow for cyoturbation?
+       !Config Def   = y 
+       !Config If    = OK_PC
+       !Config Help  = 
+       !Config         
+       !Config Units = [flag]
+       ! 
+       ok_cryoturb=.TRUE.
+       CALL getin_p('cryoturbate',ok_cryoturb)
+       !
+       !Config Key   = cryoturbation_diff_k_in
+       !Config Desc  = diffusion constant for cryoturbation 
+       !Config Def   = 0.001 
+       !Config If    = OK_PC
+       !Config Help  = 
+       !Config         
+       !Config Units = [m2/year]
+       !  
+       cryoturbation_diff_k_in = .001
+       CALL getin_p('cryoturbation_diff_k',cryoturbation_diff_k_in)
+       !
+       !Config Key   = bioturbation_diff_k_in
+       !Config Desc  = diffusion constant for bioturbation 
+       !Config Def   = 0.0
+       !Config If    = OK_PC
+       !Config Help  = 
+       !Config         
+       !Config Units = [m2/year]
+       !  
+       bioturbation_diff_k_in = 0.0001
+       CALL getin_p('bioturbation_diff_k',bioturbation_diff_k_in)
+       !
+       !Config Key   = MG_useallCpools
+       !Config Desc  = Do we allow all three C pools to feed methanogenesis?
+       !Config Def   = y 
+       !Config If    = OK_PC
+       !Config Help  = 
+       !Config         
+       !Config Units = [flag]
+       !    
+       MG_useallCpools = .TRUE.
+       CALL getin_p('MG_useallCpools', MG_useallCpools)
+       !
+       !Config Key   = max_shum_value
+       !Config Desc  = maximum saturation degree on the thermal axes
+       !Config Def   = 1 
+       !Config If    = OK_PC
+       !Config Help  = 
+       !Config         
+       !Config Units = [-]
+       !   
+       max_shum_value=1.0 
+       CALL getin_p('max_shum_value',max_shum_value)
+       hslong(:,:,:) = MAX(MIN(hslong_in(:,:,:),max_shum_value),zero)
+       !
+
+       !!  Arrays allocations
+
+       ALLOCATE (veget_mask_2d(kjpindex,nvm),stat=ier)
+       IF (ier.NE.0) THEN
+           WRITE (numout,*) ' error in veget_mask_2d allocation. We stop. We need ',kjpindex,' fois ',nvm,' words = '&
+              & , kjpindex*nvm
+           STOP 'deep_carbcycle'
+       END IF
+
+       ALLOCATE(lalo_global(kjpindex,2),stat=ier)
+       IF (ier.NE.0) THEN
+           WRITE (numout,*) ' error in lalo_global allocation. We stop. We need ',kjpindex,' fois ',2,' words = '&
+              & , kjpindex*2
+           STOP 'deep_carbcycle'
+       END IF
+
+       ALLOCATE (alt(kjpindex,nvm),stat=ier)
+       IF (ier.NE.0) THEN
+           WRITE (numout,*) ' error in alt allocation. We stop. We need ',kjpindex,' fois ',nvm,' words = '&
+              & , kjpindex*nvm
+           STOP 'deep_carbcycle'
+       END IF
+
+       ALLOCATE (altmax_lastyear(kjpindex,nvm),stat=ier)
+       IF (ier.NE.0) THEN
+           WRITE (numout,*) ' error in altmax_lastyear allocation. We stop. We need ',kjpindex,' fois ',nvm,' words = '&
+              & , kjpindex*nvm
+           STOP 'deep_carbcycle'
+       END IF 
+
+       ALLOCATE (alt_ind(kjpindex,nvm),stat=ier)
+       IF (ier.NE.0) THEN
+           WRITE (numout,*) ' error in alt_ind allocation. We stop. We need ',kjpindex,' fois ',nvm,' words = '&
+              & , kjpindex*nvm
+           STOP 'deep_carbcycle'
+       END IF
+
+       ALLOCATE (altmax_ind(kjpindex,nvm),stat=ier)
+       IF (ier.NE.0) THEN
+           WRITE (numout,*) ' error in altmax_ind allocation. We stop. We need',kjpindex,' fois ',nvm,' words = '&
+              & , kjpindex*nvm
+           STOP 'deep_carbcycle'
+       END IF
+
+       ALLOCATE (altmax_ind_lastyear(kjpindex,nvm),stat=ier)
+       IF (ier.NE.0) THEN
+           WRITE (numout,*) ' error in altmax_ind allocation. We stop. We need',kjpindex,' fois ',nvm,' words = '&
+              & , kjpindex*nvm
+           STOP 'deep_carbcycle'
+       END IF
+
+       ALLOCATE (z_root(kjpindex,nvm),stat=ier)
+       IF (ier.NE.0) THEN
+           WRITE (numout,*) ' error in z_root allocation. We stop. We need',kjpindex,' fois ',nvm,' words = '&
+              & , kjpindex*nvm
+           STOP 'deep_carbcycle'
+       END IF
+
+       ALLOCATE (rootlev(kjpindex,nvm),stat=ier)
+       IF (ier.NE.0) THEN
+           WRITE (numout,*) ' error in rootlev allocation. We stop. We need',kjpindex,' fois ',nvm,' words = '&
+              & , kjpindex*nvm
+           STOP 'deep_carbcycle'
+       END IF
+
+       ALLOCATE (heights_snow(kjpindex,nvm),stat=ier)
+       IF (ier.NE.0) THEN
+           WRITE (numout,*) ' error in heights_snow allocation. We stop. We need',kjpindex,' fois ',nvm,' words = '&
+              & , kjpindex*nvm
+           STOP 'deep_carbcycle'
+       END IF
+
+       ALLOCATE (zf_soil(0:ndeep),stat=ier)
+       IF (ier.NE.0) THEN
+           WRITE (numout,*) ' error in zf_soil allocation. We stop. We need',ndeep+1,' words = '&
+              & , ndeep+1
+           STOP 'deep_carbcycle'
+       END IF 
+       
+       ALLOCATE (zi_soil(ndeep),stat=ier)
+       IF (ier.NE.0) THEN
+           WRITE (numout,*) ' error in zi_soil allocation. We stop. We need',ndeep,' words = '&
+              & , ndeep
+           STOP 'deep_carbcycle'
+       END IF 
+
+       ALLOCATE (zf_snow(kjpindex,0:nsnow,nvm),stat=ier)
+       IF (ier.NE.0) THEN
+           WRITE (numout,*) ' error in zf_snow allocation. We stop. We need', kjpindex, ' fois ',nsnow+1, ' fois ',nvm,' words = '&
+              & , kjpindex*(nsnow+1)*nvm
+           STOP 'deep_carbcycle'
+       END IF
+
+       ALLOCATE (zi_snow(kjpindex,nsnow,nvm),stat=ier)
+       IF (ier.NE.0) THEN           
+           WRITE (numout,*) ' error in zi_snow allocation. We stop. We need', kjpindex, ' fois ',nsnow, ' fois ',nvm,' words = '&
+              & , kjpindex*nsnow*nvm
+           STOP 'deep_carbcycle'
+       END IF
+
+       ALLOCATE (zf_snow_nopftdim(kjpindex,0:nsnow),stat=ier)   
+       IF (ier.NE.0) THEN
+           WRITE (numout,*) ' error in zf_snow_nopftdim allocation. We stop. We need', kjpindex, ' fois ',nsnow+1,' words = '&
+              & , kjpindex*(nsnow+1)
+           STOP 'deep_carbcycle'
+       END IF
+       
+       ALLOCATE (zi_snow_nopftdim(kjpindex,nsnow),stat=ier)
+       IF (ier.NE.0) THEN           
+           WRITE (numout,*) ' error in zi_snow_nopftdim allocation. We stop. We need', kjpindex, ' fois ',nsnow,' words = '&
+              & , kjpindex*nsnow
+           STOP 'deep_carbcycle'
+       END IF
+
+       ALLOCATE (airvol_soil(kjpindex,ndeep,nvm),stat=ier)       
+       IF (ier.NE.0) THEN 
+           WRITE (numout,*) ' error in airvol_soil allocation. We stop. We need', kjpindex, ' fois ',ndeep, ' fois ',nvm,' words = '&
+              & , kjpindex*ndeep*nvm
+           STOP 'deep_carbcycle'
+       END IF
+       
+       ALLOCATE (totporO2_soil(kjpindex,ndeep,nvm),stat=ier)
+       IF (ier.NE.0) THEN
+           WRITE (numout,*) ' error in totporO2_soil allocation. We stop. We need', kjpindex, ' fois ',ndeep, ' fois ',nvm,' words = '&
+              & , kjpindex*ndeep*nvm
+           STOP 'deep_carbcycle'
+       END IF
+
+       ALLOCATE (totporCH4_soil(kjpindex,ndeep,nvm),stat=ier)
+       IF (ier.NE.0) THEN
+           WRITE (numout,*) ' error in totporCH4_soil allocation. We stop. We need', kjpindex, ' fois ',ndeep, ' fois ',nvm,' words = '&
+              & , kjpindex*ndeep*nvm
+           STOP 'deep_carbcycle'
+       END IF
+
+       ALLOCATE (conduct_soil(kjpindex,ndeep,nvm),stat=ier)
+       IF (ier.NE.0) THEN
+           WRITE (numout,*) ' error in conduct_soil allocation. We stop. We need', kjpindex, ' fois ',ndeep, ' fois ',nvm,' words = '&
+              & , kjpindex*ndeep*nvm
+           STOP 'deep_carbcycle'
+       END IF
+
+       ALLOCATE (diffO2_soil(kjpindex,ndeep,nvm),stat=ier)
+       IF (ier.NE.0) THEN
+           WRITE (numout,*) ' error in diffO2_soil allocation. We stop. We need', kjpindex, ' fois ',ndeep, ' fois ',nvm,' words = '&
+              & , kjpindex*ndeep*nvm
+           STOP 'deep_carbcycle'
+       END IF
+
+       ALLOCATE (diffCH4_soil(kjpindex,ndeep,nvm),stat=ier)
+       IF (ier.NE.0) THEN
+           WRITE (numout,*) ' error in diffCH4_soil allocation. We stop. We need', kjpindex, ' fois ',ndeep, ' fois ',nvm,' words = '&
+              & , kjpindex*ndeep*nvm
+           STOP 'deep_carbcycle'
+       END IF
+
+       ALLOCATE (airvol_snow(kjpindex,nsnow,nvm),stat=ier)
+       IF (ier.NE.0) THEN
+           WRITE (numout,*) ' error in airvol_snow allocation. We stop. We need', kjpindex, ' fois ',nsnow, ' fois ',nvm,' words = '&
+              & , kjpindex*nsnow*nvm
+           STOP 'deep_carbcycle'
+       END IF
+
+       ALLOCATE (totporO2_snow(kjpindex,nsnow,nvm),stat=ier)
+       IF (ier.NE.0) THEN
+           WRITE (numout,*) ' error in totporO2_snow allocation. We stop. We need', kjpindex, ' fois ',nsnow, ' fois ',nvm,' words = '&
+              & , kjpindex*nsnow*nvm
+           STOP 'deep_carbcycle'
+       END IF
+
+       ALLOCATE (totporCH4_snow(kjpindex,nsnow,nvm),stat=ier)
+       IF (ier.NE.0) THEN
+           WRITE (numout,*) ' error in totporCH4_snow allocation. We stop. We need', kjpindex, ' fois ',nsnow, ' fois ',nvm,' words = '&
+              & , kjpindex*nsnow*nvm
+           STOP 'deep_carbcycle'
+       END IF
+
+       ALLOCATE (conduct_snow(kjpindex,nsnow,nvm),stat=ier)
+       IF (ier.NE.0) THEN
+           WRITE (numout,*) ' error in conduct_snow allocation. We stop. We need', kjpindex, ' fois ',nsnow, ' fois ',nvm,' words = '&
+              & , kjpindex*nsnow*nvm
+           STOP 'deep_carbcycle'
+       END IF
+
+       ALLOCATE (diffO2_snow(kjpindex,nsnow,nvm),stat=ier)
+       IF (ier.NE.0) THEN
+           WRITE (numout,*) ' error in diffO2_snow allocation. We stop. We need', kjpindex, ' fois ',nsnow, ' fois ',nvm,' words = '&
+              & , kjpindex*nsnow*nvm
+           STOP 'deep_carbcycle'
+       END IF
+
+       ALLOCATE (diffCH4_snow(kjpindex,nsnow,nvm),stat=ier)
+       IF (ier.NE.0) THEN
+           WRITE (numout,*) ' error in diffCH4_snow allocation. We stop. We need', kjpindex, ' fois ',nsnow, ' fois ',nvm,' words = '&
+              & , kjpindex*nsnow*nvm
+           STOP 'deep_carbcycle'
+       END IF
+
+       ALLOCATE (deepc_pftmean(kjpindex,ndeep,ncarb),stat=ier)
+       IF (ier.NE.0) THEN
+           WRITE (numout,*) ' error in deepc_pftmean allocation. We stop. We need', kjpindex, ' fois ',ndeep, ' fois ',ncarb,' words = '&
+              & , kjpindex*ndeep*ncarb
+           STOP 'deep_carbcycle'
+       END IF
+
+       !! assign values for arrays
+       yr_len = NINT(one_year)
+
+       veget_max_bg(:,2:nvm) = veget_max(:,2:nvm)
+       veget_max_bg(:,1) = MAX((un - SUM(veget_max(:,2:nvm), 2)), zero)
+!!       veget_mask_2d(:,:) = veget_max_bg .GT. EPSILON(zero)
+!!       WHERE( ALL((.NOT. veget_mask_2d(:,:)), dim=2) )
+!!          veget_mask_2d(:,1) = .TRUE.
+!!       END WHERE
+       veget_mask_2d(:,:) = .TRUE.
+
+       lalo_global(:,:) = lalo(:,:)
+       alt(:,:) = 0
+       altmax_lastyear(:,:) = 0
+       alt_ind(:,:) = 0
+       altmax_ind(:,:) = 0
+       altmax_ind_lastyear(:,:) = 0
+       z_root(:,:) = 0
+       rootlev(:,:) = 0
+       ! make sure gas concentrations where not defined by veget_mask are equal
+       !to initial conditions
+       DO iv = 1, ndeep
+          WHERE ( .NOT. veget_mask_2d(:,:) )
+             O2_soil(:,iv,:) = O2_init_conc
+             CH4_soil(:,iv,:) = CH4_init_conc
+          END WHERE
+       END DO
+       DO iv = 1, nsnow
+          WHERE ( .NOT. veget_mask_2d(:,:) )
+             O2_snow(:,iv,:) = O2_surf
+             CH4_snow(:,iv,:) = CH4_surf
+          END WHERE
+       END DO
+
+       heights_snow(:,:) = zero
+       zf_soil(:) = zero
+       zi_soil(:) = zero
+       zf_snow(:,:,:) = zero
+       zi_snow(:,:,:) = zero
+       zf_snow_nopftdim(:,:) = zero
+       zi_snow_nopftdim(:,:) = zero
+       airvol_soil(:,:,:) = zero
+       totporO2_soil(:,:,:) = zero
+       totporCH4_soil(:,:,:) = zero
+       conduct_soil(:,:,:) = zero
+       diffO2_soil(:,:,:) = zero
+       diffCH4_soil(:,:,:) = zero
+       airvol_snow(:,:,:) = zero
+       totporO2_snow(:,:,:) = zero
+       totporCH4_snow(:,:,:) = zero
+       conduct_snow(:,:,:) = zero
+       diffO2_snow(:,:,:) = zero
+       diffCH4_snow(:,:,:) = zero
+
+       ! get snow and soil levels
+       DO iv = 1, nvm
+          heights_snow(:,iv) = SUM(snowdz(:,1:nsnow), 2)
+       ENDDO
+       ! Calculating intermediate and full depths for snow
+       call snowlevels (kjpindex, snowdz, zi_snow, zf_snow, veget_max_bg)
+
+       ! here we need to put the shallow and deep soil levels together to make the complete soil levels. 
+       ! This requires pulling in the indices from thermosoil and deepsoil_freeze.
+       zi_soil(:) = zz_deep(:)
+       zf_soil(1:ndeep) = zz_coef_deep(:)
+       zf_soil(0) = 0.
+
+       !    allocate arrays for gas diffusion        !
+       !    get diffusion coefficients: heat capacity,
+       !    conductivity, and oxygen diffusivity
+       
+       CALL get_gasdiff (kjpindex,hslong,tprof,snow,airvol_snow, &
+            totporO2_snow,totporCH4_snow,diffO2_snow,diffCH4_snow, &
+            airvol_soil,totporO2_soil,totporCH4_soil,diffO2_soil,diffCH4_soil, z_organic, snowrho)
+
+       !
+       !    initialize soil temperature calculation
+       !
+       CALL soil_gasdiff_main (kjpindex,time_step,index,'initialize', &	
+            pb,tsurf,tprof,diffO2_snow,diffCH4_snow, &
+            totporO2_snow,totporCH4_snow,O2_snow,CH4_snow,diffO2_soil,diffCH4_soil, &
+            totporO2_soil,totporCH4_soil,O2_soil,CH4_soil, zi_snow, zf_snow)
+       
+       !
+       !    calculate the coefficients
+       !
+       CALL soil_gasdiff_main (kjpindex,time_step,index,'coefficients', &
+            pb,tsurf,tprof,diffO2_snow,diffCH4_snow, &
+            totporO2_snow,totporCH4_snow,O2_snow,CH4_snow,diffO2_soil,diffCH4_soil, &
+            totporO2_soil,totporCH4_soil,O2_soil,CH4_soil, zi_snow, zf_snow)
+       
+
+
+       CALL itau2ymds(itau, time_step, year, month, dayno, scnd)
+       dayno = (month-1)*30 + dayno
+       CALL altcalc (kjpindex, time_step, dayno, scnd, tprof, zi_soil, alt, alt_ind, altmax, altmax_ind, &
+            altmax_lastyear, altmax_ind_lastyear)   
+
+       IF (printlev>=3 ) THEN
+          WRITE(*,*) 'deep_carbcycle: finished firstcall calcs'
+       ENDIF
+
+       ! reset
+       !
+       !Config Key   = reset_yedoma_carbon
+       !Config Desc  = Do we reset carbon concentrations for yedoma region?
+       !Config Def   = n 
+       !Config If    = OK_PC
+       !Config Help  = 
+       !Config         
+       !Config Units = [flag]
+       ! 
+       reset_yedoma_carbon = .false.
+       CALL getin_p('reset_yedoma_carbon',reset_yedoma_carbon)
+
+       IF (reset_yedoma_carbon) THEN
+          yedoma_map_filename = 'NONE'
+          yedoma_depth = zero
+          yedoma_cinit_act = zero
+          yedoma_cinit_slo = zero
+          yedoma_cinit_pas = zero
+          !
+          !Config Key   = yedoma_map_filename
+          !Config Desc  = The filename for yedoma map
+          !Config Def   = yedoma_map.nc 
+          !Config If    = OK_PC
+          !Config Help  = 
+          !Config         
+          !Config Units = []
+          ! 
+          CALL getin_p('yedoma_map_filename', yedoma_map_filename)
+          !
+          !Config Key   = yedoma_depth
+          !Config Desc  = The depth for soil carbon in yedoma
+          !Config Def   = 20 
+          !Config If    = OK_PC
+          !Config Help  = 
+          !Config         
+          !Config Units = [m]
+          ! 
+          CALL getin_p('yedoma_depth', yedoma_depth)
+          !
+          !Config Key   = deepC_a_init
+          !Config Desc  = Carbon concentration for active soil C pool in yedoma
+          !Config Def   = 1790.1  
+          !Config If    = OK_PC
+          !Config Help  = 
+          !Config         
+          !Config Units = []
+          ! 
+          CALL getin_p('deepC_a_init', yedoma_cinit_act)
+          !
+          !Config Key   = deepC_s_init
+          !Config Desc  = Carbon concentration for slow soil C pool in yedoma
+          !Config Def   = 14360.8
+          !Config If    = OK_PC
+          !Config Help  = 
+          !Config         
+          !Config Units = []
+          ! 
+          CALL getin_p('deepC_s_init', yedoma_cinit_slo)
+          !
+          !Config Key   = deepC_p_init
+          !Config Desc  = Carbon concentration for passive soil C pool in yedoma
+          !Config Def   = 1436
+          !Config If    = OK_PC
+          !Config Help  = 
+          !Config         
+          !Config Units = []
+          ! 
+          CALL getin_p('deepC_p_init', yedoma_cinit_pas)
+          ! intialize the yedoma carbon stocks
+          CALL initialize_yedoma_carbonstocks(kjpindex, lalo, deepC_a, deepC_s, deepC_p, zz_deep, &
+               yedoma_map_filename, yedoma_depth, yedoma_cinit_act,yedoma_cinit_slo, yedoma_cinit_pas, altmax_ind)
+       ENDIF
+
+
+    ENDIF ! firstcall
+
+    ! Prepare values for arrays
+    veget_max_bg(:,2:nvm) = veget_max(:,2:nvm)
+    veget_max_bg(:,1) = MAX((un - SUM(veget_max(:,2:nvm), 2)), zero)
+
+    ! whether this is a C spin-up; if not, then 
+    IF ( .NOT. no_pfrost_decomp ) THEN
+    
+            IF ( ANY(rootlev(:,:) .GT. ndeep) ) THEN
+               WRITE(*,*) 'problems with rootlev:', rootlev
+               STOP
+            ENDIF
+  
+            DO iv = 1, nvm
+                  heights_snow(:,iv) = SUM(snowdz(:,1:nsnow), 2)
+            ENDDO
+            !
+            ! define initial CH4 value (before the time step)
+            CH4ini_soil(:,:,:) = CH4_soil(:,:,:)
+  
+            ! apply maximum soil wetness criteria to prevent soils from turning to wetlands where they aren't supposed to
+            hslong(:,:,:) = MAX(MIN(hslong_in(:,:,:),max_shum_value),zero)
+            
+            
+            ! update the gas profiles
+            !
+            CALL soil_gasdiff_main (kjpindex, time_step, index, 'diffuse', &
+                 pb,tsurf,tprof,diffO2_snow,diffCH4_snow, &
+                 totporO2_snow,totporCH4_snow,O2_snow,CH4_snow,diffO2_soil,diffCH4_soil, &
+                 totporO2_soil,totporCH4_soil,O2_soil,CH4_soil, zi_snow, zf_snow)
+  
+            ! get new snow levels and interpolate gases on these levels
+            !
+            CALL snow_interpol (kjpindex,O2_snow, CH4_snow, zi_snow, zf_snow, veget_max_bg, snowdz)
+            
+            ! Compute active layer thickness
+            CALL itau2ymds(itau, time_step, year, month, dayno, scnd)
+                dayno = (month-1)*30 + dayno
+  
+            CALL altcalc (kjpindex, time_step, dayno, scnd, tprof, zi_soil, alt, alt_ind, altmax, altmax_ind, &
+                 altmax_lastyear, altmax_ind_lastyear)     
+  
+            ! list pft-mean alt and altmax for debugging purposes
+            IF (printlev>=3) THEN
+               alt_pftmean(:) = 0.
+               altmax_pftmean(:) = 0.
+               tsurf_pftmean(:) = 0.
+               DO iv = 1, nvm
+                  WHERE ( veget_mask_2d(:,iv) )
+                     alt_pftmean(:) = alt_pftmean(:) + alt(:,iv)*veget_max_bg(:,iv)
+                     altmax_pftmean(:) = altmax_pftmean(:) + altmax(:,iv)*veget_max_bg(:,iv)
+                     tsurf_pftmean(:) = tsurf_pftmean(:) + tprof(:,1,iv)*veget_max_bg(:,iv)
+                  END WHERE
+               END DO
+            END IF
+  
+            ! Make sure the rooting depth is within the active layer
+            
+            !need to sort out the rooting depth, by each STOMATE PFT
+            WHERE ( altmax_lastyear(:,:) .LT. z_root_max .and. veget_mask_2d(:,:) )
+               z_root(:,:) = altmax_lastyear(:,:)
+               rootlev(:,:) = altmax_ind_lastyear(:,:) 
+            ELSEWHERE ( veget_mask_2d(:,:) )
+               z_root(:,:) = z_root_max
+               rootlev(:,:) = altmax_ind_lastyear(:,:)  
+            ENDWHERE
+                
+            !
+            ! Carbon input into the soil
+            !
+             CALL carbinput(kjpindex,time_step,itau*time_step,no_pfrost_decomp,tprof,tsurf,hslong,dayno,z_root,altmax_lastyear, &
+                  deepC_a, deepC_s, deepC_p, soilc_in, dc_litter_z, z_organic, veget_max_bg, rprof)
+             !
+  
+             CALL permafrost_decomp (kjpindex, time_step, tprof, airvol_soil, &
+                  oxlim, tau_CH4troph, ok_methane, fbactratio, O2m, &
+                  totporO2_soil, totporCH4_soil, hslong, clay, &
+                  no_pfrost_decomp, deepC_a, deepC_s, deepC_p, deltaCH4g, deltaCH4, deltaC1_a, deltaC1_s, deltaC1_p, deltaC2, &
+                  deltaC3, O2_soil, CH4_soil, fbact, MG_useallCpools)
+  
+            ! calculate coefficients for cryoturbation calculation
+            IF (ok_cryoturb) CALL cryoturbate(kjpindex, time_step, dayno, altmax_ind_lastyear, deepC_a, deepC_s, deepC_p, &
+                 'coefficients', cryoturbation_diff_k_in/(one_day*one_year),bioturbation_diff_k_in/(one_day*one_year), &
+                 altmax_lastyear, fixed_cryoturbation_depth)
+  
+            IF (ok_cryoturb) CALL cryoturbate(kjpindex, time_step, dayno, altmax_ind_lastyear, deepC_a, deepC_s, deepC_p, &
+                 'diffuse', cryoturbation_diff_k_in/(one_day*one_year), bioturbation_diff_k_in/(one_day*one_year), &
+                 altmax_lastyear, fixed_cryoturbation_depth)
+
+             DO ip = 1, kjpindex
+                DO iv = 1, nvm
+                   IF ( veget_mask_2d(ip,iv) ) THEN
+                      ! oxic decomposition
+                      heat_Zimov(ip,:,iv) = lhc(iactive)*1.E-3*deltaC1_a(ip,:,iv) + &
+                                            lhc(islow)*1.E-3*deltaC1_s(ip,:,iv) + &
+                                            lhc(ipassive)*1.E-3*deltaC1_p(ip,:,iv)
+                      !
+                      ! methanogenesis
+                      heat_Zimov(ip,:,iv) = heat_Zimov(ip,:,iv) + lhCH4(1)*1.E-3*deltaC2(ip,:,iv)
+                      !
+                      ! methanotrophy
+                      heat_Zimov(ip,:,iv) = heat_Zimov(ip,:,iv) + lhCH4(2)*1.E-3*deltaCH4(ip,:,iv) *  &
+                           totporCH4_soil(ip,:,iv)
+                      !
+                      heat_Zimov(ip,:,iv) = heat_Zimov(ip,:,iv)/time_step
+                      
+                      !
+                      fluxCH4(ip,iv) = zero
+                   ELSE
+                      heat_Zimov(ip,:,iv) = zero
+                      fluxCH4(ip,iv) = zero
+                   ENDIF
+                ENDDO
+             ENDDO
+  
+             IF  ( .NOT. firstcall) THEN 
+                !
+                ! Plant-mediated CH4 transport     
+                !
+               CALL traMplan(CH4_soil,O2_soil,kjpindex,time_step,totporCH4_soil,totporO2_soil,z_root, &
+                    rootlev,Tgr,Tref,hslong,flupmt, &
+                    refdep, zi_soil, tprof)
+               !	flupmt=zero
+               !
+               ! CH4 ebullition
+               !
+               
+               CALL ebullition (kjpindex,time_step,tprof,totporCH4_soil,hslong,CH4_soil,febul)
+  
+               !
+            ENDIF 
+            
+            !
+            MT(:,:)=zero   
+            MG(:,:)=zero    
+            CH4i(:,:)=zero  
+            CH4ii(:,:)=zero 
+            dC1i(:,:)=zero 
+            dCi(:,:)=zero   
+            !
+            DO ip = 1, kjpindex
+               DO iv = 1, nvm
+                  IF (  veget_mask_2d(ip,iv) ) THEN
+                     DO il=1,ndeep
+                        MT(ip,iv) = MT(ip,iv) + deltaCH4(ip,il,iv)*totporCH4_soil(ip,il,iv) * &
+                             ( zf_soil(il) - zf_soil(il-1) )
+                        MG(ip,iv) = MG(ip,iv) + deltaCH4g(ip,il,iv)*totporCH4_soil(ip,il,iv) * &
+                             ( zf_soil(il) - zf_soil(il-1) )
+                        CH4i(ip,iv) = CH4i(ip,iv) + CH4_soil(ip,il,iv)*totporCH4_soil(ip,il,iv) * &
+                             (zf_soil(il)-zf_soil(il-1))
+                        CH4ii(ip,iv) = CH4ii(ip,iv) +  &
+                             CH4ini_soil(ip,il,iv)*totporCH4_soil(ip,il,iv) * &
+                             (zf_soil(il)-zf_soil(il-1))          
+                        dC1i(ip,iv) = dC1i(ip,iv) + (deltaC1_a(ip,il,iv)+deltaC1_s(ip,il,iv)+deltaC1_p(ip,il,iv)) * &
+                             ( zf_soil(il) - zf_soil(il-1) )
+                        dCi(ip,iv) = dCi(ip,iv) + (deepC_a(ip,il,iv) + deepC_s(ip,il,iv) + deepC_p(ip,il,iv)) * &
+                             ( zf_soil(il) - zf_soil(il-1) )
+                     END DO
+                  ENDIF
+               ENDDO
+            ENDDO
+            
+            !
+            !
+            
+            DO ip = 1, kjpindex
+               ! Total CH4 flux
+               sfluxCH4_deep(ip) = SUM(veget_max_bg(ip,:)*( CH4ii(ip,:)-CH4i(ip,:)+MG(ip,:)-MT(ip,:) ))/time_step
+               ! TotalCO2 flux
+               sfluxCO2_deep(ip) = SUM(veget_max_bg(ip,:)*( dC1i(ip,:) + MT(ip,:)*(12./16.) ) )/time_step
+            END DO
+  
+            resp_hetero_soil(:,:) = ( dC1i(:,:) + MT(:,:)*(12./16.) ) *one_day/time_step
+            sfluxCH4(:,:) = ( CH4ii(:,:)-CH4i(:,:)+MG(:,:)-MT(:,:) ) *one_day/time_step
+  
+  
+            ! calculate the coefficients for the next timestep:
+            !
+            ! get diffusion coefficients: heat capacity,
+            !    conductivity, and oxygen diffusivity
+            !
+            CALL get_gasdiff (kjpindex,hslong,tprof,snow,airvol_snow, &
+                 totporO2_snow,totporCH4_snow,diffO2_snow,diffCH4_snow, &
+                 airvol_soil,totporO2_soil,totporCH4_soil,diffO2_soil,diffCH4_soil, z_organic, snowrho)
+            
+            !
+            ! calculate the coefficients for the next time step
+            !
+            CALL soil_gasdiff_main (kjpindex,time_step,index,'coefficients', &
+                 pb,tsurf,tprof,diffO2_snow,diffCH4_snow, &
+                 totporO2_snow,totporCH4_snow,O2_snow,CH4_snow,diffO2_soil,diffCH4_soil, &
+                 totporO2_soil,totporCH4_soil,O2_soil,CH4_soil, zi_snow, zf_snow)
+  
+            call calc_vert_int_soil_carbon(kjpindex, deepC_a, deepC_s, deepC_p, carbon, carbon_surf, zf_soil)
+            IF (printlev>=3) WRITE(*,*) 'after calc_vert_int_soil_carbon'
+    ENDIF
+    
+    ! define pft-mean soil C profile
+    deepC_pftmean(:,:,:) = 0._r_std
+    do iv = 1, nvm
+       do il=1,ndeep
+          deepC_pftmean(:,il,iactive)  = deepC_pftmean(:,il,iactive)  + deepC_a(:,il,iv) * veget_max(:,iv)
+          deepC_pftmean(:,il,islow)    = deepC_pftmean(:,il,islow)    + deepC_s(:,il,iv) * veget_max(:,iv)
+          deepC_pftmean(:,il,ipassive) = deepC_pftmean(:,il,ipassive) + deepC_p(:,il,iv) * veget_max(:,iv)
+       end do
+    end do
+
+    !history output
+    IF ( .NOT. soilc_isspinup ) THEN
+
+       CALL histwrite_p (hist_id_stomate, 'tsurf', itime, tsurf, kjpindex, index)
+       CALL histwrite_p (hist_id_stomate, 'fluxCH4', itime, sfluxCH4, kjpindex*nvm, horipft_index)
+       CALL histwrite_p (hist_id_stomate, 'febul', itime, febul, kjpindex*nvm, horipft_index)
+       CALL histwrite_p (hist_id_stomate, 'flupmt', itime, flupmt, kjpindex*nvm, horipft_index)
+       CALL histwrite_p (hist_id_stomate, 'alt', itime, alt, kjpindex*nvm, horipft_index)
+       CALL histwrite_p (hist_id_stomate, 'altmax', itime, altmax, kjpindex*nvm, horipft_index)
+       CALL histwrite_p (hist_id_stomate, 'sfluxCH4_deep', itime, sfluxCH4_deep, kjpindex, index)
+       CALL histwrite_p (hist_id_stomate, 'sfluxCO2_deep', itime, sfluxCO2_deep, kjpindex, index)
+       CALL histwrite_p (hist_id_stomate, 'pb', itime, pb, kjpindex, index)
+       call histwrite_p (hist_id_stomate, 'deepC_a_pftmean', itime, deepC_pftmean(:,:,iactive), kjpindex*ndeep, horideep_index)
+       call histwrite_p (hist_id_stomate, 'deepC_s_pftmean', itime, deepC_pftmean(:,:,islow), kjpindex*ndeep, horideep_index)
+       call histwrite_p (hist_id_stomate, 'deepC_p_pftmean', itime, deepC_pftmean(:,:,ipassive), kjpindex*ndeep, horideep_index)
+
+       DO jv = 1, nvm   
+          IF (permafrost_veg_exists(jv)) THEN  !don't bother to write if there are pfts that don't exist in our domain
+             WRITE(part_str,'(I2)') jv
+             IF (jv < 10) part_str(1:1) = '0'
+             IF (writehist_deepC) THEN
+                CALL histwrite_p (hist_id_stomate, 'deepC_a_'//part_str(1:LEN_TRIM(part_str)), &
+                     itime, deepC_a(:,:,jv), kjpindex*ndeep, horideep_index)
+                CALL histwrite_p (hist_id_stomate, 'deepC_s_'//part_str(1:LEN_TRIM(part_str)), &
+                     itime, deepC_s(:,:,jv), kjpindex*ndeep, horideep_index)
+                CALL histwrite_p (hist_id_stomate, 'deepC_p_'//part_str(1:LEN_TRIM(part_str)), &
+                     itime, deepC_p(:,:,jv), kjpindex*ndeep, horideep_index)
+             ENDIF
+             IF (writehist_soilgases) THEN
+                CALL histwrite_p (hist_id_stomate, 'O2_soil_'//part_str(1:LEN_TRIM(part_str)), &
+                     itime, O2_soil(:,:,jv), kjpindex*ndeep, horideep_index)
+                CALL histwrite_p (hist_id_stomate, 'CH4_soil_'//part_str(1:LEN_TRIM(part_str)), &
+                     itime, CH4_soil(:,:,jv), kjpindex*ndeep, horideep_index)
+                CALL histwrite_p (hist_id_stomate, 'O2_snow_'//part_str(1:LEN_TRIM(part_str)), &
+                     itime, O2_snow(:,:,jv), kjpindex*nsnow, horisnow_index) 
+                CALL histwrite_p (hist_id_stomate, 'CH4_snow_'//part_str(1:LEN_TRIM(part_str)), &
+                     itime, CH4_snow(:,:,jv), kjpindex*nsnow, horisnow_index)
+             ENDIF
+             IF (writehist_deltaC) THEN
+                CALL histwrite_p (hist_id_stomate, 'deltaCH4g_'//part_str(1:LEN_TRIM(part_str)), &
+                     itime, deltaCH4g(:,:,jv), kjpindex*ndeep, horideep_index)
+                CALL histwrite_p (hist_id_stomate, 'deltaCH4_'//part_str(1:LEN_TRIM(part_str)), &
+                     itime, deltaCH4(:,:,jv), kjpindex*ndeep, horideep_index)
+                CALL histwrite_p (hist_id_stomate, 'deltaC1_'//part_str(1:LEN_TRIM(part_str)), &
+                     itime, deltaC1_a(:,:,jv)+deltaC1_s(:,:,jv)+deltaC1_p(:,:,jv), kjpindex*ndeep, horideep_index)
+                CALL histwrite_p (hist_id_stomate, 'deltaC2_'//part_str(1:LEN_TRIM(part_str)), &
+                     itime, deltaC2(:,:,jv), kjpindex*ndeep, horideep_index)
+                CALL histwrite_p (hist_id_stomate, 'deltaC3_'//part_str(1:LEN_TRIM(part_str)), &
+                     itime, deltaC3(:,:,jv), kjpindex*ndeep, horideep_index)
+             ENDIF
+
+             IF (writehist_zimovheat) THEN
+                CALL histwrite_p (hist_id_stomate, 'heat_Zimov_'//part_str(1:LEN_TRIM(part_str)), &
+                     itime, heat_Zimov(:,:,jv), kjpindex*ndeep, horideep_index)
+             ENDIF
+
+             IF (writehist_deltaC_litter) THEN
+                CALL histwrite_p (hist_id_stomate, 'deltaC_litter_act_'//part_str(1:LEN_TRIM(part_str)), &
+                     itime, dc_litter_z(:,iactive,:,jv)/ time_step, kjpindex*ndeep, horideep_index)
+                CALL histwrite_p (hist_id_stomate, 'deltaC_litter_slo_'//part_str(1:LEN_TRIM(part_str)), &
+                     itime, dc_litter_z(:,islow,:,jv)/ time_step, kjpindex*ndeep, horideep_index)
+             ENDIF
+             !------------------------------  further output for debugging/diagnosing
+             
+             IF (writehist_gascoeff) THEN
+                CALL histwrite_p (hist_id_stomate, 'totporO2_soil_'//part_str(1:LEN_TRIM(part_str)), &
+                     itime, totporO2_soil(:,:,jv), kjpindex*ndeep, horideep_index)
+                CALL histwrite_p (hist_id_stomate, 'diffO2_soil_'//part_str(1:LEN_TRIM(part_str)), &
+                     itime, diffO2_soil(:,:,jv), kjpindex*ndeep, horideep_index)
+                CALL histwrite_p (hist_id_stomate, 'alphaO2_soil_'//part_str(1:LEN_TRIM(part_str)), &
+                     itime, alphaO2_soil(:,:,jv), kjpindex*ndeep, horideep_index)
+                CALL histwrite_p (hist_id_stomate, 'betaO2_soil_'//part_str(1:LEN_TRIM(part_str)), &
+                     itime, betaO2_soil(:,:,jv), kjpindex*ndeep, horideep_index)
+                
+                CALL histwrite_p (hist_id_stomate, 'totporCH4_soil_'//part_str(1:LEN_TRIM(part_str)), &
+                     itime, totporCH4_soil(:,:,jv), kjpindex*ndeep, horideep_index)
+                CALL histwrite_p (hist_id_stomate, 'diffCH4_soil_'//part_str(1:LEN_TRIM(part_str)), &
+                     itime, diffCH4_soil(:,:,jv), kjpindex*ndeep, horideep_index)
+                CALL histwrite_p (hist_id_stomate, 'alphaCH4_soil_'//part_str(1:LEN_TRIM(part_str)), &
+                     itime, alphaCH4_soil(:,:,jv), kjpindex*ndeep, horideep_index)
+                CALL histwrite_p (hist_id_stomate, 'betaCH4_soil_'//part_str(1:LEN_TRIM(part_str)), &
+                     itime, betaCH4_soil(:,:,jv), kjpindex*ndeep, horideep_index)
+             ENDIF
+          END IF
+       END DO
+
+    ENDIF
+
+    ! XIOS history output
+    IF ( .NOT. soilc_isspinup ) THEN
+
+       CALL xios_orchidee_send_field ('tsurf', tsurf)
+       CALL xios_orchidee_send_field ('fluxCH4',  sfluxCH4)
+       CALL xios_orchidee_send_field ('febul', febul)
+       CALL xios_orchidee_send_field ('flupmt',  flupmt)
+       CALL xios_orchidee_send_field ( 'alt', alt )
+       CALL xios_orchidee_send_field ( 'altmax', altmax)
+! JC add for ISIMIP2b
+       CALL xios_orchidee_send_field ( 'altmax_annual', altmax(:,1))
+! End JC add
+       CALL xios_orchidee_send_field ( 'sfluxCH4_deep', sfluxCH4_deep)
+       CALL xios_orchidee_send_field ( 'sfluxCO2_deep', sfluxCO2_deep)
+       CALL xios_orchidee_send_field ( 'pb', pb)
+       call xios_orchidee_send_field ( 'deepC_a_pftmean', deepC_pftmean(:,:,iactive))
+       call xios_orchidee_send_field ( 'deepC_s_pftmean', deepC_pftmean(:,:,islow))
+       call xios_orchidee_send_field ( 'deepC_p_pftmean', deepC_pftmean(:,:,ipassive))
+
+       IF (writehist_deepC) THEN
+         CALL xios_orchidee_send_field ( 'deepC_a', deepC_a)
+         CALL xios_orchidee_send_field ( 'deepC_s', deepC_s)
+         CALL xios_orchidee_send_field ( 'deepC_p', deepC_p)
+       ENDIF
+
+       IF (writehist_soilgases) THEN
+         CALL xios_orchidee_send_field ( 'O2_soil', O2_soil)
+         CALL xios_orchidee_send_field ( 'CH4_soil', CH4_soil)
+         CALL xios_orchidee_send_field ('O2_snow', O2_snow)
+         CALL xios_orchidee_send_field ( 'CH4_snow', CH4_snow)
+       ENDIF
+
+       IF (writehist_deltaC) THEN
+         CALL xios_orchidee_send_field ( 'deltaCH4g',  deltaCH4g)
+         CALL xios_orchidee_send_field ( 'deltaCH4',  deltaCH4)
+         CALL xios_orchidee_send_field ( 'deltaC1',  deltaC1_a+deltaC1_s+deltaC1_p)
+         CALL xios_orchidee_send_field ( 'deltaC2',  deltaC2)
+         CALL xios_orchidee_send_field ( 'deltaC3',   deltaC3)
+       ENDIF
+
+       IF (writehist_zimovheat) THEN
+         CALL xios_orchidee_send_field ( 'heat_Zimov',  heat_Zimov)
+       ENDIF
+
+       IF (writehist_deltaC_litter) THEN
+         CALL xios_orchidee_send_field ( 'deltaC_litter_act',  dc_litter_z(:,iactive,:,:)/ time_step)
+         CALL xios_orchidee_send_field ( 'deltaC_litter_slo',  dc_litter_z(:,islow,:,:)/ time_step)
+       ENDIF
+
+       IF (writehist_gascoeff) THEN
+         CALL xios_orchidee_send_field ( 'totporO2_soil', totporO2_soil)
+         CALL xios_orchidee_send_field ( 'diffO2_soil', diffO2_soil)
+         CALL xios_orchidee_send_field ( 'alphaO2_soil',  alphaO2_soil)
+         CALL xios_orchidee_send_field ( 'betaO2_soil',  betaO2_soil)
+                
+         CALL xios_orchidee_send_field ( 'totporCH4_soil', totporCH4_soil)
+         CALL xios_orchidee_send_field ( 'diffCH4_soil', diffCH4_soil)
+         CALL xios_orchidee_send_field ('alphaCH4_soil', alphaCH4_soil)
+         CALL xios_orchidee_send_field ( 'betaCH4_soil', betaCH4_soil)
+       ENDIF
+
+    ENDIF
+
+    IF (printlev>=3) WRITE(*,*) 'cdk: leaving  deep_carbcycle'
+
+    IF ( firstcall )  firstcall = .FALSE.
+
+
+  END SUBROUTINE deep_carbcycle
+  
+!!
+!================================================================================================================================
+!! SUBROUTINE   : altcalc
+!!
+!>\BRIEF        This routine calculate active layer thickness
+!!
+!! DESCRIPTION : 
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : alt
+!! 
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART11    : None
+!! \n
+!_
+!================================================================================================================================  
+  SUBROUTINE altcalc (kjpindex,time_step,dayno,scnd, temp, zprof, alt, alt_ind, altmax, altmax_ind, &
+        altmax_lastyear, altmax_ind_lastyear)
+
+  !! 0. Variable and parameter declaration
+
+    !! 0.1  Input variables
+
+    INTEGER(i_std), INTENT(in) 			                 :: kjpindex
+    REAL(r_std), INTENT(in)                                      :: time_step           !! time step in seconds
+    INTEGER(i_std), INTENT(in)			                 :: dayno               !! number of the day in the current year
+    REAL(r_std), INTENT(in)			                 :: scnd                !! model time & time step
+    REAL(r_std), DIMENSION(kjpindex,ndeep, nvm), INTENT(in)      :: temp                !! soil temperature
+    REAL(r_std), DIMENSION(ndeep), INTENT(in)   	         :: zprof               !! soil depths (m)
+
+    !! 0.2 Output variables
+
+    REAL(r_std), DIMENSION(kjpindex, nvm), INTENT(out)	         :: alt	                !! active layer thickness  
+    INTEGER, DIMENSION(kjpindex, nvm), INTENT(out)	         :: alt_ind	        !! active layer index  
+    
+    !! 0.3 Modified variables
+
+    REAL(r_std), DIMENSION(kjpindex, nvm),INTENT(inout)	         :: altmax_lastyear     !! Maximum active-layer thickness
+    REAL(r_std), DIMENSION(kjpindex, nvm),INTENT(inout)          :: altmax              !! Maximum active-layer thickness
+    INTEGER(i_std), DIMENSION(kjpindex, nvm),INTENT(inout)	 :: altmax_ind          !! Maximum over the year active-layer index
+    INTEGER(i_std), DIMENSION(kjpindex, nvm),INTENT(inout)       :: altmax_ind_lastyear !! Maximum over the year active-layer index
+
+    !! 0.4 Local variables
+
+    INTEGER				                         :: ix,iz,il,iv         !! grid indices
+    LOGICAL, SAVE 				                 :: firstcall = .TRUE.
+  !$OMP THREADPRIVATE(firstcall)
+    INTEGER, save                                                :: tcounter
+    INTEGER(i_std), SAVE  			                 :: id, id2
+  !$OMP THREADPRIVATE(id)
+  !$OMP THREADPRIVATE(id2)
+    LOGICAL, SAVE			                         :: check = .FALSE.
+  !$OMP THREADPRIVATE(check)
+    LOGICAL, SAVE			                         :: newaltcalc = .FALSE.
+  !$OMP THREADPRIVATE(newaltcalc)
+    LOGICAL, DIMENSION(kjpindex,nvm)                             :: inalt, bottomlevelthawed
+    CHARACTER(LEN=16)			                         :: buf  
+    INTEGER                                                      :: lev
+
+    
+    IF ( firstcall )  THEN
+
+       ! calculate altmax_ind from altmax
+       altmax_ind(:,:) = 0
+       DO ix = 1, kjpindex
+          DO iv = 1, nvm
+             IF ( veget_mask_2d(ix,iv) ) THEN
+                DO il=1,ndeep
+                   IF ( altmax(ix,iv) .GE. zprof(il) ) THEN
+                      altmax_ind(ix,iv) = altmax_ind(ix,iv) + 1
+                   END IF
+                END DO
+             END IF
+          END DO
+       END DO
+       altmax_lastyear(:,:) = altmax(:,:)
+       altmax_ind_lastyear(:,:) = altmax_ind(:,:)
+       firstcall = .FALSE.
+
+       !Config Key   = newaltcalc
+       !Config Desc  = calculate alt ?
+       !Config Def   = n
+       !Config If    = OK_PC
+       !Config Help  = 
+       !Config Unit  = [flag]
+       CALL getin_p('newaltcalc', newaltcalc)
+
+    ELSE
+       ! all other timesteps
+       IF ( .NOT. newaltcalc ) THEN
+          DO ix = 1, kjpindex
+             DO iv = 1, nvm
+                IF ( veget_mask_2d(ix,iv) ) THEN
+                   iz = 1
+                   DO WHILE( temp(ix,iz,iv) > ZeroCelsius .AND. iz < ndeep )
+                      iz = iz + 1	  
+                   END DO
+                   IF( iz == 1 ) THEN 
+                      ! it means that all is frozen
+                      alt(ix,iv) = zero
+                   ELSE
+                      alt(ix,iv) = zprof(iz-1)
+                   END IF
+                   alt_ind(ix,iv) = iz-1
+                END IF
+             END DO
+          END DO
+       ELSE          
+          ! initialize for pfts that don't exist
+          alt(:,:) = zprof(ndeep)  
+          bottomlevelthawed(:,:) = .FALSE.
+          ! start from bottom and work up instead
+          WHERE (temp(:,ndeep,:) > ZeroCelsius ) 
+             bottomlevelthawed(:,:) = .TRUE.
+             alt(:,:) = zprof(ndeep)
+             alt_ind(:,:) = ndeep
+          END WHERE
+          inalt(:,:) = .FALSE.
+          DO iz = 1, ndeep - 1
+             lev = ndeep - iz
+             WHERE ( temp(:,lev,:) > ZeroCelsius .AND. .NOT. inalt(:,:) .AND. .NOT. bottomlevelthawed(:,:) )
+                inalt(:,:) = .TRUE.
+                alt(:,:) = zprof(lev)
+                alt_ind(:,:) = lev
+             ELSEWHERE ( temp(:,lev,:) <= ZeroCelsius .AND. inalt(:,:) .AND. .NOT. bottomlevelthawed(:,:) )
+                inalt(:,:) = .FALSE.
+             END WHERE
+          END DO
+          WHERE ( .NOT. inalt .AND. .NOT. bottomlevelthawed(:,:) ) 
+             alt(:,:) = zero
+             alt_ind(:,:) = 0
+          END WHERE
+       ENDIF
+
+       ! debug
+       IF ( check ) THEN
+          IF (ANY(alt(:,:) .GT. zprof(ndeep))) THEN
+             WRITE(*,*) 'error: alt greater than soil depth.'
+          ENDIF
+       ENDIF
+
+       ! Maximum over the year active layer thickness
+       WHERE ( ( alt(:,:) .GT. altmax(:,:) ) .AND. veget_mask_2d(:,:)  ) 
+          altmax(:,:) = alt(:,:)
+          altmax_ind(:,:) = alt_ind(:,:)
+       ENDWHERE
+       
+       IF ( .NOT. soilc_isspinup ) THEN
+             ! do it on the second timestep, that way when we are writing restart files it is not done before that!
+             ! now we are doing daily permafrost calcs, so just run it on the second day.
+          IF ( ( dayno .EQ. 2) ) THEN  
+             ! Reinitialize ALT_max
+             altmax_lastyear(:,:) = altmax(:,:)
+             altmax_ind_lastyear(:,:) = altmax_ind(:,:)
+             altmax(:,:) = alt(:,:)
+             altmax_ind(:,:) = alt_ind(:,:)
+          END IF
+       ELSE
+
+             ! for spinup, best to set altmax_lastyear to altmax, and not boter to reset since every year is the same, 
+             ! and if you try to do so, it doesn't work properly --  06 may 2010
+          altmax_lastyear(:,:) = altmax(:,:)
+          altmax_ind_lastyear(:,:) = altmax_ind(:,:)
+       END IF
+    END IF
+
+    IF (printlev>=3) WRITE(*,*) 'leaving  altcalc'
+  END SUBROUTINE altcalc
+  
+!!
+!================================================================================================================================
+!! SUBROUTINE   : soil_gasdiff_main
+!!
+!>\BRIEF        This routine calculate oxygen and methane in the snow/soil medium 
+!!
+!! DESCRIPTION : 
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : 
+!! 
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART11    : None
+!! \n
+!_
+!================================================================================================================================   
+  SUBROUTINE soil_gasdiff_main( kjpindex,time_step,index,cur_action, &
+       psol,tsurf,tprof,diffO2_snow,diffCH4_snow, &
+       totporO2_snow,totporCH4_snow,O2_snow,CH4_snow,diffO2_soil,diffCH4_soil, &
+       totporO2_soil,totporCH4_soil,O2_soil,CH4_soil, zi_snow, zf_snow)
+
+  !! 0. Variable and parameter declaration
+
+    !! 0.1  Input variables
+
+    INTEGER(i_std), INTENT(in)                                 :: kjpindex           !! number of grid points 
+    REAL(r_std), INTENT(in)                                    :: time_step          !! time step in seconds
+    CHARACTER(LEN=*), INTENT(in)                               :: cur_action         !! what to do 
+    REAL(r_std), DIMENSION(kjpindex), INTENT(in)               :: psol               !! surface pressure (Pa)
+    REAL(r_std), DIMENSION(kjpindex), INTENT(in)               :: tsurf              !! Surface temperature (K)
+    REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(in)     :: tprof              !! Soil temperature (K)
+    REAL(r_std), DIMENSION(kjpindex,nsnow,nvm), INTENT(in)     :: diffO2_snow        !! oxygen diffusivity (m**2/s)
+    REAL(r_std), DIMENSION(kjpindex,nsnow,nvm), INTENT(in)     :: diffCH4_snow       !! methane diffusivity (m**2/s)
+    REAL(r_std), DIMENSION(kjpindex,nsnow,nvm), INTENT(in)     :: totporO2_snow      !! total O2 porosity (Tans, 1998)
+    REAL(r_std), DIMENSION(kjpindex,nsnow,nvm), INTENT(in)     :: totporCH4_snow     !! total CH4 porosity (Tans, 1998)
+    REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(in)     :: diffO2_soil        !! oxygen diffusivity (m**2/s)
+    REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(in)     :: diffCH4_soil       !! methane diffusivity (m**2/s)
+    REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(in)     :: totporO2_soil      !! total O2 porosity (Tans, 1998)
+    REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(in)     :: totporCH4_soil     !! total CH4 porosity (Tans, 1998)
+    INTEGER(i_std),DIMENSION(kjpindex),INTENT(in)  :: index                          !! Indeces of permafrost points on the map
+
+    !! 0.2  Output variables
+
+    !! 0.3  Modified variables
+
+    REAL(r_std), DIMENSION(kjpindex,nsnow,nvm), INTENT(inout)  :: O2_snow            !! oxygen (g O2/m**3 air)
+    REAL(r_std), DIMENSION(kjpindex,nsnow,nvm), INTENT(inout)  :: CH4_snow           !! methane (g CH4/m**3 air)
+    REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(inout)  :: O2_soil            !! oxygen (g O2/m**3 air)
+    REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(inout)  :: CH4_soil           !! methane (g CH4/m**3 air)
+    REAL(r_std), DIMENSION(kjpindex,0:nsnow,nvm), intent(inout):: zf_snow            !! depths of full levels (m)
+    REAL(r_std), DIMENSION(kjpindex,nsnow,nvm), intent(inout)  :: zi_snow            !! depths of intermediate levels (m)
+  
+    !! 0.4 local variables
+
+    CHARACTER(LEN=50), SAVE        :: last_action = 'not called'
+  !$OMP THREADPRIVATE(last_action)
+    
+    
+    ! 1. ensure that we do not repeat actions
+    !
+    IF ( TRIM(cur_action) .EQ. TRIM(last_action) ) THEN
+       !
+       CALL ipslerr_p(3, 'soil_gasdiff_main','CANNOT TAKE THE SAME ACTION TWICE: ',cur_action, last_action)
+       !
+    ENDIF
+    !
+    ! 2. decide what to do
+    !
+    IF ( TRIM(cur_action) .EQ. 'initialize' ) THEN
+       !
+       ! 2.1 initialize
+       !
+       IF ( TRIM(last_action) .NE. 'not called' ) THEN
+          !
+          CALL ipslerr_p(3, 'soil_gasdiff_main','SOIL MODEL CANNOT BE INITIALIZED TWICE.', '', '')
+          !
+       ENDIF
+       !
+       CALL soil_gasdiff_alloc( kjpindex )
+       !
+    ELSEIF ( TRIM(cur_action) .EQ. 'diffuse' ) THEN
+       !
+       ! 2.2 calculate soil temperatures
+       !
+       CALL soil_gasdiff_diff( kjpindex,time_step,index,psol,tsurf, O2_snow, CH4_snow, O2_soil, CH4_soil)
+       !
+    ELSEIF ( TRIM(cur_action) .EQ. 'coefficients' ) THEN
+       !
+       ! 2.3 calculate coefficients (heat flux and apparent surface heat capacity)
+       !
+       CALL soil_gasdiff_coeff( kjpindex,time_step,tprof,O2_snow,CH4_snow, &
+            diffO2_snow,diffCH4_snow,totporO2_snow,totporCH4_snow,O2_soil,CH4_soil, &
+            diffO2_soil,diffCH4_soil,totporO2_soil,totporCH4_soil, zi_snow, zf_snow)
+       !
+    ELSE
+       !
+       ! 2.4 do not know this action
+       !
+       CALL ipslerr_p(3,'soil_gasdiff_main', 'This action does not exists and must be implemented', &
+                        'or its wrong:',cur_action)
+       !
+    ENDIF
+    !
+    ! 2.5 keep last action in mind
+    !
+    last_action = TRIM(cur_action)
+    
+    IF (printlev>=3) WRITE(*,*) 'leaving  soil_gasdiff_main'
+  END SUBROUTINE soil_gasdiff_main
+ 
+!!
+!================================================================================================================================
+!! SUBROUTINE   : soil_gasdiff_alloc
+!!
+!>\BRIEF        This routine allocate arrays related to oxygen and methane in the snow/soil medium 
+!!
+!! DESCRIPTION : 
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : 
+!! 
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART11    : None
+!! \n
+!_
+!================================================================================================================================   
+  SUBROUTINE soil_gasdiff_alloc( kjpindex )
+   
+  !! 0. Variable and parameter declaration
+
+    !! 0.1  Input variables
+ 
+    INTEGER(i_std), INTENT(in)                             :: kjpindex
+
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables
+    
+    !! 0.4 local variables
+
+    INTEGER(i_std)                                         :: ier
+    
+    ! Allocate the variables that need to be saved after soil_gasdiff_coeff
+
+      ALLOCATE (alphaO2_soil(kjpindex,ndeep,nvm),stat=ier)
+      IF (ier.NE.0) THEN
+          WRITE (numout,*) ' error in alphaO2_soil allocation. We stop. We need', kjpindex, ' fois ',ndeep, ' fois ',nvm,' words = '&
+             & , kjpindex*ndeep*nvm
+          STOP 'deep_carbcycle'
+      END IF
+   
+      ALLOCATE (betaO2_soil(kjpindex,ndeep,nvm),stat=ier)
+      IF (ier.NE.0) THEN
+          WRITE (numout,*) ' error in betaO2_soil allocation. We stop. We need', kjpindex, ' fois ',ndeep, ' fois ',nvm,' words = '&
+             & , kjpindex*ndeep*nvm
+          STOP 'deep_carbcycle'
+      END IF
+ 
+      ALLOCATE (alphaCH4_soil(kjpindex,ndeep,nvm),stat=ier)
+      IF (ier.NE.0) THEN
+          WRITE (numout,*) ' error in alphaCH4_soil allocation. We stop. We need', kjpindex, ' fois ',ndeep, ' fois ',nvm,' words = '&
+             & , kjpindex*ndeep*nvm
+          STOP 'deep_carbcycle'
+      END IF
+
+      ALLOCATE (betaCH4_soil(kjpindex,ndeep,nvm),stat=ier)
+      IF (ier.NE.0) THEN
+          WRITE (numout,*) ' error in betaCH4_soil allocation. We stop. We need', kjpindex, ' fois ',ndeep, ' fois ',nvm,' words = '&
+             & , kjpindex*ndeep*nvm
+          STOP 'deep_carbcycle'
+      END IF
+
+      ALLOCATE (alphaO2_snow(kjpindex,nsnow,nvm),stat=ier)
+      IF (ier.NE.0) THEN
+          WRITE (numout,*) ' error in alphaO2_snow allocation. We stop. We need', kjpindex, ' fois ',nsnow, ' fois ',nvm,' words = '&
+             & , kjpindex*nsnow*nvm
+          STOP 'deep_carbcycle'
+      END IF
+
+      ALLOCATE (betaO2_snow(kjpindex,nsnow,nvm),stat=ier)
+      IF (ier.NE.0) THEN
+          WRITE (numout,*) ' error in betaO2_snow allocation. We stop. We need', kjpindex, ' fois ',nsnow, ' fois ',nvm,' words = '&
+             & , kjpindex*nsnow*nvm
+          STOP 'deep_carbcycle'
+      END IF
+
+      ALLOCATE (alphaCH4_snow(kjpindex,nsnow,nvm),stat=ier)
+      IF (ier.NE.0) THEN
+          WRITE (numout,*) ' error in alphaCH4_snow allocation. We stop. We need', kjpindex, ' fois ',nsnow, ' fois ',nvm,' words = '&
+             & , kjpindex*nsnow*nvm
+          STOP 'deep_carbcycle'
+      END IF
+ 
+      ALLOCATE (betaCH4_snow(kjpindex,nsnow,nvm),stat=ier)
+      IF (ier.NE.0) THEN
+          WRITE (numout,*) ' error in betaCH4_snow allocation. We stop. We need', kjpindex, ' fois ',nsnow, ' fois ',nvm,' words = '&
+             & , kjpindex*nsnow*nvm
+          STOP 'deep_carbcycle'
+      END IF
+
+      ALLOCATE (zf_coeff_snow(kjpindex,0:nsnow,nvm),stat=ier)
+      IF (ier.NE.0) THEN
+          WRITE (numout,*) ' error in zf_coeff_snow allocation. We stop. We need', kjpindex, ' fois ',nsnow+1, ' fois ',nvm,' words = '&
+             & , kjpindex*(nsnow+1)*nvm
+          STOP 'deep_carbcycle'
+      END IF
+
+      ALLOCATE (zi_coeff_snow(kjpindex,nsnow,nvm),stat=ier)
+      IF (ier.NE.0) THEN
+          WRITE (numout,*) ' error in zi_coeff_snow allocation. We stop. We need', kjpindex, ' fois ',nsnow, ' fois ',nvm,' words = '&
+             & , kjpindex*nsnow*nvm
+          STOP 'deep_carbcycle'
+      END IF
+
+      ALLOCATE (mu_snow(kjpindex,nvm),stat=ier)
+      IF (ier.NE.0) THEN
+          WRITE (numout,*) ' error in mu_snow allocation. We stop. We need', kjpindex, ' fois ',nvm,' words = '&
+             & , kjpindex*nvm
+          STOP 'deep_carbcycle'
+      END IF
+
+      alphaO2_soil(:,:,:) = zero
+      betaO2_soil(:,:,:) = zero
+      alphaCH4_soil(:,:,:) = zero
+      betaCH4_soil(:,:,:) = zero
+      alphaO2_snow(:,:,:) = zero
+      betaO2_snow(:,:,:) = zero
+      alphaCH4_snow(:,:,:) = zero
+      betaCH4_snow(:,:,:) = zero
+      zf_coeff_snow(:,:,:) = zero
+      zi_coeff_snow(:,:,:) = zero
+      mu_snow(:,:) = zero
+    
+  END SUBROUTINE soil_gasdiff_alloc
+ 
+!!
+!================================================================================================================================
+!! SUBROUTINE   : soil_gasdiff_coeff
+!!
+!>\BRIEF        This routine calculate coeff related to gas diffuvisity
+!!
+!! DESCRIPTION : 
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : 
+!! 
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART11    : None
+!! \n
+!_
+!================================================================================================================================   
+  
+  SUBROUTINE soil_gasdiff_coeff( kjpindex,time_step,tprof,O2_snow,CH4_snow, &
+       diffO2_snow,diffCH4_snow,totporO2_snow,totporCH4_snow,O2_soil,CH4_soil, &
+       diffO2_soil,diffCH4_soil,totporO2_soil,totporCH4_soil, zi_snow, zf_snow)
+
+
+  !! 0. Variable and parameter declaration
+
+    !! 0.1  Input variables
+
+    INTEGER(i_std), INTENT(in)                                 :: kjpindex            !! number of grid points 
+    REAL(r_std), INTENT(in)                                    :: time_step           !! time step in seconds
+    REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(in)     :: tprof               !! Soil temperature (K)
+    REAL(r_std), DIMENSION(kjpindex,nsnow,nvm), INTENT(in)     :: diffO2_snow         !! oxygen diffusivity (m**2/s)
+    REAL(r_std), DIMENSION(kjpindex,nsnow,nvm), INTENT(in)     :: diffCH4_snow        !! methane diffusivity (m**2/s)
+    REAL(r_std), DIMENSION(kjpindex,nsnow,nvm), INTENT(in)     :: totporO2_snow       !! total O2 porosity (Tans, 1998)
+    REAL(r_std), DIMENSION(kjpindex,nsnow,nvm), INTENT(in)     :: totporCH4_snow      !! total CH4 porosity (Tans, 1998)
+    REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(in)     :: diffO2_soil         !! oxygen diffusivity (m**2/s)
+    REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(in)     :: diffCH4_soil        !! methane diffusivity (m**2/s)
+    REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(in)     :: totporO2_soil       !! total O2 porosity (Tans, 1998)
+    REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(in)     :: totporCH4_soil      !! total CH4 porosity (Tans, 1998)
+    REAL(r_std), DIMENSION(kjpindex,nsnow,nvm), INTENT(in)     :: O2_snow             !! oxygen (g O2/m**3 air)
+    REAL(r_std), DIMENSION(kjpindex,nsnow,nvm), INTENT(in)     :: CH4_snow            !! methane (g CH4/m**3 air)
+    REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(in)     :: O2_soil             !! oxygen (g O2/m**3 air)
+    REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(in)     :: CH4_soil            !! methane (g CH4/m**3 air)
+    REAL(r_std), DIMENSION(kjpindex,0:nsnow,nvm), INTENT(in)   :: zf_snow             !! depths of full levels (m)
+    REAL(r_std), DIMENSION(kjpindex,nsnow,nvm), INTENT(in)     :: zi_snow             !! depths of intermediate levels (m)
+
+    !! 0.2  Output variables
+
+    !! 0.3  Modified variables
+
+    !! 0.4 local variables
+
+    REAL(r_std), DIMENSION(kjpindex,nsnow,nvm)         :: xcO2_snow,xdO2_snow
+    REAL(r_std), DIMENSION(kjpindex,nsnow,nvm)         :: xcCH4_snow,xdCH4_snow
+    REAL(r_std), DIMENSION(kjpindex,ndeep,nvm)         :: xcO2_soil,xdO2_soil
+    REAL(r_std), DIMENSION(kjpindex,ndeep,nvm)         :: xcCH4_soil,xdCH4_soil
+    INTEGER(i_std)                                     :: il
+    REAL(r_std), DIMENSION(kjpindex,nvm)               :: xeO2,xeCH4
+    LOGICAL, DIMENSION(kjpindex,nvm)                   :: snow_height_mask_2d
+    LOGICAL, SAVE :: firstcall = .true.
+  !$OMP THREADPRIVATE(firstcall)
+
+    ! loop over materials (soil, snow), beginning at the bottom
+    !
+    ! 1. define useful variables linked to geometry and physical properties
+    !
+    ! 1.1 normal levels
+    !
+    ! default value if inexistent
+    xcO2_snow(:,1,:) = xcO2_soil(:,1,:)
+    xdO2_snow(:,1,:) = xdO2_soil(:,1,:)
+    xcCH4_snow(:,1,:) = xcCH4_soil(:,1,:)
+    xdCH4_snow(:,1,:) = xdCH4_soil(:,1,:)
+    !
+    snow_height_mask_2d(:,:) = ( heights_snow(:,:) .GT. hmin_tcalc )
+    !
+    DO il = 1,nsnow-1
+       !
+       WHERE ( snow_height_mask_2d(:,:) .AND. veget_mask_2d(:,:) )
+          !
+          xcO2_snow(:,il,:) = ( zf_snow(:,il,:) - zf_snow(:,il-1,:) ) * &
+               totporO2_snow(:,il,:) / time_step
+          xcCH4_snow(:,il,:) = ( zf_snow(:,il,:) - zf_snow(:,il-1,:) ) * &
+               totporCH4_snow(:,il,:) / time_step
+          !
+          xdO2_snow(:,il,:) = diffO2_snow(:,il,:) /  &
+               (zi_snow(:,il+1,:)-zi_snow(:,il,:))
+          xdCH4_snow(:,il,:) = diffCH4_snow(:,il,:) /  &
+               (zi_snow(:,il+1,:)-zi_snow(:,il,:))
+          !
+       ENDWHERE
+    END DO
+    !
+    DO il = 1,ndeep-1
+       !
+       WHERE ( veget_mask_2d(:,:) )
+          !
+          xcO2_soil(:,il,:) = ( zf_soil(il) - zf_soil(il-1) ) * &
+               totporO2_soil(:,il,:) / time_step
+          xcCH4_soil(:,il,:) = ( zf_soil(il) - zf_soil(il-1) ) * &
+               totporCH4_soil(:,il,:) / time_step
+          !
+          xdO2_soil(:,il,:) = diffO2_soil(:,il,:) /  &
+               (zi_soil(il+1)-zi_soil(il))
+          xdCH4_soil(:,il,:) = diffCH4_soil(:,il,:) /  &
+               (zi_soil(il+1)-zi_soil(il))
+          !
+       ENDWHERE
+       !
+    ENDDO
+    !
+    ! 1.2 for the lower boundary, define a similar geometric variable.
+    !
+    !snow
+    !
+    WHERE ( snow_height_mask_2d(:,:) .AND. veget_mask_2d(:,:) ) 
+       xcO2_snow(:,nsnow,:) = ( zf_snow(:,nsnow,:) -  &
+            zf_snow(:,nsnow-1,:) ) *  &
+            totporO2_snow(:,nsnow,:) / time_step
+       xdO2_snow(:,nsnow,:) = diffO2_snow(:,nsnow,:) /  &
+            ( zi_soil(1) +  &
+            zf_snow(:,nsnow,:) - zi_snow(:,nsnow,:) )
+       xcCH4_snow(:,nsnow,:) = ( zf_snow(:,nsnow,:) -  &
+            zf_snow(:,nsnow-1,:) ) * &
+            totporCH4_snow(:,nsnow,:) / time_step
+       xdCH4_snow(:,nsnow,:) = diffCH4_snow(:,nsnow,:) /  &
+            ( zi_soil(1) +  &
+            zf_snow(:,nsnow,:) - zi_snow(:,nsnow,:) )
+    ENDWHERE
+    !
+    ! soil
+    ! 
+    WHERE (  veget_mask_2d(:,:) ) ! removed heights_soil logic
+       xcO2_soil(:,ndeep,:) =  &
+            ( zf_soil(ndeep) - zf_soil(ndeep-1) ) * &
+            totporO2_soil(:,ndeep,:) / time_step
+       xdO2_soil(:,ndeep,:) = diffO2_soil(:,ndeep,:) /  &
+            ( zf_soil(ndeep) - zi_soil(ndeep) )
+       xcCH4_soil(:,ndeep,:) =  &
+            ( zf_soil(ndeep) - zf_soil(ndeep-1) ) * &
+            totporCH4_soil(:,ndeep,:) / time_step
+       xdCH4_soil(:,ndeep,:) = diffCH4_soil(:,ndeep,:) /  &
+            ( zf_soil(ndeep) - zi_soil(ndeep) )
+    ENDWHERE    
+    !
+    ! 1.3 extrapolation factor from first levels to surface
+    !
+    WHERE ( snow_height_mask_2d(:,:)  .AND. veget_mask_2d(:,:) )
+       mu_snow(:,:) = zi_snow(:,1,:) / ( zi_snow(:,2,:) - zi_snow(:,1,:) )
+    ELSEWHERE ( veget_mask_2d(:,:) )
+       mu_snow(:,:) = .5 ! any value
+    ENDWHERE
+    !
+    mu_soil = zi_soil(1) / ( zi_soil(2) - zi_soil(1) )
+    !
+    ! 2. bottom level: treatment depends on lower boundary condition
+    !
+    ! soil
+    !
+    WHERE ( veget_mask_2d(:,:) ) ! removed heights_soil logic
+       !
+       xeO2(:,:) = xcO2_soil(:,ndeep,:) + xdO2_soil(:,ndeep-1,:)
+       xeCH4(:,:) = xcCH4_soil(:,ndeep,:) + xdCH4_soil(:,ndeep-1,:)
+       !
+       alphaO2_soil(:,ndeep-1,:) = xdO2_soil(:,ndeep-1,:) / xeO2(:,:)
+       alphaCH4_soil(:,ndeep-1,:) = xdCH4_soil(:,ndeep-1,:)  &
+            / xeCH4(:,:)
+       !
+       betaO2_soil(:,ndeep-1,:) =  &
+            (xcO2_soil(:,ndeep,:)*O2_soil(:,ndeep,:))/xeO2(:,:)
+       betaCH4_soil(:,ndeep-1,:) =  &
+            (xcCH4_soil(:,ndeep,:)*CH4_soil(:,ndeep,:))/xeCH4(:,:)
+       !
+    ENDWHERE
+    !
+    !snow
+    !
+    WHERE ( snow_height_mask_2d(:,:) .AND. veget_mask_2d(:,:) )
+       !
+       ! dernier niveau
+       !
+       xeO2(:,:) = xcO2_soil(:,1,:) + &
+            (1.-alphaO2_soil(:,1,:))*xdO2_soil(:,1,:) +  &
+            xdO2_snow(:,nsnow,:)
+       xeCH4(:,:) = xcCH4_soil(:,1,:) + &
+            (1.-alphaCH4_soil(:,1,:))*xdCH4_soil(:,1,:) + &
+            xdCH4_snow(:,nsnow,:)
+       !
+       alphaO2_snow(:,nsnow,:) = xdO2_snow(:,nsnow,:)/xeO2(:,:)
+       alphaCH4_snow(:,nsnow,:) = xdCH4_snow(:,nsnow,:) &
+            /xeCH4(:,:)
+       !
+       betaO2_snow(:,nsnow,:) =  &
+            ( xcO2_soil(:,1,:)*O2_soil(:,1,:) + &
+            xdO2_soil(:,1,:)*betaO2_soil(:,1,:) ) &
+            / xeO2(:,:)
+       betaCH4_snow(:,nsnow,:) =  &
+            ( xcCH4_soil(:,1,:)*CH4_soil(:,1,:) + &
+            xdCH4_soil(:,1,:)*betaCH4_soil(:,1,:) ) &
+            / xeCH4(:,:)
+       !
+       ! avant-dernier niveau
+       !
+       xeO2(:,:) = xcO2_snow(:,nsnow,:) + &
+            (1.-alphaO2_snow(:,nsnow,:))*xdO2_snow(:,nsnow,:) + &
+            xdO2_snow(:,nsnow-1,:)
+       xeCH4(:,:) = xcCH4_snow(:,nsnow,:) + &
+            (1.-alphaCH4_snow(:,nsnow,:))*xdCH4_snow(:,nsnow,:) &
+            + xdCH4_snow(:,nsnow-1,:)
+       !
+       alphaO2_snow(:,nsnow-1,:) =  &
+            xdO2_snow(:,nsnow-1,:) / xeO2(:,:)
+       alphaCH4_snow(:,nsnow-1,:) =  &
+            xdCH4_snow(:,nsnow-1,:) / xeCH4(:,:)
+       !
+       betaO2_snow(:,nsnow-1,:) = &
+            ( xcO2_snow(:,nsnow,:)*O2_snow(:,nsnow,:) + &
+            xdO2_snow(:,nsnow,:)*betaO2_snow(:,nsnow,:) ) &
+            / xeO2(:,:)
+       betaCH4_snow(:,nsnow-1,:) = &
+            ( xcCH4_snow(:,nsnow,:)*CH4_snow(:,nsnow,:) + &
+            xdCH4_snow(:,nsnow,:)*betaCH4_snow(:,nsnow,:) ) &
+            / xeCH4(:,:)
+       !
+    ELSEWHERE ( veget_mask_2d(:,:) )
+       !
+       alphaO2_snow(:,nsnow,:) = 1.
+       alphaCH4_snow(:,nsnow,:) = 1.
+       betaO2_snow(:,nsnow,:) = zero
+       betaCH4_snow(:,nsnow,:) = zero
+       !
+       alphaO2_snow(:,nsnow-1,:) = 1.
+       alphaCH4_snow(:,nsnow-1,:) = 1.
+       betaO2_snow(:,nsnow-1,:) = zero
+       betaCH4_snow(:,nsnow-1,:) = zero
+       !
+    ENDWHERE
+    !    
+            
+    !
+    ! 3. the other levels
+    !
+    DO il = nsnow-2,1,-1 !snow
+       !
+       WHERE ( snow_height_mask_2d(:,:) .AND. veget_mask_2d(:,:) )
+          !
+          xeO2(:,:) = xcO2_snow(:,il+1,:) +  &
+               (1.-alphaO2_snow(:,il+1,:))*xdO2_snow(:,il+1,:) + xdO2_snow(:,il,:)
+          xeCH4(:,:) = xcCH4_snow(:,il+1,:) +  &
+               (1.-alphaCH4_snow(:,il+1,:))*xdCH4_snow(:,il+1,:) +  &
+               xdCH4_snow(:,il,:)
+          !
+          alphaO2_snow(:,il,:) = xdO2_snow(:,il,:) / xeO2(:,:)
+          alphaCH4_snow(:,il,:) = xdCH4_snow(:,il,:) / xeCH4(:,:)
+          !
+          betaO2_snow(:,il,:) =  &
+               ( xcO2_snow(:,il+1,:)*O2_snow(:,il+1,:) +  &
+               xdO2_snow(:,il+1,:)*betaO2_snow(:,il+1,:) ) / xeO2(:,:)
+          betaCH4_snow(:,il,:) =  &
+               ( xcCH4_snow(:,il+1,:)*CH4_snow(:,il+1,:) +  &
+               xdCH4_snow(:,il+1,:)*betaCH4_snow(:,il+1,:) ) / xeCH4(:,:)
+          !
+       ELSEWHERE ( veget_mask_2d(:,:) )
+          !
+          alphaO2_snow(:,il,:) = 1.
+          alphaCH4_snow(:,il,:) = 1.
+          !
+          betaO2_snow(:,il,:) = zero
+          betaCH4_snow(:,il,:) = zero
+          !
+       ENDWHERE
+       !
+    ENDDO
+    !
+    DO il = ndeep-2,1,-1 !soil
+       !
+       WHERE ( veget_mask_2d(:,:) ) !removed heights_soil logic
+          !
+          xeO2(:,:) = xcO2_soil(:,il+1,:) +  &
+               (1.-alphaO2_soil(:,il+1,:))*xdO2_soil(:,il+1,:) + xdO2_soil(:,il,:)
+          xeCH4(:,:) = xcCH4_soil(:,il+1,:) +  &
+               (1.-alphaCH4_soil(:,il+1,:))*xdCH4_soil(:,il+1,:) +  &
+               xdCH4_soil(:,il,:)
+          !
+          alphaO2_soil(:,il,:) = xdO2_soil(:,il,:) / xeO2(:,:)
+          alphaCH4_soil(:,il,:) = xdCH4_soil(:,il,:) / xeCH4(:,:)
+          !
+          betaO2_soil(:,il,:) =  &
+               ( xcO2_soil(:,il+1,:)*O2_soil(:,il+1,:) +  &
+               xdO2_soil(:,il+1,:)*betaO2_soil(:,il+1,:) ) / xeO2(:,:)
+          betaCH4_soil(:,il,:) =  &
+               ( xcCH4_soil(:,il+1,:)*CH4_soil(:,il+1,:) +  &
+               xdCH4_soil(:,il+1,:)*betaCH4_soil(:,il+1,:) ) / xeCH4(:,:)
+          !
+       ENDWHERE
+       !
+    ENDDO
+    !
+    ! 4. store thickness of the different levels for all soil types (for security) 
+    !
+    zf_coeff_snow(:,:,:) = zf_snow(:,:,:)
+    zi_coeff_snow(:,:,:) = zi_snow(:,:,:)
+
+    !--hist out for keeping track of these
+    IF (firstcall) THEN
+       firstcall = .false.
+    ELSE
+    ENDIF
+
+  END SUBROUTINE soil_gasdiff_coeff
+ 
+!!
+!================================================================================================================================
+!! SUBROUTINE   : soil_gasdiff_diff
+!!
+!>\BRIEF        This routine update oxygen and methane in the snow and soil 
+!!
+!! DESCRIPTION : 
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : 
+!! 
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART11    : None
+!! \n
+!_
+!================================================================================================================================    
+  
+  SUBROUTINE soil_gasdiff_diff( kjpindex,time_step,index,pb,tsurf, O2_snow, CH4_snow, O2_soil, CH4_soil)
+   
+  !! 0. Variable and parameter declaration
+
+    !! 0.1  Input variables
+
+    INTEGER(i_std), INTENT(in)                                 :: kjpindex             !! number of grid points 
+    REAL(r_std), INTENT(in)                                    :: time_step            !! time step in seconds
+    REAL(r_std), DIMENSION(kjpindex), INTENT(in)               :: pb                   !! Surface pressure
+    REAL(r_std), DIMENSION(kjpindex), INTENT(in)               :: tsurf                !! Surface temperature
+    INTEGER(i_std),DIMENSION(kjpindex),INTENT(in)              :: index                !! Indeces of the points on the map 
+    !! 0.2  Output variables
+
+    !! 0.3  Modified variables
+
+    REAL(r_std), DIMENSION(kjpindex,nsnow,nvm), INTENT(inout)  :: O2_snow              !! oxygen (g O2/m**3 air)
+    REAL(r_std), DIMENSION(kjpindex,nsnow,nvm), INTENT(inout)  :: CH4_snow             !! methane (g CH4/m**3 air)
+    REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(inout)  :: O2_soil              !! oxygen (g O2/m**3 air)
+    REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(inout)  :: CH4_soil             !! methane (g CH4/m**3 air)
+
+    !! 0.4 local variables
+ 
+    INTEGER(i_std)                                             :: it, ip, il, iv
+    LOGICAL, DIMENSION(kjpindex,nvm)                           :: snowtop
+    REAL(r_std), DIMENSION(kjpindex,nvm)                       :: O2sa, CH4sa
+    
+    !
+    ! 1.1 Determine which is the first existing soil type.
+    !
+    snowtop(:,:) = .FALSE.  
+    !
+    !ignore snow for now...
+    WHERE ( heights_snow(:,:) .GT. hmin_tcalc )
+       snowtop(:,:) = .TRUE.
+    ENDWHERE
+    !
+    ! 2.gas diffusion
+    !
+    ! 2.1 top level
+    !
+    ! 2.1.1 non-existing
+    !
+    DO iv = 1, nvm
+       O2sa(:,iv) = pb(:)/(RR*tsurf(:)) * O2_surf * wO2
+       CH4sa(:,iv) = pb(:)/(RR*tsurf(:)) * CH4_surf * wCH4
+    ENDDO
+    !
+    WHERE ( (.NOT. snowtop(:,:)) .AND. veget_mask_2d(:,:) ) ! it equals 1 (snow) but there is no snow...
+       !
+       O2_snow(:,1,:) = O2sa(:,:)
+       CH4_snow(:,1,:) = CH4sa(:,:)
+       !
+       O2_soil(:,1,:) = ( O2sa(:,:) + mu_soil*betaO2_soil(:,1,:) ) / &
+            ( 1. + mu_soil*(1.-alphaO2_soil(:,1,:)) )
+       CH4_soil(:,1,:) = ( CH4sa(:,:) + mu_soil*betaCH4_soil(:,1,:) ) / &
+            ( 1. + mu_soil*(1.-alphaCH4_soil(:,1,:)) )
+       !
+    ENDWHERE
+    !
+    ! 2.1.2 first existing soil type
+    !
+    WHERE ( snowtop(:,:) .AND. veget_mask_2d(:,:) )
+       !
+       O2_snow(:,1,:) = ( O2sa(:,:) + mu_snow(:,:)*betaO2_snow(:,1,:) ) / &
+            ( 1. + mu_snow(:,:)*(1.-alphaO2_snow(:,1,:)) )
+       CH4_snow(:,1,:) = ( CH4sa(:,:) + mu_snow(:,:)*betaCH4_snow(:,1,:) ) / &
+            ( 1. + mu_snow(:,:)*(1.-alphaCH4_snow(:,1,:)) )
+       !
+       O2_soil(:,1,:) =  &
+            alphaO2_snow(:,nsnow,:) * O2_snow(:,nsnow,:) + &
+            betaO2_snow(:,nsnow,:)
+       CH4_soil(:,1,:) =  &
+            alphaCH4_snow(:,nsnow,:) * CH4_snow(:,nsnow,:) + &
+            betaCH4_snow(:,nsnow,:)
+       ! debug: need to check for weird numbers here!
+    ENDWHERE
+    !
+    ! 2.2 other levels
+    !
+    DO il = 2, nsnow
+       
+       WHERE ( veget_mask_2d(:,:) )
+          !
+          O2_snow(:,il,:) =  &
+               alphaO2_snow(:,il-1,:) * O2_snow(:,il-1,:) + &
+               betaO2_snow(:,il-1,:)
+          CH4_snow(:,il,:) =  &
+               alphaCH4_snow(:,il-1,:) * CH4_snow(:,il-1,:) + &
+               betaCH4_snow(:,il-1,:)
+       END WHERE
+    ENDDO
+    DO il = 2, ndeep
+       
+       WHERE ( veget_mask_2d(:,:)  )
+          !
+          O2_soil(:,il,:) =  &
+               alphaO2_soil(:,il-1,:) * O2_soil(:,il-1,:) + &
+               betaO2_soil(:,il-1,:)
+          CH4_soil(:,il,:) =  &
+               alphaCH4_soil(:,il-1,:) * CH4_soil(:,il-1,:) + &
+               betaCH4_soil(:,il-1,:)
+       END WHERE
+    ENDDO
+
+  END SUBROUTINE soil_gasdiff_diff
+ 
+!!
+!================================================================================================================================
+!! SUBROUTINE   : get_gasdiff
+!!
+!>\BRIEF        This routine update oxygen and methane in the snow and soil 
+!!
+!! DESCRIPTION : 
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : 
+!! 
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART11    : None
+!! \n
+!_
+!================================================================================================================================    
+  SUBROUTINE get_gasdiff (kjpindex,hslong,tprof,snow,airvol_snow, &
+       totporO2_snow,totporCH4_snow,diffO2_snow,diffCH4_snow, &
+       airvol_soil,totporO2_soil,totporCH4_soil,diffO2_soil,diffCH4_soil, z_organic, snowrho)
+   
+  !! 0. Variable and parameter declaration
+
+    !! 0.1  Input variables
+
+    INTEGER(i_std), INTENT(in)                                 :: kjpindex          !! number of grid points 
+    REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(in)     :: hslong            !! deep long term soil humidity profile 
+    REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(in)     :: tprof             !! Soil temperature (K)      
+    REAL(r_std), DIMENSION(kjpindex,nsnow), INTENT(in)         :: snowrho           !! snow density 
+    REAL(r_std), DIMENSION(kjpindex),  INTENT (in)             :: snow              !! Snow mass [Kg/m^2]
+    REAL(r_std), DIMENSION(kjpindex),   INTENT (in)            :: z_organic         !! depth to organic soil
+
+    !! 0.2  Output variables
+
+    REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(out)    :: airvol_soil
+    REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(out)    :: totporO2_soil     !! total O2 porosity (Tans, 1998)
+    REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(out)    :: totporCH4_soil    !! total CH4 porosity 
+    REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(out)    :: diffO2_soil       !! oxygen diffusivity (m**2/s)
+    REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(out)    :: diffCH4_soil      !! methane diffusivity (m**2/s)
+    REAL(r_std), DIMENSION(kjpindex,nsnow,nvm), INTENT(out)    :: airvol_snow
+    REAL(r_std), DIMENSION(kjpindex,nsnow,nvm), INTENT(out)    :: totporO2_snow     !! total O2 porosity (Tans, 1998)
+    REAL(r_std), DIMENSION(kjpindex,nsnow,nvm), INTENT(out)    :: totporCH4_snow    !! total CH4 porosity (Tans, 1998)
+    REAL(r_std), DIMENSION(kjpindex,nsnow,nvm), INTENT(out)    :: diffO2_snow       !! oxygen diffusivity (m**2/s)
+    REAL(r_std), DIMENSION(kjpindex,nsnow,nvm), INTENT(out)    :: diffCH4_snow      !! methane diffusivity (m**2/s)
+   
+    !! 0.3  Modified variables
+
+    !! 0.4 local variables
+ 
+    REAL(r_std), DIMENSION(kjpindex,nsnow,nvm)                 :: density_snow
+    REAL(r_std), DIMENSION(kjpindex,nsnow,nvm)                 :: porosity_snow
+    REAL(r_std), DIMENSION(kjpindex,nsnow,nvm)                 :: tortuosity_snow
+    REAL(r_std), DIMENSION(kjpindex,ndeep,nvm)                 :: density_soil
+    REAL(r_std), DIMENSION(kjpindex,ndeep,nvm)                 :: porosity_soil
+    REAL(r_std), DIMENSION(kjpindex,ndeep,nvm)                 :: tortuosity_soil
+    INTEGER(i_std)                                             :: it,ip, il, iv
+    REAL(r_std)                                                :: x, rho_iw
+    REAL(r_std)                                                :: csat, fng
+    REAL(r_std),  SAVE                                         :: cond_fact 
+  !$OMP THREADPRIVATE(cond_fact)
+    LOGICAL, SAVE                                              :: pr_fois=.TRUE.
+  !$OMP THREADPRIVATE(pr_fois)
+    
+    IF (pr_fois) THEN
+       cond_fact=1.
+       CALL getin_p('COND_FACT',cond_fact) 
+        WRITE(*,*) 'COND_FACT=',cond_fact
+       pr_fois=.FALSE.
+    ENDIF
+    
+    !
+    ! 1. Three-layers snow model with snow density resolved at each snow layer
+    !
+    DO iv = 1, nvm 
+       density_snow(:,:,iv) = snowrho(:,:)
+    ENDDO
+    porosity_snow(:,:,:) = (1. - density_snow(:,:,:)/rho_ice )
+    tortuosity_snow(:,:,:) = porosity_snow(:,:,:)**(1./3.)     ! based on Sommerfeld et al., GBC, 1996
+    diffO2_snow(:,:,:) = diffO2_air * porosity_snow(:,:,:) * tortuosity_snow(:,:,:)
+    diffCH4_snow(:,:,:) = diffCH4_air * porosity_snow(:,:,:) * tortuosity_snow(:,:,:)
+    airvol_snow(:,:,:) = MAX(porosity_snow(:,:,:),avm)
+    totporO2_snow(:,:,:) = airvol_snow(:,:,:)
+    totporCH4_snow(:,:,:) = airvol_snow(:,:,:)
+    !
+    ! 2. soil: depends on temperature and soil humidity
+    !
+    DO ip = 1, kjpindex
+       !
+       DO iv = 1, nvm
+          !
+          IF ( veget_mask_2d(ip,iv) ) THEN
+             !
+             DO il = 1, ndeep
+                !
+                ! 2.1 soil dry density, porosity, and dry heat capacity
+                !
+                porosity_soil(ip,il,iv) = tetasat
+                !
+                !
+                ! 2.2 heat capacity and density as a function of
+                !     ice and water content
+                !  removed these as we are calculating thermal evolution in the sechiba subroutines
+               
+                !
+                ! 2.3 oxygen diffusivity: soil can get waterlogged,
+                !     therefore take soil humidity into account
+                !
+                tortuosity_soil(ip,il,iv) = 2./3. ! Hillel, 1980
+                airvol_soil(ip,il,iv) = porosity_soil(ip,il,iv)*(1.-hslong(ip,il,iv))  
+                totporO2_soil(ip,il,iv) = airvol_soil(ip,il,iv) + porosity_soil(ip,il,iv)*BunsenO2*hslong(ip,il,iv)  
+                totporCH4_soil(ip,il,iv) = airvol_soil(ip,il,iv) + porosity_soil(ip,il,iv)*BunsenCH4*hslong(ip,il,iv)  
+                diffO2_soil(ip,il,iv) = (diffO2_air*airvol_soil(ip,il,iv) + & 
+                     diffO2_w*BunsenO2*hslong(ip,il,iv)*porosity_soil(ip,il,iv))*tortuosity_soil(ip,il,iv)  
+                diffCH4_soil(ip,il,iv) = (diffCH4_air*airvol_soil(ip,il,iv) + & 
+                     diffCH4_w*BunsenCH4*hslong(ip,il,iv)*porosity_soil(ip,il,iv))*tortuosity_soil(ip,il,iv)  
+                !
+          END DO
+       ELSE
+          tortuosity_soil(ip,:,iv) = EPSILON(0.)
+          airvol_soil(ip,:,iv) =  EPSILON(0.)
+          totporO2_soil(ip,:,iv) =  EPSILON(0.)
+          totporCH4_soil(ip,:,iv) = EPSILON(0.)
+          diffO2_soil(ip,:,iv) = EPSILON(0.)
+          diffCH4_soil(ip,:,iv) =  EPSILON(0.)
+       END IF
+    ENDDO
+ ENDDO
+
+END SUBROUTINE get_gasdiff
+  
+!!
+!================================================================================================================================
+!! SUBROUTINE   : traMplan
+!!
+!>\BRIEF        This routine calculates plant-mediated transport of methane
+!!
+!! DESCRIPTION : 
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : 
+!! 
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART11    : None
+!! \n
+!_
+!================================================================================================================================    
+  SUBROUTINE traMplan(CH4,O2,kjpindex,time_step,totporCH4,totporO2,z_root,rootlev,Tgr,Tref,hslong,flupmt, &
+       refdep, zi_soil, tprof)
+
+  !! 0. Variable and parameter declaration
+
+    !! 0.1  Input variables
+    
+    INTEGER(i_std), INTENT(in)			                  :: kjpindex    
+    REAL(r_std), INTENT(in)                                       :: time_step      !! time step in seconds
+    REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(in)        :: totporO2       !! total oxygen porosity
+    REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(in)        :: totporCH4      !! total methane porosity
+    REAL(r_std), DIMENSION(kjpindex,ndeep,nvm),INTENT(in)         :: tprof          !! soil temperature (K)
+    INTEGER(i_std),DIMENSION(kjpindex,nvm),INTENT(in)		  :: rootlev        !! the deepest model level within the rooting depth 
+    REAL(r_std), DIMENSION(kjpindex,nvm),INTENT(in)		  :: z_root         !! the rooting depth
+    REAL(r_std), INTENT(in) 					  :: Tgr            !! Temperature at which plants begin to grow (C)
+    REAL(r_std), DIMENSION(ndeep), INTENT(in)                     :: zi_soil        !!  depths at intermediate levels 
+    REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(in)        :: hslong         !! deep soil humidity
+
+    !! 0.2 Output variables
+
+    REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(out)             :: flupmt         !! plant-mediated methane flux (g m-2 s-1)
+
+    !! 0.3 Modified variables
+
+    REAL(r_std), DIMENSION(kjpindex,nvm),INTENT(inout)            :: Tref           !! Ref. temperature for growing season caluculation (C)
+    REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(inout)     :: O2
+    REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(inout)     :: CH4
+
+    !! 0.4 local variables
+    REAL(r_std), DIMENSION(kjpindex,nvm)   			  :: CH4atm         !! CH4 atm concentration
+    REAL(r_std), DIMENSION(kjpindex,nvm)                          :: dCH4           !! delta CH4 per m3 air
+    REAL(r_std), DIMENSION(kjpindex,nvm)   			  :: dO2            !! O2 change
+    REAL(r_std), DIMENSION(kjpindex,nvm)	       		  :: fgrow          !! Plant growing state (maturity index)
+    REAL(r_std)                            			  :: froot          !! vertical distribution of roots
+    REAL(r_std)					                  :: Tmat           !! Temperature at which plants reach maturity (C)
+    REAL(r_std), PARAMETER 				          :: La_min = zero
+    REAL(r_std), PARAMETER                                        :: La = 4.
+    REAL(r_std), PARAMETER 				          :: La_max = La_min + La
+    REAL(r_std), PARAMETER 				          :: Tveg = 10      !! Vegetation type control on the plant-mediated transport, Adjustable parameter,
+                                                                                    !! but we start from 10 following Walter et al (2001) tundra value 
+    REAL(r_std), PARAMETER 				          :: Pox = 0.5      !! fraction of methane oxydized near the roots
+    LOGICAL, SAVE 				                  :: firstcall=.TRUE.
+  !$OMP THREADPRIVATE(firstcall)
+    INTEGER(i_std)       				          :: il,ip, iv
+    LOGICAL, SAVE			                          :: check = .FALSE.
+  !$OMP THREADPRIVATE(check)
+    REAL(r_std), INTENT(in)			                  :: refdep         !! Depth to compute reference temperature for the growing season (m)
+    INTEGER(i_std), SAVE				          :: reflev = 0     !! Level closest to reference depth refdep
+  !$OMP THREADPRIVATE(reflev)
+   
+
+    IF (firstcall) THEN
+       firstcall = .FALSE.
+
+       ! Find the level closest to refdep
+       DO il=1,ndeep
+          IF (zi_soil(il) .GT. refdep .AND. reflev.EQ.0) reflev = il-1
+       ENDDO
+       IF (reflev.EQ.0) reflev = ndeep
+
+
+       IF (check) THEN
+          OPEN (28,file='pmt.dat',status='unknown') 
+          OPEN (29,file='pmtf.dat',status='unknown')
+       ENDIF
+    ENDIF
+
+     ! Update seasonal reference temperature trace record  
+     WHERE ( veget_mask_2d(:,:) )          
+        Tref(:,:) = tprof(:,reflev,:) - ZeroCelsius
+     END WHERE
+
+    Tmat = Tgr + 10._r_std
+    flupmt(:,:) = zero
+    CH4atm(:,:) = zero  
+
+
+    ! Plant growing state (maturity index)
+    WHERE (Tref(:,:).LE.Tgr .AND. veget_mask_2d(:,:) )
+       fgrow(:,:) = La_min
+    ELSEWHERE (Tref(:,:).GE.Tmat .AND. veget_mask_2d(:,:) )
+       fgrow(:,:) = La_max
+    ELSEWHERE   ( veget_mask_2d(:,:))
+       fgrow(:,:) = La_min + La * (1 - ((Tmat - Tref(:,:))/(Tmat - Tgr))**2)
+    ENDWHERE
+
+    DO ip=1,kjpindex
+       DO iv = 1, nvm
+          IF ( (z_root(ip,iv) .GT. 0.) .AND. veget_mask_2d(ip,iv) ) THEN ! added this to prevent pmt calcs when soil frozen
+             DO il=1,rootlev(ip,iv)
+                ! vertical distribution of roots
+                froot = MAX( 2 * (z_root(ip,iv) - REAL( zi_soil(il) )) / z_root(ip,iv), zero) 
+                ! Methane removal from a given depth. We assume that the methane
+                ! in air pores is always in equilibrium with that dissolved 
+                ! in water-filled pores. If soil humidity is low,
+                ! with root water as well
+                ! We assume that PMT is proportional to soil humidity
+                dCH4(ip,iv) = 0.01_r_std * Tveg * froot * fgrow(ip,iv) * hslong(ip,il,iv) * (CH4(ip,il,iv) - CH4atm(ip,iv))  
+                ! No transport if soil concentration is less than atmospheric
+                IF (dCH4(ip,iv).LT.CH4atm(ip,iv)) dCH4(ip,iv) = zero 
+                ! Strange thing in WH 2001: 0.01*Tveg*froot*fgrow > 1
+                ! at Tveg=15, froot&fgrow=max, i.e. more CH4 is taken than available
+                ! So need to impose a limitation:
+                IF (dCH4(ip,iv).GT.CH4(ip,il,iv)) dCH4(ip,iv) = CH4(ip,il,iv)
+                ! Methane concentration is decreased within the root layer:
+                
+                CH4(ip,il,iv) = CH4(ip,il,iv) - dCH4(ip,iv)
+                ! O2 concentration is decreased in reaction with
+                ! dCH4*Pox*time_step
+                dO2(ip,iv) = dCH4(ip,iv)*Pox * wO2/wCH4 * totporCH4(ip,il,iv)/totporO2(ip,il,iv)
+                IF ( dO2(ip,iv).LT.O2(ip,il,iv) ) O2(ip,il,iv) = O2(ip,il,iv) - dO2(ip,iv)
+                
+                ! CO2 concentration is increased by dCH4(:)*Pox
+                
+                ! Integration	 
+                flupmt(ip,iv) = flupmt(ip,iv) + dCH4(ip,iv)*totporCH4(ip,il,iv)/time_step * (1 - Pox) * &
+                     ( zf_soil(il) - zf_soil(il-1) )
+             ENDDO
+          END IF
+       ENDDO
+    ENDDO
+    
+    IF (check) THEN
+       WRITE(29,*) flupmt(:,:)
+       CALL flush(28) 
+       CALL flush(29) 
+    END IF
+    
+  END SUBROUTINE traMplan
+  
+!!
+!================================================================================================================================
+!! SUBROUTINE   : ebullition
+!!
+!>\BRIEF        This routine calculates CH4 ebullition
+!!
+!! DESCRIPTION : 
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : 
+!! 
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART11    : None
+!! \n
+!_
+!================================================================================================================================     
+  SUBROUTINE ebullition (kjpindex,time_step,tprof,totporCH4_soil,hslong,Ch4_soil,febul)
+   
+  !! 0. Variable and parameter declaration
+
+    !! 0.1  Input variables 
+
+    INTEGER(i_std), INTENT(in)                                  :: kjpindex
+    REAL(r_std), INTENT(in)                                     :: time_step      !! time step in seconds
+    REAL(r_std), DIMENSION(kjpindex,ndeep,nvm),INTENT(in)       :: tprof          !! soil temperature (K)
+    REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(in)      :: totporCH4_soil !! total methane porosity
+    REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(in)      :: hslong         !! deep soil humidity
+
+    !! 0.2 Output variables
+    
+    REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(out)           :: febul          !! CH4 ebullition
+
+    !! 0.3 Modified variables
+
+    REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(inout)   :: Ch4_soil       !! methane 
+
+    !! 0.4 Local variables
+    REAL(r_std)                                                 :: dCH4, CH4d
+    INTEGER(i_std)                                              :: ip, il, iv
+    REAL(r_std)                                                 :: dz
+    REAL(r_std), PARAMETER                                      :: tortuosity=2./3. 
+    REAL(r_std), PARAMETER                                      :: wsize=0.01
+    REAL(r_std), PARAMETER                                      :: CH4wm = 12.E-3 !! CH4 concentration threshold for ebullition (8-16 mg/m3 in Walter&Heimann 2000)
+    REAL(r_std)                                                 :: hum
+
+    DO ip=1,kjpindex
+       DO iv = 1, nvm
+          IF ( veget_mask_2d(ip,iv) ) THEN
+             febul(ip,iv) = zero
+             IF (hslong(ip,1,iv).GT.ebuthr) THEN
+                DO il = ndeep, 1, -1
+                   CH4d = Ch4_soil(ip,il,iv) - CH4wm/BunsenCH4
+                   IF (CH4d .GT. EPSILON(0.)) THEN  
+                      IF (il.GT.1) THEN
+                         dz = zi_soil(il) - zi_soil(il-1)
+                         hum = ( hslong(ip,il,iv) + hslong(ip,il-1,iv) ) / 2 
+                      ELSE
+                         dz = zi_soil(1)
+                         hum = hslong(ip,1,iv)
+                      ENDIF
+                      
+                      dCH4 = hum**( dz/wsize/tortuosity ) * CH4d
+                      dCH4 = CH4d 
+                      
+                      Ch4_soil(ip,il,iv) = Ch4_soil(ip,il,iv) - dCH4
+                      
+                   
+                      febul(ip,iv) = febul(ip,iv) + dCH4 * totporCH4_soil(ip,il,iv) *  &
+                           ( zf_soil(il) - zf_soil(il-1) ) / time_step
+                      
+                   ENDIF 
+                ENDDO
+             ENDIF 
+          END IF
+       ENDDO
+    ENDDO
+  END SUBROUTINE ebullition
+  
+!!
+!================================================================================================================================
+!! SUBROUTINE   : microactem
+!!
+!>\BRIEF        This routine calculates parameters describing bacterial activity (time constant tau[s]) as a function of temperature
+!!
+!! DESCRIPTION : 
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : 
+!! 
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART11    : None
+!! \n
+!_
+!================================================================================================================================     
+  FUNCTION microactem ( temp_kelvin, frozen_respiration_func, moist_in, i_ind, j_ind, k_ind, zi_soil ) RESULT ( fbact )
+
+  !! 0. Variable and parameter declaration
+
+    !! 0.1  Input variables 
+    
+    INTEGER(i_std), INTENT(in)                        :: i_ind
+    INTEGER(i_std), INTENT(in)                        :: j_ind
+    INTEGER(i_std), INTENT(in)                        :: k_ind
+    INTEGER(i_std), INTENT(in)                        :: frozen_respiration_func
+    REAL, DIMENSION(i_ind, j_ind, k_ind), INTENT(in)  :: moist_in
+    REAL, DIMENSION(i_ind, j_ind, k_ind), INTENT(in)  :: temp_kelvin
+    REAL, DIMENSION(j_ind), INTENT(in)                :: zi_soil
+
+    !! 0.2 Output variables 
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+
+    REAL, DIMENSION(i_ind, j_ind, k_ind)              :: fbact
+    REAL, DIMENSION(i_ind, j_ind, k_ind)              :: tempfunc_result
+    INTEGER(i_std), PARAMETER                         :: ntconfun = 7
+    REAL(r_std), DIMENSION(ntconfun)                  :: tconfun
+    REAL(r_std), DIMENSION(ntconfun)                  :: tauconfun
+    INTEGER                                           :: itz
+    INTEGER                                           :: ii, ij, ik
+    REAL, DIMENSION(i_ind, j_ind, k_ind)              :: moistfunc_result
+    REAL(r_std), parameter                            :: q10 = 2.0
+    REAL(r_std), PARAMETER                            :: stomate_tau = 4.699E6  !4.7304E7 !4.699E6  
+    logical, parameter                                :: limit_decomp_moisture = .true.
+    REAL(r_std), SAVE                                 :: depth_modifier = 1.E6 ! e-folding depth of turnover rates,following Koven et al.,2013,Biogeosciences. A very large value means no depth modification
+  !$OMP THREADPRIVATE(depth_modifier)
+    LOGICAL, SAVE                                     :: is_firstcall = .TRUE.
+  !$OMP THREADPRIVATE(is_firstcall)
+
+    IF (is_firstcall) THEN
+        !
+        !Config Key   = depth_modifier 
+        !Config Desc  = e-folding depth of turnover rates,following Koven et
+        !Config DEsc    al.,2013,Biogeosciences. A very large value means no depth modification 
+        !Config Def   = 1.E6 
+        !Config If    = 
+        !Config Help  = 
+        !Config         
+        !Config Units = [-]
+        !
+        CALL getin_p('depth_modifier',depth_modifier)
+        is_firstcall = .FALSE. 
+    ENDIF
+
+    SELECT CASE(frozen_respiration_func)
+
+    CASE(0) ! this is the standard ORCHIDEE state
+
+       tempfunc_result(:,:,:) = EXP( log(q10) * ( temp_kelvin(:,:,:) - (ZeroCelsius+30.) ) / 10. )
+       tempfunc_result(:,:,:) = MIN( 1._r_std, tempfunc_result(:,:,:) )
+
+    CASE(1)  ! cutoff respiration when T < -1C
+       WHERE (temp_kelvin(:,:,:) .GT. ZeroCelsius ) ! normal as above
+          tempfunc_result(:,:,:) = EXP( log(q10) * ( temp_kelvin(:,:,:) - (ZeroCelsius+30.) ) / 10. )
+       ELSEWHERE (temp_kelvin(:,:,:) .GT. ZeroCelsius - 1. )  ! linear dropoff to zero
+          tempfunc_result(:,:,:) = (temp_kelvin(:,:,:) - (ZeroCelsius - 1.)) * &
+               EXP( log(q10) * ( ZeroCelsius - (ZeroCelsius+30.) ) / 10. )
+       ELSEWHERE  ! zero
+          tempfunc_result(:,:,:) = EPSILON(0.)
+       endwhere
+
+       tempfunc_result(:,:,:) = MAX(MIN( 1._r_std, tempfunc_result(:,:,:) ), EPSILON(0.))
+
+    CASE(2)  ! cutoff respiration when T < -3C
+       WHERE (temp_kelvin(:,:,:) .GT. ZeroCelsius ) ! normal as above
+          tempfunc_result(:,:,:) = EXP( log(q10) * ( temp_kelvin(:,:,:) - (ZeroCelsius+30.) ) / 10. )
+       ELSEWHERE (temp_kelvin(:,:,:) .GT. ZeroCelsius - 3. )  ! linear dropoff to zero
+          tempfunc_result(:,:,:) = ((temp_kelvin(:,:,:) - (ZeroCelsius - 3.))/3.) * &
+               EXP( log(q10) * ( ZeroCelsius - (ZeroCelsius+30.) ) / 10. )
+       ELSEWHERE  ! zero
+          tempfunc_result(:,:,:) = EPSILON(0.)
+       endwhere
+
+    CASE(3)  ! q10 = 100 when below zero
+       WHERE (temp_kelvin(:,:,:) .GT. ZeroCelsius ) ! normal as above
+          tempfunc_result(:,:,:) = EXP( log(q10) * ( temp_kelvin(:,:,:) - (ZeroCelsius+30.) ) / 10. )
+       ELSEWHERE 
+          tempfunc_result(:,:,:) = EXP( log(100.) * ( temp_kelvin(:,:,:) - (ZeroCelsius) ) / 10. ) * &
+               EXP( log(q10) * ( -30. ) / 10. )
+       endwhere
+
+    CASE(4)  ! q10 = 1000 when below zero
+       WHERE (temp_kelvin(:,:,:) .GT. ZeroCelsius ) ! normal as above
+          tempfunc_result(:,:,:) = EXP( log(q10) * ( temp_kelvin(:,:,:) - (ZeroCelsius+30.) ) / 10. )
+       ELSEWHERE 
+          tempfunc_result(:,:,:) = EXP( log(1000.) * ( temp_kelvin(:,:,:) - (ZeroCelsius) ) / 10. ) * &
+               EXP( log(q10) * ( -30. ) / 10. )
+       endwhere
+
+    CASE DEFAULT
+       WRITE(*,*) 'microactem ERROR: frozen_respiration_func not in list: ', frozen_respiration_func
+       STOP
+
+    END SELECT
+    tempfunc_result(:,:,:) = MAX(MIN( 1._r_std, tempfunc_result(:,:,:) ), EPSILON(0.))
+
+    !---- stomate residence times: -----!
+    ! residence times in carbon pools (days)
+    !carbon_tau(iactive) = .149 * one_year        !!!!???? 1.5 years
+    !carbon_tau(islow) = 5.48 * one_year          !!!!???? 25 years
+    !carbon_tau(ipassive) = 241. * one_year       !!!!???? 1000 years
+    !-----------------------------------!
+    IF ( limit_decomp_moisture ) THEN
+       ! stomate moisture control function
+       moistfunc_result(:,:,:) = -1.1 * moist_in(:,:,:) * moist_in(:,:,:) + 2.4 * moist_in(:,:,:) - 0.29
+       moistfunc_result(:,:,:) = max( 0.25_r_std, min( 1._r_std, moistfunc_result(:,:,:) ) )
+    ELSE
+       moistfunc_result(:,:,:) = 1._r_std
+    ENDIF
+
+    DO ij = 1, ndeep
+      fbact(:,ij,:) = stomate_tau/(moistfunc_result(:,ij,:) * tempfunc_result(:,ij,:)) / EXP(-zi_soil(ij)/depth_modifier)
+    ENDDO
+
+    ! chaoyue: We tentatively increase the turnover of soil C in croplands,
+    ! as shown here to decrease its tau -- the residence time.
+    DO ik = 1,nvm
+      IF ( (.NOT. natural(ik)) .AND. (.NOT. is_c4(ik)) .AND. (.NOT. pasture(ik)) ) THEN
+        fbact(:,:,ik) = fbact(:,:,ik)/flux_tot_coeff(1)
+      ELSEIF ( (.NOT. natural(ik)) .AND. is_c4(ik) .AND. (.NOT. pasture(ik)) ) THEN
+        fbact(:,:,ik) = fbact(:,:,ik)/flux_tot_coeff(2)
+      ENDIF
+    ENDDO
+    
+  END FUNCTION microactem
+  
+  
+!!
+!================================================================================================================================
+!! SUBROUTINE   : snowlevels
+!!
+!>\BRIEF        This routine calculates depths of full levels and intermediate
+!!              levels related to snow pack
+!!
+!! DESCRIPTION : 
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : 
+!! 
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART11    : None
+!! \n
+!_
+!================================================================================================================================     
+ 
+  SUBROUTINE snowlevels( kjpindex, snowdz, zi_snow, zf_snow, veget_max )
+
+  !! 0. Variable and parameter declaration
+
+    !! 0.1  Input variables     
+
+    INTEGER(i_std), INTENT(in)                                          :: kjpindex
+    REAL(r_std), DIMENSION(kjpindex,nvm),INTENT(in)                     :: veget_max     !! maximum vegetation fraction
+    REAL(r_std), DIMENSION(kjpindex,nsnow),INTENT(in)                   :: snowdz        !! snow depth
+
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables
+
+    REAL(r_std), DIMENSION(kjpindex,0:nsnow,nvm), INTENT(inout)         :: zf_snow       !! depths of full levels (m)
+    REAL(r_std), DIMENSION(kjpindex,nsnow,nvm), INTENT(inout)           :: zi_snow       !! depths of intermediate levels (m)
+
+    !! 0.4 Local variables
+
+    REAL(r_std), DIMENSION(kjpindex,nvm)                                :: z_alpha       !! parameter of the geometric series
+    INTEGER(i_std)                                                      :: il,it, ix, iv
+    INTEGER(i_std)                                                      :: it_beg,it_end
+    INTEGER(i_std), PARAMETER                                           :: niter = 10
+    REAL(r_std), DIMENSION(kjpindex)                                    :: dxmin
+    INTEGER(i_std), DIMENSION(kjpindex)                                 :: imin
+    INTEGER(i_std)                                                      :: i,j
+    REAL(r_std), DIMENSION(kjpindex,nvm)                                :: xi, xf
+    REAL(r_std), DIMENSION(kjpindex,nsnow,nvm)                          :: snowdz_pft 
+
+    snowdz_pft(:,:,:) = 0.0 
+    DO il = 1,nsnow 
+       DO iv = 1, nvm
+          WHERE ( veget_mask_2d(:,iv) ) 
+                snowdz_pft(:,il,iv) = snowdz(:,il)
+          ENDWHERE
+       ENDDO 
+    ENDDO
+    !
+    ! calculate snow discretisation
+    !
+    WHERE ( veget_mask_2d(:,:) )
+       zf_snow(:,0,:) = 0.
+    END WHERE
+    !
+    DO il = 1, nsnow
+       IF ( il .EQ. 1 ) THEN
+          WHERE ( veget_mask_2d(:,:) )
+             
+             zi_snow(:,il,:) = snowdz_pft(:,1,:) / 2. 
+             
+             zf_snow(:,il,:) = snowdz_pft(:,1,:)
+        
+          END WHERE
+       ENDIF
+
+       IF ( il .GT. 1 ) THEN
+          WHERE ( veget_mask_2d(:,:) )
+             
+             zi_snow(:,il,:) = zf_snow(:,il-1,:) + snowdz_pft(:,il,:) / 2 
+             
+             zf_snow(:,il,:) = SUM(snowdz_pft(:,1:il,:),2)
+
+          END WHERE
+       ENDIF
+
+    ENDDO
+    
+    DO ix = 1, kjpindex
+       DO il = 1, nsnow
+          zi_snow_nopftdim(ix,il) = SUM(zi_snow(ix,il,:)*veget_max(ix,:))
+          zf_snow_nopftdim(ix,il) = SUM(zf_snow(ix,il,:)*veget_max(ix,:))
+       END DO
+    END DO
+    
+  END SUBROUTINE snowlevels
+ 
+!!
+!================================================================================================================================
+!! SUBROUTINE   : snow_interpol
+!!
+!>\BRIEF        This routine interpolates oxygen and methane into snow layers
+!!
+!! DESCRIPTION : 
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : 
+!! 
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART11    : None
+!! \n
+!_
+!================================================================================================================================     
+ 
+  SUBROUTINE snow_interpol (kjpindex,snowO2, snowCH4, zi_snow, zf_snow, veget_max, snowdz)
+    
+  !! 0. Variable and parameter declaration
+
+    !! 0.1  Input variables     
+
+    INTEGER(i_std), INTENT(in)                                  :: kjpindex
+    REAL(r_std), DIMENSION(kjpindex,nsnow), INTENT(in)          :: snowdz       !! snow depth at each layer
+    REAL(r_std), DIMENSION(kjpindex,nvm),INTENT(in)             :: veget_max    !! maximum vegetation fraction                                                           
+
+    !! 0.2 Output variables                                     
+                                                                
+    !! 0.3 Modified variables                                   
+
+    REAL(r_std), DIMENSION(kjpindex,nsnow,nvm), INTENT(inout)   :: snowO2       !! snow oxygen (g O2/m**3 air)
+    REAL(r_std), DIMENSION(kjpindex,nsnow,nvm), INTENT(inout)   :: snowCH4      !! snow methane (g CH4/m**3 air), needed just for num. scheme
+    REAL(r_std), DIMENSION(kjpindex,0:nsnow,nvm), INTENT(inout) :: zf_snow      !! depths at full levels
+    REAL(r_std), DIMENSION(kjpindex,nsnow,nvm), INTENT(inout)   :: zi_snow      !! depths at intermediate levels
+
+    !! 0.4 Local variables
+    REAL(r_std), DIMENSION(kjpindex,nsnow,nvm)                  :: isnow        !! index of first old layer that is deeper
+    INTEGER(i_std), DIMENSION(kjpindex,nsnow,nvm)               :: i1,i2        !! indices of the layers used for the inter- or extrapolation
+    REAL(r_std), DIMENSION(kjpindex,nsnow,nvm)                  :: snowO2o      !! initial snow oxygen (g O2/m**3 air)
+    REAL(r_std), DIMENSION(kjpindex,nsnow,nvm)                  :: snowCH4o     !! initial snow methane (g CH4/m**3 air)
+    REAL(r_std), DIMENSION(kjpindex,nvm)                        :: dzio         !! initial distance between two levels
+    INTEGER(i_std)                                      :: il, it, ip, ill, iv  !! indices
+    REAL(r_std), DIMENSION(kjpindex,0:nsnow,nvm)              :: zfo            !! initial depths at full levels
+    REAL(r_std), DIMENSION(kjpindex,nsnow,nvm)                :: zio            !! initial depths at intermediate levels    
+    
+    
+    
+    ! 1. save old discretisation and temperatures
+    
+    zio(:,:,:) = zi_snow(:,:,:)
+    
+    zfo(:,:,:) = zf_snow(:,:,:)
+    
+    snowO2o(:,:,:) = snowO2(:,:,:)
+    snowCH4o(:,:,:) = snowCH4(:,:,:)
+    
+    ! 2. new discretisation
+    
+    CALL snowlevels( kjpindex, snowdz, zi_snow, zf_snow, veget_max)
+    
+    ! 3. for each new intermediate layer, look for the first old intermediate 
+    !   layer that is deeper
+    
+    DO il = 1, nsnow
+       
+       isnow(:,il,:) = -1
+       
+       DO ill = nsnow,1,-1
+          
+          WHERE ( zio(:,ill,:) .GT. zi_snow(:,il,:) .AND. veget_mask_2d(:,:) )
+             
+             isnow(:,il,:) = ill
+             
+          ENDWHERE
+          
+       ENDDO
+       
+    ENDDO
+   
+    ! 4. determine which levels to take for the inter- or extrapolation
+    
+
+    DO ip = 1, kjpindex
+       DO iv = 1, nvm
+          IF ( veget_mask_2d(ip,iv) ) THEN
+             DO il = 1, nsnow
+                !
+                IF ( isnow(ip,il,iv) .EQ. 1  ) THEN
+                   !
+                   ! 4.1 first old layer is below new layer:
+                   !       extrapolation from layers 1 and 2
+                   !
+                   i1(ip,il,iv) = 1
+                   i2(ip,il,iv) = 2
+                   !
+                ELSEIF ( isnow(ip,il,iv) .EQ. -1 ) THEN
+                   !
+                   ! 4.2 new layer is below last old layer:
+                   !       extrapolation from layers nsnow-1 and nsnow
+                   !
+                   i1(ip,il,iv) = nsnow-1
+                   i2(ip,il,iv) = nsnow
+                   !
+                ELSE
+                   !
+                   ! 4.3 new layer is between two old layers: interpolation
+                   !
+                   i1(ip,il,iv) = isnow(ip,il,iv)-1
+                   i2(ip,il,iv) = isnow(ip,il,iv)
+                   !
+                ENDIF
+                
+             ENDDO
+          ENDIF
+       ENDDO
+    ENDDO
+    
+    ! 5. inter- or extrapolate
+    
+    DO ip = 1, kjpindex
+       DO iv = 1, nvm
+          IF ( veget_mask_2d(ip,iv) ) THEN
+             DO il = 1, nsnow
+                dzio(ip,iv) = zio(ip,i2(ip,il,iv),iv) - zio(ip,i1(ip,il,iv),iv)
+                
+                IF ( dzio(ip,iv) .GT. min_stomate ) THEN
+                   
+                   snowO2(ip,il,iv) =  snowO2o(ip,i1(ip,il,iv),iv) + &
+                        ( zi_snow(ip,il,iv) - zio(ip,i1(ip,il,iv),iv) ) / dzio(ip,iv) * &
+                        ( snowO2o(ip,i2(ip,il,iv),iv) - snowO2o(ip,i1(ip,il,iv),iv)  )
+                   snowCH4(ip,il,iv) =  snowCH4o(ip,i1(ip,il,iv),iv) + &
+                        ( zi_snow(ip,il,iv) - zio(ip,i1(ip,il,iv),iv) ) / dzio(ip,iv) * &
+                        ( snowCH4o(ip,i2(ip,il,iv),iv) - snowCH4o(ip,i1(ip,il,iv),iv)  )
+                   
+                ELSE
+                   
+                   snowO2(ip,il,iv) = snowO2o(ip,i1(ip,il,iv),iv) 
+                   snowCH4(ip,il,iv) = snowCH4o(ip,i1(ip,il,iv),iv) 
+                   
+                ENDIF
+                
+             ENDDO
+          ENDIF
+       ENDDO
+       
+    ENDDO
+  END SUBROUTINE snow_interpol
+ 
+!!
+!================================================================================================================================
+!! SUBROUTINE   : permafrost_carbon_clear
+!!
+!>\BRIEF        
+!!
+!! DESCRIPTION : 
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : 
+!! 
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART11    : None
+!! \n
+!_
+!================================================================================================================================     
+  SUBROUTINE permafrost_carbon_clear()
+    IF (ALLOCATED(veget_mask_2d)) DEALLOCATE(veget_mask_2d)
+    IF (ALLOCATED(heights_snow)) DEALLOCATE(heights_snow)
+    IF (ALLOCATED(zf_soil)) DEALLOCATE(zf_soil)
+    IF (ALLOCATED(zi_soil)) DEALLOCATE(zi_soil)
+    IF (ALLOCATED(zf_snow)) DEALLOCATE(zf_snow)
+    IF (ALLOCATED(zi_snow)) DEALLOCATE(zi_snow)
+    IF (ALLOCATED(alphaO2_soil )) DEALLOCATE(alphaO2_soil )
+    IF (ALLOCATED(betaO2_soil )) DEALLOCATE(betaO2_soil )
+    IF (ALLOCATED(alphaCH4_soil )) DEALLOCATE(alphaCH4_soil )
+    IF (ALLOCATED(betaCH4_soil )) DEALLOCATE(betaCH4_soil )
+    IF (ALLOCATED(alphaO2_snow )) DEALLOCATE(alphaO2_snow )
+    IF (ALLOCATED(betaO2_snow )) DEALLOCATE(betaO2_snow )
+    IF (ALLOCATED(alphaCH4_snow )) DEALLOCATE(alphaCH4_snow )
+    IF (ALLOCATED(betaCH4_snow )) DEALLOCATE(betaCH4_snow )
+    IF (ALLOCATED(zf_coeff_snow )) DEALLOCATE(zf_coeff_snow )
+    IF (ALLOCATED(zi_coeff_snow )) DEALLOCATE(zi_coeff_snow )
+    IF (ALLOCATED(mu_snow )) DEALLOCATE(mu_snow )
+    IF (ALLOCATED(deepc_pftmean )) DEALLOCATE(deepc_pftmean )
+    
+  END SUBROUTINE permafrost_carbon_clear
+
+!!
+!================================================================================================================================
+!! SUBROUTINE   : initialize_yedoma_carbonstocks
+!!
+!>\BRIEF        This routine intialize soil carbon in yedoma region
+!!
+!! DESCRIPTION : 
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : 
+!! 
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART11    : None
+!! \n
+!_
+!================================================================================================================================     
+
+  SUBROUTINE initialize_yedoma_carbonstocks(kjpindex, lalo, soilc_a, soilc_s, soilc_p, zz_deep, &
+       yedoma_map_filename, yedoma_depth, yedoma_cinit_act, yedoma_cinit_slo, yedoma_cinit_pas, altmax_ind)
+   
+  !! 0. Variable and parameter declaration
+
+    !! 0.1  Input variables     
+ 
+    INTEGER(i_std), INTENT(in)                                       :: kjpindex            !! domain size
+    REAL(r_std), DIMENSION(kjpindex,2), INTENT(in)                   :: lalo                !! geographic lat/lon
+    REAL(r_std), DIMENSION(ndeep),   INTENT (in)                     :: zz_deep             !! deep vertical profile
+    CHARACTER(LEN=80), INTENT (in)                                   :: yedoma_map_filename !! yedoma map
+    REAL(r_std), INTENT(in)                                          :: yedoma_depth        !! depth of yedoma carbon stock
+    REAL(r_std), INTENT(in)                                          :: yedoma_cinit_act    !! initial active soil C concentration 
+    REAL(r_std), INTENT(in)                                          :: yedoma_cinit_slo    !! initial slow soil C concentration 
+    REAL(r_std), INTENT(in)                                          :: yedoma_cinit_pas    !! initial passive soil C concentration 
+    INTEGER(i_std), DIMENSION(kjpindex,nvm),INTENT(in)	             :: altmax_ind          !! Maximum over the year active-layer index
+
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables
+
+    REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(inout)        :: soilc_a             !! active soil C concentration
+    REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(inout)        :: soilc_s             !! slow soil C concentration
+    REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(inout)        :: soilc_p             !! passive soil C concentration
+
+    !! 0.4 Local variables
+    REAL(r_std), DIMENSION(kjpindex)                                 :: yedoma
+    INTEGER(i_std)                                                   :: il, ils, ip, ix, iy, imin, jmin, ier, iv
+    REAL(r_std)                                                      :: dlon, dlonmin, dlat, dlatmin
+    INTEGER(i_std)                                                   :: iml, jml, lml, tml, fid
+    REAL(r_std),ALLOCATABLE,DIMENSION(:,:)                           :: xx,yy, yedoma_file
+    REAL(r_std),ALLOCATABLE,DIMENSION(:)                             :: x,y
+    REAL(r_std)                                                      :: lev(1), date, dt
+    INTEGER(i_std)                                                   :: itau(1)
+    INTEGER(i_std)                                                   :: yedoma_depth_index, iz
+    
+    ! plus bas, on prend la temperature lue dans un fichier climato si celui-ci existe
+
+    IF ( yedoma_map_filename .EQ. "NONE" ) THEN
+       yedoma(:) = zero
+    ELSE IF ( yedoma_map_filename .EQ. "EVERYWHERE" ) THEN
+       yedoma(:) = 1.
+    ELSE
+       CALL flininfo(yedoma_map_filename,iml, jml, lml, tml, fid)
+
+       ALLOCATE (yy(iml,jml),stat=ier)
+       IF (ier.NE.0) THEN
+           WRITE (numout,*) ' error in yy allocation. We stop. We need ',iml,' fois ',jml,' words = '&
+              & , iml*jml
+           STOP 'deep_carbcycle'
+       END IF
+
+       ALLOCATE (xx(iml,jml),stat=ier)
+       IF (ier.NE.0) THEN
+           WRITE (numout,*) ' error in xx allocation. We stop. We need ',iml,'fois ',jml,' words = '&
+              & , iml*jml
+           STOP 'deep_carbcycle'
+       END IF
+
+       ALLOCATE (x(iml),stat=ier)
+       IF (ier.NE.0) THEN
+           WRITE (numout,*) ' error in x allocation. We stop. We need',iml,' words = '&
+              & , iml
+           STOP 'deep_carbcycle'
+       END IF
+
+       ALLOCATE (y(jml),stat=ier)
+       IF (ier.NE.0) THEN
+           WRITE (numout,*) ' error in y allocation. We stop. We need',jml,'words = '&
+              & , jml
+           STOP 'deep_carbcycle'
+       END IF
+
+       ALLOCATE (yedoma_file(iml,jml),stat=ier)
+       IF (ier.NE.0) THEN
+           WRITE (numout,*) ' error in yedoma_file allocation. We stop. We need ',iml,'fois ',jml,' words = '&
+              & , iml*jml
+           STOP 'deep_carbcycle'
+       END IF
+
+       CALL flinopen (yedoma_map_filename, .FALSE., iml, jml, lml, &
+            xx, yy, lev, tml, itau, date, dt, fid)
+       CALL flinget (fid, 'yedoma', iml, jml, lml, tml, &
+            1, 1, yedoma_file)
+       CALL flinclo (fid)
+       ! On suppose que le fichier est regulier.
+       ! Si ce n'est pas le cas, tant pis. Les temperatures seront mal
+       ! initialisees et puis voila. De toute maniere, il faut avoir
+       ! l'esprit mal tourne pour avoir l'idee de faire un fichier de
+       ! climatologie avec une grille non reguliere.
+       x(:) = xx(:,1)
+       y(:) = yy(1,:)
+       ! prendre la valeur la plus proche
+       DO ip = 1, kjpindex
+          dlonmin = HUGE(1.)
+          DO ix = 1,iml
+             dlon = MIN( ABS(lalo(ip,2)-x(ix)), ABS(lalo(ip,2)+360.-x(ix)), ABS(lalo(ip,2)-360.-x(ix)) )
+             IF ( dlon .LT. dlonmin ) THEN
+                imin = ix
+                dlonmin = dlon
+             ENDIF
+          ENDDO
+          dlatmin = HUGE(1.)
+          DO iy = 1,jml
+             dlat = ABS(lalo(ip,1)-y(iy))
+             IF ( dlat .LT. dlatmin ) THEN
+                jmin = iy
+                dlatmin = dlat
+             ENDIF
+          ENDDO
+          yedoma(ip) = yedoma_file(imin,jmin)
+       ENDDO
+       DEALLOCATE (yy)
+       DEALLOCATE (xx)
+       DEALLOCATE (x)
+       DEALLOCATE (y)
+       DEALLOCATE (yedoma_file)
+    ENDIF
+    
+    yedoma_depth_index = 0
+    DO iz = 1, ndeep
+       IF (zz_deep(iz) .LE. yedoma_depth ) yedoma_depth_index = yedoma_depth_index + 1
+    END DO
+    WRITE(*,*) 'yedoma_depth_index ', yedoma_depth_index, ' at depth ', yedoma_depth
+
+    IF ( yedoma_depth_index .GT. 0) THEN
+       DO ix = 1, kjpindex
+          DO iv = 2, nvm  !!! no yedoma carbon for PFT zero.
+             IF ( veget_mask_2d(ix,iv) ) THEN
+                DO iz = 1, yedoma_depth_index
+                   IF (yedoma(ix) .GT. 0.)  THEN
+                      IF ( iz .GE. altmax_ind(ix,iv) ) THEN  !!! only put yedoma carbon at base of and below the active layer
+                         soilc_a(ix, iz,iv) = yedoma_cinit_act
+                         soilc_s(ix, iz,iv) = yedoma_cinit_slo
+                         soilc_p(ix, iz,iv) = yedoma_cinit_pas
+                      ELSE
+                         soilc_a(ix, iz,iv) = zero
+                         soilc_s(ix, iz,iv) = zero
+                         soilc_p(ix, iz,iv) = zero
+                      ENDIF
+                   ELSE
+                      soilc_a(ix, iz,iv) = zero
+                      soilc_s(ix, iz,iv) = zero
+                      soilc_p(ix, iz,iv) = zero
+                   END IF
+                END DO
+             ENDIF
+          ENDDO
+       ENDDO
+    ENDIF
+
+  END SUBROUTINE initialize_yedoma_carbonstocks
+!!
+!================================================================================================================================
+!! SUBROUTINE   : carbinput
+!!
+!>\BRIEF        This routine calculate carbon input to the soil
+!!
+!! DESCRIPTION : 
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : 
+!! 
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART11    : None
+!! \n
+!_
+!================================================================================================================================     
+  SUBROUTINE carbinput(kjpindex,time_step,time,no_pfrost_decomp,tprof,tsurf,hslong, dayno,z_root,altmax, &
+       soilc_a, soilc_s, soilc_p, soilc_in, dc_litter_z, z_organic, veget_max, rprof)
+   
+  !! 0. Variable and parameter declaration
+
+    !! 0.1  Input variables     
+ 
+    INTEGER(i_std), INTENT(in)				             :: kjpindex         !! domain size
+    REAL(r_std), INTENT(in)                                          :: time_step        !! time step in seconds
+    REAL(r_std), INTENT(in)				             :: time  
+    LOGICAL, INTENT(in)				                     :: no_pfrost_decomp  
+    REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(in)           :: tprof            !! Soil temperature (K)
+    REAL(r_std), DIMENSION(kjpindex), INTENT(in)		     :: tsurf	         !! Surface temperature (K)
+    REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(in)	     :: hslong           !! deep soil humidity
+    INTEGER(i_std), INTENT(in)				             :: dayno            !! current day of year
+    REAL(r_std), DIMENSION(kjpindex,nvm),INTENT(in)		     :: z_root           !! the rooting depth 
+    REAL(r_std), DIMENSION(kjpindex,nvm),INTENT(in)		     :: altmax           !! Maximum over the year active-layer thickness
+    REAL(r_std), DIMENSION(kjpindex),   INTENT (in)                  :: z_organic        !! depth to organic soil
+    REAL(r_std),DIMENSION(kjpindex,nvm),INTENT(in)                   :: veget_max        !! Maximum fraction of vegetation type
+    REAL(r_std), DIMENSION(kjpindex,ncarb,nvm), INTENT(in)           :: soilc_in         !! quantity of carbon going into carbon pools from litter decomposition (gC/(m**2 of ground)/day)
+
+    !! 0.2 Output variables
+
+    REAL(r_std), DIMENSION(kjpindex,ncarb,ndeep,nvm), INTENT(out)    :: dc_litter_z      !! depth_dependent carbon input due to litter
+
+    !! 0.3 Modified variables
+
+    REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(inout)        :: soilc_a          !! active soil C
+    REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(inout)        :: soilc_s          !! slow soil C
+    REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(inout)        :: soilc_p          !! passive soil C
+
+    !! 0.4 Local variables
+
+    REAL(r_std), DIMENSION(kjpindex,ncarb,nvm)                       :: dc_litter        !! depth-integrated carbon input due to litter decomposition
+    REAL(r_std), DIMENSION(kjpindex,ncarb,nvm)                       :: soilc_in_finite
+    REAL(r_std), DIMENSION(kjpindex,nvm)                             :: intdep           !! integral depth of carbon deposition   
+    REAL(r_std), DIMENSION(kjpindex,ncarb,nvm)                       :: carbinp_correction
+    REAL(r_std), DIMENSION(kjpindex,ncarb,nvm)                       :: soilc_in_TS
+    LOGICAL, SAVE  			                             :: firstcall = .TRUE.
+  !$OMP THREADPRIVATE(firstcall)
+    REAL(r_std), DIMENSION(kjpindex,nvm)  		             :: z_lit            !! litter input e-folding depth
+    INTEGER				                             :: il,ic,iv, ix
+    LOGICAL, SAVE			                             :: check = .FALSE.
+  !$OMP THREADPRIVATE(check)
+    REAL(r_std), PARAMETER			                     :: dgyrst = 96.
+    INTEGER(i_std), SAVE  			                     :: id, id2, id3, id4
+  !$OMP THREADPRIVATE(id)
+  !$OMP THREADPRIVATE(id2)
+  !$OMP THREADPRIVATE(id3)
+  !$OMP THREADPRIVATE(id4)
+    CHARACTER(LEN=16)			                             :: buf  
+    INTEGER				                             :: recn
+    LOGICAL, SAVE                                                    :: correct_carboninput_vertprof = .TRUE.
+  !$OMP THREADPRIVATE(correct_carboninput_vertprof)
+    LOGICAL, SAVE                                                    :: new_carbinput_intdepzlit = .FALSE.
+  !$OMP THREADPRIVATE(new_carbinput_intdepzlit)
+    REAL(r_std), DIMENSION(ndeep), SAVE                              :: z_thickness
+  !$OMP THREADPRIVATE(z_thickness)
+    REAL(r_std), DIMENSION(ndeep)                                    :: root_prof
+    REAL(r_std), SAVE                                                :: minaltmax = 0.1
+  !$OMP THREADPRIVATE(minaltmax)
+    REAL(r_std), SAVE                                                :: maxaltmax = 2.
+  !$OMP THREADPRIVATE(maxaltmax)
+    REAL(r_std), SAVE                                                :: finerootdepthratio = 0.5  !! the ratio of fine root to overall root e-folding depth (for C inputs)
+  !$OMP THREADPRIVATE(finerootdepthratio)
+    REAL(r_std), SAVE                                                :: altrootratio = 0.5        !! the maximum ratio of fine root depth to active layer thickness (for C inputs)
+  !$OMP THREADPRIVATE(altrootratio)
+    REAL(r_std), DIMENSION(kjpindex,nvm), INTENT(in)                 :: rprof                     !! root depth (m)
+    INTEGER, save                                                    :: tcounter
+
+
+    
+    IF (no_pfrost_decomp) THEN
+       !
+       ! no carbon input during spinup
+       !
+       dc_litter(:,:,:) = 0.
+       ! 
+    ELSE	 
+       !
+       IF (firstcall) THEN
+          
+          DO il = 1, ndeep
+             z_thickness(il) = zf_soil(il) - zf_soil(il-1) 
+          END DO
+
+          !
+          !Config Key   = new_carbinput_intdepzlit
+          !Config Desc  = 
+          !Config Def   = n
+          !Config If    = OK_PC
+          !Config Help  = 
+          !Config Units = [flag]
+          CALL getin_p('new_carbinput_intdepzlit', new_carbinput_intdepzlit)
+
+          !
+          !Config Key   = correct_carboninput_vertprof
+          !Config Desc  = 
+          !Config Def   = n
+          !Config If    = OK_PC
+          !Config Help  = 
+          !Config Units = [flag]
+          CALL getin_p('correct_carboninput_vertprof', correct_carboninput_vertprof)
+
+
+          ! Diagnostic output init
+          
+          IF (check) THEN
+             tcounter = 1
+             WRITE(buf,'(I3)') yr_len
+             id2 = 0
+             CALL fliocrfd ('alt.nc', (/'geo ','veg ','time'/), (/kjpindex, nvm, -1/), id, id2, 'REPLACE')
+             CALL fliodefv (id,'time',(/ 3 /),units='seconds since 0000-01-01 00:00:00',v_t=flio_r8)
+             CALL flioputa (id,'time','title','time')
+             CALL flioputa (id,'time','calendar',TRIM(buf)//'d')	 
+             CALL fliodefv (id,'alt',(/ 1,2,3 /),units='m',v_t=flio_r8)
+
+             CALL fliocrfd ('soilc_litterinput.nc', (/'geo ','carb','veg ','time'/), (/kjpindex,ncarb,nvm,-1/), id3, id4, 'REPLACE')
+             CALL fliodefv (id3,'time',(/ 4 /),units='seconds since 0000-01-01 00:00:00',v_t=flio_r8)
+             CALL flioputa (id3,'time','title','time')
+             CALL flioputa (id3,'time','calendar',TRIM(buf)//'d')	 
+             CALL fliodefv (id3,'dc_litter',(/ 1,2,3,4 /),units='g C / ts',v_t=flio_r8)
+             CALL fliodefv (id3,'soilc_in_TS',(/ 1,2,3,4 /),units='g C / ts',v_t=flio_r8)
+
+ 
+          ENDIF ! check
+          
+          firstcall = .FALSE.
+          !
+       ENDIF ! firstcall
+       
+       !
+       ! 1. Litter input and decomposition
+       !
+       ! add up the soil carbon from all veg pools, and change units from  (gC/(m**2 of ground)/day) to gC/m^2 per timestep      
+       soilc_in_TS(:,:,:) = soilc_in(:,:,:)*time_step/one_day
+       
+       
+       ! 2. Carbon input e-folding depth. We distribute with e-depth = min(z_root,intdep) 
+       !	and integral depth = min(altmax,z_org)
+       !     ! e-folding depth cannot be greater than integral depth
+       
+       ! change to make intdep equal to z_root alone
+       IF ( .NOT. new_carbinput_intdepzlit ) THEN 
+          z_lit(:,:) = z_root(:,:)
+          intdep(:,:) = z_root(:,:)
+       ELSE
+          !change to separate e-folding depths for roots  from total depth over which to integrate
+          z_lit(:,:) = MIN(rprof(:,:)*finerootdepthratio, altmax(:,:)*altrootratio)   ! z_lit is the e-folding depth
+          intdep(:,:) = MIN(altmax(:,:), maxaltmax)  ! intdep is the maximum depth of integration; 
+       ENDIF
+       
+       ! Litter is decomposed somehow (?) even when alt == 0. To avoid carbon loss,
+       ! we distribute this carbon within the first 2 soil layers when alt == 0
+       WHERE ( intdep(:,:) .LT. zi_soil(2) ) intdep(:,:) = zi_soil(2) +EPSILON(0.)  
+       WHERE ( z_lit(:,:) .LT. zi_soil(2) ) z_lit(:,:) = zi_soil(2)
+       
+       !
+       ! 3. Carbon input. 
+       !
+       dc_litter_z(:,:,:,:) = zero
+       
+       dc_litter(:,:,:)=zero
+       
+       
+       DO il = 1, ndeep
+          DO ic = 1, ncarb
+             
+             ! 3.1. from litter.
+             
+             WHERE ( zi_soil(il) .LT. intdep(:,:) .AND. veget_mask_2d(:,:) )
+                dc_litter_z(:,ic,il,:) = soilc_in_TS(:,ic,:) / z_lit(:,:) / ( 1. - EXP( -intdep(:,:) / z_lit(:,:) ) ) &
+                     * EXP( -zi_soil(il) / z_lit(:,:) )
+             ELSEWHERE 
+                dc_litter_z(:,ic,il,:) = zero
+             ENDWHERE
+             
+             dc_litter(:,ic,:) = dc_litter(:,ic,:) + dc_litter_z(:,ic,il,:) * (zf_soil(il)-zf_soil(il-1)) 
+             
+          ENDDO 
+          
+       ENDDO 
+       
+       
+       IF ( correct_carboninput_vertprof ) THEN 
+          !! correct for the truncated carbon adddition profile here by multiplying by a scalar
+          DO ic = 1, ncarb
+             WHERE ( dc_litter(:,ic,:) .GT. EPSILON(0.) .AND. veget_mask_2d(:,:) ) 
+                carbinp_correction(:,ic,:) = soilc_in_TS(:,ic,:)/dc_litter(:,ic,:)
+             ELSEWHERE
+                carbinp_correction(:,ic,:) = 0.
+             END WHERE
+          END DO
+          
+          dc_litter(:,:,:)=0.
+          DO ic = 1, ncarb
+             DO il = 1, ndeep
+                WHERE ( veget_mask_2d(:,:) )
+                   dc_litter_z(:,ic,il,:) = carbinp_correction(:,ic,:)*dc_litter_z(:,ic,il,:)
+                END WHERE
+                dc_litter(:,ic,:) = dc_litter(:,ic,:) + dc_litter_z(:,ic,il,:) * (zf_soil(il)-zf_soil(il-1)) !! check again
+             END DO
+          END DO
+          
+          
+       ENDIF
+        
+       DO il = 1, ndeep
+          WHERE ( veget_mask_2d(:,:) ) 
+             soilc_a(:,il,:) = soilc_a(:,il,:) + dc_litter_z(:,iactive,il,:)
+             soilc_s(:,il,:) = soilc_s(:,il,:) + dc_litter_z(:,islow,il,:)
+             soilc_p(:,il,:) = soilc_p(:,il,:) + dc_litter_z(:,ipassive,il,:)
+          END WHERE
+       END DO
+       
+       ! Diagnostic output
+       
+       IF (check) THEN        
+          recn = NINT(time/time_step)
+          tcounter = tcounter + 1
+          WRITE(*,*) 'carbinput check: output to .nc number',recn
+          WRITE(*,*) 'time',time
+          WRITE(*,*) 'time_step',time_step
+          
+          CALL flioputv (id,'time', time, (/ tcounter /) ) 
+          CALL flioputv (id,'alt', altmax(:,:), start = (/ 1, 1, tcounter /), count = (/ kjpindex, nvm, 1 /) )
+          CALL fliosync(id) 
+ 
+          CALL flioputv (id3,'time', time, (/ tcounter /) ) 
+          CALL flioputv (id3,'soilc_in_TS', soilc_in_TS(:,:,:), start = (/ 1, 1, 1, tcounter /), &
+               count = (/ kjpindex, ncarb, nvm, 1 /) )
+          CALL flioputv (id3,'dc_litter', dc_litter(:,:,:), start = (/ 1, 1, 1, tcounter /), &
+               count = (/ kjpindex, ncarb, nvm, 1 /) )
+          CALL fliosync(id3) 
+       ENDIF
+           
+    ENDIF 
+
+  END SUBROUTINE carbinput
+
+!!
+!================================================================================================================================
+!! SUBROUTINE   : cryoturbate
+!!
+!>\BRIEF        This routine calculates cryoturbation process
+!!
+!! DESCRIPTION : 
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : 
+!! 
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART11    : None
+!! \n
+!_
+!================================================================================================================================     
+  
+  SUBROUTINE cryoturbate(kjpindex, time_step, dayno, altmax_ind, deepC_a, deepC_s, deepC_p, &
+       action, diff_k_const, bio_diff_k_const, altmax_lastyear, fixed_cryoturbation_depth)
+
+  !! 0. Variable and parameter declaration
+
+    !! 0.1  Input variables     
+
+    INTEGER(i_std), INTENT(in)				       :: kjpindex         !! domain size
+    REAL(r_std), INTENT(in)                                    :: time_step        !! time step in seconds
+    INTEGER(i_std), INTENT(in)			               :: dayno            !! number of the day in the current year
+    INTEGER(i_std), DIMENSION(kjpindex,nvm),INTENT(in)	       :: altmax_ind       !! Maximum over the year active-layer index
+    REAL(r_std), DIMENSION(kjpindex,nvm),INTENT(in)            :: altmax_lastyear  !! Maximum over the year active-layer thickness
+    CHARACTER(LEN=*), INTENT(in)                               :: action           !! what to do
+    REAL(r_std), INTENT(in)                                    :: diff_k_const
+    REAL(r_std), INTENT(in)                                    :: bio_diff_k_const
+
+    !! 0.2 Output variables 
+
+    !! 0.3 Modified variables
+    REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(inout)  :: deepC_a          !! soil carbon (g/m**3) active
+    REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(inout)  :: deepC_s          !! soil carbon (g/m**3) slow
+    REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(inout)  :: deepC_p          !! soil carbon (g/m**3) passive
+    REAL(r_std), DIMENSION(kjpindex,nvm),INTENT(inout)         :: fixed_cryoturbation_depth  !! depth to hold cryoturbation to for fixed runs
+
+    !! 0.4 Local variables
+    LOGICAL, SAVE			                       :: firstcall = .TRUE.
+  !$OMP THREADPRIVATE(firstcall)
+    LOGICAL, SAVE			                       :: use_new_cryoturbation
+  !$OMP THREADPRIVATE(use_new_cryoturbation)
+    INTEGER, SAVE			                       :: cryoturbation_method
+  !$OMP THREADPRIVATE(cryoturbation_method)
+    REAL(r_std), DIMENSION(kjpindex,nvm)                       :: altC_a_old       !! soil carbon (g/m**2) active integrated over active layer before cryoturbation
+    REAL(r_std), DIMENSION(kjpindex,nvm)                       :: altC_s_old       !! soil carbon (g/m**2) slow integrated over active layer before cryoturbation
+    REAL(r_std), DIMENSION(kjpindex,nvm)                       :: altC_p_old       !! soil carbon (g/m**2) passive integrated over active layer before cryoturbation
+    REAL(r_std), DIMENSION(kjpindex,nvm)                       :: altC_a
+    REAL(r_std), DIMENSION(kjpindex,nvm)                       :: altC_s
+    REAL(r_std), DIMENSION(kjpindex,nvm)                       :: altC_p
+    INTEGER(i_std), PARAMETER                                  :: n_totakefrom = 3 !! how many surface layers to subtract from in mass balance
+    REAL(r_std), DIMENSION(kjpindex,nvm)                       :: surfC_totake_a   !! active soil carbon to subtract from surface layers to maintain mass balance (g/m**3) 
+    REAL(r_std), DIMENSION(kjpindex,nvm)                       :: surfC_totake_s   !! slow soil carbon to subtract from surface layers to maintain mass balance (g/m**3) 
+    REAL(r_std), DIMENSION(kjpindex,nvm)                       :: surfC_totake_p   !! passive soil carbon to subtract from surface layers to maintain mass balance (g/m**3) 
+    REAL(r_std), DIMENSION(kjpindex,nvm)                       :: error_a
+    REAL(r_std), DIMENSION(kjpindex,nvm)                       :: error_s
+    REAL(r_std), DIMENSION(kjpindex,nvm)                       :: error_p
+    INTEGER(i_std)                                             :: ip, il, ier, iv
+    CHARACTER(LEN=20), SAVE                                    :: last_action = 'not called'
+  !$OMP THREADPRIVATE(last_action)
+    INTEGER(i_std)                                             :: cryoturb_date
+    REAL(r_std), SAVE                                          :: max_cryoturb_alt
+  !$OMP THREADPRIVATE(max_cryoturb_alt)
+    REAL(r_std), SAVE                                          :: min_cryoturb_alt
+  !$OMP THREADPRIVATE(min_cryoturb_alt)
+    REAL(r_std), SAVE                                          :: bioturbation_depth
+  !$OMP THREADPRIVATE(bioturbation_depth)
+    LOGICAL, SAVE			                       :: reset_fixed_cryoturbation_depth = .FALSE.
+  !$OMP THREADPRIVATE(reset_fixed_cryoturbation_depth)
+    LOGICAL, SAVE			                       :: use_fixed_cryoturbation_depth = .FALSE.
+  !$OMP THREADPRIVATE(use_fixed_cryoturbation_depth)
+    REAL(r_std), DIMENSION(kjpindex,nvm)	               :: cryoturbation_depth
+    
+    
+    ! 1. ensure that we do not repeat actions
+    !
+    IF ( action .EQ. last_action ) THEN
+       !
+       WRITE(*,*) 'CANNOT TAKE THE SAME ACTION TWICE: ',TRIM(action)
+       STOP
+       !
+    ENDIF
+    
+    IF (firstcall) THEN
+          
+          ! 2. faire les trucs du debut
+          
+          ! 2.1 allocation des variables
+          ALLOCATE (xe_a(kjpindex,nvm),stat=ier)
+          IF (ier.NE.0) THEN
+             WRITE (numout,*) ' error in xe_a allocation. We stop. We need ',kjpindex,' fois ',nvm,' words = '&
+              & , kjpindex*nvm
+             STOP 'deep_carbcycle'
+          END IF
+
+          ALLOCATE (xe_s(kjpindex,nvm),stat=ier)
+          IF (ier.NE.0) THEN
+             WRITE (numout,*) ' error in xe_s allocation. We stop. We need ',kjpindex,' fois ',nvm,' words = '&
+              & , kjpindex*nvm
+             STOP 'deep_carbcycle'
+          END IF
+ 
+          ALLOCATE (xe_p(kjpindex,nvm),stat=ier)
+          IF (ier.NE.0) THEN
+             WRITE (numout,*) ' error in xe_p allocation. We stop. We need ',kjpindex,' fois ',nvm,' words = '&
+              & , kjpindex*nvm
+             STOP 'deep_carbcycle'
+          END IF
+
+          ALLOCATE (xc_cryoturb(kjpindex,ndeep,nvm),stat=ier)
+          IF (ier.NE.0) THEN
+             WRITE (numout,*) ' error in xc_cryoturb allocation. We stop. We need ',kjpindex,' fois ',ndeep,' fois ',nvm,' words = '&
+              & , kjpindex*ndeep*nvm
+             STOP 'deep_carbcycle'
+          END IF
+
+          ALLOCATE (xd_cryoturb(kjpindex,ndeep,nvm),stat=ier)
+          IF (ier.NE.0) THEN
+             WRITE (numout,*) ' error in xd_cryoturb allocation. We stop. We need ',kjpindex,' fois ',ndeep,' fois ',nvm,' words = '&
+              & , kjpindex*ndeep*nvm
+             STOP 'deep_carbcycle'
+          END IF
+
+          ALLOCATE (alpha_a(kjpindex,ndeep,nvm),stat=ier)
+          IF (ier.NE.0) THEN
+             WRITE (numout,*) ' error in alpha_a allocation. We stop. We need ',kjpindex,' fois ',ndeep,' fois ',nvm,' words = '&
+              & , kjpindex*ndeep*nvm
+             STOP 'deep_carbcycle'
+          END IF
+	  alpha_a(:,:,:)=0.
+
+          ALLOCATE (alpha_s(kjpindex,ndeep,nvm),stat=ier)
+          IF (ier.NE.0) THEN
+             WRITE (numout,*) ' error in alpha_s allocation. We stop. We need ',kjpindex,' fois ',ndeep,' fois ',nvm,' words = '&
+              & , kjpindex*ndeep*nvm
+             STOP 'deep_carbcycle'
+          END IF
+	  alpha_s(:,:,:)=0.
+
+          ALLOCATE (alpha_p(kjpindex,ndeep,nvm),stat=ier)
+          IF (ier.NE.0) THEN
+             WRITE (numout,*) ' error in alpha_p allocation. We stop. We need ',kjpindex,' fois ',ndeep,' fois ',nvm,' words = '&
+              & , kjpindex*ndeep*nvm
+             STOP 'deep_carbcycle'
+          END IF
+	  alpha_p(:,:,:)=0.
+
+          ALLOCATE (mu_soil_rev(kjpindex,nvm),stat=ier)
+          IF (ier.NE.0) THEN
+             WRITE (numout,*) ' error in mu_soil_rev allocation. We stop. We need ',kjpindex,' fois ',nvm,' words = '&
+              & , kjpindex*nvm
+             STOP 'deep_carbcycle'
+          END IF
+	  mu_soil_rev(:,:)=0.
+
+          ALLOCATE (beta_a(kjpindex,ndeep,nvm),stat=ier)
+          IF (ier.NE.0) THEN
+             WRITE (numout,*) ' error in beta_a allocation. We stop. We need ',kjpindex,' fois ',ndeep,' fois ',nvm,' words = '&
+              & , kjpindex*ndeep*nvm 
+             STOP 'deep_carbcycle'
+          END IF
+	  beta_a(:,:,:)=0.
+
+          ALLOCATE (beta_s(kjpindex,ndeep,nvm),stat=ier)
+          IF (ier.NE.0) THEN
+             WRITE (numout,*) ' error in beta_s allocation. We stop. We need ',kjpindex,' fois ',ndeep,' fois ',nvm,' words = '&
+              & , kjpindex*ndeep*nvm
+             STOP 'deep_carbcycle'
+          END IF
+	  beta_s(:,:,:)=0.
+          
+          ALLOCATE (beta_p(kjpindex,ndeep,nvm),stat=ier)
+          IF (ier.NE.0) THEN
+             WRITE (numout,*) ' error in beta_p allocation. We stop. We need ',kjpindex,' fois ',ndeep,' fois ',nvm,' words = '&
+              & , kjpindex*ndeep*nvm
+             STOP 'deep_carbcycle'
+          END IF
+ 	  beta_p(:,:,:)=0.
+        
+          ALLOCATE (diff_k(kjpindex,ndeep,nvm),stat=ier)
+          IF (ier.NE.0) THEN
+             WRITE (numout,*) ' error in diff_k allocation. We stop. We need ',kjpindex,' fois ',ndeep,' fois ',nvm,' words = '&
+              & , kjpindex*ndeep*nvm
+             STOP 'deep_carbcycle'
+          END IF
+          
+          ALLOCATE (cryoturb_location(kjpindex,nvm),stat=ier)
+          IF (ier.NE.0) THEN
+             WRITE (numout,*) ' error in cryoturb_location allocation. We stop. We need ',kjpindex,' fois ',nvm,' words = '&
+              & , kjpindex*nvm
+             STOP 'deep_carbcycle'
+          END IF
+
+          ALLOCATE (bioturb_location(kjpindex,nvm),stat=ier)
+          IF (ier.NE.0) THEN
+             WRITE (numout,*) ' error in bioturb_location allocation. We stop. We need ',kjpindex,' fois ',nvm,' words = '&
+              & , kjpindex*nvm
+             STOP 'deep_carbcycle'
+          END IF
+
+           
+          cryoturb_location(:,:) = .false.
+          use_new_cryoturbation = .false.
+          !
+          !Config Key   = use_new_cryoturbation
+          !Config Desc  = 
+          !Config Def   = n
+          !Config If    = OK_PC
+          !Config Help  = 
+          !Config Units = [flag]
+          CALL getin_p('use_new_cryoturbation', use_new_cryoturbation)
+          !
+          !Config Key   = cryoturbation_method
+          !Config Desc  = 
+          !Config Def   = 1
+          !Config If    =  OK_PC 
+          !Config Help  = 
+          !Config Units = []
+          cryoturbation_method = 4
+          CALL getin_p('cryoturbation_method', cryoturbation_method)
+          !
+          !Config Key   = max_cryoturb_alt
+          !Config Desc  = 
+          !Config Def   = 1
+          !Config If    = OK_PC
+          !Config Help  = 
+          !Config Units = []
+          max_cryoturb_alt = 3.
+          CALL getin_p('max_cryoturb_alt',max_cryoturb_alt)
+          !
+          !Config Key   = min_cryoturb_alt
+          !Config Desc  = 
+          !Config Def   = 1
+          !Config If    = OK_PC
+          !Config Help  = 
+          !Config Units = []
+          min_cryoturb_alt = 0.01
+          CALL getin_p('min_cryoturb_alt',min_cryoturb_alt)
+          !
+          !Config Key   = reset_fixed_cryoturbation_depth
+          !Config Desc  = 
+          !Config Def   = n
+          !Config If    = OK_PC
+          !Config Help  = 
+          !Config Units = [flag]
+          CALL getin_p('reset_fixed_cryoturbation_depth',reset_fixed_cryoturbation_depth)
+          IF (reset_fixed_cryoturbation_depth) THEN
+             fixed_cryoturbation_depth = altmax_lastyear
+          ENDIF
+          !
+          !Config Key   = use_fixed_cryoturbation_depth
+          !Config Desc  = 
+          !Config Def   = n
+          !Config If    = OK_PC
+          !Config Help  = 
+          !Config Units = [flag]
+          CALL getin_p('use_fixed_cryoturbation_depth',use_fixed_cryoturbation_depth)
+          bioturb_location(:,:) = .false.
+          !
+          !Config Key   = bioturbation_depth
+          !Config Desc  = maximum bioturbation depth 
+          !Config Def   = 2
+          !Config If    = ok_pc
+          !Config Help  = 
+          !Config Units = m
+          bioturbation_depth = 2.
+          CALL getin_p('bioturbation_depth',bioturbation_depth)
+          
+          firstcall = .FALSE.
+    ENDIF
+
+    IF ( action .EQ. 'diffuse' ) THEN
+          ! 1. calculate the total soil carbon in the active layer
+          altC_a_old(:,:) = zero
+          altC_s_old(:,:) = zero
+          altC_p_old(:,:) = zero
+          altC_a(:,:) = zero
+          altC_s(:,:) = zero
+          altC_p(:,:) = zero
+
+          DO ip = 1, kjpindex
+             DO iv = 1, nvm
+                IF ( cryoturb_location(ip,iv) .OR. bioturb_location(ip,iv) )THEN 
+                   ! 1. calculate the total soil carbon
+                   DO il = 1, ndeep
+                      altC_a_old(ip,iv) = altC_a_old(ip,iv) + deepC_a(ip,il,iv)*(zf_soil(il)-zf_soil(il-1))
+                      altC_s_old(ip,iv) = altC_s_old(ip,iv) + deepC_s(ip,il,iv)*(zf_soil(il)-zf_soil(il-1))
+                      altC_p_old(ip,iv) = altC_p_old(ip,iv) + deepC_p(ip,il,iv)*(zf_soil(il)-zf_soil(il-1))
+                   ENDDO
+                   
+                   ! 2. diffuse the soil carbon                 
+                   deepC_a(ip,1,iv) = (deepC_a(ip,1,iv)+mu_soil_rev(ip,iv)*beta_a(ip,1,iv)) / (1.+mu_soil_rev(ip,iv)*(1.-alpha_a(ip,1,iv)))
+                   deepC_s(ip,1,iv) = (deepC_s(ip,1,iv)+mu_soil_rev(ip,iv)*beta_s(ip,1,iv)) / (1.+mu_soil_rev(ip,iv)*(1.-alpha_s(ip,1,iv)))
+                   deepC_p(ip,1,iv) = (deepC_p(ip,1,iv)+mu_soil_rev(ip,iv)*beta_p(ip,1,iv)) / (1.+mu_soil_rev(ip,iv)*(1.-alpha_p(ip,1,iv)))
+
+                   DO il = 2, ndeep
+                      deepC_a(ip,il,iv) = alpha_a(ip,il-1,iv)*deepC_a(ip,il-1,iv) + beta_a(ip,il-1,iv)
+                      deepC_s(ip,il,iv) = alpha_s(ip,il-1,iv)*deepC_s(ip,il-1,iv) + beta_s(ip,il-1,iv)
+                      deepC_p(ip,il,iv) = alpha_p(ip,il-1,iv)*deepC_p(ip,il-1,iv) + beta_p(ip,il-1,iv)
+                   ENDDO
+
+                   ! 3. recalculate the total soil carbon
+                   DO il = 1, ndeep
+                      altC_a(ip,iv) = altC_a(ip,iv) + deepC_a(ip,il,iv)*(zf_soil(il)-zf_soil(il-1))
+                      altC_s(ip,iv) = altC_s(ip,iv) + deepC_s(ip,il,iv)*(zf_soil(il)-zf_soil(il-1))
+                      altC_p(ip,iv) = altC_p(ip,iv) + deepC_p(ip,il,iv)*(zf_soil(il)-zf_soil(il-1))
+                   ENDDO
+
+                   
+                   IF ( altC_a_old(ip,iv) > min_stomate .AND. (ABS(altC_a(ip,iv)-altC_a_old(ip,iv))/altC_a_old(ip,iv).GT. min_stomate) ) THEN
+                      WRITE (numout,*) 'DZ warn: cryoturbate: total C not conserved','ip=',ip,'iv=',iv,'A,diff=',altC_a(ip,iv),altC_a_old(ip,iv),altC_a(ip,iv)-altC_a_old(ip,iv),(altC_a(ip,iv)-altC_a_old(ip,iv))/altC_a_old(ip,iv)
+                      CALL ipslerr_p (3,'cryoturbate','','','')
+                   ENDIF
+
+                   IF ( altC_s_old(ip,iv) > min_stomate .AND. (ABS(altC_s(ip,iv)-altC_s_old(ip,iv))/altC_s_old(ip,iv).GT. min_stomate) ) THEN
+                      WRITE (numout,*) 'DZ warn: cryoturbate: total C not conserved','ip=',ip,'iv=',iv,'S,diff=',altC_s(ip,iv),altC_s_old(ip,iv),altC_s(ip,iv)-altC_s_old(ip,iv),(altC_s(ip,iv)-altC_s_old(ip,iv))/altC_s_old(ip,iv)
+                      CALL ipslerr_p (3,'cryoturbate','','','')
+                   ENDIF
+
+                   IF ( altC_p_old(ip,iv) > min_stomate .AND. (ABS(altC_p(ip,iv)-altC_p_old(ip,iv))/altC_p_old(ip,iv).GT. min_stomate) ) THEN
+                      WRITE (numout,*) 'DZ warn: cryoturbate: total C not conserved','ip=',ip,'iv=',iv,'P,diff=',altC_p(ip,iv),altC_p_old(ip,iv),altC_p(ip,iv)-altC_p_old(ip,iv),(altC_p(ip,iv)-altC_p_old(ip,iv))/altC_p_old(ip,iv)
+                      CALL ipslerr_p (3,'cryoturbate','','','')
+                   ENDIF
+
+                   ! 4. subtract the soil carbon in the top layer(s) so that the total carbon content of the active layer is conserved.             
+                   ! for now remove this correction term...
+!                   surfC_totake_a(ip,iv) = (altC_a(ip,iv)-altC_a_old(ip,iv))/(zf_soil(altmax_ind(ip,iv))-zf_soil(0))
+!                   surfC_totake_s(ip,iv) = (altC_s(ip,iv)-altC_s_old(ip,iv))/(zf_soil(altmax_ind(ip,iv))-zf_soil(0))
+!                   surfC_totake_p(ip,iv) = (altC_p(ip,iv)-altC_p_old(ip,iv))/(zf_soil(altmax_ind(ip,iv))-zf_soil(0))
+!                   deepC_a(ip,1:altmax_ind(ip,iv),iv) = deepC_a(ip,1:altmax_ind(ip,iv),iv) - surfC_totake_a(ip,iv)
+!                   deepC_s(ip,1:altmax_ind(ip,iv),iv) = deepC_s(ip,1:altmax_ind(ip,iv),iv) - surfC_totake_s(ip,iv)
+!                   deepC_p(ip,1:altmax_ind(ip,iv),iv) = deepC_p(ip,1:altmax_ind(ip,iv),iv) - surfC_totake_p(ip,iv)
+!
+!                   ! if negative values appear, we don't subtract the delta-C from top layers
+!                   IF (ANY(deepC_a(ip,1:altmax_ind(ip,iv),iv) .LT. zero) ) THEN
+!                      deepC_a(ip,1:altmax_ind(ip,iv),iv)=deepC_a(ip,1:altmax_ind(ip,iv),iv)+surfC_totake_a(ip,iv)
+!                      IF (altC_a(ip,iv) .GT. zero) THEN
+!                         deepC_a(ip,:,iv)=deepC_a(ip,:,iv)*altC_a_old(ip,iv)/altC_a(ip,iv)
+!                      ENDIF
+!                   ENDIF
+!                   IF (ANY(deepC_s(ip,1:altmax_ind(ip,iv),iv) .LT. zero) ) THEN
+!                      deepC_s(ip,1:altmax_ind(ip,iv),iv)=deepC_s(ip,1:altmax_ind(ip,iv),iv)+surfC_totake_s(ip,iv)
+!                      IF (altC_s(ip,iv) .GT. zero) THEN
+!                         deepC_s(ip,:,iv)=deepC_s(ip,:,iv)*altC_s_old(ip,iv)/altC_s(ip,iv)
+!                      ENDIF
+!                   ENDIF
+!                   IF (ANY(deepC_p(ip,1:altmax_ind(ip,iv),iv) .LT. zero) ) THEN
+!                      deepC_p(ip,1:altmax_ind(ip,iv),iv)=deepC_p(ip,1:altmax_ind(ip,iv),iv)+surfC_totake_p(ip,iv)
+!                      IF (altC_p(ip,iv) .GT. zero) THEN
+!                         deepC_p(ip,:,iv)=deepC_p(ip,:,iv)*altC_p_old(ip,iv)/altC_p(ip,iv)
+!                      ENDIF
+!                   ENDIF
+
+          	   ! Consistency check. Potentially add to STRICT_CHECK flag
+                   IF ( ANY(deepC_a(ip,:,iv) .LT. zero) ) THEN
+                      WRITE (numout,*) 'cryoturbate: deepC_a<0','ip=',ip,'iv=',iv,'deepC_a=',deepC_a(ip,:,iv)
+                      CALL ipslerr_p (3,'cryoturbate','','','')                            
+                   ENDIF
+                   IF ( ANY(deepC_s(ip,:,iv) .LT. zero) ) THEN
+                      WRITE (numout,*) 'cryoturbate: deepC_s<0','ip=',ip,'iv=',iv,'deepC_s=',deepC_s(ip,:,iv)         
+                      CALL ipslerr_p (3,'cryoturbate','','','')                            
+                   ENDIF
+                   IF ( ANY(deepC_p(ip,:,iv) .LT. zero) ) THEN
+                      WRITE (numout,*) 'cryoturbate: deepC_p<0','ip=',ip,'iv=',iv,'deepC_p=',deepC_p(ip,:,iv)         
+                     CALL ipslerr_p (3,'cryoturbate','','','')                            
+                   ENDIF
+
+                ENDIF
+             ENDDO
+          ENDDO
+
+
+    ELSEIF ( action .EQ. 'coefficients' ) THEN
+       IF (firstcall) THEN
+          WRITE(*,*) 'error: initilaizations have to happen before coefficients calculated. we stop.'
+          STOP
+       ENDIF
+
+       cryoturb_location(:,:) =  ( altmax_lastyear(:,:) .LT. max_cryoturb_alt ) &
+!In the former vertical discretization scheme the first level was at 0.016 cm; now it's only 0.00048 so we set an equivalent threshold directly as a fixed depth of 1 cm,
+            .AND. ( altmax_lastyear(:,:) .GE. min_cryoturb_alt ) .AND. veget_mask_2d(:,:)
+       IF (use_fixed_cryoturbation_depth) THEN
+          cryoturbation_depth(:,:) = fixed_cryoturbation_depth(:,:)
+       ELSE
+          cryoturbation_depth(:,:) = altmax_lastyear(:,:)
+       ENDIF
+
+       bioturb_location(:,:) = ( ( altmax_lastyear(:,:) .GE. max_cryoturb_alt ) .AND. veget_mask_2d(:,:) )
+
+       DO ip = 1, kjpindex
+          DO iv = 1,nvm
+             IF ( cryoturb_location(ip,iv) ) THEN
+                !
+                IF (use_new_cryoturbation) THEN
+                   SELECT CASE(cryoturbation_method)
+                   CASE(1)
+                      !
+                      DO il = 1, ndeep ! linear dropoff to zero between alt and 2*alt
+                         IF ( zi_soil(il) .LE. cryoturbation_depth(ip,iv) ) THEN
+                            diff_k(ip,il,iv) = diff_k_const
+                         ELSE
+                            diff_k(ip,il,iv) = diff_k_const*(un-MAX(MIN((zi_soil(il)/cryoturbation_depth(ip,iv))-un,un),zero))
+                         ENDIF
+                      END DO
+                      !
+                   CASE(2)
+                      !
+                      DO il = 1, ndeep ! exponential dropoff with e-folding distace = alt, below the active layer
+                         IF ( zi_soil(il) .LE. cryoturbation_depth(ip,iv) ) THEN
+                            diff_k(ip,il,iv) = diff_k_const
+                         ELSE
+                            diff_k(ip,il,iv) = diff_k_const*(EXP(-MAX((zi_soil(il)/cryoturbation_depth(ip,iv)-un),zero)))
+                         ENDIF
+                      END DO
+                      !
+                   CASE(3)
+                      !
+                      ! exponential dropoff with e-folding distace = alt, starting at surface
+                      diff_k(ip,:,iv) = diff_k_const*(EXP(-(zi_soil(:)/cryoturbation_depth(ip,iv))))
+                      !
+                   CASE(4)
+                      !
+                      DO il = 1, ndeep ! linear dropoff to zero between alt and 3*alt
+                         IF ( zi_soil(il) .LE. cryoturbation_depth(ip,iv) ) THEN
+                            diff_k(ip,il,iv) = diff_k_const
+                         ELSE
+                            diff_k(ip,il,iv) = diff_k_const*(un-MAX(MIN((zi_soil(il)-cryoturbation_depth(ip,iv))/ &
+                                 (2.*cryoturbation_depth(ip,iv)),un),zero))
+                         ENDIF
+                         IF ( zf_soil(il) .GT. max_cryoturb_alt ) THEN
+                            diff_k(ip,il,iv) = zero
+                         ENDIF
+                      END DO
+                      ! 
+                      IF (printlev>=3) WRITE(*,*) 'cryoturb method 4: ip, iv, diff_k(ip,:,iv): ', ip, iv, diff_k(ip,:,iv)
+                   CASE(5)
+                      !
+                      DO il = 1, ndeep ! linear dropoff to zero between alt and 3m
+                         IF ( zi_soil(il) .LE. cryoturbation_depth(ip,iv) ) THEN
+                            diff_k(ip,il,iv) = diff_k_const
+                         ELSE
+                            diff_k(ip,il,iv) = diff_k_const*(un-MAX(MIN((zi_soil(il)-cryoturbation_depth(ip,iv))/ &
+                                 (3.-cryoturbation_depth(ip,iv)),un),zero))
+                         ENDIF
+                      END DO
+                      !
+                      IF (printlev>=3) WRITE(*,*) 'cryoturb method 5: ip, iv, diff_k(ip,:,iv): ', ip, iv, diff_k(ip,:,iv)
+                   END SELECT
+                   
+                   ELSE ! old cryoturbation scheme 
+                   !
+                   diff_k(ip,1:altmax_ind(ip,iv),iv) = diff_k_const
+                   diff_k(ip, altmax_ind(ip,iv)+1,iv) = diff_k_const/10.
+                   diff_k(ip, altmax_ind(ip,iv)+2,iv) = diff_k_const/100.
+                   diff_k(ip,(altmax_ind(ip,iv)+3):ndeep,iv) = zero
+                ENDIF
+             ELSE IF ( bioturb_location(ip,iv) ) THEN
+                DO il = 1, ndeep
+                   IF ( zi_soil(il) .LE. bioturbation_depth ) THEN
+                      diff_k(ip,il,iv) = bio_diff_k_const
+                   ELSE
+                      diff_k(ip,il,iv) = zero
+                   ENDIF
+                END DO
+	     ELSE
+                diff_k(ip,:,iv) = zero
+             END IF
+          END DO
+       END DO
+
+       mu_soil_rev=diff_k(:,1,:)*time_step/(zf_soil(1)-zf_soil(0))/(zi_soil(2)-zi_soil(1))
+       
+       DO il = 1,ndeep-1
+          WHERE ( cryoturb_location(:,:) .OR. bioturb_location(:,:) )
+             xc_cryoturb(:,il,:) = (zf_soil(il)-zf_soil(il-1))  / time_step
+             xd_cryoturb(:,il,:) = diff_k(:,il,:) / (zi_soil(il+1)-zi_soil(il))
+          endwhere
+       ENDDO
+       
+       WHERE ( cryoturb_location(:,:) .OR. bioturb_location(:,:)  )
+          xc_cryoturb(:,ndeep,:) = (zf_soil(ndeep)-zf_soil(ndeep-1))  / time_step
+          
+          !bottom
+          xe_a(:,:) = xc_cryoturb(:,ndeep,:)+xd_cryoturb(:,ndeep-1,:)
+          xe_s(:,:) = xc_cryoturb(:,ndeep,:)+xd_cryoturb(:,ndeep-1,:)
+          xe_p(:,:) = xc_cryoturb(:,ndeep,:)+xd_cryoturb(:,ndeep-1,:)
+          alpha_a(:,ndeep-1,:) = xd_cryoturb(:,ndeep-1,:) / xe_a(:,:)
+          alpha_s(:,ndeep-1,:) = xd_cryoturb(:,ndeep-1,:) / xe_s(:,:)
+          alpha_p(:,ndeep-1,:) = xd_cryoturb(:,ndeep-1,:) / xe_p(:,:)
+          beta_a(:,ndeep-1,:) = xc_cryoturb(:,ndeep,:)*deepC_a(:,ndeep,:) / xe_a(:,:)
+          beta_s(:,ndeep-1,:) = xc_cryoturb(:,ndeep,:)*deepC_s(:,ndeep,:) / xe_s(:,:)
+          beta_p(:,ndeep-1,:) = xc_cryoturb(:,ndeep,:)*deepC_p(:,ndeep,:) / xe_p(:,:)
+       END WHERE
+
+       !other levels
+       DO il = ndeep-2,1,-1
+          WHERE ( cryoturb_location(:,:) .OR. bioturb_location(:,:) )
+             xe_a(:,:) = xc_cryoturb(:,il+1,:) + (1.-alpha_a(:,il+1,:))*xd_cryoturb(:,il+1,:) + xd_cryoturb(:,il,:)
+             xe_s(:,:) = xc_cryoturb(:,il+1,:) + (1.-alpha_s(:,il+1,:))*xd_cryoturb(:,il+1,:) + xd_cryoturb(:,il,:)
+             xe_p(:,:) = xc_cryoturb(:,il+1,:) + (1.-alpha_p(:,il+1,:))*xd_cryoturb(:,il+1,:) + xd_cryoturb(:,il,:)
+             alpha_a(:,il,:) = xd_cryoturb(:,il,:) / xe_a(:,:)
+             alpha_s(:,il,:) = xd_cryoturb(:,il,:) / xe_s(:,:)
+             alpha_p(:,il,:) = xd_cryoturb(:,il,:) / xe_p(:,:)
+             beta_a(:,il,:) = (xc_cryoturb(:,il+1,:)*deepC_a(:,il+1,:)+xd_cryoturb(:,il+1,:)*beta_a(:,il+1,:)) / xe_a(:,:)
+             beta_s(:,il,:) = (xc_cryoturb(:,il+1,:)*deepC_s(:,il+1,:)+xd_cryoturb(:,il+1,:)*beta_s(:,il+1,:)) / xe_s(:,:)
+             beta_p(:,il,:) = (xc_cryoturb(:,il+1,:)*deepC_p(:,il+1,:)+xd_cryoturb(:,il+1,:)*beta_p(:,il+1,:)) / xe_p(:,:)
+          END WHERE
+       ENDDO
+
+    ELSE
+       !
+       ! do not know this action
+       !
+       CALL ipslerr_p(3, 'cryoturbate', 'DO NOT KNOW WHAT TO DO:', TRIM(action), '')
+       !
+    ENDIF
+    
+    ! keep last action in mind
+    !
+    last_action = action
+    
+  END  SUBROUTINE cryoturbate
+
+!!
+!================================================================================================================================
+!! SUBROUTINE   : permafrost_decomp
+!!
+!>\BRIEF        This routine calculates carbon decomposition
+!! DESCRIPTION : 
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : 
+!! 
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART11    : None
+!! \n
+!_
+!================================================================================================================================     
+
+  SUBROUTINE permafrost_decomp (kjpindex, time_step, tprof, airvol_soil, &
+       oxlim, tau_CH4troph, ok_methane, fbactratio, O2m, &
+       totporO2_soil, totporCH4_soil, hslong, clay, &
+       no_pfrost_decomp, deepC_a, deepC_s, deepC_p, deltaCH4g, deltaCH4, deltaC1_a, deltaC1_s, deltaC1_p, deltaC2, &
+       deltaC3, O2_soil, CH4_soil, fbact_out, MG_useallCpools)
+
+  !! 0. Variable and parameter declaration
+
+    !! 0.1  Input variables     
+
+    INTEGER(i_std), INTENT(in)				       :: kjpindex        !! domain size
+    REAL(r_std), INTENT(in)                                    :: time_step       !! time step in seconds
+    REAL(r_std), DIMENSION(kjpindex,ndeep,nvm),   INTENT(in)   :: tprof           !! deep temperature profile
+    REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(in)     :: airvol_soil
+    LOGICAL, INTENT(in)                                        :: oxlim           !! O2 limitation taken into account
+    REAL(r_std), INTENT(in)                                    :: tau_CH4troph    !! time constant of methanetrophy (s)
+    LOGICAL, INTENT(in)                                        :: ok_methane      !! Is Methanogenesis and -trophy taken into account? 
+    REAL(r_std), INTENT(in)                                    :: fbactratio      !! time constant of methanogenesis (ratio to that of oxic)
+    REAL(r_std), INTENT(in)                                    :: O2m             !! oxygen concentration [g/m3] below which there is anoxy 
+    REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(in)     :: totporO2_soil   !! total O2 porosity (Tans, 1998)
+    REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(in)     :: totporCH4_soil  !! total CH4 porosity (Tans, 1998)
+    REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(in)     :: hslong          !! deep soil humidity
+    REAL(r_std), DIMENSION(kjpindex), INTENT(in)               :: clay            !! clay content
+    LOGICAL, INTENT(in)				               :: no_pfrost_decomp!! Whether this is a spinup run
+    REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(in)     :: fbact_out
+    LOGICAL, INTENT(in)                                        :: MG_useallCpools !! Do we allow all three C pools to feed methanogenesis?
+    !! 0.2 Output variables
+
+    !! 0.3 Modified variables
+
+    REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(inout)  :: deepC_a         !! soil carbon (g/m**3) active
+    REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(inout)  :: deepC_s         !! soil carbon (g/m**3) slow
+    REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(inout)  :: deepC_p         !! soil carbon (g/m**3) passive
+    REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(inout)  :: deltaCH4
+    REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(inout)  :: deltaCH4g
+    REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(inout)  :: deltaC1_a
+    REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(inout)  :: deltaC1_s
+    REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(inout)  :: deltaC1_p
+    REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(inout)  :: deltaC2
+    REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(inout)  :: deltaC3
+    REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(inout)  :: O2_soil         !! oxygen (g O2/m**3 air)
+    REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(inout)  :: CH4_soil        !! methane (g CH4/m**3 air)
+
+    !! 0.4 Local variables
+
+    INTEGER(i_std)                                             :: ier
+    REAL(r_std), DIMENSION(3,3)                                :: cflux           !! fluxes between soil carbon reservoirs
+    REAL(r_std), DIMENSION(kjpindex,ndeep,nvm)                 :: nadd_soil       !! number of moles created / m**3 of air
+    REAL(r_std)                                                :: fbact_a,fbact_s, fbact_p,temp
+    REAL(r_std)                                                :: fbactCH4_a, fbactCH4_s, fbactCH4_p
+    REAL(r_std)                                                :: dC,dCm
+    REAL(r_std)                                                :: dCH4,dCH4m,dO2
+    INTEGER(i_std)                                             :: il, ip, iv
+    LOGICAL, SAVE                                              :: firstcall = .TRUE.        !! first call?
+  !$OMP THREADPRIVATE(firstcall)
+
+
+    IF (firstcall) THEN
+
+       ALLOCATE (fc(kjpindex,3,3,nvm),stat=ier)
+       IF (ier.NE.0) THEN
+          WRITE (numout,*) ' error in fc allocation. We stop. We need ',kjpindex,' fois ',3,' fois ',3,' fois ',nvm,' words = '&
+           & , kjpindex*3*3*nvm
+          STOP 'deep_carbcycle'
+       END IF
+       ALLOCATE (fr(kjpindex,3,nvm),stat=ier)
+       IF (ier.NE.0) THEN
+          WRITE (numout,*) ' error in fc allocation. We stop. We need ',kjpindex,' fois ',3,' fois ',nvm,' words = '&
+           & , kjpindex*3*nvm
+          STOP 'deep_carbcycle'
+       END IF
+
+       !
+       ! calculate carbon flux fractions
+       !
+       DO iv =1,nvm
+          fc(:,iactive,iactive,iv) = 0.0_r_std
+          fc(:,iactive,ipassive,iv) = 0.004_r_std
+          fc(:,iactive,islow,iv) = 1._r_std - (.85-.68*clay(:)) - fc(:,iactive,ipassive,iv)
+          !
+          fc(:,islow,islow,iv) = .0_r_std
+          fc(:,islow,iactive,iv) = .42_r_std
+          fc(:,islow,ipassive,iv) = .03_r_std
+          !
+          fc(:,ipassive,ipassive,iv) = .0_r_std
+          fc(:,ipassive,iactive,iv) = .45_r_std
+          fc(:,ipassive,islow,iv) = .0_r_std
+          !
+          fr(:,:,iv) = 1._r_std-fc(:,:,iactive,iv)-fc(:,:,islow,iv)-fc(:,:,ipassive,iv)
+          firstcall = .FALSE.
+       END DO
+       IF (printlev>=3) THEN
+          DO ip = 1,kjpindex
+             WRITE(*,*) 'cdk: permafrost_decomp: i, fraction respired gridcell(i) :', ip, fr(ip,:,1)
+          END DO
+       ENDIF
+    ENDIF
+    
+    !
+    ! calculate carbon consumption
+    !
+    nadd_soil(:,:,:) = zero
+    cflux(:,:) = zero
+
+    deltaC1_a(:,:,:) = zero
+    deltaC1_s(:,:,:) = zero
+    deltaC1_p(:,:,:) = zero
+    deltaCH4(:,:,:) = zero
+    deltaCH4g(:,:,:) = zero
+    deltaC2(:,:,:) = zero
+    deltaC3(:,:,:) = zero   
+    DO ip = 1, kjpindex
+       !
+       DO iv = 1, nvm
+          !
+          IF (  veget_mask_2d(ip,iv) ) THEN
+             !
+             DO il = 1, ndeep
+                !
+                ! 1 function that gives carbon residence time as a function of
+                !     soil temperature (in seconds)
+                !
+                temp = tprof(ip,il,iv) - ZeroCelsius
+                IF (no_pfrost_decomp) THEN
+                   ! no decomposition during spinup
+                   fbact_a = HUGE(1.0)
+                ELSE
+                   fbact_a = fbact_out(ip,il,iv)
+                   fbact_a = MAX(fbact_a,time_step)
+                ENDIF
+                !
+                IF ( fbact_a/HUGE(1.) .GT. .1 ) THEN
+                   fbact_s = fbact_a
+                   fbact_p = fbact_a
+                ELSE
+                   fbact_s = fbact_a * fslow
+                   fbact_p = fbact_a * fpassive
+                ENDIF
+                !
+                ! methanogenesis: first guess, 10 times (fbactratio) slower than oxic
+                ! decomposition
+                IF ( fbact_a/HUGE(1.) .GT. .1 ) THEN 
+                   fbactCH4_a = fbact_a
+                   fbactCH4_s = fbact_s
+                   fbactCH4_p = fbact_p
+                ELSE
+                   fbactCH4_a = fbact_a * fbactratio
+                   IF ( MG_useallCpools ) THEN
+                      fbactCH4_s = fbact_s * fbactratio
+                      fbactCH4_p = fbact_p * fbactratio
+                   ELSE
+                      fbactCH4_s = HUGE(1.0)
+                      fbactCH4_p = HUGE(1.0)
+                   ENDIF
+                ENDIF
+                !
+                ! 2 oxic decomposition: carbon and oxygen consumption
+                !
+                ! 2.1 active
+                !
+                IF (oxlim) THEN
+                   dCm = O2_soil(ip,il,iv)*airvol_soil(ip,il,iv)*wC/wO2
+                   dC = MIN(deepC_a(ip,il,iv) * time_step/fbact_a,dCm)
+                ELSE
+                   dC = deepC_a(ip,il,iv) * time_step/fbact_a
+                ENDIF
+
+                ! pour actif
+                dC = dC * ( 1. - .75 * clay(ip) )
+
+                ! flux vers les autres reservoirs
+                cflux(iactive,ipassive) = fc(ip,iactive,ipassive,iv) * dC
+                cflux(iactive,islow) = fc(ip,iactive,islow,iv) * dC
+                !
+                deepC_a(ip,il,iv) = deepC_a(ip,il,iv) - dC
+                dO2 = wO2/wC * dC*fr(ip,iactive,iv) / totporO2_soil(ip,il,iv)
+                O2_soil(ip,il,iv) = MAX( O2_soil(ip,il,iv) - dO2, zero)
+                ! keep delta C * fr in memory (generates energy)
+                deltaC1_a(ip,il,iv) = dC*fr(ip,iactive,iv) !!this line!!!
+                !
+                ! 2.2 slow       
+                !
+                IF (oxlim) THEN
+                   dCm = O2_soil(ip,il,iv)*airvol_soil(ip,il,iv)*wC/wO2
+                   dC = MIN(deepC_s(ip,il,iv) * time_step/fbact_s,dCm)
+                ELSE
+                   dC = deepC_s(ip,il,iv) * time_step/fbact_s
+                ENDIF
+                ! flux vers les autres reservoirs
+                cflux(islow,iactive) = fc(ip,islow,iactive,iv) * dC
+                cflux(islow,ipassive) = fc(ip,islow,ipassive,iv) * dC
+                !
+                deepC_s(ip,il,iv) = deepC_s(ip,il,iv) - dC
+                dO2 = wO2/wC * dC*fr(ip,islow,iv) / totporO2_soil(ip,il,iv)
+                O2_soil(ip,il,iv) = MAX( O2_soil(ip,il,iv) - dO2, zero)
+                ! keep delta C * fr in memory (generates energy)
+                deltaC1_s(ip,il,iv) =  dC*fr(ip,islow,iv)
+                !
+                ! 2.3 passive
+                !
+                IF (oxlim) THEN
+                   dCm = O2_soil(ip,il,iv)*airvol_soil(ip,il,iv)*wC/wO2
+                   dC = MIN(deepC_p(ip,il,iv) * time_step/fbact_p,dCm)
+                ELSE
+                   dC = deepC_p(ip,il,iv) * time_step/fbact_p
+                ENDIF
+                ! flux vers les autres reservoirs
+                cflux(ipassive,iactive) = fc(ip,ipassive,iactive,iv) * dC
+                cflux(ipassive,islow) = fc(ip,ipassive,islow,iv) * dC
+                !
+                deepC_p(ip,il,iv) = deepC_p(ip,il,iv) - dC
+                dO2 = wO2/wC * dC*fr(ip,ipassive,iv) / totporO2_soil(ip,il,iv)
+                O2_soil(ip,il,iv) = MAX( O2_soil(ip,il,iv) - dO2, zero)
+                ! keep delta C * fr in memory (generates energy)
+                deltaC1_p(ip,il,iv) =  dC*fr(ip,ipassive,iv)
+                !
+                !
+                ! 3 methanogenesis or methanotrophy
+                !   
+                !
+                IF (ok_methane) THEN
+                   !
+                   !
+                   ! 3.1 active pool methanogenesis
+                   dC = deepC_a(ip,il,iv) * time_step / fbactCH4_a * EXP(-O2_soil(ip,il,iv)*(1+hslong(ip,il,iv) * &
+                        (BunsenO2-1.)) / O2m ) !DKtest: when commented, no ox lim for MG
+                   ! pour actif
+                   dC = dC * ( 1. - .75 * clay(ip) )
+                   dCH4 = dc*fr(ip,iactive,iv) * wCH4/wC / totporCH4_soil(ip,il,iv)
+                   !
+                   !
+                   ! flux vers les autres reservoirs
+                   cflux(iactive,ipassive)=cflux(iactive,ipassive)+fc(ip,iactive,ipassive,iv)*dC
+                   cflux(iactive,islow)=cflux(iactive,islow)+fc(ip,iactive,islow,iv)*dC
+                   !
+                   deepC_a(ip,il,iv) = deepC_a(ip,il,iv) - dC
+                   !
+                   deltaCH4g(ip,il,iv) = dCH4
+                   !
+                   CH4_soil(ip,il,iv) = CH4_soil(ip,il,iv) + dCH4
+                   ! keep delta C*fr in memory (generates energy)
+                   deltaC2(ip,il,iv) = dC*fr(ip,iactive,iv)
+                   !
+                   ! how many moles of gas / m**3 of air did we generate?
+                   ! (methanogenesis generates 1 molecule net if we take
+                   !  B -> B' + CH4 ) 
+                   nadd_soil(ip,il,iv) = nadd_soil(ip,il,iv) + dCH4/wCH4
+                   !
+                   !
+                   IF ( MG_useallCpools ) THEN
+                      !
+                      ! 3.2 slow pool methanogenesis  cdk: adding this to allow other carbon pools to participate in MG
+                      dC = deepC_s(ip,il,iv) * time_step / fbactCH4_s * EXP(-O2_soil(ip,il,iv)*(1+hslong(ip,il,iv) * &
+                           (BunsenO2-1.)) / O2m ) !DKtest: when commented, no ox lim for MG
+                      dCH4 = dc*fr(ip,islow,iv) * wCH4/wC / totporCH4_soil(ip,il,iv)
+                      !
+                      ! flux vers les autres reservoirs
+                      cflux(islow,ipassive)=cflux(islow,ipassive)+fc(ip,islow,ipassive,iv)*dC
+                      cflux(islow,iactive)=cflux(islow,iactive)+fc(ip,islow,iactive,iv)*dC
+                      !
+                      deepC_s(ip,il,iv) = deepC_s(ip,il,iv) - dC
+                      !
+                      deltaCH4g(ip,il,iv) = deltaCH4g(ip,il,iv) + dCH4
+                      CH4_soil(ip,il,iv) = CH4_soil(ip,il,iv) + dCH4
+                      ! keep delta C*fr in memory (generates energy)
+                      deltaC2(ip,il,iv) = deltaC2(ip,il,iv) + dC*fr(ip,islow,iv)
+                      !
+                      ! how many moles of gas / m**3 of air did we generate?
+                      ! (methanogenesis generates 1 molecule net if we take
+                      !  B -> B' + CH4 ) 
+                      nadd_soil(ip,il,iv) = nadd_soil(ip,il,iv) + dCH4/wCH4
+                      !	      
+                      !
+                      !
+                      ! 3.3 passive pool methanogenesis  cdk: adding this to allow other carbon pools to participate in MG
+                      dC = deepC_p(ip,il,iv) * time_step / fbactCH4_p * EXP(-O2_soil(ip,il,iv)*(1+hslong(ip,il,iv) * &
+                          (BunsenO2-1.)) / O2m ) !DKtest: when commented, no ox lim for MG
+                      dCH4 = dc*fr(ip,ipassive,iv) * wCH4/wC / totporCH4_soil(ip,il,iv)
+                      !
+                      ! flux vers les autres reservoirs
+                      cflux(ipassive,islow)=cflux(ipassive,islow)+fc(ip,ipassive,islow,iv)*dC
+                      cflux(ipassive,iactive)=cflux(ipassive,iactive)+fc(ip,ipassive,iactive,iv)*dC
+                      !
+                      deepC_p(ip,il,iv) = deepC_p(ip,il,iv) - dC
+                      !
+                      deltaCH4g(ip,il,iv) = deltaCH4g(ip,il,iv) + dCH4
+                      CH4_soil(ip,il,iv) = CH4_soil(ip,il,iv) + dCH4
+                      ! keep delta C*fr in memory (generates energy)
+                      deltaC2(ip,il,iv) = deltaC2(ip,il,iv) + dC*fr(ip,ipassive,iv)
+                      !
+                      ! how many moles of gas / m**3 of air did we generate?
+                      ! (methanogenesis generates 1 molecule net if we take
+                      !  B -> B' + CH4 ) 
+                      nadd_soil(ip,il,iv) = nadd_soil(ip,il,iv) + dCH4/wCH4
+                      !	      
+                      !
+                   ENDIF
+                   !
+                   ! trophy: 
+                   ! no temperature dependence except that T>0ï¿œï¿œC (Price et
+                   ! al, GCB 2003; Koschorrek and Conrad, GBC 1993).
+                   ! tau_CH4troph is such that we fall between values of
+                   ! soil methane oxidation flux given by these authors.
+                   ! 
+                   IF ( temp .GE. zero ) THEN
+                      !
+                      dCH4m = O2_soil(ip,il,iv)/2. * wCH4/wO2 * totporO2_soil(ip,il,iv)/totporCH4_soil(ip,il,iv)
+                      !      		dCH4m = CH4_soil(ip,il,iv)  !DKtest - no ox lim to trophy
+                      dCH4 = MIN( CH4_soil(ip,il,iv) * time_step/MAX(tau_CH4troph,time_step), dCH4m )
+                      CH4_soil(ip,il,iv) = CH4_soil(ip,il,iv) - dCH4
+                      dO2 = 2.*dCH4 * wO2/wCH4 * totporCH4_soil(ip,il,iv)/totporO2_soil(ip,il,iv)
+                      O2_soil(ip,il,iv) = MAX( O2_soil(ip,il,iv) - dO2, zero)
+                      ! keep delta CH4 in memory (generates energy)
+                      deltaCH4(ip,il,iv) = dCH4
+                      ! carbon (g/m3 soil) transformed to CO2
+                      deltaC3(ip,il,iv)=dCH4/wCH4*wC*totporCH4_soil(ip,il,iv)
+                      ! how many moles of gas / m**3 of air did we generate?
+                      ! (methanotrophy consumes 2 molecules net if we take
+                      !  CH4 + 2 O2 -> CO2 + 2 H2O )
+                      nadd_soil(ip,il,iv) = nadd_soil(ip,il,iv)-2.*dCH4/wCH4
+                      !
+                   ENDIF
+                   
+                ENDIF
+               
+                ! 4 add fluxes between reservoirs
+                
+                deepC_a(ip,il,iv)=deepC_a(ip,il,iv)+cflux(islow,iactive)+cflux(ipassive,iactive)
+                deepC_s(ip,il,iv)=deepC_s(ip,il,iv)+cflux(iactive,islow)+cflux(ipassive,islow)
+                deepC_p(ip,il,iv)=deepC_p(ip,il,iv)+cflux(iactive,ipassive)+cflux(islow,ipassive)
+                
+             ENDDO
+             
+          ELSE
+
+          ENDIF
+          
+       ENDDO
+       
+    ENDDO
+  END SUBROUTINE permafrost_decomp
+
+
+!!
+!================================================================================================================================
+!! SUBROUTINE   : calc_vert_int_soil_carbon
+!!
+!>\BRIEF        This routine calculates carbon decomposition
+!!
+!! DESCRIPTION : 
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S) : 
+!! 
+!! REFERENCE(S) : None
+!!
+!! FLOWCHART11    : None
+!! \n
+!_
+!================================================================================================================================     
+
+  SUBROUTINE calc_vert_int_soil_carbon(kjpindex, deepC_a, deepC_s, deepC_p, carbon, carbon_surf, zf_soil)
+
+  !! 0. Variable and parameter declaration
+
+    !! 0.1  Input variables     
+
+    INTEGER(i_std), INTENT(in)                                :: kjpindex   !! domain size
+    REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(in)    :: deepC_a    !! active pool deepc
+    REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(in)    :: deepC_s    !! slow pool deepc
+    REAL(r_std), DIMENSION(kjpindex,ndeep,nvm), INTENT(in)    :: deepC_p    !! passive pool deepc
+    REAL(r_std), DIMENSION(0:ndeep), INTENT(in)               :: zf_soil    !! depths at full levels
+   
+    !! 0.2 Output variables
+
+    REAL(r_std), DIMENSION(kjpindex,ncarb,nvm), INTENT (out)  :: carbon     !! vertically-integrated carbon pool: active, slow, or passive, (gC/(m**2 of ground))
+    REAL(r_std), DIMENSION(kjpindex,ncarb,nvm),   INTENT (out):: carbon_surf!! vertically-integrated carbon pool to 1 meter: active, slow, or passive,(gC/(m**2 of ground))
+
+    !! 0.3 Modified variables
+
+    !! 0.4 Local variables
+    INTEGER(i_std)                                            :: il
+    real(r_std), parameter                                    ::  maxdepth=2.!! depth to which we intergrate the carbon for carbon_surf calculation                              
+
+    carbon(:,:,:) = zero
+    DO il = 1, ndeep
+       WHERE ( veget_mask_2d(:,:) ) 
+          carbon(:,iactive,:) = carbon(:,iactive,:) + deepC_a(:,il,:)*(zf_soil(il)-zf_soil(il-1))
+          carbon(:,islow,:) = carbon(:,islow,:) + deepC_s(:,il,:)*(zf_soil(il)-zf_soil(il-1))
+          carbon(:,ipassive,:) = carbon(:,ipassive,:) + deepC_p(:,il,:)*(zf_soil(il)-zf_soil(il-1))
+       END WHERE
+    ENDDO
+
+    carbon_surf(:,:,:) = zero
+    DO il = 1, ndeep
+       if (zf_soil(il-1) .lt. maxdepth ) then
+          where ( veget_mask_2d(:,:) ) 
+             carbon_surf(:,iactive,:) = carbon_surf(:,iactive,:) + deepC_a(:,il,:)*(min(maxdepth,zf_soil(il))-zf_soil(il-1))
+             carbon_surf(:,islow,:) = carbon_surf(:,islow,:) + deepC_s(:,il,:)*(min(maxdepth,zf_soil(il))-zf_soil(il-1))
+             carbon_surf(:,ipassive,:) = carbon_surf(:,ipassive,:) + deepC_p(:,il,:)*(min(maxdepth,zf_soil(il))-zf_soil(il-1))
+          end where
+       endif
+    ENDDO
+
+  END SUBROUTINE calc_vert_int_soil_carbon
+
+END MODULE stomate_permafrost_soilcarbon
Index: /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_stomate/stomate_stics.f90
===================================================================
--- /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_stomate/stomate_stics.f90	(revision 6940)
+++ /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_stomate/stomate_stics.f90	(revision 6940)
@@ -0,0 +1,1949 @@
+! =================================================================================================================================
+! MODULE       : stomate_stics
+!
+! CONTACT      : orchidee-help _at_ listes.ipsl.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF       Groups the subroutines which interface with or are related with sticslai
+!
+!!
+!!\n DESCRIPTION : None
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! REFERENCE(S)	: None
+!!
+!! SVN :
+!! $HeadURL: svn://forge.ipsl.jussieu.fr/orchidee/branches/ORCHIDEE-MICT/ORCHIDEE/src_stomate/stomate.f90 $
+!! $Date: 2017-07-17 16:22:36 +0200 (Mon, 17 Jul 2017) $
+!! $Revision: 4509 $
+!! \n
+!_ ================================================================================================================================
+
+MODULE stomate_stics
+
+  ! Modules used:
+  USE netcdf
+  USE defprec
+  USE grid
+  USE constantes
+  USE constantes_soil
+  USE pft_parameters
+  USE ioipsl
+  USE ioipsl_para 
+  USE mod_orchidee_para
+  USE interpol_help  ! necessary for management map input
+
+  IMPLICIT NONE
+
+  ! Private & public routines
+  PRIVATE
+  PUBLIC stomate_stics_ManageInput, stomate_stics_read_cycle, stomate_stics_read_rotation, stomate_stics_read_plantdate, stomate_stics_get_cmd
+  PUBLIC stomate_stics_NfertInput,  stomat_stics_calc_N_limfert,     stomate_stics_rotation
+
+  ! Public variables (not recommended)
+  !PUBLIC 
+
+CONTAINS
+! 
+!! ================================================================================================================================
+!! SUBROUTINE 	: stomate_forcing_CropVar
+!!
+!>\BRIEF        Interpolate (extract) Crop Variety information for each crop type
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): None 
+!!
+!! REFERENCES	: None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  SUBROUTINE slowproc_CropVar(nbpt, lalo, neighbours, resolution, contfrac,&  ! In
+                              plantcyc, cropvar ) ! Out
+    ! 
+    ! 
+    ! INTEGER(i_std)            :: iv
+    ! INTEGER(i_std),DIMENSION(nvm) :: plantdate_default = (/(0,iv=1,nvm)/)
+    ! !It should be defined as an array for different crops
+    ! !The value should be given outside this program and subject to crop type
+    ! !if being defined outside, please comment the above sentence
+    
+    ! 0.1 INPUT
+    ! 
+    INTEGER(i_std), INTENT(in)  :: nbpt         ! Number of points for which the data needs to be interpolated (extracted)
+    REAL(r_std), INTENT(in) :: lalo(nbpt,2)     ! Vector of latitude and longtitude
+    INTEGER(i_std), INTENT(in)  :: neighbours(nbpt,8)   ! Vectors of neighbours for each grid point
+    ! (1=N, 2=NE, 3=E, 4=SE, 5=S, 6=SW, 7=W, 8=NW)
+    !REAL(r_std),INTENT(in)  :: resolution(nbpt,2)   ! The size in km of each grid box in lat and lon
+    REAL(r_std)             :: resolution(nbpt,2)   ! The size in km of each grid box in lat and lon
+    REAL(r_std),INTENT(in)  :: contfrac(nbpt)   ! The fraction of land in each grid box
+    ! INTEGER(I_std),INTENT(in) :: plantcyc         ! The time of the rotation
+    ! in this year (0 means this info unknown)
+    ! INTEGER(i_std), INTENT(in)    :: croptype     ! The type of crop being
+    ! simulated
+    ! not necessary as we read planting date data for all crop types
+    ! 
+    ! 0.2 OUTPUT
+    ! 
+    REAL(r_std),ALLOCATABLE, INTENT(out)    :: cropvar(:,:,:)   ! The crop variety matrix
+    INTEGER(i_std), INTENT(out) :: plantcyc     ! times of rotation that year
+    ! nvm is the number of PFTs, there may not be planting date for all the PFTs
+    ! 
+    ! 0.3 LOCAL
+    ! 
+    INTEGER(i_std)      :: nbvmax       ! a parameter for interpolation
+    CHARACTER(LEN=80)       :: filename
+    INTEGER(i_std)      :: iml, jml, lml, tml, fid, fid1
+    INTEGER(i_std)      :: ip, jp, ib, ilf, fopt ! for-loop variable
+    INTEGER(i_std)      :: nbexp
+    REAL(r_std)         :: lev(1), date, dt
+    REAL(r_std)         :: missing_val
+    INTEGER(i_std)      :: itau(1)
+
+    INTEGER(i_std)      :: nb_dim
+    INTEGER,DIMENSION(flio_max_var_dims) :: l_d_w
+    LOGICAL         :: l_ex
+    
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)    :: lat_rel, lon_rel
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:,:,:)  :: cropvar_mat ! LON LAT VEGET PLANTCYC TIME_COUNTER
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:,:)    :: cropvar_mat_1 ! LON LAT VEGET, PLANTCYC it is used when input file does not have time counter
+    ! INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:)   :: plntdt_mat
+    ! Because flinget does not support reading integer matrix, plntdt_mat has to
+    ! be real
+    ! or we will have to rewrite IOIPSL
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:) :: mask
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)    :: temp_var
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)    :: sub_area
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:,:)   :: sub_index
+
+    REAL(r_std) :: sgn, sum_float
+    INTEGER(i_std) :: ivgt, icyc, pltcyc, it
+    CHARACTER(LEN=30) :: callsign
+    LOGICAL :: ok_interpol
+    INTEGER :: ALLOC_ERR
+    INTEGER(i_std) :: cps,maxcp,jlf,maxps
+    INTEGER(i_std),ALLOCATABLE,DIMENSION(:) :: hashlst1
+    REAL(r_std),ALLOCATABLE,DIMENSION(:) :: hashlst2
+    REAL(r_std) :: areamax
+    LOGICAL ok_var  
+
+
+    ! croptype = TRIM(croptype) !if croptype is a string
+    ! else a switch expression is needed
+    filename = "/work/cont003/p529tan/WXH/CropVar_1990.nc" ! default input file
+    ! String operation needed
+    CALL getin_p('CROPVAR_FILE',filename)
+
+    IF (is_root_prc) THEN
+    ! ? what does is_root_prc mean?
+        CALL flininfo(filename, iml, jml, lml, tml, fid)
+        ! CALL flinclo(fid)
+    ENDIF
+    CALL bcast(iml)
+    CALL bcast(jml)
+    ! CALL bcast(lml)
+    ! CALL bcast(tml)
+    
+    ! Printing information for debugging
+    WRITE(numout, *) "Xuhui's debug info for slowproc_CropVar #1:"
+    WRITE(numout, *) "filename is: ", filename
+    WRITE(numout, *) "Dimension 1, lon, iml:", iml
+    WRITE(numout, *) "Dimension 2, lat, jml:", jml
+    WRITE(numout, *) "Dimension 3, veget, lml:", lml
+    WRITE(numout, *) "Dimension 4, time, tml:", tml
+    ! apparently, flinget function is not designed to take veget but levels to
+    ! be the 
+    ! 3rd dimension, modification to lml is needed
+    CALL flioopfd(filename,fid1)
+    CALL flioinqv(fid1,v_n="CROPVAR", l_ex = l_ex, nb_dims = nb_dim, len_dims =l_d_w)
+    IF (lml == 0) THEN
+        ! CALL
+        ! flioinqv(fid1,v_n="PLNTDT",l_ex=l_ex,nb_dims=nb_dim,len_dims=l_d_w)
+        lml=l_d_w(3)
+        WRITE(numout, *) "len_dims: ", l_d_w
+        WRITE(numout, *) "lml AFTER revision"
+        WRITE(numout, *) "lml: ", lml
+    ENDIF
+    IF (nb_dim.EQ.5) THEN
+        plantcyc = l_d_w(4)
+        tml = l_d_w(5)
+        WRITE(numout,*) 'No. of plantcycle in the input: ', plantcyc
+        WRITE(numout,*) 'tml changed to: ', tml
+    ELSE
+        IF (nb_dim.EQ.4) THEN
+            plantcyc = 0
+        ELSE
+            WRITE(numout,*) "Error: More axis in PlantDate than expected"
+            STOP
+        ENDIF
+    ENDIF
+    IF (plantcyc>3) THEN
+        WRITE(numout,*) "Rotation cycle more than accepted: ",plantcyc
+    ENDIF
+    WRITE(numout,*) "plantcyc: ",plantcyc
+    CALL flioclo(fid1)
+    CALL bcast(lml)
+    CALL bcast(tml)
+    ! CALL bcast(plantcyc)
+    
+    ALLOC_ERR=-1
+    ALLOCATE(cropvar(nbpt,lml,tml),STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+        WRITE(numout,*) "ERROR IN ALLOCATION OF cropvar: ", ALLOC_ERR
+    ENDIF
+    WRITE(numout,*) "cropvar ALLOCATED"
+    ! 
+    !! assumption: the crop variety file is a 0.5 degree planting date (julian
+    !date) file
+    ! 
+    ALLOC_ERR=-1
+    ALLOCATE(lat_rel(iml,jml), STAT=ALLOC_ERR)
+      IF (ALLOC_ERR/=0) THEN
+        WRITE(numout,*) "ERROR IN ALLOCATION of lat_rel : ",ALLOC_ERR
+        STOP 
+    ENDIF
+    ALLOC_ERR=-1
+    ALLOCATE(lon_rel(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+        WRITE(numout,*) "ERROR IN ALLOCATION of lon_rel : ",ALLOC_ERR
+        STOP 
+    ENDIF
+    ALLOC_ERR=-1
+    ALLOCATE(mask(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+        WRITE(numout,*) "ERROR IN ALLOCATION of mask : ",ALLOC_ERR
+        STOP 
+    ENDIF
+    
+    IF (plantcyc == 0) THEN
+        ALLOC_ERR=-1
+        ALLOCATE(cropvar_mat_1(iml,jml,lml,tml), STAT=ALLOC_ERR) 
+        ! !lml is supposed to be nvm (number of PFTs), if not ,change it
+        IF (ALLOC_ERR/=0) THEN
+            WRITE(numout,*) "ERROR IN ALLOCATION of cropvar_mat_1 : ",ALLOC_ERR
+            STOP 
+        ENDIF
+        ALLOC_ERR=-1
+        ALLOCATE(cropvar_mat(iml,jml,lml,1,tml), STAT=ALLOC_ERR)
+        IF (ALLOC_ERR/=0) THEN
+            WRITE(numout,*) "ERROR IN ALLOCATION of cropvar_mat: ", ALLOC_ERR
+            STOP
+        ENDIF
+    ELSE
+        ALLOC_ERR=-1
+        ALLOCATE(cropvar_mat(iml,jml,lml,plantcyc,tml), STAT=ALLOC_ERR)
+        IF (ALLOC_ERR/=0) THEN
+            WRITE(numout,*) "ERROR IN ALLOCATION of cropvar_mat: ", ALLOC_ERR
+            STOP
+        ENDIF
+    ENDIF
+    
+    ! input of some attributes
+    ! IF (is_root_prc) CALL flinopen(filename, .FALSE., iml, jml, lml, lon_rel,
+    ! lat_rel, lev, tml, itau, date, dt, fid)
+    ! CALL bcast(lon_rel)
+    ! CALL bcast(lat_rel)
+    ! CALL bcast(itau)
+    ! CALL bcast(date)
+    ! CALL bcast(dt)
+    IF (is_root_prc) THEN
+        CALL flinget(fid, 'LON', iml, jml, lml, tml, 1, 1, lon_rel)
+        CALL flinget(fid, 'LAT', iml, jml, lml, tml, 1, 1, lat_rel)
+        CALL bcast(lon_rel)
+        CALL bcast(lat_rel)
+        ! WRITE (numout,*) 'lon_rel size: ', SIZE(lon_rel)
+        ! WRITE (numout,*) 'lat_rel size: ', SIZE(lat_rel)
+    ENDIF
+
+    ! input of the matrix
+    IF (is_root_prc) THEN 
+        ! CALL flinget(fid, 'CROPVAR', iml, jml, lml, tml, 1, 1, crop_mat) 
+        ! time_counter has to be 1, or it will not match the size of plntdt_mat
+        CALL flioopfd(filename,fid1)
+        IF (plantcyc>3) THEN
+            WRITE(numout,*) "slowproc_CropVar : Planting cycle more than model accepted"
+            STOP
+        ELSE
+            IF (plantcyc > 0) THEN
+                CALL fliogetv(fid1,'CROPVAR',cropvar_mat,start=(/1,1,1,1,1/),count=(/iml,jml,lml,plantcyc,tml/))
+            ELSEIF (plantcyc == 0) THEN
+                CALL fliogetv(fid1,'CROPVAR',cropvar_mat_1,start=(/1,1,1,1/),count=(/iml,jml,lml,tml/))
+            ELSE
+                WRITE(numout,*) "invalid plantcyc axis : ", plantcyc
+            ENDIF
+        ENDIF
+        ! get missing_val
+        CALL fliogeta(fid1,'CROPVAR','missing_value',missing_val)
+        CALL flioclo(fid1)
+    ENDIF
+    IF (plantcyc == 0) THEN
+        cropvar_mat(:,:,:,1,:) = cropvar_mat_1(:,:,:,:)
+        ! CALL bcast(cropvar_mat)
+        DEALLOCATE(cropvar_mat_1)
+    ELSE
+        ! CALL bcast(cropvar_mat)
+    ENDIF
+    ! WRITE(numout,*) 'cropvar_mat size: ',SIZE(cropvar_mat)
+    ! WRITE(numout,*) 'missing value: ', missing_val
+    ! WRITE(numout,*) 'lat(361,284): ',lat_rel(361,284)
+    ! WRITE(numout,*) 'lon(361,284): ',lon_rel(361,284)
+    ! WRITE(numout,*) 'cropvar(361,284,1,1): ',cropvar_mat(361,284,1,1)
+    
+    IF (is_root_prc) CALL flinclo(fid)
+    
+    cropvar(:,:,:) = zero ! nbpt veget time
+    IF (plantcyc == 0) THEN
+        pltcyc = 1
+    ELSE
+        pltcyc = plantcyc
+    ENDIF
+    
+    DO it = 1,tml
+        DO icyc = 1,1 ! pltcyc ! not dealing with plant cycles for now
+            DO ivgt = 1,lml ! ? We can suppose PFTs less than 10 are natural veg without planting date, but not now
+                IF (natural(ivgt)) THEN
+                    WRITE(numout,*) "veget, plantcyc, time: ", ivgt,icyc,it
+                    nbexp = 0
+                    ! the number of exceptions
+                    
+                    ! mask of available value
+                    !
+                    ! mask is commented because it is of no use right now.
+                    mask(:,:) = zero;  ! Defined in constante.f90
+                    DO ip = 1,iml
+                        DO jp = 1,jml
+                            IF ((cropvar_mat(ip,jp,ivgt,icyc,it) .GT. min_sechiba) .AND.  &
+                            (cropvar_mat(ip,jp,ivgt,icyc,it) /= missing_val)) THEN
+                                mask(ip,jp) = un;  ! Defined in constante.f90
+                                ! here we assumed that for each plant cycle at each 
+                                ! there might be missing data at different grid
+                                ! in this case, mask has to be generated each plant
+                                ! cycle each time step
+                            ENDIF
+                        ENDDO
+                    ENDDO
+                    
+                    ! Interpolation started
+                    nbvmax = 200
+                    ! the maximum amount of fine grids that one coarse grid may have
+                    
+                    callsign = "Crop Variety"
+                    
+                    ok_interpol = .FALSE.
+                    
+                    DO WHILE ( .NOT. ok_interpol )
+                        WRITE(numout,*) "Pojection arrays for ", callsign, ":"
+                        WRITE(numout,*) "nbvmax = ", nbvmax
+                        
+                        ALLOC_ERR = -1
+                        ALLOCATE(temp_var(nbvmax,lml), STAT=ALLOC_ERR)
+                        IF (ALLOC_ERR /=0) THEN
+                            WRITE(numout,*) "ERROR IN ALLOCATION OF temp_var :",ALLOC_ERR
+                            STOP
+                        ENDIF
+                        ALLOC_ERR = -1
+                        ALLOCATE(sub_index(nbpt,nbvmax,2), STAT=ALLOC_ERR)
+                        IF (ALLOC_ERR /=0) THEN
+                            WRITE(numout,*) "ERROR IN ALLOCATION OF sub_index :", ALLOC_ERR
+                            STOP
+                        ENDIF
+                        sub_index(:,:,:) = zero
+                        ALLOC_ERR = -1
+                        ALLOCATE(sub_area(nbpt, nbvmax), STAT=ALLOC_ERR)
+                        IF (ALLOC_ERR /=0) THEN
+                            WRITE(numout,*) "ERROR IN ALLOCATION OF sub_area :", ALLOC_ERR
+                            STOP
+                        ENDIF
+                        sub_area(:,:) = zero
+                        resolution(:,:) = resolution(:,:)/1000 ! m -> km
+                        write(*,*) "resolution updated: ", resolution(1,:), "km"
+                        
+                        CALL aggregate_p(nbpt, lalo, neighbours, resolution,contfrac, &
+                        &                iml, jml, lon_rel, lat_rel, mask, callsign, &
+                        &                nbvmax, sub_index, sub_area, ok_interpol)
+                        
+                        IF ( .NOT. ok_interpol ) THEN
+                            DEALLOCATE(temp_var)
+                            DEALLOCATE(sub_index)
+                            DEALLOCATE(sub_area)
+                            nbvmax = nbvmax * 2
+                        ENDIF
+                    ENDDO
+                    
+                    ! assign the values to plantdate
+                    ! values should be given to all PFTs
+                    DO ib = 1, nbpt
+                        ! cropvar(ib,:,icyc) = zero
+                        
+                        ! examing all sub_point we found
+                        fopt = COUNT(sub_area(ib,:)>zero)
+                        
+                        ! confirm that we found some points
+                        IF ( fopt .EQ. 0) THEN
+                            nbexp = nbexp + 1
+                            cropvar(ib,ivgt,it) = val_exp ! cropvar_default(ivgt)
+                        ELSE
+                            DO ilf = 1,fopt
+                                ! !Not to get lat and lon in wrong order
+                                temp_var(ilf,ivgt) = cropvar_mat(sub_index(ib,ilf,1),sub_index(ib,ilf,2),ivgt,icyc,it)
+                            ENDDO
+                            
+                            
+                            ! sum_float = zero
+                            ok_var = .FALSE.
+                            maxcp = nbvmax/2;
+                            DO WHILE (.NOT. ok_var)
+                                
+                                ALLOCATE(hashlst1(maxcp), STAT=ALLOC_ERR) ! no. 
+                                IF (ALLOC_ERR /=0) THEN
+                                    WRITE(numout,*) "ERROR IN ALLOCATION OF hashlst1:", ALLOC_ERR
+                                    STOP
+                                ENDIF
+                                ALLOCATE(hashlst2(maxcp), STAT=ALLOC_ERR) ! area
+                                IF (ALLOC_ERR /=0) THEN
+                                    WRITE(numout,*) "ERROR IN ALLOCATION OF hashlst2:", ALLOC_ERR
+                                    STOP
+                                ENDIF
+                                hashlst1(:) = 0
+                                hashlst2(:) = zero
+                                sgn = zero
+                                cps = 1;
+                                DO ilf = 1,fopt
+                                    sgn = sgn + sub_area(ib,ilf)
+                                    IF (cps==1) THEN
+                                        hashlst1(cps) = temp_var(ilf,ivgt)
+                                        hashlst2(cps) = hashlst2(cps) + sub_area(ib,ilf)
+                                        cps = cps + 1
+                                    ELSE
+                                        IF (cps .EQ. maxcp) THEN
+                                            EXIT
+                                        ELSE
+                                            DO jlf = 1,cps
+                                                IF (temp_var(ilf,ivgt) .EQ. hashlst1(jlf)) THEN
+                                                    hashlst2(jlf) = hashlst2(jlf) +sub_area(ib,ilf)
+                                                    EXIT
+                                                ELSEIF (jlf .EQ. cps) THEN 
+                                                    ! .AND. (temp_var(ilf,ivgt) .NE.
+                                                    ! hashlst(jlf,1))
+                                                    hashlst1(cps) = temp_var(ilf,ivgt)
+                                                    hashlst2(cps) = hashlst2(cps) + sub_area(ib,ilf) 
+                                                    ! better to multiply PFT here
+                                                    cps = cps + 1;
+                                                ENDIF
+                                            ENDDO
+                                        ENDIF
+                                    ENDIF
+                                ENDDO
+                                
+                                WRITE(numout,*) "total variety number: ",cps
+                                IF (cps .LT. maxcp) THEN
+                                    ok_var = .TRUE.
+                                    ! find the variety with maximum area
+                                    
+                                ELSE
+                                    ! ok_var = .FALSE.
+                                    maxcp = maxcp * 2
+                                    DEALLOCATE(hashlst1)
+                                    DEALLOCATE(hashlst2)
+                                ENDIF
+                            ENDDO
+                            
+                            ! Normalize the surface
+                            IF ( sgn .LT. min_sechiba) THEN
+                                nbexp = nbexp + 1
+                                cropvar(ib,ivgt,it) = val_exp !plantdate_default(ivgt)
+                            ELSE
+                                areamax = zero
+                                maxps = 0
+                                IF (cps .LE. 1) THEN
+                                    WRITE(numout,*) "no sub point found, probably an error occured"
+                                    STOP
+                                ENDIF
+                                DO jlf = 1,cps-1
+                                    IF (hashlst2(jlf) .GT. areamax) THEN
+                                        areamax = hashlst2(jlf)
+                                        maxps = jlf
+                                    ENDIF
+                                ENDDO
+                                cropvar(ib,ivgt,it) = hashlst1(maxps)
+                                DEALLOCATE(hashlst1)
+                                DEALLOCATE(hashlst2)
+                            !   ! INMAX
+                            !   cropvar(ib,ivgt,icyc) = ANINT(sum_float/sgn)
+                            ENDIF
+                            
+                        ENDIF
+                    
+                    ENDDO
+                    
+                    IF ( nbexp .GT. 0) THEN
+                        WRITE(numout,*) 'slowproc_PlntDt : default plant date was applied in ', nbexp, 'grid(s)'
+                        WRITE(numout,*) 'slowproc_PlntDt : These are either coastal points or having missing data'
+                    ENDIF
+                    DEALLOCATE (sub_area)
+                    DEALLOCATE (sub_index)
+                    DEALLOCATE (temp_var)
+                    ! WRITE(numout,*) 'Planting Date of Site 1 veget ',ivgt,' :
+                    ! ',plantdate(1,ivgt,icyc)
+                ENDIF
+            ENDDO
+            ! End of Veget cycle    
+        ENDDO 
+        ! End of Rotation cycle
+    ENDDO
+    ! END of Time Axis cycle
+    
+    DEALLOCATE (lat_rel)
+    DEALLOCATE (lon_rel)
+    DEALLOCATE (mask)
+    ! DEALLOCATE (sub_area)
+    ! DEALLOCATE (sub_index)
+    ! DEALLOCATE (temp_date)
+    DEALLOCATE (cropvar_mat)
+    
+    WRITE (numout,*) 'Output Crop Variety:'
+    WRITE (numout,*) 'timestep 1:'
+    WRITE (numout,*) cropvar(1,:,1)
+    IF (plantcyc>1) THEN
+        WRITE (numout,*) 'timestep 2:'
+        WRITE (numout,*) cropvar(1,:,2)
+    ENDIF
+    WRITE (numout,*) '***END of DEBUG INFO slowproc_CropVar***'
+    ! WRITE (numout,*) 'Manual STOP after slowproc_CropVar'
+    ! STOP
+    RETURN
+    
+  END SUBROUTINE slowproc_CropVar
+! End of Edition by Xuhui, Nov. 27th 010
+
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: stomate_stics_ManageInput
+!!
+!>\BRIEF        Interpolate (extract) Planting Date information  for a specific crop typ
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S) : Xuhui Wang, Oct. 18th, 2010
+!!
+!! MAIN OUTPUT VARIABLE(S): None 
+!!
+!! REFERENCES	: None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  SUBROUTINE stomate_stics_ManageInput(nbpt, lalo, neighbours, resolution, contfrac,strIn, varname, manage, yrlen)
+  
+!    INTEGER, parameter :: i_std = 4
+!    REAL, parameter :: r_std = 8
+    ! 
+    ! 0.1 INPUT
+    ! 
+    INTEGER(i_std), INTENT(in)  :: nbpt         ! Number of points for which the data needs to be interpolated (extracted)
+    REAL(r_std), INTENT(in) :: lalo(nbpt,2)     ! Vector of latitude and longtitude
+    INTEGER(i_std), INTENT(in)  :: neighbours(nbpt,8)   ! Vectors of neighbours for each grid point
+    ! (1=N, 2=NE, 3=E, 4=SE, 5=S, 6=SW, 7=W, 8=NW)
+    REAL(r_std),INTENT(in)  :: resolution(nbpt,2)   ! The size in km of each grid box in lat and lon
+    REAL(r_std),INTENT(in)  :: contfrac(nbpt)   ! The fraction of land in each grid box
+    CHARACTER(LEN=30),INTENT(in) :: strIn       ! getin parameter and Call Sign of the management data
+    CHARACTER(LEN=30),INTENT(in) :: varname     ! variable name in the nc file
+    ! 
+    ! 0.2 OUTPUT
+    ! 
+    REAL(r_std),ALLOCATABLE, INTENT(out)    :: manage(:,:,:)    ! The planting date of the crop: nbpt, veg, year
+    ! nvm is the number of PFTs, there may not be planting date for all the PFTs
+    INTEGER(i_std), INTENT(out)             :: yrlen            ! year length of the output matrix
+    ! 
+    ! 0.3 LOCAL
+    ! 
+    INTEGER(i_std)      :: nbvmax       ! a parameter for interpolation
+    REAL(r_std)         :: myres(nbpt,2)
+    CHARACTER(LEN=80)       :: filename
+    INTEGER(i_std)      :: iml, jml, lml, tml, fid, fid1
+    INTEGER(i_std)      :: ip, jp, ib, ilf, fopt, it ! for-loop variable
+    INTEGER(i_std)      :: nbexp
+    REAL(r_std)         :: lev(1), date, dt
+    REAL(r_std)         :: missing_val
+    INTEGER(i_std)      :: itau(1)
+
+    INTEGER(i_std)      :: nb_dim
+    INTEGER,DIMENSION(flio_max_var_dims) :: l_d_w
+    LOGICAL         :: l_ex
+    
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)    :: lat_rel, lon_rel
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:,:)    :: manage_mat ! LON LAT VEGET, Time
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:) :: mask
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)    :: temp_data
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)    :: sub_area
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:,:)   :: sub_index
+
+    REAL(r_std) :: sgn, sum_float
+    INTEGER(i_std) :: ivgt   ! , icyc, pltcyc
+    CHARACTER(LEN=30) :: callsign
+    LOGICAL :: ok_interpol
+    INTEGER :: ALLOC_ERR
+    LOGICAL :: mydebug = .false.
+
+!   ! croptype = TRIM(croptype) !if croptype is a string
+!   ! else a switch expression is needed
+!   filename = "/work/cont003/p529tan/WXH/plt_date_modif.nc" ! default input
+!   file
+!   ! String operation needed
+    filename = "PlantingDate.nc"
+    CALL getin_p(strIn,filename)
+
+    IF (is_root_prc) THEN
+    ! ? what does is_root_prc mean?
+        CALL flininfo(filename, iml, jml, lml, tml, fid)
+    ENDIF
+    CALL bcast(iml)
+    CALL bcast(jml)
+    ! CALL bcast(lml)
+    ! CALL bcast(tml)
+    
+    ! Printing information for debugging
+    IF (mydebug) THEN
+        WRITE(numout, *) "Xuhui's debug info for stomate_stics_ManageInput #1:"
+        WRITE(numout, *) "string in: ", strIn
+        WRITE(numout, *) "variable name: ", varname
+        WRITE(numout, *) "filename is: ", filename
+        WRITE(numout, *) "Dimension 1, lon, iml:", iml
+        WRITE(numout, *) "Dimension 2, lat, jml:", jml
+        WRITE(numout, *) "Dimension 3, veget, lml:", lml
+        WRITE(numout, *) "Dimension 4, time, tml:", tml
+    ENDIF
+    ! apparently, flinget function is not designed to take veget but levels to
+    ! be the 
+    ! 3rd dimension, modification to lml is needed
+
+!JG all flio calls must be done by is_root_prc
+    IF (is_root_prc) THEN
+       CALL flioopfd(filename,fid1)
+       CALL flioinqv(fid1,v_n=varname, l_ex = l_ex, nb_dims = nb_dim, len_dims =l_d_w)
+       IF (lml == 0) THEN
+          ! CALL
+          ! flioinqv(fid1,v_n="PLNTDT",l_ex=l_ex,nb_dims=nb_dim,len_dims=l_d_w)
+          lml=l_d_w(3)
+          IF (mydebug) THEN
+              WRITE(numout, *) "len_dims: ", l_d_w
+              WRITE(numout, *) "lml AFTER revision"
+              WRITE(numout, *) "lml: ", lml
+          ENDIF
+       ENDIF
+       IF (mydebug) THEN
+           WRITE(numout,*) "nb_dim: ", nb_dim
+           WRITE(numout,*) "resolution: ", resolution(1,:)
+       ENDIF
+       
+       IF (nb_dim .NE. 4) THEN
+          WRITE(numout,*) "dimension not supported for ", nb_dim
+       ENDIF
+       tml = l_d_w(4)
+       !yrlen = tml
+    END IF
+    IF (mydebug) THEN
+        WRITE(numout, *) "Now the tml is, :", tml 
+        WRITE(numout, *) "Now the lml is:", lml
+    ENDIF
+     
+!JG REMVOVE    CALL flioclo(fid1)
+    CALL bcast(lml)
+    CALL bcast(tml)
+    CALL bcast(nb_dim)
+    ! CALL bcast(plantcyc)
+    
+    ! JG yrlen must not be done after bcast(tml)
+    yrlen = tml
+    
+    ALLOC_ERR=-1
+    ALLOCATE(manage(nbpt,lml,tml),STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+        WRITE(numout,*) "ERROR IN ALLOCATION OF manage: ", ALLOC_ERR
+    ENDIF
+    WRITE(numout,*) "manage ALLOCATED"
+    !CALL bcast(manage)
+    
+    ! 
+    ALLOC_ERR=-1
+    ALLOCATE(lat_rel(iml,jml), STAT=ALLOC_ERR)
+      IF (ALLOC_ERR/=0) THEN
+        WRITE(numout,*) "ERROR IN ALLOCATION of lat_rel : ",ALLOC_ERR
+        STOP 
+    ENDIF
+!    CALL bcast(lat_rel)
+
+    ALLOC_ERR=-1
+    ALLOCATE(lon_rel(iml,jml), STAT=ALLOC_ERR)
+   IF (ALLOC_ERR/=0) THEN
+        WRITE(numout,*) "ERROR IN ALLOCATION of lon_rel : ",ALLOC_ERR
+        STOP 
+    ENDIF
+!    CALL bcast(lon_rel)
+
+    ALLOC_ERR=-1
+    ALLOCATE(mask(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+        WRITE(numout,*) "ERROR IN ALLOCATION of mask : ",ALLOC_ERR
+        STOP 
+    ENDIF
+!    CALL bcast(mask)
+    
+
+    ALLOC_ERR=-1
+    ALLOCATE(manage_mat(iml,jml,lml,tml), STAT=ALLOC_ERR) 
+    ! !lml is supposed to be nvm (number of PFTs), if not ,change it
+    IF (ALLOC_ERR/=0) THEN
+        WRITE(numout,*) "ERROR IN ALLOCATION of manage_mat : ",ALLOC_ERR
+        STOP 
+    ENDIF
+!    CALL bcast(manage_mat)
+!    WRITE (numout,*) 'bcast manage_mat'
+
+    ! input of some attributes
+    IF (is_root_prc) THEN
+! JG with the flioclo, done before this was not ok. Now ok
+        CALL flinget(fid, 'LON', iml, jml, lml, tml, 1, 1, lon_rel)
+        CALL flinget(fid, 'LAT', iml, jml, lml, tml, 1, 1, lat_rel)
+    ENDIF
+    CALL bcast(lon_rel)
+    CALL bcast(lat_rel)
+    WRITE (numout,*) 'lon_rel size: ', SIZE(lon_rel)
+    WRITE (numout,*) 'lat_rel size: ', SIZE(lat_rel)
+    
+
+    ! input of the matrix
+    IF (is_root_prc) THEN 
+        ! CALL flinget(fid, 'PLNTDT', iml, jml, lml, tml, 1, 1, plntdt_mat) 
+! JG remove CALL flioopfd: already done 
+!       CALL flioopfd(filename,fid1)
+        CALL fliogetv(fid1,trim(varname),manage_mat,start=(/1,1,1,1/),count=(/iml,jml,lml,tml/))
+        ! get missing_val
+        CALL fliogeta(fid1,varname,'missing_value',missing_val)
+        CALL flioclo(fid1)
+    ENDIF
+    CALL bcast(manage_mat)
+    CALL bcast(missing_val)
+    WRITE (numout,*) 'bcast manage_mat'
+    
+
+    ! WRITE(numout,*) 'manage_mat size: ',SIZE(manage_mat)
+    ! WRITE(numout,*) 'missing value: ', missing_val
+    ! WRITE(numout,*) 'lat(361,284): ',lat_rel(361,284)
+    ! WRITE(numout,*) 'lon(361,284): ',lon_rel(361,284)
+    ! WRITE(numout,*) 'plntdt(361,284,1,1): ',plntdt_mat(361,284,1,1)
+    
+    IF (is_root_prc) CALL flinclo(fid)
+    
+    manage(:,:,:) = zero ! nbpt veget year
+    
+    DO it = 1,tml
+        DO ivgt = 1,lml ! ? We can suppose PFTs less than 10 are natural veg without planting date, but not now
+            IF (.NOT. natural(ivgt)) THEN
+                WRITE(numout,*) "veget, time: ", ivgt,it
+                nbexp = 0
+                ! the number of exceptions
+                
+                ! mask of available value
+                mask(:,:) = zero;  ! Defined in constante.f90
+                DO ip = 1,iml
+                    DO jp = 1,jml
+                        IF ((manage_mat(ip,jp,ivgt,it) .GT. min_sechiba) .AND. &
+                        (manage_mat(ip,jp,ivgt,it) /= missing_val)) THEN
+                            mask(ip,jp) = un;  ! Defined in constante.f90
+                            ! here we assumed that for each plant cycle at each 
+                            ! there might be missing data at different grid
+                            ! in this case, mask has to be generated each plant
+                            ! cycle each time step
+                        ENDIF
+                    ENDDO
+                ENDDO
+                
+                ! Interpolation started
+                nbvmax = 200
+                ! the maximum amount of fine grids that one coarse grid may have
+                
+                callsign = strIn
+                
+                ok_interpol = .FALSE.
+                
+                DO WHILE ( .NOT. ok_interpol )
+                    WRITE(numout,*) "Pojection arrays for ", callsign, ":"
+                    WRITE(numout,*) "nbvmax = ", nbvmax
+                    
+                    ALLOC_ERR = -1
+                    ALLOCATE(temp_data(nbvmax,lml), STAT=ALLOC_ERR)
+                    IF (ALLOC_ERR /=0) THEN
+                        WRITE(numout,*) "ERROR IN ALLOCATION OF temp_data :", ALLOC_ERR
+                        STOP
+                    ENDIF
+                    temp_data = zero
+                    ALLOC_ERR = -1
+                    ALLOCATE(sub_index(nbpt,nbvmax,2), STAT=ALLOC_ERR)
+                    IF (ALLOC_ERR /=0) THEN
+                        WRITE(numout,*) "ERROR IN ALLOCATION OF sub_index :", ALLOC_ERR
+                        STOP
+                    ENDIF
+                    sub_index(:,:,:) = zero
+                    ALLOC_ERR = -1
+                    ALLOCATE(sub_area(nbpt, nbvmax), STAT=ALLOC_ERR)
+                    IF (ALLOC_ERR /=0) THEN
+                        WRITE(numout,*) "ERROR IN ALLOCATION OF sub_area :",ALLOC_ERR
+                        STOP
+                    ENDIF
+                    sub_area(:,:) = zero
+                    myres(:,:) = resolution(:,:)/1000  !m -> km
+                    write(numout,*) "resolution updated: ", myres(1,:), " km"
+                    !CALL bcast(myres)
+!                    CALL bcast(myres)
+                    
+!                    write(*,*) "calling aggregate_p? "
+                   CALL aggregate_p(nbpt, lalo, neighbours, myres, contfrac, &
+                    &                iml, jml, lon_rel, lat_rel, mask, callsign, &
+                    &                nbvmax, sub_index, sub_area, ok_interpol)
+!                    write(numout,*) "wu: we finished aggregate_p:) "                   
+ 
+                    IF ( .NOT. ok_interpol ) THEN
+                        DEALLOCATE(temp_data)
+                        DEALLOCATE(sub_index)
+                        DEALLOCATE(sub_area)
+                        nbvmax = nbvmax * 2
+                    ENDIF
+                ENDDO
+                
+!                WRITE(numout,*) "called aggregate_p"
+                ! assign the values to plantdate
+                ! values should be given to all PFTs
+                DO ib = 1, nbpt
+                    ! examing all sub_point we found
+                    fopt = COUNT(sub_area(ib,:)>zero)
+                    
+                    ! confirm that we found some points
+                    IF ( fopt .EQ. 0) THEN
+                        nbexp = nbexp + 1
+                        manage(ib,ivgt,it) = val_exp
+                    ELSE
+                        DO ilf = 1,fopt
+                            ! !Not to get lat and lon in wrong order
+                            temp_data(ilf,ivgt) = manage_mat(sub_index(ib,ilf,1),sub_index(ib,ilf,2),ivgt,it)
+                        ENDDO
+                        
+                        sgn = zero
+                        sum_float = zero
+                        DO ilf = 1,fopt
+                            ! average the data weighted by area ! better to multiply
+                            ! PFT HERE
+                            ! need to add management specific judgem
+                                sum_float = sum_float + temp_data(ilf,ivgt)*sub_area(ib,ilf)
+                                sgn = sgn + sub_area(ib,ilf)
+                        ENDDO
+                        
+                        ! Normalize the surface
+                        ! sgn can be a scaler, however, to prepare it for future
+                        ! incorporation of fraction
+                        ! I make it a vector with nvm values which are equal to each
+                        ! other
+                        IF ( sgn .LT. min_sechiba) THEN
+                            nbexp = nbexp + 1
+                            manage(ib,ivgt,it) = val_exp ! plantdate_default(ivgt)
+                        ELSE
+                            manage(ib,ivgt,it) = ANINT(sum_float/sgn)
+                        ENDIF
+                        
+                    ENDIF
+                
+                ENDDO ! ib
+                
+                IF ( nbexp .GT. 0) THEN
+                    WRITE(numout,*) 'stomate_stics_ManageInput : exp_val was applied in', nbexp, 'grid(s)'
+                    WRITE(numout,*) 'stomate_stics_ManageInput : These are either coastal points or having missing data'
+                ENDIF
+                DEALLOCATE (sub_area)
+                DEALLOCATE (sub_index)
+                DEALLOCATE (temp_data)
+                ! WRITE(numout,*) 'Planting Date of Site 1 veget ',ivgt,' :
+                ! ',plantdate(1,ivgt,icyc)
+            ENDIF
+        ENDDO
+        ! End of Veget cycle    
+    ENDDO
+    ! End of Time Axis cycle
+    
+    DEALLOCATE (lat_rel)
+    DEALLOCATE (lon_rel)
+    DEALLOCATE (mask)
+    DEALLOCATE (manage_mat)
+    
+    WRITE (numout,*) 'Output Management Date:'
+    WRITE (numout,*) 'time_step 1:'
+    WRITE (numout,*) manage(1,:,1)
+    IF (tml>1) THEN
+        WRITE (numout,*) 'time_step 2:'
+        WRITE (numout,*) manage(1,:,2)
+    ENDIF
+    WRITE (numout,*) '***END of DEBUG INFO stomate_stics_ManageInput***'
+    RETURN
+    
+  END SUBROUTINE stomate_stics_ManageInput
+! End of Edition by Xuhui, Mar. 16th 2011
+
+
+
+! Date: 22.06.2014, Xuhui Wang
+! Interpolate (extract) Nitrogen fertilization information 
+! for a specific crop type
+!! ================================================================================================================================
+!! SUBROUTINE 	: stomate_stics_NfertInput 
+!!
+!>\BRIEF        
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): None 
+!!
+!! REFERENCES	: None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  SUBROUTINE stomate_stics_NfertInput(nbpt, lalo, neighbours, resolution, contfrac,strIn, varname, Nfert, yrlen)
+  
+!    INTEGER, parameter :: i_std = 4
+!    REAL, parameter :: r_std = 8
+    ! 
+    ! 0.1 INPUT
+    ! 
+    INTEGER(i_std), INTENT(in)  :: nbpt         ! Number of points for which the data needs to be interpolated (extracted)
+    REAL(r_std), INTENT(in) :: lalo(nbpt,2)     ! Vector of latitude and longtitude
+    INTEGER(i_std), INTENT(in)  :: neighbours(nbpt,8)   ! Vectors of neighbours for each grid point
+    ! (1=N, 2=NE, 3=E, 4=SE, 5=S, 6=SW, 7=W, 8=NW)
+    REAL(r_std),INTENT(in)  :: resolution(nbpt,2)   ! The size in km of each grid box in lat and lon
+    !REAL(r_std)             :: resolution(nbpt,2)   ! The size in km of each grid box in lat and lon
+    REAL(r_std),INTENT(in)  :: contfrac(nbpt)   ! The fraction of land in each grid box
+    CHARACTER(LEN=30),INTENT(in) :: strIn       ! getin parameter and Call Sign of the Nfertment data
+    CHARACTER(LEN=30),INTENT(in) :: varname     ! variable name in the nc file
+    ! 
+    ! 0.2 OUTPUT
+    ! 
+    REAL(r_std),ALLOCATABLE, INTENT(out)    :: Nfert(:,:,:)    ! The planting date of the crop: nbpt, veg, year
+    ! nvm is the number of PFTs, there may not be planting date for all the PFTs
+    INTEGER(i_std), INTENT(out)             :: yrlen            ! year length of the output matrix
+    ! 
+    ! 0.3 LOCAL
+    ! 
+    INTEGER(i_std)      :: nbvmax       ! a parameter for interpolation
+    REAL(r_std)         :: myres(nbpt,2)
+    CHARACTER(LEN=80)       :: filename
+    INTEGER(i_std)      :: iml, jml, lml, tml, fid, fid1
+    INTEGER(i_std)      :: ip, jp, ib, ilf, fopt, it ! for-loop variable
+    INTEGER(i_std)      :: nbexp
+    REAL(r_std)         :: lev(1), date, dt
+    REAL(r_std)         :: missing_val
+    INTEGER(i_std)      :: itau(1)
+
+    INTEGER(i_std)      :: nb_dim
+    INTEGER,DIMENSION(flio_max_var_dims) :: l_d_w
+    LOGICAL         :: l_ex
+    
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)    :: lat_rel, lon_rel
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:,:,:)    :: Nfert_mat ! LON LAT VEGET, Time
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:) :: mask
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)    :: temp_data
+    REAL(r_std), ALLOCATABLE, DIMENSION(:,:)    :: sub_area
+    INTEGER(i_std), ALLOCATABLE, DIMENSION(:,:,:)   :: sub_index
+
+    REAL(r_std) :: sgn, sum_float
+    INTEGER(i_std) :: ivgt   ! , icyc, pltcyc
+    CHARACTER(LEN=30) :: callsign
+    LOGICAL :: ok_interpol
+    INTEGER :: ALLOC_ERR
+
+!   ! croptype = TRIM(croptype) !if croptype is a string
+!   ! else a switch expression is needed
+!   filename = "/work/cont003/p529tan/WXH/plt_date_modif.nc" ! default input
+!   file
+!   ! String operation needed
+    filename = "Nfert.nc"
+    CALL getin_p(strIn,filename)
+
+    IF (is_root_prc) THEN
+    ! ? what does is_root_prc mean?
+        CALL flininfo(filename, iml, jml, lml, tml, fid)
+    ENDIF
+    CALL bcast(iml)
+    CALL bcast(jml)
+    ! CALL bcast(lml)
+    ! CALL bcast(tml)
+    
+    ! Printing information for debugging
+    WRITE(numout, *) "Xuhui's debug info for stomate_stics_NfertInput #1:"
+    WRITE(numout, *) "string in: ", strIn
+    WRITE(numout, *) "variable name: ", varname
+    WRITE(numout, *) "filename is: ", filename
+    WRITE(numout, *) "Dimension 1, lon, iml:", iml
+    WRITE(numout, *) "Dimension 2, lat, jml:", jml
+    WRITE(numout, *) "Dimension 3, veget, lml:", lml
+    WRITE(numout, *) "Dimension 4, time, tml:", tml
+    ! apparently, flinget function is not designed to take veget but levels to
+    ! be the 
+    ! 3rd dimension, modification to lml is needed
+
+!JG all flio calls must be done by is_root_prc
+    IF (is_root_prc) THEN
+       CALL flioopfd(filename,fid1)
+       CALL flioinqv(fid1,v_n=varname, l_ex = l_ex, nb_dims = nb_dim, len_dims =l_d_w)
+       IF (lml == 0) THEN
+          ! CALL
+          ! flioinqv(fid1,v_n="PLNTDT",l_ex=l_ex,nb_dims=nb_dim,len_dims=l_d_w)
+          lml=l_d_w(3)
+          WRITE(numout, *) "len_dims: ", l_d_w
+          WRITE(numout, *) "lml AFTER revision"
+          WRITE(numout, *) "lml: ", lml
+       ENDIF
+       WRITE(numout,*) "nb_dim: ", nb_dim
+       WRITE(numout,*) "resolution: ", resolution(1,:)
+       
+       IF (nb_dim .NE. 4) THEN
+          WRITE(numout,*) "dimension not supported for ", nb_dim
+       ENDIF
+       tml = l_d_w(4)
+       !yrlen = tml
+    END IF
+    
+    WRITE(numout, *) "Now the tml is, :", tml 
+    WRITE(numout, *) "Now the lml is:", lml
+     
+!JG REMVOVE    CALL flioclo(fid1)
+    CALL bcast(lml)
+    CALL bcast(tml)
+    CALL bcast(nb_dim)
+    ! CALL bcast(plantcyc)
+    
+    ! JG yrlen must not be done after bcast(tml)
+    yrlen = tml
+    
+    ALLOC_ERR=-1
+    ALLOCATE(Nfert(nbpt,lml,tml),STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+        WRITE(numout,*) "ERROR IN ALLOCATION OF Nfert: ", ALLOC_ERR
+    ENDIF
+    WRITE(numout,*) "Nfert ALLOCATED"
+    !CALL bcast(Nfert)
+    
+    ! 
+    ALLOC_ERR=-1
+    ALLOCATE(lat_rel(iml,jml), STAT=ALLOC_ERR)
+      IF (ALLOC_ERR/=0) THEN
+        WRITE(numout,*) "ERROR IN ALLOCATION of lat_rel : ",ALLOC_ERR
+        STOP 
+    ENDIF
+!    CALL bcast(lat_rel)
+
+    ALLOC_ERR=-1
+    ALLOCATE(lon_rel(iml,jml), STAT=ALLOC_ERR)
+   IF (ALLOC_ERR/=0) THEN
+        WRITE(numout,*) "ERROR IN ALLOCATION of lon_rel : ",ALLOC_ERR
+        STOP 
+    ENDIF
+!    CALL bcast(lon_rel)
+
+    ALLOC_ERR=-1
+    ALLOCATE(mask(iml,jml), STAT=ALLOC_ERR)
+    IF (ALLOC_ERR/=0) THEN
+        WRITE(numout,*) "ERROR IN ALLOCATION of mask : ",ALLOC_ERR
+        STOP 
+    ENDIF
+!    CALL bcast(mask)
+    
+
+    ALLOC_ERR=-1
+    ALLOCATE(Nfert_mat(iml,jml,lml,tml), STAT=ALLOC_ERR) 
+    ! !lml is supposed to be nvm (number of PFTs), if not ,change it
+    IF (ALLOC_ERR/=0) THEN
+        WRITE(numout,*) "ERROR IN ALLOCATION of Nfert_mat : ",ALLOC_ERR
+        STOP 
+    ENDIF
+!    CALL bcast(Nfert_mat)
+!    WRITE (numout,*) 'bcast Nfert_mat'
+
+    ! input of some attributes
+    IF (is_root_prc) THEN
+! JG with the flioclo, done before this was not ok. Now ok
+        CALL flinget(fid, 'LON', iml, jml, lml, tml, 1, 1, lon_rel)
+        CALL flinget(fid, 'LAT', iml, jml, lml, tml, 1, 1, lat_rel)
+    ENDIF
+    CALL bcast(lon_rel)
+    CALL bcast(lat_rel)
+    WRITE (numout,*) 'lon_rel size: ', SIZE(lon_rel)
+    WRITE (numout,*) 'lat_rel size: ', SIZE(lat_rel)
+    
+
+    ! input of the matrix
+    IF (is_root_prc) THEN 
+        ! CALL flinget(fid, 'PLNTDT', iml, jml, lml, tml, 1, 1, plntdt_mat) 
+! JG remove CALL flioopfd: already done 
+!       CALL flioopfd(filename,fid1)
+        CALL fliogetv(fid1,trim(varname),Nfert_mat,start=(/1,1,1,1/),count=(/iml,jml,lml,tml/))
+        ! get missing_val
+        CALL fliogeta(fid1,varname,'missing_value',missing_val)
+        CALL flioclo(fid1)
+    ENDIF
+    CALL bcast(Nfert_mat)
+    
+    IF (is_root_prc) CALL flinclo(fid)
+    
+    Nfert(:,:,:) = zero ! nbpt veget year
+    
+    DO it = 1,tml
+        DO ivgt = 1,lml ! ? We can suppose PFTs less than 10 are natural veg without planting date, but not now
+            IF (.NOT. natural(ivgt)) THEN
+                WRITE(numout,*) "veget, time: ", ivgt,it
+                nbexp = 0
+                ! the number of exceptions
+                
+                ! mask of available value
+                mask(:,:) = zero;  ! Defined in constante.f90
+                DO ip = 1,iml
+                    DO jp = 1,jml
+                        IF ((Nfert_mat(ip,jp,ivgt,it) .GE. zero) .AND. &
+                        (Nfert_mat(ip,jp,ivgt,it) /= missing_val)) THEN
+                            mask(ip,jp) = un;  ! Defined in constante.f90
+                            ! here we assumed that for each plant cycle at each 
+                            ! there might be missing data at different grid
+                            ! in this case, mask has to be generated each plant
+                            ! cycle each time step
+                        ENDIF
+                    ENDDO
+                ENDDO
+                
+                ! Interpolation started
+                nbvmax = 200
+                ! the maximum amount of fine grids that one coarse grid may have
+                
+                callsign = strIn
+                
+                ok_interpol = .FALSE.
+                
+                DO WHILE ( .NOT. ok_interpol )
+                    WRITE(numout,*) "Pojection arrays for ", callsign, ":"
+                    WRITE(numout,*) "nbvmax = ", nbvmax
+                    
+                    ALLOC_ERR = -1
+                    ALLOCATE(temp_data(nbvmax,lml), STAT=ALLOC_ERR)
+                    IF (ALLOC_ERR /=0) THEN
+                        WRITE(numout,*) "ERROR IN ALLOCATION OF temp_data :", ALLOC_ERR
+                        STOP
+                    ENDIF
+                    ALLOC_ERR = -1
+                    ALLOCATE(sub_index(nbpt,nbvmax,2), STAT=ALLOC_ERR)
+                    IF (ALLOC_ERR /=0) THEN
+                        WRITE(numout,*) "ERROR IN ALLOCATION OF sub_index :", ALLOC_ERR
+                        STOP
+                    ENDIF
+                    sub_index(:,:,:) = zero
+                    ALLOC_ERR = -1
+                    ALLOCATE(sub_area(nbpt, nbvmax), STAT=ALLOC_ERR)
+                    IF (ALLOC_ERR /=0) THEN
+                        WRITE(numout,*) "ERROR IN ALLOCATION OF sub_area :",ALLOC_ERR
+                        STOP
+                    ENDIF
+                    sub_area(:,:) = zero
+                    myres(:,:) = resolution(:,:)/1000  !m -> km
+                    write(numout,*) "resolution updated: ", myres(1,:), " km"
+                    !CALL bcast(myres)
+                    
+!                    write(numout,*) "wu: stepping in aggregate_p? "
+                    CALL aggregate_p(nbpt, lalo, neighbours, myres, contfrac, &
+                    &                iml, jml, lon_rel, lat_rel, mask, callsign, &
+                    &                nbvmax, sub_index, sub_area, ok_interpol)
+!                    write(numout,*) "wu: we finished aggregate_p:) "                   
+ 
+                    IF ( .NOT. ok_interpol ) THEN
+                        DEALLOCATE(temp_data)
+                        DEALLOCATE(sub_index)
+                        DEALLOCATE(sub_area)
+                        nbvmax = nbvmax * 2
+                    ENDIF
+                ENDDO
+                
+!                WRITE(numout,*) "called aggregate_p"
+                ! assign the values to plantdate
+                ! values should be given to all PFTs
+                DO ib = 1, nbpt
+                    ! examing all sub_point we found
+                    fopt = COUNT(sub_area(ib,:)>zero)
+                    
+                    ! confirm that we found some points
+                    IF ( fopt .EQ. 0) THEN
+                        nbexp = nbexp + 1
+!                        Nfert(ib,ivgt,it) = val_exp
+                        Nfert(ib,ivgt,it) = 0
+                    ELSE
+                        DO ilf = 1,fopt
+                            ! !Not to get lat and lon in wrong order
+                            temp_data(ilf,ivgt) = Nfert_mat(sub_index(ib,ilf,1),sub_index(ib,ilf,2),ivgt,it)
+                        ENDDO
+                        
+                        sgn = zero
+                        sum_float = zero
+                        DO ilf = 1,fopt
+                            ! average the data weighted by area ! better to multiply
+                            ! PFT HERE
+                            ! need to add Nfertment specific judgem
+                                sum_float = sum_float + temp_data(ilf,ivgt)*sub_area(ib,ilf)
+                                sgn = sgn + sub_area(ib,ilf)
+                        ENDDO
+                        
+                        ! Normalize the surface
+                        ! sgn can be a scaler, however, to prepare it for future
+                        ! incorporation of fraction
+                        ! I make it a vector with nvm values which are equal to each
+                        ! other
+                        IF ( sgn .LT. min_sechiba) THEN
+                            nbexp = nbexp + 1
+!                            Nfert(ib,ivgt,it) = val_exp ! plantdate_default(ivgt)
+                            Nfert(ib,ivgt,it) = 0 ! plantdate_default(ivgt)
+                        ELSE
+                            !Nfert(ib,ivgt,it) = ANINT(sum_float/sgn)
+                            Nfert(ib,ivgt,it) = sum_float/sgn
+                        ENDIF
+                        
+                    ENDIF
+                
+                ENDDO ! ib
+                
+                IF ( nbexp .GT. 0) THEN
+                    WRITE(numout,*) 'stomate_stics_NfertInput : 0 was applied in', nbexp, 'grid(s)'
+                    WRITE(numout,*) 'stomate_stics_NfertInput : These are either coastal points or having missing data'
+                ENDIF
+                DEALLOCATE (sub_area)
+                DEALLOCATE (sub_index)
+                DEALLOCATE (temp_data)
+                ! WRITE(numout,*) 'Planting Date of Site 1 veget ',ivgt,' :
+                ! ',plantdate(1,ivgt,icyc)
+            ENDIF
+        ENDDO
+        ! End of Veget cycle    
+    ENDDO
+    ! End of Time Axis cycle
+    
+    DEALLOCATE (lat_rel)
+    DEALLOCATE (lon_rel)
+    DEALLOCATE (mask)
+    DEALLOCATE (Nfert_mat)
+    
+  END SUBROUTINE stomate_stics_NfertInput
+! End of Edition by Xuhui, Mar. 16th 2011
+ 
+!! ================================================================================================================================
+!! SUBROUTINE 	: stomate_stics_calc_N_limfert
+!!
+!>\BRIEF        
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): None 
+!!
+!! REFERENCES	: None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  SUBROUTINE stomat_stics_calc_N_limfert(npts,N_fert_total,N_limfert)
+ 
+  INTEGER (i_std)                             , INTENT(in)  :: npts
+  !REAL(r_std), DIMENSION(npts,nvm,nstocking), INTENT(in) :: nfertamm
+  !REAL(r_std), DIMENSION(npts,nvm,nstocking), INTENT(in) :: nfertnit
+  !REAL(r_std), DIMENSION(npts,nvm,nstocking), INTENT(in) :: nliquidmanure
+  !REAL(r_std), DIMENSION(npts,nvm,nstocking), INTENT(in) :: nslurry
+  !REAL(r_std), DIMENSION(npts,nvm,nstocking), INTENT(in) :: nsolidmanure
+  !REAL(r_std), DIMENSION(npts,nvm)          , INTENT(in) :: legume_fraction
+  !REAL(r_std), DIMENSION(npts,nvm)          , INTENT(in) :: soil_fertility
+  REAL(r_std), DIMENSION(npts,nvm)          , INTENT(in)  :: N_fert_total
+  REAL(r_std), DIMENSION(:,:)               , INTENT(out) :: N_limfert
+ 
+ 
+  INTEGER(i_std) :: k,j,ip
+ 
+    !N_fert_total(:,:) = 0.0
+    !DO k=1,nstocking
+    !  N_fert_total(:,:) = (N_fert_total(:,:) + nfertamm(:,:,k) + &
+    !                      nfertnit(:,:,k) + nliquidmanure(:,:,k) + &
+    !                      nslurry(:,:,k) + nsolidmanure(:,:,k))
+    !ENDDO
+    !N_fert_total(:,:) = N_fert_total(:,:) * 10000
+    !DO j=2,nvm
+    !  IF ((management_intensity(j) .EQ. 2).AND. is_c3(j)) THEN
+    !    N_fert_total(:,mcut_C3)=N_fert_total(:,j)
+    !    N_fert_total(:,mgraze_C3)=N_fert_total(:,j)
+    !  ENDIF
+    !  IF ((management_intensity(j) .EQ. 2).AND. (.NOT.is_c3(j))) THEN
+    !    N_fert_total(:,mcut_C4)=N_fert_total(:,j)
+    !    N_fert_total(:,mgraze_C4)=N_fert_total(:,j)
+    !  ENDIF
+    !  
+    !ENDDO
+   
+ 
+!    N_limfert(:,:) = 1. + N_effect - N_effect * (0.75 ** (N_fert_total(:,:)/30))
+    N_limfert(:,:) = 0
+    DO j=2, nvm
+        IF ( (SP_neffmax(j) .lt. zero) .AND. ( ok_LAIdev(j) ) ) THEN
+            CALL ipslerr_p(3, 'calc_limfert', 'negative N effect', '', '')
+        ENDIF
+        IF ( ok_LAIdev(j) ) THEN
+            N_limfert(:,j) = 1. + SP_neffmax(j) - SP_neffmax(j)*(SP_nsatrat(j) ** (N_fert_total(:,j)/10))
+        ELSE
+            N_limfert(:,j) = 1.
+        ENDIF
+    ENDDO
+
+!    WHERE (N_limfert(:,:) .LT. 1.0) ! never reached if N_effect>0
+!      N_limfert(:,:) = 1.0
+!    ELSEWHERE (N_limfert(:,:) .GT. 2.0) ! will yield mistake if N_effect>1
+!      N_limfert(:,:) = 1.+N_effect
+!    ENDWHERE
+    
+  END SUBROUTINE stomat_stics_calc_N_limfert
+  ! end of the nitrogen fertilization module
+
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: stomate_stics_read_cycle 
+!!
+!>\BRIEF        
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): None 
+!!
+!! REFERENCES	: None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  SUBROUTINE stomate_stics_read_cycle(nbpt,lalo,neighbours,resolution,contfrac, & ! in
+                        cyc_num, cyc_num_tot ) ! out
+    ! 0.1 INPUT
+    !    
+    INTEGER(i_std), INTENT(in)  :: nbpt         ! Number of points for which the data needs to be interpolated (extracted)
+    REAL(r_std), INTENT(in) :: lalo(nbpt,2)     ! Vector of latitude and longtitude
+    INTEGER(i_std), INTENT(in)  :: neighbours(nbpt,8)   ! Vectors of neighbours for each grid point
+    ! (1=N, 2=NE, 3=E, 4=SE, 5=S, 6=SW, 7=W, 8=NW)
+    REAL(r_std),INTENT(in)  :: resolution(nbpt,2)   ! The size in km of each grid box in lat and lon
+    !REAL(r_std)             :: resolution(nbpt,2)   ! The size in km of each     !grid box in lat and lon
+    REAL(r_std),INTENT(in)  :: contfrac(nbpt)   ! The fraction of land in each grid box
+
+    INTEGER(i_std),INTENT(out), DIMENSION(nbpt,nvm) :: cyc_num ! flag for starting the rotation for kjpindex, nvm
+    INTEGER(i_std),INTENT(out), DIMENSION(nbpt) :: cyc_num_tot ! number of current rotation cycle
+
+    ! 0.3 local variables
+    INTEGER(i_std)                                        :: yrlen
+    CHARACTER(LEN=30)                                     :: strManage
+    CHARACTER(LEN=30)                                     :: strVar
+    REAL(r_std),DIMENSION(:,:,:),ALLOCATABLE      :: manage
+    INTEGER(i_std)                                :: ip
+
+!!!!-------------------------------------------------------------------------------------------
+
+            cyc_num(:,:) = 1 
+
+            CALL getin_p('IMPOSE_ROT',rot_1d)
+            ! by default, rot_1d is true
+            IF (nbpt==1) THEN
+                cyc_num_tot(1) = cyc_rot_max
+            ELSE    ! multiple point simulations
+                IF (rot_1d) THEN
+                    cyc_num_tot(:) = cyc_rot_max
+                ELSE
+                    strManage = 'NUMROTATE_FILE'
+                    strVar = 'CycleNum'
+                    CALL stomate_stics_ManageInput(nbpt,lalo,neighbours,resolution,contfrac,strManage,strVar,manage,yrlen)
+                    DO ip = 1,nbpt
+                        cyc_num_tot(ip) = INT(MAXVAL(manage(ip,:,1)),i_std)
+                        IF (cyc_num_tot(ip) .LT. 1) THEN
+                            cyc_num_tot(ip) = 1 ! at least one cycle in rotation
+                            WRITE(numout,*) 'WARNING xuhui: ip, cyc_num_tot(ip) ', ip, MAXVAL(manage(ip,:,1))
+                        ENDIF
+                    ENDDO
+                    IF (MAXVAL(cyc_num_tot(:))>10) THEN
+                        WRITE(numout,*) 'xuhui: rotation cycles longer than 10, likely a bug'
+                    ENDIF
+                    IF (MAXVAL(cyc_num_tot(:))>cyc_rot_max) THEN
+                        WRITE(numout,*) 'xuhui: No. of rotation updated'
+                        WRITE(numout,*) 'MAXVAL(cyc_num_tot(:)), cyc_rot_max', MAXVAL(cyc_num_tot(:)), cyc_rot_max
+                        cyc_rot_max = MAXVAL(cyc_num_tot(:))
+                    ELSEIF (MAXVAL(cyc_num_tot(:))<cyc_rot_max) THEN
+                        WRITE(numout,*) 'xuhui: MAXVAL(cyc_num_tot(:))<cyc_rot_max',MAXVAL(cyc_num_tot(:)), cyc_rot_max
+                        WRITE(numout,*) 'bad setting in cyc_rot_max'
+                        WRITE(numout,*) 'xuhui: No. of rotation updated'
+                        cyc_rot_max = MAXVAL(cyc_num_tot(:))
+                    ENDIF
+                ENDIF
+            ENDIF
+            IF (ALLOCATED(manage)) DEALLOCATE(manage) ! clear manage for other input purpose
+
+  END SUBROUTINE stomate_stics_read_cycle
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: stomate_stics_read_rotation 
+!!
+!>\BRIEF        
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): None 
+!!
+!! REFERENCES	: None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  SUBROUTINE stomate_stics_read_rotation(nbpt,lalo,neighbours,resolution,contfrac, & ! in
+                                   rot_cmd_store )  ! out
+    ! 0.1 INPUT
+    !    
+    INTEGER(i_std), INTENT(in)  :: nbpt         ! Number of points for which the data needs to be interpolated (extracted)
+    REAL(r_std), INTENT(in) :: lalo(nbpt,2)     ! Vector of latitude and longtitude
+    INTEGER(i_std), INTENT(in)  :: neighbours(nbpt,8)   ! Vectors of neighbours for each grid point
+    ! (1=N, 2=NE, 3=E, 4=SE, 5=S, 6=SW, 7=W, 8=NW)
+    REAL(r_std),INTENT(in)  :: resolution(nbpt,2)   ! The size in km of each grid box in lat and lon
+    !REAL(r_std)             :: resolution(nbpt,2)   ! The size in km of each     !grid box in lat and lon
+    REAL(r_std),INTENT(in)  :: contfrac(nbpt)   ! The fraction of land in each grid box
+
+    INTEGER(i_std), INTENT(out), ALLOCATABLE, DIMENSION(:,:,:) :: rot_cmd_store
+
+    ! 0.3 local variables
+    INTEGER(i_std)                                        :: yrlen
+    CHARACTER(LEN=30)                                     :: strManage
+    CHARACTER(LEN=30)                                     :: strVar
+    CHARACTER(LEN=30)                                     :: temp_varname !! temporary variable string for rot_1d only
+    REAL(r_std),DIMENSION(:,:,:),ALLOCATABLE              :: manage
+    INTEGER(i_std)                                        :: ip, kc, ier
+    INTEGER(i_std),DIMENSION(rot_cmd_max)                 :: temp_cmd  !! temporary command variable for rot_1d only
+
+!!!!-------------------------------------------------------------------------------------------
+
+            !!!! rotation command
+            IF (rot_1d) THEN
+                DO kc = 1,cyc_rot_max
+                    WRITE(temp_varname,"('CMDROTATE_',i1)"),kc
+                    CALL getin_p(temp_varname,temp_cmd)
+                    !!!! confirm how getin_p perform when the input command is less than rot_cmd_max
+                    WRITE(numout,*) 'xuhui: kc, ', kc, 'temp_cmd, ', temp_cmd
+                    DO ip = 1,nbpt
+                        rot_cmd_store(ip,:,kc) = temp_cmd
+                    ENDDO
+                ENDDO
+            ELSE ! reading rotation map
+                strManage = 'CMDROTATE_FILE'
+                strVar = 'Command'
+                CALL stomate_stics_ManageInput(nbpt,lalo,neighbours,resolution,contfrac,strManage,strVar,manage,yrlen)
+                !!! dimension of manage: kjpindex, cm_max, cyc_rot_max
+                IF ( SIZE(manage,3,i_std) .NE. cyc_rot_max ) THEN
+                    WRITE(numout,*) 'SIZE(manage,3), cyc_rot_max', SIZE(manage,3,i_std), cyc_rot_max
+                    STOP 'input rotation cycle did not match cyc_rot_max'
+                ENDIF
+                IF ( SIZE(manage,2,i_std) .GT. rot_cmd_max ) THEN
+                    IF (SIZE(manage,2,i_std) .GT. 10 ) THEN
+                        WRITE(numout,*) 'WARNING: more than 10 commands for one rotation'
+                        WRITE(numout,*) 'xuhui: memory issue may occur. Are you sure about so many rotation commands?'
+                    ENDIF
+                    WRITE(numout,*) 'xuhui: update rot_cmd_max'
+                    WRITE(numout,*) ' SIZE(manage,2), rot_cmd_max', SIZE(manage,2,i_std), rot_cmd_max
+                    rot_cmd_max = SIZE(manage,2,i_std)
+                    DEALLOCATE(rot_cmd_store)
+                    ALLOCATE(rot_cmd_store(nbpt,rot_cmd_max,cyc_rot_max),stat=ier)
+                    IF (ier/=0) THEN
+                        WRITE(numout,*) "ERROR IN RE-ALLOCATION OF rot_cmd_store: ",ier
+                        STOP 'stomate_init rot_cmd_store reallocate'
+                    ENDIF
+                ENDIF
+                IF (SIZE(manage,2,i_std) .LT. rot_cmd_max) THEN
+                    rot_cmd_store(:,1:SIZE(manage,2,i_std),:) = INT(manage,i_std)
+                    rot_cmd_store(:,SIZE(manage,2,i_std)+1:rot_cmd_max,:) = 0
+                ELSE  !!! size equivalent
+                    rot_cmd_store = INT(manage,i_std)
+                ENDIF
+            ENDIF
+            IF (ALLOCATED(manage)) DEALLOCATE(manage) ! clear manage for other input purpose
+
+  END SUBROUTINE stomate_stics_read_rotation
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: stomate_stics_read_plantdate 
+!!
+!>\BRIEF        
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): None 
+!!
+!! REFERENCES	: None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  SUBROUTINE stomate_stics_read_plantdate(nbpt,lalo,neighbours,resolution,contfrac, & ! in
+                                    cyc_num, &
+                                    plantdate, plantdate_now) ! out
+    ! 0.1 INPUT
+    !    
+    INTEGER(i_std), INTENT(in)  :: nbpt         ! Number of points for which the data needs to be interpolated (extracted)
+    REAL(r_std), INTENT(in) :: lalo(nbpt,2)     ! Vector of latitude and longtitude
+    INTEGER(i_std), INTENT(in)  :: neighbours(nbpt,8)   ! Vectors of neighbours for each grid point
+    ! (1=N, 2=NE, 3=E, 4=SE, 5=S, 6=SW, 7=W, 8=NW)
+    REAL(r_std),INTENT(in)  :: resolution(nbpt,2)   ! The size in km of each grid box in lat and lon
+    !REAL(r_std)             :: resolution(nbpt,2)   ! The size in km of each     !grid box in lat and lon
+    REAL(r_std),INTENT(in)  :: contfrac(nbpt)   ! The fraction of land in each grid box
+    INTEGER(i_std),INTENT(in), DIMENSION(nbpt,nvm) :: cyc_num ! flag for starting the rotation for kjpindex, nvm
+
+    INTEGER(i_std), INTENT(out), DIMENSION (nbpt,nvm,cyc_rot_max)  :: plantdate !! kjpindex, nvm, cyc_rot_max
+    INTEGER(i_std), INTENT(out), DIMENSION (nbpt,nvm)  :: plantdate_now !! kjpindex, nvm, plantdate of current cycle
+
+    ! 0.3 local variables
+    INTEGER(i_std)                                        :: yrlen
+    CHARACTER(LEN=30)                                     :: strManage
+    CHARACTER(LEN=30)                                     :: strVar
+    REAL(r_std),DIMENSION(:,:,:),ALLOCATABLE              :: manage
+    INTEGER(i_std)                                        :: ip, kc, ier, j
+
+!!!!-------------------------------------------------------------------------------------------
+
+        !iplt_1d = .TRUE.
+        CALL getin_p('IMPOSE_IPLT',iplt_1d)
+        IF (.not. iplt_1d) THEN
+            strManage = "IPLT_FILE"
+            strVar = "PLNTDT"
+            CALL stomate_stics_ManageInput(nbpt,lalo,neighbours,resolution,contfrac,strManage,strVar,manage,yrlen)
+            !manage(manage=val_exp) = 1 !when there is exceptional value, we applied 1
+            IF ( SIZE(manage,3,i_std) .NE. cyc_rot_max ) THEN
+                WRITE(numout,*) 'cyc_rot_max, SIZE(manage,3)', cyc_rot_max, SIZE(manage,3,i_std)
+                STOP 'input and specified maximum rotation cycle not matched'
+            ENDIF
+    
+            !!!! deal with exceptional values
+            DO ip = 1,nbpt
+                DO j = 2,nvm
+                    IF ( ok_LAIdev(j) ) THEN
+                        DO kc = 1,cyc_rot_max
+                            IF ( (manage(ip,j,kc)==val_exp) .OR. (manage(ip,j,kc) .LT. zero) ) THEN
+                                manage(ip,j,kc) = 1 + 365*(kc-1)
+                            ENDIF
+                        ENDDO
+                    ENDIF
+                ENDDO
+            ENDDO
+    
+            DO j = 2,nvm
+                IF (nvm_plnt) THEN
+                    IF (.NOT. (nvm .EQ. SIZE(manage,2,i_std)) ) THEN
+                        WRITE(numout,*) 'nvm_plnt: ', nvm_plnt
+                        WRITE(numout,*) 'nvm, SIZE(manage,2)', nvm, SIZE(manage,2,i_std)
+                        STOP 'PFT more than input planting date'
+                    ENDIF
+                    WHERE(manage(:,j,:) >= val_exp)
+                        manage(:,j,:) = val_exp
+                    ENDWHERE
+                    plantdate(:,j,:) = INT(manage(:,j,:),i_std)
+                ELSE    
+                    IF (MAXVAL(pft_to_mtc(:)) > SIZE(manage,2,i_std)) THEN
+                        WRITE(numout,*) 'nvm_plnt: ', nvm_plnt
+                        WRITE(numout,*) 'MAXVAL(pft_to_mtc(:)), SIZE(manage,2)', MAXVAL(pft_to_mtc(:)), SIZE(manage,2,i_std)
+                        STOP 'PFT more than input planting date'
+                    ENDIF
+                    WHERE(manage(:,j,:) >= val_exp)
+                        manage(:,j,:) = val_exp
+                    ENDWHERE
+                    plantdate(:,j,:) = INT(manage(:,pft_to_mtc(j),:),i_std) 
+                ENDIF
+            ENDDO
+        ELSE ! iplt_1d
+            IF (nvm_plnt) THEN
+                IF (nvm .GT. SIZE(SP_iplt0,1,i_std)) THEN
+                    WRITE(numout,*) 'nvm_plnt: ', nvm_plnt
+                    WRITE(numout,*) 'nvm, SIZE(SP_iplt0,1)', nvm, SIZE(SP_iplt0,1,i_std)
+                    STOP 'PFT more than input planting date'
+                ENDIF
+                DO j = 2,nvm
+                    plantdate(:,j,1) = SP_iplt0(j)
+                    IF ( cyc_rot_max .GT. 1) THEN
+                        plantdate(:,j,2) = SP_iplt1(j)
+                    ENDIF
+                    IF ( cyc_rot_max .GT. 2) THEN
+                        plantdate(:,j,3) = SP_iplt2(j)
+                    ENDIF
+                ENDDO
+            ELSE !!!! using pft_to_mtc
+                WRITE(numout,*) 'SP_iplt0, ', SP_iplt0
+                IF (MAXVAL(pft_to_mtc(:)) .GT.  SIZE(SP_iplt0,1,i_std)) THEN
+                    WRITE(numout,*) 'nvm_plnt: ', nvm_plnt
+                    WRITE(numout,*) 'MAXVAL(pft_to_mtc(:)), SIZE(SP_iplt0,1)', MAXVAL(pft_to_mtc(:)), SIZE(SP_iplt0,1,i_std)
+                    STOP 'PFT more than input planting date'
+                ENDIF
+                DO j = 2,nvm
+                    plantdate(:,j,1) = SP_iplt0(pft_to_mtc(j))
+                    IF ( cyc_rot_max .GT. 1) THEN
+                        plantdate(:,j,2) = SP_iplt1(pft_to_mtc(j))
+                    ENDIF
+                    IF ( cyc_rot_max .GT. 2) THEN
+                        plantdate(:,j,3) = SP_iplt2(pft_to_mtc(j))
+                    ENDIF
+                ENDDO
+            ENDIF
+        ENDIF ! iplt_1d
+
+        IF (ok_rotate) THEN
+            DO ip = 1,nbpt
+                DO j = 2,nvm
+                    IF (ok_LAIdev(j)) THEN
+                        plantdate_now(ip,j) = plantdate(ip,j,cyc_num(ip,j))
+                    ENDIF
+                ENDDO
+            ENDDO
+        ELSE
+            plantdate_now = plantdate(:,:,1)
+        ENDIF
+  END SUBROUTINE stomate_stics_read_plantdate
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: stomate_stics_get_cmd
+!!
+!>\BRIEF        
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): None 
+!!
+!! REFERENCES	: None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  SUBROUTINE stomate_stics_get_cmd(cmdin, src_rot, tgt_rot, prc_rot)
+  ! 0.1 Input
+  INTEGER(i_std),INTENT(in)  :: cmdin
+  ! 0.2 Output
+  INTEGER(i_std),INTENT(out) :: src_rot, tgt_rot
+  REAL(r_std),INTENT(out)    :: prc_rot
+
+  ! 0.3 Local variables
+
+  !!!! --------------------------------------------------------------
+    IF (cmdin > 1010000 .OR. cmdin < 0 ) THEN
+        WRITE(numout,*) 'cmdin, ',cmdin
+        STOP 'cmd error in stomate_stics_get_cmd'
+    ENDIF
+    IF (cmdin == 0) THEN
+        tgt_rot = 0
+        src_rot = 0
+        
+        prc_rot = 0.0
+    ELSE
+        tgt_rot = MOD(cmdin, 100)
+        src_rot = MOD(FLOOR(FLOAT(cmdin)/100), 100)
+
+        prc_rot = FLOAT(FLOOR(FLOAT(cmdin)/10000))/100.0
+        IF (printlev >=4) THEN
+            WRITE(numout,*) 'xuhui: cmdin, tgt_rot, src_rot, prc_rot', cmdin, src_rot, tgt_rot, prc_rot
+        ENDIF
+        IF (prc_rot .GT. 1.0 .AND. prc_rot .LT. 1.0+0.01) THEN ! resolve potential  precision issues
+            prc_rot = 1.0
+        ENDIF
+        !!! consistency check
+        IF (prc_rot .GT. 1.0) THEN
+            WRITE(numout,*) 'percent change larger than 1..., prc_rot',prc_rot
+            STOP 'incorrect percent rotation, stomate_stics_get_cmd'
+        ENDIF
+        IF ( (tgt_rot .GT. nvm) .OR. ( .NOT. (ok_LAIdev(tgt_rot) .OR. (tgt_rot .EQ. 1)) ) ) THEN
+            WRITE(numout,*) 'rotation target error: tgt_rot ', tgt_rot
+            WRITE(numout,*) 'nvm, ok_LAIdev', nvm, ok_LAIdev
+            STOP 'incorrect rotation target, stomate_stics_get_cmd'
+        ENDIF
+        IF ( (src_rot .GT. nvm) .OR. ( .NOT. (ok_LAIdev(src_rot) .OR. (src_rot .EQ. 1)) ) ) THEN
+            WRITE(numout,*) 'rotation target error: src_rot ', src_rot
+            WRITE(numout,*) 'nvm, ok_LAIdev', nvm, ok_LAIdev
+            STOP 'incorrect rotation source, stomate_stics_get_cmd'
+        ENDIF
+    ENDIF
+  END SUBROUTINE stomate_stics_get_cmd
+
+
+!! ================================================================================================================================
+!! SUBROUTINE 	: stomate_stics_rotation
+!!
+!>\BRIEF        
+!!
+!! DESCRIPTION  : None
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! MAIN OUTPUT VARIABLE(S): None 
+!!
+!! REFERENCES	: None
+!!
+!! FLOWCHART    : None
+!! \n
+!_ ================================================================================================================================
+  SUBROUTINE stomate_stics_rotation(kjpindex, ip, matrix_prc, maxfrac,  & ! in
+                              in_cycle, cyc_num_tot, plantdate, nrec, nlev, &
+                              plantdate_now, &   ! inout
+                              soilc_mict, cyc_num, litter, turnover_daily, & 
+                              deepC_a, deepC_s, deepC_p, carbon, &
+                              age, ind, PFTpresent, senescence, &
+                              when_growthinit, everywhere, leaf_frac  )
+  !!! This subroutine transfer litter and soil carbon when the cropland is rotated
+  !!! update plantdate_now
+  !!! veget_max and soil water and thermo properties will be transferred in sechiba_main
+  ! 0.1 Input
+  INTEGER(i_std),INTENT(in)                     :: kjpindex ! number of land points
+  INTEGER(i_std),INTENT(in)                     :: ip ! target point
+  REAL(r_std),DIMENSION(nvm,nvm),INTENT(in)     :: matrix_prc ! rotation matrix in % of veget_max
+  REAL(r_std),DIMENSION(nvm),INTENT(in)         :: maxfrac ! veget_max before rotation
+  LOGICAL, DIMENSION(kjpindex, nvm), INTENT(in)          :: in_cycle 
+  INTEGER(i_std), DIMENSION(kjpindex), INTENT(in)   :: cyc_num_tot ! number of current rotation cycle
+  INTEGER(i_std), DIMENSION(kjpindex,nvm,cyc_rot_max), INTENT(in)  :: plantdate !! kjpindex, nvm, cyc_rot_max
+  INTEGER(i_std), DIMENSION(kjpindex, nvm), INTENT(in)        :: nrec
+  INTEGER(i_std), DIMENSION(kjpindex, nvm), INTENT(in)        :: nlev
+
+  ! 0.2 Output
+  INTEGER(i_std), DIMENSION (kjpindex,nvm), INTENT(inout)  :: plantdate_now !! kjpindex, nvm, plantdate of current cycle
+  REAL(r_std), DIMENSION(ndeep,nvm), INTENT(out)  :: soilc_mict
+  INTEGER(i_std),INTENT(inout), DIMENSION(kjpindex,nvm) :: cyc_num ! flag for starting the rotation for kjpindex, nvm
+  REAL(r_std), INTENT(inout), DIMENSION(:,:,:,:,:)  :: litter ! Above and below ground metabolic and structural litter per ground area 
+  REAL(r_std), INTENT(inout), DIMENSION(:,:,:,:)    :: turnover_daily ! Senescence-driven turnover (better: mortality) of leaves and roots  
+  REAL(r_std), INTENT(inout), DIMENSION(:,:,:)      :: deepC_a        ! deep active carbon profile
+  REAL(r_std), INTENT(inout), DIMENSION(:,:,:)      :: deepC_s        ! deep slow carbon profile
+  REAL(r_std), INTENT(inout), DIMENSION(:,:,:)      :: deepC_p        ! deep passive carbon profile
+  REAL(r_std), INTENT(inout), DIMENSION(:,:,:)      :: carbon          ! Soil carbon pools per ground area: active, slow, or passive 
+  REAL(r_std), INTENT(inout), DIMENSION(:,:)        :: age                  !! Age of PFT it normalized by biomass - can increase and decrease - (years)
+  REAL(r_std), INTENT(inout), DIMENSION(:,:)        :: ind                  !! Vegetation density, number of individuals per unit 
+  LOGICAL, INTENT(inout), DIMENSION(:,:)            :: PFTpresent           !! PFT exists (equivalent to veget > 0 for natural PFTs)
+  LOGICAL, INTENT(inout), DIMENSION(:,:)            :: senescence           !! The PFT is senescent
+  REAL(r_std), INTENT(inout), DIMENSION(:,:)        :: when_growthinit      !! Days since beginning of growing season (days)
+  REAL(r_std), INTENT(inout), DIMENSION(:,:)    :: everywhere           !! Is the PFT everywhere in the grid box or very localized 
+  REAL(r_std), INTENT(inout), DIMENSION(:,:,:)  :: leaf_frac            !! PFT fraction of leaf mass in leaf age class (0-1, 
+
+
+  ! 0.3 Local Variables
+  REAL(r_std),DIMENSION(nvm,nlitt,nlevs,nelements)         :: dilu_lit !! Litter dilution
+  REAL(r_std),DIMENSION(nvm,nparts,nelements)              :: dilu_turn !! Turnover dilution
+  REAL(r_std),DIMENSION(nvm,ncarb)                         :: dilu_soil_carbon
+  REAL(r_std),DIMENSION(nvm,ndeep,ncarb)                   :: dilu_soil_carbon_vertres !!vertically-resolved Soil C arbondilution (gC/mÂ²)
+
+  REAL(r_std),DIMENSION(ncarb,nvm)                 :: carbon_old
+  REAL(r_std),DIMENSION(nlitt,nvm,nlevs,nelements) :: litter_old
+  REAL(r_std),DIMENSION(nvm,nparts,nelements)      :: turnover_old
+  REAL(r_std), DIMENSION(ndeep,nvm)                :: deepC_a_old
+  REAL(r_std), DIMENSION(ndeep,nvm)                :: deepC_s_old 
+  REAL(r_std), DIMENSION(ndeep,nvm)                :: deepC_p_old 
+
+  REAL(r_std),DIMENSION(nvm)                    :: maxfrac_new ! veget_max after rotation
+  INTEGER(i_std)                                :: i,jtar,jsrc,tempcyc
+  INTEGER(i_std),DIMENSION(nvm)        :: cyc_num_old
+  INTEGER(i_std)                                :: rngTol = 14
+  LOGICAL                                       :: f_convert
+
+  !!!! -------------------------------------------------------
+
+  !1.0 update cyc_num plantdate_now
+!  temp_cyc = cyc_num
+  cyc_num_old = cyc_num(ip,:)
+  !!! source crops
+  DO jsrc = 2,nvm
+    IF (SUM(matrix_prc(jsrc,:)) .GT. min_stomate) THEN
+    !!!! rotation from the jsrc, clean the rotation cycle of this PFT
+        cyc_num(ip,jsrc) = 1
+    ENDIF
+  ENDDO
+
+  maxfrac_new = maxfrac
+  litter_old = litter(ip,:,:,:,:)
+  turnover_old = turnover_daily(ip,:,:,:)
+  IF (ok_pc) THEN
+    deepC_a_old = deepC_a(ip,:,:)
+    deepC_s_old = deepC_s(ip,:,:)
+    deepC_p_old = deepC_p(ip,:,:)
+  ELSE
+    carbon_old = carbon(ip,:,:)
+  ENDIF
+  !!! target crops
+  DO jtar = 1, nvm
+    dilu_lit(:,:,:,:) = zero
+    dilu_turn(:,:,:) = zero
+    dilu_soil_carbon(:,:) = zero
+    dilu_soil_carbon_vertres(:,:,:) = zero
+    tempcyc = cyc_num_old(jtar)
+    IF (SUM(matrix_prc(:,jtar)) .GT. min_stomate) THEN
+        DO jsrc = 2, nvm
+            IF (matrix_prc(jsrc,jtar) .GT. min_stomate) THEN
+                f_convert = .FALSE.
+                IF (in_cycle(ip,jtar)) THEN 
+                    ! a complex case when the target PFT is still growing
+                    ! this is a bad case we do not allow
+                    WRITE(numout,*) 'rotate to a growing PFT: jsrc, jtar',jsrc, jtar
+                    WRITE(numout,*) 'in_cycle(ip,jtar) ', in_cycle(ip,jtar)
+                    STOP 'non-permitted rotation case occurred'
+                ELSE
+                    IF ( cyc_num(ip,jtar) == 1 ) THEN 
+                        !! simple case when target PFT is awating start
+                        IF (cyc_num_old(jsrc) .LT. cyc_num_tot(ip)) THEN
+                            cyc_num(ip,jtar) = cyc_num_old(jsrc) + 1
+                        ELSE ! complete of one rotation cycle, back to 1
+                            cyc_num(ip,jtar) = 1
+                        ENDIF
+                        plantdate_now(ip,jtar) = plantdate(ip,jtar,cyc_num(ip,jtar))
+                        IF ( (nrec(ip,jsrc) < nlev(ip,jsrc)) .AND. (nrec(ip,jsrc) .GT. 0) ) THEN 
+                            !harvest occured in the next-year of planting, adjusting planting date next cycle
+                            IF (plantdate_now(ip,jtar) > 365) plantdate_now(ip,jtar) = plantdate_now(ip,jtar) - 365
+                        ENDIF
+                        !!! when next planting date passed but within tolerance range
+                        IF ( (nrec(ip,jsrc) .GE. plantdate_now(ip,jtar)) .AND. (nrec(ip,jsrc) .GT. 0) .AND.  &
+                             (nrec(ip,jsrc) .LT. rngTol+plantdate_now(ip,jtar)) ) THEN
+                            plantdate_now(ip,jtar) = nrec(ip,jsrc)+2  ! we still grow it the day after tomorrow
+                        ENDIF
+                        maxfrac_new(jtar) = maxfrac_new(jtar) + matrix_prc(jsrc,jtar) * maxfrac(jsrc)
+                        maxfrac_new(jsrc) = maxfrac_new(jsrc) - matrix_prc(jsrc,jtar) * maxfrac(jsrc)
+                        f_convert = .TRUE.
+                    ELSEIF ( (tempcyc-1 .EQ. cyc_num_old(jsrc)) .OR. (tempcyc==1 .AND. cyc_num_old(jsrc)==cyc_num_tot(ip)) ) THEN
+                        ! one cycle ahead waiting to start
+                        ! no need to change cyc_num & planting date
+                        maxfrac_new(jtar) = maxfrac_new(jtar) + matrix_prc(jsrc,jtar) * maxfrac(jsrc)
+                        maxfrac_new(jsrc) = maxfrac_new(jsrc) - matrix_prc(jsrc,jtar) * maxfrac(jsrc)
+                        f_convert = .TRUE.
+                    ELSE
+                        WRITE(numout,*) 'rotation situation unexpected:'
+                        WRITE(numout,*) 'cyc_num_old(ip,jsrc), cyc_num_old(ip,jtar)',cyc_num_old(jsrc), cyc_num_old(jtar)
+                        WRITE(numout,*) 'cyc_num(ip,jtar)',cyc_num(ip,jtar)
+                        WRITE(numout,*) 'maxfrac',maxfrac
+                        STOP 'stomate_stics_rotation error with unexpected command'
+                    ENDIF ! tempcyc == 1
+                ENDIF ! in_cycle(jtar)
+
+                IF (f_convert) THEN
+                !!!! transfering soil and litter/turnover carbon pools
+                    !!! this is actually the better place to modify f_rot_sech & rot_cmd
+                    
+                    !!! first is source crops
+                    dilu_lit(jsrc,:,:,:) = litter_old(:,jsrc,:,:)
+                    dilu_turn(jsrc,:,:) = turnover_old(jsrc,:,:)
+                    IF (ok_pc) THEN
+                        dilu_soil_carbon_vertres(jsrc,:,iactive) = deepC_a_old(:,jsrc)
+                        dilu_soil_carbon_vertres(jsrc,:,islow) = deepC_s_old(:,jsrc)
+                        dilu_soil_carbon_vertres(jsrc,:,ipassive) = deepC_p_old(:,jsrc)
+                    ELSE    
+                        dilu_soil_carbon(jsrc,:) = carbon_old(:,jsrc)
+                    ENDIF
+                ENDIF ! we indeed converting jsrc to jtar
+            ENDIF !jsrc -> jtar
+        ENDDO !jsrc
+        !!! then is the conversion of litter and carbon to target crop
+        ! by design, SUM(matrix_prc(jtar,:)), should be either 0 or 1, this
+        ! is simply in case for more complex situations...
+        litter(ip,:,jtar,:,:) = litter_old(:,jtar,:,:) *  maxfrac(jtar) * (1.0 - SUM(matrix_prc(jtar,:))) 
+        turnover_daily(ip,jtar,:,:) = turnover_old(jtar,:,:) * maxfrac(jtar) * (1.0 - SUM(matrix_prc(jtar,:)))
+        IF (ok_pc) THEN
+            deepC_a(ip,:,jtar) = deepC_a_old(:,jtar) * maxfrac(jtar) * (1.0 - SUM(matrix_prc(jtar,:)))
+            deepC_s(ip,:,jtar) = deepC_s_old(:,jtar) * maxfrac(jtar) * (1.0 - SUM(matrix_prc(jtar,:)))
+            deepC_p(ip,:,jtar) = deepC_p_old(:,jtar) * maxfrac(jtar) * (1.0 - SUM(matrix_prc(jtar,:)))
+        ELSE
+            carbon(ip,:,jtar) = carbon_old(:,jtar) * maxfrac(jtar) * (1.0 - SUM(matrix_prc(jtar,:)))
+        ENDIF
+        DO jsrc = 1,nvm
+            litter(ip,:,jtar,:,:) = litter(ip,:,jtar,:,:) + (maxfrac(jsrc) * matrix_prc(jsrc,jtar) * dilu_lit(jsrc,:,:,:)) 
+            turnover_daily(ip,jtar,:,:) = turnover_daily(ip,jtar,:,:) + (maxfrac(jsrc) * matrix_prc(jsrc,jtar) * dilu_turn(jsrc,:,:)) 
+            IF (ok_pc) THEN
+                deepC_a(ip,:,jtar) = deepC_a(ip,:,jtar) + (maxfrac(jsrc) * matrix_prc(jsrc,jtar) * dilu_soil_carbon_vertres(jsrc,:,iactive))
+                deepC_s(ip,:,jtar) = deepC_s(ip,:,jtar) + (maxfrac(jsrc) * matrix_prc(jsrc,jtar) * dilu_soil_carbon_vertres(jsrc,:,islow))
+                deepC_p(ip,:,jtar) = deepC_p(ip,:,jtar) + (maxfrac(jsrc) * matrix_prc(jsrc,jtar) * dilu_soil_carbon_vertres(jsrc,:,ipassive))
+            ELSE
+                carbon(ip,:,jtar) = carbon(ip,:,jtar) + (maxfrac(jsrc) * matrix_prc(jsrc,jtar) * dilu_soil_carbon(jsrc,:))
+            ENDIF
+        ENDDO
+        litter(ip,:,jtar,:,:) = litter(ip,:,jtar,:,:) /  maxfrac_new(jtar)
+        turnover_daily(ip,jtar,:,:) = turnover_daily(ip,jtar,:,:) /  maxfrac_new(jtar)
+        IF (ok_pc) THEN
+            deepC_a(ip,:,jtar) = deepC_a(ip,:,jtar) / maxfrac_new(jtar)
+            deepC_s(ip,:,jtar) = deepC_s(ip,:,jtar) / maxfrac_new(jtar)
+            deepC_p(ip,:,jtar) = deepC_p(ip,:,jtar) / maxfrac_new(jtar)
+        ELSE
+            carbon(ip,:,jtar) = carbon(ip,:,jtar) / maxfrac_new(jtar)
+        ENDIF
+        age(ip,jtar) = zero
+
+        IF ( (maxfrac(jtar) .LT. min_stomate) .AND. (maxfrac_new(jtar) .GT. min_stomate) ) THEN !initialize a previously non-existed PFT
+            ind(ip,jtar) = maxfrac_new(jtar)
+            PFTpresent(ip,jtar) = .TRUE.
+            !everywhere(ip,jtar) = 1.
+            senescence(ip,jtar) = .TRUE.
+            age(ip,jtar) = zero
+            when_growthinit(ip,jtar) = large_value
+            leaf_frac(ip,jtar,1) = 1.0
+        ENDIF
+
+    ENDIF ! to jtar > 0
+  ENDDO !jtar
+  IF (printlev>=4) THEN
+    WRITE(numout,*) 'maxfrac', maxfrac
+    WRITE(numout,*) 'maxfrac_new', maxfrac_new
+    DO i = 1,3
+        WRITE(numout,*) 'i, carbon_old(i,:)', i, carbon_old(i,:)
+        WRITE(numout,*) 'i, carbon(ip,i,:)', i, carbon(ip,i,:)
+    ENDDO
+    WRITE(numout,*) 'SUM(litter_old(:,:,:,icarbon))',SUM(litter_old(:,:,:,icarbon))
+    WRITE(numout,*) 'SUM(litter(ip,:,:,:,icarbon))',SUM(litter(ip,:,:,:,icarbon))
+  ENDIF
+
+  DO jsrc = 1,nvm
+    IF ( maxfrac_new(jsrc)  .LT.  min_stomate ) THEN
+    ! clean the litter and soil carbon pool of the  PFT no longer existed
+        cyc_num(ip,jsrc) = 1
+        litter(ip,:,jsrc,:,:) = zero
+        turnover_daily(ip,jsrc,:,:) = zero
+        IF (ok_pc) THEN
+            deepC_a(ip,:,jsrc) = zero
+            deepC_s(ip,:,jsrc) = zero
+            deepC_p(ip,:,jsrc) = zero
+            
+        ELSE
+            carbon(ip,:,jsrc) = zero
+        ENDIF
+        ind(ip,jsrc) = zero
+        PFTpresent(ip,jsrc) = .FALSE.
+        senescence(ip,jsrc) = .FALSE.
+        age(ip,jsrc) = zero
+        when_growthinit(ip,jsrc) = large_value
+        everywhere(ip,jsrc) = zero
+    ENDIF
+  ENDDO
+
+  soilc_mict(:,:) = deepC_a(ip,:,:) + deepC_s(ip,:,:) + deepC_p(ip,:,:)
+
+  !!! now check the maxfrac_new for consistency
+  IF ( SUM(maxfrac_new(:)) .GT. 1.0 ) THEN
+    WRITE(numout,*) 'vegetation fraction greater than 1.0 after rotation'
+    WRITE(numout,*) 'ip, maxfrac_new,', ip, maxfrac_new
+    STOP 'stomate_stics_rotation: wrong vegetation fraction'
+  ENDIF
+
+  END SUBROUTINE stomate_stics_rotation
+
+END MODULE stomate_stics
Index: /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_stomate/stomate_wet_ch4.f90
===================================================================
--- /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_stomate/stomate_wet_ch4.f90	(revision 6940)
+++ /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_stomate/stomate_wet_ch4.f90	(revision 6940)
@@ -0,0 +1,1138 @@
+! =================================================================================================================================
+! MODULE       : stomate_wet_ch4
+!
+! CONTACT      : orchidee-help _at_ listes.ipsl.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF       CH4_calcul main module
+!!
+!!\n DESCRIPTION : None
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! REFERENCE(S)	: None
+!!
+!! SVN :
+!! $HeadURL: svn://forge.ipsl.jussieu.fr/orchidee/branches/ORCHIDEE-MICT/ORCHIDEE/src_stomate/stomate.f90 $
+!! $Date: 2017-07-28 17:48:13 +0200 (Fri, 28 Jul 2017) $
+!! $Revision: 4542 $
+!! \n
+!_ ================================================================================================================================
+MODULE stomate_wet_ch4
+
+  ! modules used:
+  USE stomate_wet_ch4_constantes_var
+  USE stomate_wet_ch4_pt_ter_0
+  USE stomate_wet_ch4_pt_ter_wet
+
+  IMPLICIT NONE
+
+  ! private & public routines
+
+  PRIVATE
+  PUBLIC stomate_wet_ch4_initialize, stomate_wet_ch4_main, stomate_wet_ch4_clear, stomate_wet_ch4_finalize, &
+         stomate_wet_ch4_histdef, stomate_wet_ch4_config_parameters
+
+  ! density flux of methane calculated for entire pixel (gCH4/dt/m**2)
+  ! pour wetland avc Water Table Depth (WTD) = 0
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:) :: ch4_flux_density_tot_0
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:) :: ch4_flux_density_dif_0
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:) :: ch4_flux_density_bub_0
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:) :: ch4_flux_density_pla_0
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)  :: uo_0 !concentration dim = (kjpindex,nvert)
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)  :: uold2_0 !concentration au pas de temps precedent
+!pour wetland avc WTD = -x1
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:) :: ch4_flux_density_tot_wet1
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:) :: ch4_flux_density_dif_wet1
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:) :: ch4_flux_density_bub_wet1
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:) :: ch4_flux_density_pla_wet1
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)  :: uo_wet1
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)  :: uold2_wet1
+!pour wetland avc WTD = -x2
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:) :: ch4_flux_density_tot_wet2
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:) :: ch4_flux_density_dif_wet2
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:) :: ch4_flux_density_bub_wet2
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:) :: ch4_flux_density_pla_wet2
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)  :: uo_wet2
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)  :: uold2_wet2
+!pour wetland avc WTD = -x3
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:) :: ch4_flux_density_tot_wet3
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:) :: ch4_flux_density_dif_wet3
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:) :: ch4_flux_density_bub_wet3
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:) :: ch4_flux_density_pla_wet3
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)  :: uo_wet3
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)  :: uold2_wet3
+!pour wetland avc WTD = -x4
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:) :: ch4_flux_density_tot_wet4
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:) :: ch4_flux_density_dif_wet4
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:) :: ch4_flux_density_bub_wet4
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:) :: ch4_flux_density_pla_wet4
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)  :: uo_wet4
+  REAL(r_std),ALLOCATABLE,SAVE,DIMENSION(:,:)  :: uold2_wet4
+
+
+CONTAINS
+
+!! ================================================================================================================================
+!! SUBROUTINE   : stomate_wet_ch4_config_parameters
+!!
+!>\BRIEF        stomate cste WETLAND
+!!
+!! DESCRIPTION  : 
+!!                
+!! \n
+!_ ================================================================================================================================
+!!
+  SUBROUTINE stomate_wet_ch4_config_parameters
+       !Config Key   = nvert
+       !Config Desc  = nb of vertical layers for CH4 diffusion 
+       !Config If    = CH4_CALCUL
+       !Config Def   = 171 
+       !Config Help  = 
+       !Config Units = [-]   
+       CALL getin_p('NVERT',nvert)
+
+       !Config Key   = ns
+       !Config Desc  = nb of vertical layers for CH4 diffusion 
+       !Config If    = CH4_CALCUL
+       !Config Def   = 151 
+       !Config Help  = 
+       !Config Units = [-]   
+       CALL getin_p('NS',ns)
+
+       !Config Key   = nday
+       !Config Desc  = nb of vertical layers for CH4 diffusion 
+       !Config If    = CH4_CALCUL
+       !Config Def   = 24
+       !Config Help  = 
+       !Config Units = [-]   
+       CALL getin_p('NDAY',nday)
+
+       !Config Key   = h
+       !Config Desc  = nb of vertical layers for CH4 diffusion 
+       !Config If    = CH4_CALCUL
+       !Config Def   = 0.1
+       !Config Help  = 
+       !Config Units = [-]   
+       CALL getin_p('H',h)
+
+       !Config Key   = rk
+       !Config Desc  = nb of vertical layers for CH4 diffusion 
+       !Config If    = CH4_CALCUL
+       !Config Def   = 1
+       !Config Help  = 
+       !Config Units = [-]   
+       CALL getin_p('RK',rk)
+
+       !Config Key   = diffair
+       !Config Desc  = nb of vertical layers for CH4 diffusion 
+       !Config If    = CH4_CALCUL
+       !Config Def   = 7.2 
+       !Config Help  = 
+       !Config Units = [-]   
+       CALL getin_p('DIFFAIR',diffair)
+
+       !Config Key   = pox
+       !Config Desc  = nb of vertical layers for CH4 diffusion 
+       !Config If    = CH4_CALCUL
+       !Config Def   = 0.5 
+       !Config Help  = 
+       !Config Units = [-]   
+       CALL getin_p('POX',pox)
+
+       !Config Key   = dveg
+       !Config Desc  = nb of vertical layers for CH4 diffusion 
+       !Config If    = CH4_CALCUL
+       !Config Def   = 0.001 
+       !Config Help  = 
+       !Config Units = [-]   
+       CALL getin_p('DVEG',dveg)
+
+       !Config Key   = rkm
+       !Config Desc  = nb of vertical layers for CH4 diffusion 
+       !Config If    = CH4_CALCUL
+       !Config Def   = 5.0
+       !Config Help  = 
+       !Config Units = [-]   
+       CALL getin_p('RKM',rkm)
+
+       !Config Key   = xvmax
+       !Config Desc  = nb of vertical layers for CH4 diffusion 
+       !Config If    = CH4_CALCUL
+       !Config Def   = 20.0 
+       !Config Help  = 
+       !Config Units = [-]   
+       CALL getin_p('XVMAX',xvmax)
+
+       !Config Key   = oxq10
+       !Config Desc  = nb of vertical layers for CH4 diffusion 
+       !Config If    = CH4_CALCUL
+       !Config Def   = 2.0 
+       !Config Help  = 
+       !Config Units = [-]   
+       CALL getin_p('OXQ10',oxq10)
+
+       !Config Key   = scmax
+       !Config Desc  = nb of vertical layers for CH4 diffusion 
+       !Config If    = CH4_CALCUL
+       !Config Def   = 500. 
+       !Config Help  = 
+       !Config Units = [-]   
+       CALL getin_p('SCMAX',scmax)
+
+       !Config Key   = sr0pl
+       !Config Desc  = nb of vertical layers for CH4 diffusion 
+       !Config If    = CH4_CALCUL
+       !Config Def   = 600. 
+       !Config Help  = 
+       !Config Units = [-]   
+       CALL getin_p('SR0PL',sr0pl)
+
+       !Config Key   = pwater_wet1
+       !Config Desc  = depth where saturation: definition for wetland 1  
+       !Config If    = CH4_CALCUL
+       !Config Def   = -3 
+       !Config Help  = 
+       !Config Units = [cm]   
+       CALL getin_p('PWATER_WET1',pwater_wet1)
+
+       !Config Key   = pwater_wet2
+       !Config Desc  = depth where saturation: definition for wetland 1  
+       !Config If    = CH4_CALCUL
+       !Config Def   = -9 
+       !Config Help  = 
+       !Config Units = [cm]   
+       CALL getin_p('PWATER_WET2',pwater_wet2)
+
+       !Config Key   = pwater_wet3
+       !Config Desc  = depth where saturation: definition for wetland 1  
+       !Config If    = CH4_CALCUL
+       !Config Def   = -15 
+       !Config Help  = 
+       !Config Units = [cm]   
+       CALL getin_p('PWATER_WET3',pwater_wet3)
+
+       !Config Key   = pwater_wet4
+       !Config Desc  = depth where saturation: definition for wetland 1  
+       !Config If    = CH4_CALCUL
+       !Config Def   = -21 
+       !Config Help  = 
+       !Config Units = [cm]   
+       CALL getin_p('PWATER_WET4',pwater_wet4)
+
+       !Config Key   = rpv
+       !Config Desc  = nb of vertical layers for CH4 diffusion 
+       !Config If    = CH4_CALCUL
+       !Config Def   = 0.5 
+       !Config Help  = 
+       !Config Units = [-]   
+       CALL getin_p('RPV',rpv)
+
+       !Config Key   = iother
+       !Config Desc  = nb of vertical layers for CH4 diffusion 
+       !Config If    = CH4_CALCUL
+       !Config Def   = -1.0 
+       !Config Help  = 
+       !Config Units = [-]   
+       CALL getin_p('IOTHER',iother)
+
+       !Config Key   = rq10
+       !Config Desc  = nb of vertical layers for CH4 diffusion 
+       !Config If    = CH4_CALCUL
+       !Config Def   = 3.0 
+       !Config Help  = 
+       !Config Units = [-]   
+       CALL getin_p('RQ10',rq10)
+
+       !Config Key   = alpha_CH4
+       !Config Desc  = nb of vertical layers for CH4 diffusion 
+       !Config If    = CH4_CALCUL
+       !Config Def   = /0.009,0.004,0.021/
+       !Config Help  = 
+       !Config Units = [-]   
+       CALL getin_p('ALPHA_CH4',alpha_CH4)
+
+  END SUBROUTINE stomate_wet_ch4_config_parameters
+
+!! ================================================================================================================================
+!! SUBROUTINE   : stomate_wet_ch4_readrestart
+!!
+!>\BRIEF        Read restart variables
+!!
+!! DESCRIPTION  : 
+!!                
+!! \n
+!_ ================================================================================================================================
+!!
+  SUBROUTINE stomate_wet_ch4_readrestart ( rest_id, itime )
+
+    ! 0.4 Local variables
+    CHARACTER(LEN=100)                   :: var_name !! Name of permafrost forcing file
+    INTEGER(i_std), INTENT(in)           :: rest_id
+    INTEGER(i_std), INTENT(in)           :: itime 
+
+    INTEGER(i_std) ::  nivo
+!_ ================================================================================================================================
+
+    uo_0(:,:) = val_exp
+    var_name = 'uo_0'
+    CALL restget_p (rest_id, var_name, nbp_glo,   nvert, 1, itime, &
+         &              .TRUE.,uo_0 , 'gather', nbp_glo, index_g)
+    IF (ALL(uo_0(:,:) == val_exp)) THEN
+       DO nivo=1,nvert
+          IF (nivo .LE. ns) THEN
+            uo_0(:,nivo) = scmax
+         ELSE
+            uo_0(:,nivo) = CH4atmo_CONC
+         ENDIF
+      ENDDO
+   ENDIF
+
+   uold2_0(:,:) = val_exp
+   var_name = 'uold2_0'
+   CALL restget_p (rest_id, var_name, nbp_glo,   nvert, 1, itime, &
+        &              .TRUE.,uold2_0 , 'gather', nbp_glo, index_g)
+   IF (ALL(uold2_0(:,:) == val_exp)) THEN
+      DO nivo=1,nvert
+         IF (nivo .LE. ns) THEN
+            uold2_0(:,nivo) = scmax
+         ELSE
+            uold2_0(:,nivo) = CH4atmo_CONC
+         ENDIF
+      ENDDO
+   ENDIF
+   
+   uo_wet1(:,:) = val_exp
+   var_name = 'uo_wet1'
+   CALL restget_p (rest_id, var_name, nbp_glo,   nvert, 1, itime, &
+       &              .TRUE.,uo_wet1 , 'gather', nbp_glo, index_g)
+   IF (ALL(uo_wet1(:,:) == val_exp)) THEN
+      DO nivo=1,nvert
+         IF (nivo .LE. ns-10) THEN
+            uo_wet1(:,nivo) = scmax
+         ELSE
+            uo_wet1(:,nivo) = CH4atmo_CONC
+         ENDIF
+      ENDDO
+   ENDIF
+   
+   uold2_wet1(:,:) = val_exp
+   var_name = 'uold2_wet1'
+   CALL restget_p (rest_id, var_name, nbp_glo,   nvert, 1, itime, &
+        &              .TRUE.,uold2_wet1 , 'gather', nbp_glo, index_g)
+   IF (ALL(uold2_wet1(:,:) == val_exp)) THEN
+      DO nivo=1,nvert
+         IF (nivo .LE. ns-10) THEN
+            uold2_wet1(:,nivo) = scmax
+         ELSE
+            uold2_wet1(:,nivo) = CH4atmo_CONC
+         ENDIF
+      ENDDO
+   ENDIF
+  
+   uo_wet2(:,:) = val_exp
+   var_name = 'uo_wet2'
+   CALL restget_p (rest_id, var_name, nbp_glo,   nvert, 1, itime, &
+        &              .TRUE.,uo_wet2 , 'gather', nbp_glo, index_g)
+   IF (ALL(uo_wet2(:,:) == val_exp)) THEN
+      DO nivo=1,nvert
+         IF (nivo .LE. ns-10) THEN
+            uo_wet2(:,nivo) = scmax
+         ELSE
+            uo_wet2(:,nivo) = CH4atmo_CONC
+         ENDIF
+      ENDDO
+   ENDIF
+
+   uold2_wet2(:,:) = val_exp
+   var_name = 'uold2_wet2'
+   CALL restget_p (rest_id, var_name, nbp_glo,   nvert, 1, itime, &
+        &              .TRUE.,uold2_wet2 , 'gather', nbp_glo, index_g)
+   IF (ALL(uold2_wet2(:,:) == val_exp)) THEN
+      DO nivo=1,nvert
+         IF (nivo .LE. ns-10) THEN
+            uold2_wet2(:,nivo) = scmax
+         ELSE
+            uold2_wet2(:,nivo) = CH4atmo_CONC
+         ENDIF
+      ENDDO
+   ENDIF
+
+   uo_wet3(:,:) = val_exp
+   var_name = 'uo_wet3'
+   CALL restget_p (rest_id, var_name, nbp_glo,   nvert, 1, itime, &
+        &              .TRUE.,uo_wet3 , 'gather', nbp_glo, index_g)
+   IF (ALL(uo_wet3(:,:) == val_exp)) THEN
+      DO nivo=1,nvert
+         IF (nivo .LE. ns-10) THEN
+            uo_wet3(:,nivo) = scmax
+         ELSE
+            uo_wet3(:,nivo) = CH4atmo_CONC
+         ENDIF
+      ENDDO
+   ENDIF
+   
+   uold2_wet3(:,:) = val_exp
+   var_name = 'uold2_wet3'
+   CALL restget_p (rest_id, var_name, nbp_glo,   nvert, 1, itime, &
+        &              .TRUE.,uold2_wet3 , 'gather', nbp_glo, index_g)
+   IF (ALL(uold2_wet3(:,:) == val_exp)) THEN
+      DO nivo=1,nvert
+         IF (nivo .LE. ns-10) THEN
+            uold2_wet3(:,nivo) = scmax
+         ELSE
+            uold2_wet3(:,nivo) = CH4atmo_CONC
+         ENDIF
+      ENDDO
+   ENDIF
+
+   uo_wet4(:,:) = val_exp
+   var_name = 'uo_wet4'
+   CALL restget_p (rest_id, var_name, nbp_glo,   nvert, 1, itime, &
+        &              .TRUE.,uo_wet4 , 'gather', nbp_glo, index_g)
+   IF (ALL(uo_wet4(:,:) == val_exp)) THEN
+      DO nivo=1,nvert
+         IF (nivo .LE. ns-10) THEN
+            uo_wet4(:,nivo) = scmax
+         ELSE
+            uo_wet4(:,nivo) = CH4atmo_CONC
+         ENDIF
+      ENDDO
+   ENDIF
+
+   uold2_wet4(:,:) = val_exp
+   var_name = 'uold2_wet4'
+   CALL restget_p (rest_id, var_name, nbp_glo,   nvert, 1, itime, &
+        &              .TRUE.,uold2_wet4 , 'gather', nbp_glo, index_g)
+   IF (ALL(uold2_wet4(:,:) == val_exp)) THEN
+      DO nivo=1,nvert
+         IF (nivo .LE. ns-10) THEN
+            uold2_wet4(:,nivo) = scmax
+         ELSE
+            uold2_wet4(:,nivo) = CH4atmo_CONC
+         ENDIF
+      ENDDO
+   ENDIF
+  END SUBROUTINE stomate_wet_ch4_readrestart
+
+!! ================================================================================================================================
+!! SUBROUTINE   : stomate_wet_ch4_writerestart
+!!
+!>\BRIEF        Module restart write variables
+!!
+!! DESCRIPTION  : 
+!!                
+!! \n
+!_ ================================================================================================================================
+!!
+  SUBROUTINE stomate_wet_ch4_writerestart ( rest_id, itime )
+
+    ! 0.1 Input variables
+    INTEGER(i_std), INTENT(in) :: rest_id
+    INTEGER(i_std), INTENT(in) :: itime
+
+    ! 0.4 Local variables
+    CHARACTER(LEN=100)                   :: var_name !! Name of permafrost forcing file
+
+!_ ================================================================================================================================
+    var_name = 'uo_0'
+    CALL restput_p (rest_id, var_name, nbp_glo, nvert, 1, itime, &
+         &              uo_0, 'scatter', nbp_glo, index_g)
+    
+    var_name = 'uold2_0'
+    CALL restput_p (rest_id, var_name, nbp_glo, nvert, 1, itime, &
+         &              uold2_0, 'scatter', nbp_glo, index_g)
+    
+    var_name = 'uo_wet1'
+    CALL restput_p (rest_id, var_name, nbp_glo, nvert, 1, itime, &
+         &              uo_wet1, 'scatter', nbp_glo, index_g)
+    
+    var_name = 'uold2_wet1'
+    CALL restput_p (rest_id, var_name, nbp_glo, nvert, 1, itime, &
+         &              uold2_wet1, 'scatter', nbp_glo, index_g)
+    
+    var_name = 'uo_wet2'
+    CALL restput_p (rest_id, var_name, nbp_glo, nvert, 1, itime, &
+         &              uo_wet2, 'scatter', nbp_glo, index_g)
+ 
+    var_name = 'uold2_wet2'
+    CALL restput_p (rest_id, var_name, nbp_glo, nvert, 1, itime, &
+         &              uold2_wet2, 'scatter', nbp_glo, index_g)
+
+    var_name = 'uo_wet3'
+    CALL restput_p (rest_id, var_name, nbp_glo, nvert, 1, itime, &
+       &              uo_wet3, 'scatter', nbp_glo, index_g)
+    
+    var_name = 'uold2_wet3'
+    CALL restput_p (rest_id, var_name, nbp_glo, nvert, 1, itime, &
+         &              uold2_wet3, 'scatter', nbp_glo, index_g)
+    
+    var_name = 'uo_wet4'
+    CALL restput_p (rest_id, var_name, nbp_glo, nvert, 1, itime, &
+         &              uo_wet4, 'scatter', nbp_glo, index_g)
+    
+    var_name = 'uold2_wet4'
+    CALL restput_p (rest_id, var_name, nbp_glo, nvert, 1, itime, &
+         &              uold2_wet4, 'scatter', nbp_glo, index_g)
+
+  END SUBROUTINE stomate_wet_ch4_writerestart
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : stomate_wet_ch4_initialize
+!!
+!>\BRIEF        Module initialization
+!!
+!! DESCRIPTION  : 
+!!                
+!! \n
+!_ ================================================================================================================================
+!!
+  SUBROUTINE stomate_wet_ch4_initialize ( kjpindex, rest_id, itime )
+    !
+    ! 0 declarations
+    !
+
+    ! 0.1 input
+    INTEGER(i_std), INTENT(in)                     :: kjpindex ! Domain size
+    INTEGER(i_std), INTENT(in)                     :: rest_id
+    INTEGER(i_std), INTENT(in)                     :: itime
+
+    ! 0.2 modified fields
+
+    ! 0.3 output
+
+    ! 0.4 local
+!_ ================================================================================================================================
+   !1.4.10 wetland CH4
+   !pss:+
+   !appel routines pour calcul des densites de flux de CH4
+
+        
+   !Config  Key  = CH4atm_CONC
+   !Config  Desc = 
+   !Config If    = CH4_CALCUL
+   !Config  Def  = 0.0017
+   !Config  Help = 
+   !               
+   !Config Units = [-]
+   CH4atmo_CONC=0.0017
+   CALL getin_p('CH4atmo_CONC', CH4atmo_CONC)
+
+   CH4_WTD1  = .TRUE.
+   !Config  Key  = CH4_WTD1
+   !Config  Desc = 
+   !Config If    = CH4_CALCUL
+   !Config  Def  = True
+   !Config  Help = 
+   !               
+   !Config Units = Y/n
+   CALL getin_p('CH4_WTD1', CH4_WTD1)
+   !Config  Key  = CH4_WTD2
+   !Config  Desc = 
+   !Config If    = CH4_CALCUL
+   !Config  Def  = True
+   !Config  Help = 
+   !               
+   !Config Units = Y/n
+   CH4_WTD2  = .TRUE.
+   CALL getin_p('CH4_WDT2', CH4_WTD2)
+   !Config  Key  = CH4_WTD3
+   !Config  Desc = 
+   !Config If    = CH4_CALCUL
+   !Config  Def  = True
+   !Config  Help = 
+   !               
+   !Config Units = Y/n
+   CH4_WTD3  = .TRUE.
+   CALL getin_p('CH4_WTD3', CH4_WTD3)
+   !Config  Key  = CH4_WTD4
+   !Config  Desc = 
+   !Config If    = CH4_CALCUL
+   !Config  Def  = True
+   !Config  Help = 
+   !               
+   !Config Units = Y/n
+   CH4_WTD4  = .TRUE.
+   CALL getin_p('CH4_WTD4', CH4_WTD4)
+
+   ! allocate
+   CALL stomate_wet_ch4_init (kjpindex)
+
+   ! read data from restart files (if any)
+   CALL stomate_wet_ch4_readrestart (rest_id, itime)
+
+  END SUBROUTINE stomate_wet_ch4_initialize
+
+!! ================================================================================================================================
+!! SUBROUTINE   : stomate_wet_ch4_init
+!!
+!>\BRIEF        Module variables allocation 
+!!
+!! DESCRIPTION  : 
+!!                
+!! \n
+!_ ================================================================================================================================
+!!
+  SUBROUTINE stomate_wet_ch4_init ( kjpindex )
+    !
+    ! 0 declarations
+    !
+
+    ! 0.1 input
+
+    ! Domain size
+    INTEGER(i_std), INTENT(in)                                 :: kjpindex
+    ! 0.2 modified fields
+
+    ! 0.3 output
+
+    ! 0.4 local
+    INTEGER(i_std)               :: ier
+!_ ================================================================================================================================
+
+    ALLOCATE(ch4_flux_density_tot_0(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3, 'stomate_wet_ch4_initialize', 'There is an allocation variable error: ', 'ch4_flux_density_tot_0', '')
+    ch4_flux_density_tot_0 = zero
+
+    ALLOCATE(ch4_flux_density_dif_0(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3, 'stomate_wet_ch4_initialize', 'There is an allocation variable error: ', 'ch4_flux_density_dif_0', '')
+    ch4_flux_density_dif_0 = zero
+
+    ALLOCATE(ch4_flux_density_bub_0(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3, 'stomate_wet_ch4_initialize', 'There is an allocation variable error: ', 'ch4_flux_density_bub_0', '')
+    ch4_flux_density_bub_0 = zero
+
+    ALLOCATE(ch4_flux_density_pla_0(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3, 'stomate_wet_ch4_initialize', 'There is an allocation variable error: ', 'ch4_flux_density_pla_0', '')
+    ch4_flux_density_pla_0 = zero
+
+    
+    ALLOCATE(ch4_flux_density_tot_wet1(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3, 'stomate_wet_ch4_initialize', 'There is an allocation variable error: ', 'ch4_flux_density_tot_wet1', '')
+    ch4_flux_density_tot_wet1 = zero
+
+    ALLOCATE(ch4_flux_density_dif_wet1(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3, 'stomate_wet_ch4_initialize', 'There is an allocation variable error: ', 'ch4_flux_density_dif_wet1', '')
+    ch4_flux_density_dif_wet1 = zero
+
+    ALLOCATE(ch4_flux_density_bub_wet1(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3, 'stomate_wet_ch4_initialize', 'There is an allocation variable error: ', 'ch4_flux_density_bub_wet1', '')
+    ch4_flux_density_bub_wet1 = zero
+
+    ALLOCATE(ch4_flux_density_pla_wet1(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3, 'stomate_wet_ch4_initialize', 'There is an allocation variable error: ', 'ch4_flux_density_pla_wet1', '')
+    ch4_flux_density_pla_wet1 = zero
+
+
+    ALLOCATE(ch4_flux_density_tot_wet2(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3, 'stomate_wet_ch4_initialize', 'There is an allocation variable error: ', 'ch4_flux_density_tot_wet2', '')
+    ch4_flux_density_tot_wet2 = zero
+
+    ALLOCATE(ch4_flux_density_dif_wet2(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3, 'stomate_wet_ch4_initialize', 'There is an allocation variable error: ', 'ch4_flux_density_dif_wet2', '')
+    ch4_flux_density_dif_wet2 = zero
+
+    ALLOCATE(ch4_flux_density_bub_wet2(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3, 'stomate_wet_ch4_initialize', 'There is an allocation variable error: ', 'ch4_flux_density_bub_wet2', '')
+    ch4_flux_density_bub_wet2 = zero
+
+    ALLOCATE(ch4_flux_density_pla_wet2(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3, 'stomate_wet_ch4_initialize', 'There is an allocation variable error: ', 'ch4_flux_density_pla_wet2', '')
+    ch4_flux_density_pla_wet2 = zero
+
+   
+    ALLOCATE(ch4_flux_density_tot_wet3(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3, 'stomate_wet_ch4_initialize', 'There is an allocation variable error: ', 'ch4_flux_density_tot_wet3', '')
+    ch4_flux_density_tot_wet3 = zero
+
+    ALLOCATE(ch4_flux_density_dif_wet3(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3, 'stomate_wet_ch4_initialize', 'There is an allocation variable error: ', 'ch4_flux_density_dif_wet3', '')
+    ch4_flux_density_dif_wet3 = zero
+
+    ALLOCATE(ch4_flux_density_bub_wet3(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3, 'stomate_wet_ch4_initialize', 'There is an allocation variable error: ', 'ch4_flux_density_bub_wet3', '')
+    ch4_flux_density_bub_wet3 = zero
+
+    ALLOCATE(ch4_flux_density_pla_wet3(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3, 'stomate_wet_ch4_initialize', 'There is an allocation variable error: ', 'ch4_flux_density_pla_wet3', '')
+    ch4_flux_density_pla_wet3 = zero
+
+    
+    ALLOCATE(ch4_flux_density_tot_wet4(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3, 'stomate_wet_ch4_initialize', 'There is an allocation variable error: ', 'ch4_flux_density_tot_wet4', '')
+    ch4_flux_density_tot_wet4 = zero
+    
+    ALLOCATE(ch4_flux_density_dif_wet4(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3, 'stomate_wet_ch4_initialize', 'There is an allocation variable error: ', 'ch4_flux_density_dif_wet4', '')
+    ch4_flux_density_dif_wet4 = zero
+   
+    ALLOCATE(ch4_flux_density_bub_wet4(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3, 'stomate_wet_ch4_initialize', 'There is an allocation variable error: ', 'ch4_flux_density_bub_wet4', '')
+    ch4_flux_density_bub_wet4 = zero
+  
+    ALLOCATE(ch4_flux_density_pla_wet4(kjpindex),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3, 'stomate_wet_ch4_initialize', 'There is an allocation variable error: ', 'ch4_flux_density_pla_wet4', '')
+    ch4_flux_density_pla_wet4 = zero
+ 
+
+    ALLOCATE(uo_0(kjpindex,nvert),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3, 'stomate_wet_ch4_initialize', 'There is an allocation variable error: ', 'uo_0', '')
+    uo_0 = zero
+
+    ALLOCATE(uold2_0(kjpindex,nvert),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3, 'stomate_wet_ch4_initialize', 'There is an allocation variable error: ', 'uold2_0', '')
+    uold2_0 = zero
+
+    ALLOCATE(uo_wet1(kjpindex,nvert),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3, 'stomate_wet_ch4_initialize', 'There is an allocation variable error: ', 'uo_wet1', '')
+    uo_wet1 = zero
+
+    ALLOCATE(uold2_wet1(kjpindex,nvert),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3, 'stomate_wet_ch4_initialize', 'There is an allocation variable error: ', 'uold2_wet1', '')
+    uold2_wet1 = zero
+
+    ALLOCATE(uo_wet2(kjpindex,nvert),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3, 'stomate_wet_ch4_initialize', 'There is an allocation variable error: ', 'uo_wet2', '')
+    uo_wet2 = zero
+
+    ALLOCATE(uold2_wet2(kjpindex,nvert),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3, 'stomate_wet_ch4_initialize', 'There is an allocation variable error: ', 'uold2_wet2', '')
+    uold2_wet2 = zero
+
+    ALLOCATE(uo_wet3(kjpindex,nvert),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3, 'stomate_wet_ch4_initialize', 'There is an allocation variable error: ', 'uo_wet3', '')
+    uo_wet3 = zero
+
+    ALLOCATE(uold2_wet3(kjpindex,nvert),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3, 'stomate_wet_ch4_initialize', 'There is an allocation variable error: ', 'uold2_wet3', '')
+    uold2_wet3 = zero
+
+    ALLOCATE(uo_wet4(kjpindex,nvert),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3, 'stomate_wet_ch4_initialize', 'There is an allocation variable error: ', 'uo_wet4', '')
+    uo_wet4 = zero
+
+    ALLOCATE(uold2_wet4(kjpindex,nvert),stat=ier)
+    IF (ier /= 0) CALL ipslerr_p(3, 'stomate_wet_ch4_initialize', 'There is an allocation variable error: ', 'uold2_wet4', '')
+    uold2_wet4 = zero
+
+  END SUBROUTINE stomate_wet_ch4_init
+
+!! ================================================================================================================================
+!! SUBROUTINE   : stomate_wet_ch4_main
+!!
+!>\BRIEF        ch4 main body
+!!
+!! DESCRIPTION  : 
+!!                
+!! \n
+!_ ================================================================================================================================
+!!
+  SUBROUTINE stomate_wet_ch4_main ( kjpindex,       stempdiag,      tsurf_daily, tsurf_year,    &
+                                    veget_cov_max,  veget,          lai, carbon,                &
+                                    carbon_surf,    itime,          hist_id_stomate, hori_index) 
+    !
+    ! 0 declarations
+    !
+
+    ! 0.1 input
+
+    ! Domain size
+    INTEGER(i_std), INTENT(in)                                 :: kjpindex 
+    REAL(r_std),DIMENSION (:,:), INTENT (in)               :: stempdiag   ! kjpindex, nslm
+    ! temperature (K) at the surface
+    REAL(r_std), DIMENSION(:), INTENT(in)                  :: tsurf_daily ! kjpindex
+
+    ! temperature (K) at the surface
+    REAL(r_std), DIMENSION(:), INTENT(in)                  :: tsurf_year ! kjpindex
+
+    ! "maximal" coverage fraction of a PFT (LAI -> infinity) on nat/agri ground
+    REAL(r_std), DIMENSION(:,:), INTENT(in)               :: veget_cov_max    ! kjpindex, nvm
+    REAL(r_std), DIMENSION(:,:), INTENT(in)               :: veget            ! kjpindex, nvm
+    REAL(r_std), DIMENSION(:,:),INTENT(in)  :: lai               !! Leaf area inex @tex $(m^2 m^{-2})$ @endtex
+    !! Carbon pool integrated to over surface soils: active, slow, or passive ( kjpindex, ncarb, nvm )
+    REAL(r_std), DIMENSION(:,:,:), INTENT(in)        :: carbon_surf 
+    !! Soil carbon pools per ground area: active, slow, or ( kjpindex, ncarb, nvm ) 
+    REAL(r_std), DIMENSION(:,:,:), INTENT(in)        :: carbon 
+    INTEGER(i_std), INTENT(in)                                      :: itime 
+    INTEGER(i_std), INTENT(in)                                      :: hist_id_stomate
+    INTEGER(i_std), DIMENSION(:), INTENT(in)                        :: hori_index     !! Move to Horizontal indices
+
+    ! 0.2 modified fields
+
+    ! 0.3 output
+
+    ! 0.4 local
+
+!_ ================================================================================================================================
+
+    IF (.NOT. CH4_calcul) CALL ipslerr_p(3, 'stomate_wet_ch4_main', & 
+        'CH4 module needs to be enabled to run this subroutine', 'Set CH4_CALCUL=y', &
+        'in your run.def file')
+
+
+    !routine pour densite de flux d un wetland ou WTD = 0
+    CALL ch4_wet_flux_density_0 (kjpindex,stempdiag,tsurf_daily,tsurf_year,veget_cov_max,veget,&
+         & carbon,lai,uo_0,uold2_0, ch4_flux_density_tot_0, ch4_flux_density_dif_0,&
+         & ch4_flux_density_bub_0,ch4_flux_density_pla_0, CH4atmo_CONC)  
+
+
+    IF (CH4_WTD1) THEN
+       !routine calcule densite de flux d un wetland ou WTD = pwater_wet1 (cf.stomate_cste_wetlands.f90) 
+       CALL ch4_wet_flux_density_wet (kjpindex,stempdiag,tsurf_daily,tsurf_year,veget_cov_max,veget,&
+            & carbon_surf,lai,uo_wet1,uold2_wet1,ch4_flux_density_tot_wet1, ch4_flux_density_dif_wet1, &
+            & ch4_flux_density_bub_wet1,ch4_flux_density_pla_wet1, CH4atmo_CONC, pwater_wet1)  
+    ENDIF
+         
+      IF (CH4_WTD2) THEN
+         !routine calcule densite de flux d un wetland ou WTD = pwater_wet2 (cf.stomate_cste_wetlands.f90) 
+         CALL ch4_wet_flux_density_wet (kjpindex,stempdiag,tsurf_daily,tsurf_year,veget_cov_max,veget,&
+              & carbon_surf,lai,uo_wet2,uold2_wet2,ch4_flux_density_tot_wet2, ch4_flux_density_dif_wet2, &
+              & ch4_flux_density_bub_wet2,ch4_flux_density_pla_wet2, CH4atmo_CONC, pwater_wet2)  
+      ENDIF
+
+      IF (CH4_WTD3) THEN
+         !routine calcule densite de flux d un wetland ou WTD = pwater_wet3 (cf.stomate_cste_wetlands.f90) 
+         CALL ch4_wet_flux_density_wet (kjpindex,stempdiag,tsurf_daily,tsurf_year,veget_cov_max,veget,&
+              & carbon_surf,lai,uo_wet3,uold2_wet3,ch4_flux_density_tot_wet3, ch4_flux_density_dif_wet3, &
+              & ch4_flux_density_bub_wet3,ch4_flux_density_pla_wet3, CH4atmo_CONC, pwater_wet3)  
+      ENDIF
+
+      IF (CH4_WTD4) THEN
+         !routine calcule densite de flux d un wetland ou WTD = pwater_wet4 (cf.stomate_cste_wetlands.f90) 
+         CALL ch4_wet_flux_density_wet (kjpindex,stempdiag,tsurf_daily,tsurf_year,veget_cov_max,veget,&
+            & carbon_surf,lai,uo_wet4,uold2_wet4,ch4_flux_density_tot_wet4, ch4_flux_density_dif_wet4, &
+            & ch4_flux_density_bub_wet4,ch4_flux_density_pla_wet4, CH4atmo_CONC, pwater_wet4)  
+      ENDIF
+      
+!!!! Wetland CH4 methane
+!pss:+
+    CALL histwrite_p (hist_id_stomate, 'CH4_FLUX_TOT_0', itime, &
+                    ch4_flux_density_tot_0, kjpindex, hori_index)
+    CALL histwrite_p (hist_id_stomate, 'CH4_FLUX_DIF_0', itime, &
+                    ch4_flux_density_dif_0, kjpindex, hori_index)
+    CALL histwrite_p (hist_id_stomate, 'CH4_FLUX_BUB_0', itime, &
+                    ch4_flux_density_bub_0, kjpindex, hori_index)
+    CALL histwrite_p (hist_id_stomate, 'CH4_FLUX_PLA_0', itime, &
+                    ch4_flux_density_pla_0, kjpindex, hori_index)
+    CALL histwrite_p (hist_id_stomate, 'CH4_FLUX_TOT_wet1', itime, &
+                    ch4_flux_density_tot_wet1, kjpindex, hori_index)
+    CALL histwrite_p (hist_id_stomate, 'CH4_FLUX_DIF_wet1', itime, &
+                    ch4_flux_density_dif_wet1, kjpindex, hori_index)
+    CALL histwrite_p (hist_id_stomate, 'CH4_FLUX_BUB_wet1', itime, &
+                    ch4_flux_density_bub_wet1, kjpindex, hori_index)
+    CALL histwrite_p (hist_id_stomate, 'CH4_FLUX_PLA_wet1', itime, &
+                    ch4_flux_density_pla_wet1, kjpindex, hori_index)
+    CALL histwrite_p (hist_id_stomate, 'CH4_FLUX_TOT_wet2', itime, &
+                    ch4_flux_density_tot_wet2, kjpindex, hori_index)
+    CALL histwrite_p (hist_id_stomate, 'CH4_FLUX_DIF_wet2', itime, &
+                    ch4_flux_density_dif_wet2, kjpindex, hori_index)
+    CALL histwrite_p (hist_id_stomate, 'CH4_FLUX_BUB_wet2', itime, &
+                    ch4_flux_density_bub_wet2, kjpindex, hori_index)
+    CALL histwrite_p (hist_id_stomate, 'CH4_FLUX_PLA_wet2', itime, &
+                    ch4_flux_density_pla_wet2, kjpindex, hori_index)
+    CALL histwrite_p (hist_id_stomate, 'CH4_FLUX_TOT_wet3', itime, &
+                    ch4_flux_density_tot_wet3, kjpindex, hori_index)
+    CALL histwrite_p (hist_id_stomate, 'CH4_FLUX_DIF_wet3', itime, &
+                    ch4_flux_density_dif_wet3, kjpindex, hori_index)
+    CALL histwrite_p (hist_id_stomate, 'CH4_FLUX_BUB_wet3', itime, &
+                    ch4_flux_density_bub_wet3, kjpindex, hori_index)
+    CALL histwrite_p (hist_id_stomate, 'CH4_FLUX_PLA_wet3', itime, &
+                    ch4_flux_density_pla_wet3, kjpindex, hori_index)
+    CALL histwrite_p (hist_id_stomate, 'CH4_FLUX_TOT_wet4', itime, &
+                    ch4_flux_density_tot_wet4, kjpindex, hori_index)
+    CALL histwrite_p (hist_id_stomate, 'CH4_FLUX_DIF_wet4', itime, &
+                    ch4_flux_density_dif_wet4, kjpindex, hori_index)
+    CALL histwrite_p (hist_id_stomate, 'CH4_FLUX_BUB_wet4', itime, &
+                    ch4_flux_density_bub_wet4, kjpindex, hori_index)
+    CALL histwrite_p (hist_id_stomate, 'CH4_FLUX_PLA_wet4', itime, &
+                    ch4_flux_density_pla_wet4, kjpindex, hori_index)
+
+  END SUBROUTINE stomate_wet_ch4_main
+
+!! ================================================================================================================================
+!! SUBROUTINE   : stomate_wet_ch4_clear
+!!
+!>\BRIEF        Module variables deallocation
+!!
+!! DESCRIPTION  : 
+!!                
+!! \n
+!_ ================================================================================================================================
+!!
+  SUBROUTINE stomate_wet_ch4_clear ( )
+    !
+    ! 0 declarations
+    !
+
+    ! 0.1 input
+
+    ! 0.2 modified fields
+
+    ! 0.3 output
+
+    ! density flux of methane calculated for entire pixel (gCH4/dt/m**2)
+
+    ! 0.4 local
+
+
+    IF (ALLOCATED(uo_0)) DEALLOCATE(uo_0)
+    IF (ALLOCATED(uold2_0)) DEALLOCATE(uold2_0)
+    IF (ALLOCATED(uo_wet1)) DEALLOCATE(uo_wet1)
+    IF (ALLOCATED(uold2_wet1)) DEALLOCATE(uold2_wet1)
+    IF (ALLOCATED(uo_wet2)) DEALLOCATE(uo_wet2)
+    IF (ALLOCATED(uold2_wet2)) DEALLOCATE(uold2_wet2)
+    IF (ALLOCATED(uo_wet3)) DEALLOCATE(uo_wet3)
+    IF (ALLOCATED(uold2_wet3)) DEALLOCATE(uold2_wet3)
+    IF (ALLOCATED(uo_wet4)) DEALLOCATE(uo_wet4)
+    IF (ALLOCATED(uold2_wet4)) DEALLOCATE(uold2_wet4)
+
+    IF (ALLOCATED(ch4_flux_density_tot_0)) DEALLOCATE(ch4_flux_density_tot_0)
+    IF (ALLOCATED(ch4_flux_density_dif_0)) DEALLOCATE(ch4_flux_density_dif_0)
+    IF (ALLOCATED(ch4_flux_density_bub_0)) DEALLOCATE(ch4_flux_density_bub_0)
+    IF (ALLOCATED(ch4_flux_density_pla_0)) DEALLOCATE(ch4_flux_density_pla_0)
+    IF (ALLOCATED(ch4_flux_density_tot_wet1)) DEALLOCATE(ch4_flux_density_tot_wet1)
+    IF (ALLOCATED(ch4_flux_density_dif_wet1)) DEALLOCATE(ch4_flux_density_dif_wet1)
+    IF (ALLOCATED(ch4_flux_density_bub_wet1)) DEALLOCATE(ch4_flux_density_bub_wet1)
+    IF (ALLOCATED(ch4_flux_density_pla_wet1)) DEALLOCATE(ch4_flux_density_pla_wet1)
+    IF (ALLOCATED(ch4_flux_density_tot_wet2)) DEALLOCATE(ch4_flux_density_tot_wet2)
+    IF (ALLOCATED(ch4_flux_density_dif_wet2)) DEALLOCATE(ch4_flux_density_dif_wet2)
+    IF (ALLOCATED(ch4_flux_density_bub_wet2)) DEALLOCATE(ch4_flux_density_bub_wet2)
+    IF (ALLOCATED(ch4_flux_density_pla_wet2)) DEALLOCATE(ch4_flux_density_pla_wet2)
+    IF (ALLOCATED(ch4_flux_density_tot_wet3)) DEALLOCATE(ch4_flux_density_tot_wet3)
+    IF (ALLOCATED(ch4_flux_density_dif_wet3)) DEALLOCATE(ch4_flux_density_dif_wet3)
+    IF (ALLOCATED(ch4_flux_density_bub_wet3)) DEALLOCATE(ch4_flux_density_bub_wet3)
+    IF (ALLOCATED(ch4_flux_density_pla_wet3)) DEALLOCATE(ch4_flux_density_pla_wet3)
+    IF (ALLOCATED(ch4_flux_density_tot_wet4)) DEALLOCATE(ch4_flux_density_tot_wet4)
+    IF (ALLOCATED(ch4_flux_density_dif_wet4)) DEALLOCATE(ch4_flux_density_dif_wet4)
+    IF (ALLOCATED(ch4_flux_density_bub_wet4)) DEALLOCATE(ch4_flux_density_bub_wet4)
+    IF (ALLOCATED(ch4_flux_density_pla_wet4)) DEALLOCATE(ch4_flux_density_pla_wet4)
+
+    CALL ch4_wet_flux_density_clear_0
+    CALL ch4_wet_flux_density_clear_wet
+
+  END SUBROUTINE stomate_wet_ch4_clear
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : stomate_wet_ch4_finalize
+!!
+!>\BRIEF       Write data to restart file 
+!!
+!! DESCRIPTION  : 
+!!                
+!! \n
+!_ ================================================================================================================================
+!!
+  SUBROUTINE stomate_wet_ch4_finalize ( rest_id, itime )
+
+    ! 0.1 Input variables
+    INTEGER(i_std), INTENT(in) :: rest_id
+    INTEGER(i_std), INTENT(in) :: itime
+
+!_ =====================================================================================================================
+
+    !
+    ! 0 declarations
+    !
+
+    ! 0.1 input
+
+    ! 0.2 modified fields
+
+    ! 0.3 output
+
+    ! density flux of methane calculated for entire pixel (gCH4/dt/m**2)
+
+    ! 0.4 local
+
+    CALL stomate_wet_ch4_writerestart( rest_id, itime)
+
+  END SUBROUTINE stomate_wet_ch4_finalize
+
+
+!! ================================================================================================================================
+!! SUBROUTINE   : stomate_wet_ch4_histdef
+!!
+!>\BRIEF        Define IOIPSL history output
+!!
+!! DESCRIPTION  :  
+!!                
+!! \n
+!_ ================================================================================================================================
+!!
+  SUBROUTINE stomate_wet_ch4_histdef (iim, jjm, dt, hist_hori_id, hist_id, ave, &
+                                      hist_id_stomate )
+    !
+    ! 0 declarations
+    !
+
+    ! 0.1 input
+    INTEGER(i_std), INTENT(in)          :: iim, jjm  !! Size in x and y of the data to be handeled
+    
+    REAL(r_std),INTENT(in)              :: hist_id            !- Time step of history file (s)
+    
+    INTEGER(i_std),INTENT(in)           :: hist_hori_id !- id horizontal grid
+    
+    REAL(r_std),INTENT(in)              :: dt !- Time step of STOMATE (seconds)
+
+    CHARACTER(LEN=40), DIMENSION(:), INTENT(in) ::  ave
+
+    INTEGER(i_std),INTENT(in)           :: hist_id_stomate !- history stomate id
+    ! 0.2 modified fields
+
+    ! 0.3 output
+
+    ! 0.4 local
+!_ ================================================================================================================================
+
+    CALL histdef (hist_id_stomate, &
+         &               TRIM("CH4_FLUX_TOT_0      "), &
+         &               TRIM("flux density tot of CH4 by wetlands               "), &
+         &               TRIM("mgCH4/d/m**2        "), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(5), dt, hist_id)
+    
+    CALL histdef (hist_id_stomate, &
+         &               TRIM("CH4_FLUX_DIF_0      "), &
+         &               TRIM("flux density dif of CH4 by wetlands               "), &
+         &               TRIM("mgCH4/d/m**2        "), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(5), dt, hist_id)
+    
+    CALL histdef (hist_id_stomate, &
+         &               TRIM("CH4_FLUX_BUB_0      "), &
+         &               TRIM("flux density bub of CH4 by wetlands               "), &
+         &               TRIM("mgCH4/d/m**2        "), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(5), dt, hist_id)
+    
+    CALL histdef (hist_id_stomate, &
+         &               TRIM("CH4_FLUX_PLA_0      "), &
+         &               TRIM("flux density pla of CH4 by wetlands               "), &
+         &               TRIM("mgCH4/d/m**2        "), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(5), dt, hist_id)
+    
+    !!pour wetland avec WTD = -x1
+    CALL histdef (hist_id_stomate, &
+         &               TRIM("CH4_FLUX_TOT_wet1    "), &
+         &               TRIM("flux density tot of CH4 by wetlands               "), &
+         &               TRIM("mgCH4/d/m**2        "), iim,jjm, hist_hori_id, &
+         &               1,1,1, -99,32, ave(5), dt, hist_id)
+    
+   CALL histdef (hist_id_stomate, &
+        &               TRIM("CH4_FLUX_DIF_wet1    "), &
+        &               TRIM("flux density dif of CH4 by wetlands               "), &
+        &               TRIM("mgCH4/d/m**2        "), iim,jjm, hist_hori_id, &
+        &               1,1,1, -99,32, ave(5), dt, hist_id)
+   
+   CALL histdef (hist_id_stomate, &
+        &               TRIM("CH4_FLUX_BUB_wet1    "), &
+        &               TRIM("flux density bub of CH4 by wetlands               "), &
+        &               TRIM("mgCH4/d/m**2        "), iim,jjm, hist_hori_id, &
+        &               1,1,1, -99,32, ave(5), dt, hist_id)
+   
+   CALL histdef (hist_id_stomate, &
+        &               TRIM("CH4_FLUX_PLA_wet1    "), &
+        &               TRIM("flux density pla of CH4 by wetlands               "), &
+        &               TRIM("mgCH4/d/m**2        "), iim,jjm, hist_hori_id, &
+        &               1,1,1, -99,32, ave(5), dt, hist_id)
+   
+   !pour wetland avc WTD = -x2
+   CALL histdef (hist_id_stomate, &
+        &               TRIM("CH4_FLUX_TOT_wet2    "), &
+        &               TRIM("flux density tot of CH4 by wetlands               "), &
+        &               TRIM("mgCH4/d/m**2        "), iim,jjm, hist_hori_id, &
+        &               1,1,1, -99,32, ave(5), dt, hist_id)
+   
+   CALL histdef (hist_id_stomate, &
+        &               TRIM("CH4_FLUX_DIF_wet2    "), &
+        &               TRIM("flux density dif of CH4 by wetlands               "), &
+        &               TRIM("mgCH4/d/m**2        "), iim,jjm, hist_hori_id, &
+        &               1,1,1, -99,32, ave(5), dt, hist_id)
+   
+   CALL histdef (hist_id_stomate, &
+        &               TRIM("CH4_FLUX_BUB_wet2    "), &
+        &               TRIM("flux density bub of CH4 by wetlands               "), &
+        &               TRIM("mgCH4/d/m**2        "), iim,jjm, hist_hori_id, &
+        &               1,1,1, -99,32, ave(5), dt, hist_id)
+   
+   CALL histdef (hist_id_stomate, &
+        &               TRIM("CH4_FLUX_PLA_wet2    "), &
+        &               TRIM("flux density pla of CH4 by wetlands               "), &
+        &               TRIM("mgCH4/d/m**2        "), iim,jjm, hist_hori_id, &
+        &               1,1,1, -99,32, ave(5), dt, hist_id)
+
+   !pour wetland avec WTD = -x3
+   CALL histdef (hist_id_stomate, &
+        &               TRIM("CH4_FLUX_TOT_wet3    "), &
+        &               TRIM("flux density tot of CH4 by wetlands               "), &
+        &               TRIM("mgCH4/d/m**2        "), iim,jjm, hist_hori_id, &
+        &               1,1,1, -99,32, ave(5), dt, hist_id)
+   
+   CALL histdef (hist_id_stomate, &
+        &               TRIM("CH4_FLUX_DIF_wet3    "), &
+        &               TRIM("flux density dif of CH4 by wetlands               "), &
+        &               TRIM("mgCH4/d/m**2        "), iim,jjm, hist_hori_id, &
+        &               1,1,1, -99,32, ave(5), dt, hist_id)
+   
+   CALL histdef (hist_id_stomate, &
+        &               TRIM("CH4_FLUX_BUB_wet3    "), &
+        &               TRIM("flux density bub of CH4 by wetlands               "), &
+        &               TRIM("mgCH4/d/m**2        "), iim,jjm, hist_hori_id, &
+        &               1,1,1, -99,32, ave(5), dt, hist_id)
+   
+   CALL histdef (hist_id_stomate, &
+        &               TRIM("CH4_FLUX_PLA_wet3    "), &
+        &               TRIM("flux density pla of CH4 by wetlands               "), &
+        &               TRIM("mgCH4/d/m**2        "), iim,jjm, hist_hori_id, &
+        &               1,1,1, -99,32, ave(5), dt, hist_id)
+   
+   !wetland avc WTD = -x4
+   CALL histdef (hist_id_stomate, &
+        &               TRIM("CH4_FLUX_TOT_wet4    "), &
+        &               TRIM("flux density tot of CH4 by wetlands               "), &
+        &               TRIM("mgCH4/d/m**2        "), iim,jjm, hist_hori_id, &
+        &               1,1,1, -99,32, ave(5), dt, hist_id)
+   
+   CALL histdef (hist_id_stomate, &
+        &               TRIM("CH4_FLUX_DIF_wet4    "), &
+        &               TRIM("flux density dif of CH4 by wetlands               "), &
+        &               TRIM("mgCH4/d/m**2        "), iim,jjm, hist_hori_id, &
+        &               1,1,1, -99,32, ave(5), dt, hist_id)
+   
+   CALL histdef (hist_id_stomate, &
+        &               TRIM("CH4_FLUX_BUB_wet4    "), &
+        &               TRIM("flux density bub of CH4 by wetlands               "), &
+        &               TRIM("mgCH4/d/m**2        "), iim,jjm, hist_hori_id, &
+        &               1,1,1, -99,32, ave(5), dt, hist_id)
+   
+   CALL histdef (hist_id_stomate, &
+        &               TRIM("CH4_FLUX_PLA_wet4    "), &
+        &               TRIM("flux density pla of CH4 by wetlands               "), &
+        &               TRIM("mgCH4/d/m**2        "), iim,jjm, hist_hori_id, &
+        &               1,1,1, -99,32, ave(5), dt, hist_id)
+
+  END SUBROUTINE stomate_wet_ch4_histdef
+  
+
+END MODULE stomate_wet_ch4
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
Index: /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_stomate/stomate_wet_ch4_constantes_var.f90
===================================================================
--- /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_stomate/stomate_wet_ch4_constantes_var.f90	(revision 6940)
+++ /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_stomate/stomate_wet_ch4_constantes_var.f90	(revision 6940)
@@ -0,0 +1,76 @@
+! =================================================================================================================================
+! MODULE       : stomate_wet_ch4_constantes_var
+!
+! CONTACT      : orchidee-help _at_ listes.ipsl.fr
+!
+! LICENCE      : IPSL (2006)
+! This software is governed by the CeCILL licence see ORCHIDEE/ORCHIDEE_CeCILL.LIC
+!
+!>\BRIEF       CH4_calcul main module
+!!
+!!\n DESCRIPTION : None
+!!
+!! RECENT CHANGE(S) : None
+!!
+!! REFERENCE(S)	: None
+!!
+!! SVN :
+!! $HeadURL: svn://forge.ipsl.jussieu.fr/orchidee/branches/ORCHIDEE-MICT/ORCHIDEE/src_stomate/stomate.f90 $
+!! $Date: 2017-07-28 17:48:13 +0200 (Fri, 28 Jul 2017) $
+!! $Revision: 4542 $
+!! \n
+!_ ================================================================================================================================
+MODULE stomate_wet_ch4_constantes_var
+  ! modules used:
+  USE ioipsl_para
+
+  IMPLICIT NONE
+
+  ! private & public routines
+
+  PUBLIC
+!
+! stomate cste WETLAND 
+!
+  ! Nb of vertical layers for CH4 diffussion
+  INTEGER(i_std),SAVE  :: nvert = 171 
+  INTEGER(i_std),SAVE  :: ns = 151
+  INTEGER(i_std),SAVE  :: nday = 24
+  REAL(r_std),SAVE  :: h = 0.1
+  REAL(r_std),SAVE  :: rk = 1
+  REAL(r_std),PARAMETER  :: rkh = 100 !rk/h**2
+  REAL(r_std),SAVE  :: diffair = 7.2
+  REAL(r_std),SAVE  :: pox = 0.5
+  REAL(r_std),SAVE  :: dveg = 0.001
+  REAL(r_std),SAVE  :: rkm = 5.0
+  REAL(r_std),SAVE  :: xvmax = 20.0
+  REAL(r_std),SAVE  :: oxq10 = 2.0
+  REAL(r_std),PARAMETER  :: funit = 3.84 !3.84/rk
+  REAL(r_std),SAVE  :: scmax = 500.
+  REAL(r_std),SAVE  :: sr0pl = 600.
+
+!valeur de WTD pour les routines de calcul de densite de flux de CH4
+  REAL(r_std),SAVE  :: pwater_wet1=-3
+  REAL(r_std),SAVE  :: pwater_wet2=-9
+  REAL(r_std),SAVE  :: pwater_wet3=-15
+  REAL(r_std),SAVE  :: pwater_wet4=-21
+
+  REAL(r_std),SAVE  :: rpv = 0.5
+  REAL(r_std),SAVE  :: iother = -1.0
+
+!!pour l instant je les mets constantes pour toutes les latitudes
+  REAL(r_std),SAVE  :: rq10 = 3.0
+
+  REAL(r_std),SAVE , DIMENSION(3) :: alpha_CH4 = (/0.006,0.004,0.028/)
+
+!FLAG for CH4 from wetland
+  LOGICAL,SAVE                            :: CH4_WTD1, CH4_WTD2, CH4_WTD3, CH4_WTD4
+
+!atmoshpere methane concentration/ near surface methane concentration
+  REAL(r_std), SAVE            :: CH4atmo_CONC
+
+CONTAINS
+
+
+END MODULE stomate_wet_ch4_constantes_var
+
Index: /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_stomate/stomate_wet_ch4_pt_ter_0.f90
===================================================================
--- /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_stomate/stomate_wet_ch4_pt_ter_0.f90	(revision 6940)
+++ /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_stomate/stomate_wet_ch4_pt_ter_0.f90	(revision 6940)
@@ -0,0 +1,1907 @@
+  !Bruno Ringeval; routines de calcul des densites de flux de CH4 a l interface surface/atmo
+  !routines inspirées TRES fortement du modèle de Walter et al.
+  !j indique quand c'est possible les routines du modele initial de Walter a laquelle appartiennent les differents "bouts" ci-dessous
+  !modifications principales: modif du calcul du substrat de la methanogenèse
+  !couplage avec ORCHIDEE (pas de temps, boucle sur les grid-cells, etc.)
+
+  !Cette routine calcule les densites de flux de CH4 pour un wetlands dont la water table depth est constante dans le temps et situee à la surface du sol
+  !=> simplification par rapport au modele original (WTD variable) ; les parties inutiles ont ete mises en commentaires quand cela a ete possible (ces parties sont differentes dans stomate_*_ter_0.f90 et stomate_*_ter_m10.f90)
+  !Dans cette routine, il n'y a pas de calcul d oxydation (WTD=0)
+
+MODULE stomate_wet_ch4_pt_ter_0
+  ! modules used:
+!  USE ioipsl
+  USE pft_parameters_var
+  USE stomate_wet_ch4_constantes_var
+
+  IMPLICIT NONE
+
+  ! private & public routines
+
+  PRIVATE
+  PUBLIC ch4_wet_flux_density_0,ch4_wet_flux_density_clear_0
+
+    ! first call
+    LOGICAL, SAVE                                              :: firstcall = .TRUE.
+
+CONTAINS
+
+  SUBROUTINE ch4_wet_flux_density_clear_0
+    firstcall=.TRUE.
+  END SUBROUTINE ch4_wet_flux_density_clear_0
+
+
+  SUBROUTINE ch4_wet_flux_density_0 ( npts,stempdiag,tsurf,tsurf_year,veget_max,veget,&
+     & carbon_surf,lai,uo,uold2,ch4_flux_density_tot, ch4_flux_density_dif, & 
+     & ch4_flux_density_bub, ch4_flux_density_pla, catm)  
+
+
+!BR: certaines variables du modele de Walter ne sont pas "consistent" avec
+!celles d ORCHIDEE: rprof (root depth, rprof), 
+!pr le moment conserve le calcul fait au sein du modele de Walter
+!le travail de coéhrence entre les 2 modèles a été fait pour le LAI (j ai enlevé
+!le calcul du LAI au sein du modele de Walter)
+
+    !
+    ! 0 declarations
+    !
+
+    ! 0.1 input
+
+    ! Domain size
+    INTEGER(i_std), INTENT(in)                                 :: npts
+     ! natural space
+    !REAL(r_std), DIMENSION(npts), INTENT(in)                    :: space_nat
+    ! Soil temperature (K)
+!    REAL(r_std),DIMENSION (npts,nslm), INTENT (in)              :: tsoil
+
+    REAL(r_std),DIMENSION (:,:), INTENT (in)              :: stempdiag ! npts, nslm
+
+    ! "maximal" coverage fraction of a PFT (LAI -> infinity) on nat/agri ground
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: veget_max
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: veget
+    ! carbon pool: active, slow, or passive, natural and agricultural (gC/m**2 of
+    !   natural or agricultural ground)
+    !pss+++++
+    REAL(r_std), DIMENSION(npts,ncarb,nvm), INTENT(in)        :: carbon_surf
+!    REAL(r_std), DIMENSION(npts,ncarb,nvm), INTENT(in)        :: carbon
+    !pss-----
+
+    ! temperature (K) at the surface
+    REAL(r_std), DIMENSION(npts), INTENT(in)                           :: tsurf
+
+!BR
+    ! temperature (K) at the surface
+    REAL(r_std), DIMENSION(npts), INTENT(in)                           :: tsurf_year
+
+    ! LAI
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: lai
+
+    REAL(r_std),INTENT (in)              :: catm
+
+    ! 0.2 modified fields
+
+!BR: a faire: rajouter le carbone du sol dans les variables modifiees
+
+    REAL(r_std), DIMENSION(npts,nvert), INTENT(inout)                      :: uo
+    REAL(r_std), DIMENSION(npts,nvert), INTENT(inout)                      :: uold2
+
+    ! 0.3 output
+
+    ! density flux of methane calculated for entire pixel (gCH4/dt/m**2)
+    REAL(r_std), DIMENSION(npts), INTENT(out)             :: ch4_flux_density_tot
+    REAL(r_std), DIMENSION(npts), INTENT(out)             :: ch4_flux_density_dif
+    REAL(r_std), DIMENSION(npts), INTENT(out)             :: ch4_flux_density_bub
+    REAL(r_std), DIMENSION(npts), INTENT(out)             :: ch4_flux_density_pla
+
+    ! 0.4 local
+
+    ! ajout
+    REAL(r_std), DIMENSION(npts)                 :: substrat
+    REAL(r_std)                                   :: mwater
+
+    ! Index
+    INTEGER(i_std)                                              :: i
+    INTEGER(i_std)                                              :: j
+    INTEGER(i_std), DIMENSION(npts)                            :: j_point    
+    INTEGER(i_std)                                              :: ipoint
+
+    !variables appelees dans l ancien Scalc
+    !Vcalc.var
+    INTEGER(i_std)                               :: nsoil
+    INTEGER(i_std)                               :: nroot
+!    INTEGER(i_std)                               :: ihelp
+    !Cmodel.cb
+!new dimension
+    REAL(r_std), DIMENSION(npts)                  :: rcmax
+    REAL(r_std),DIMENSION(npts, ns)               :: forg
+    !on definit uo  dans modified fields: doit etre conserve d une iteration a l autre
+    !Cread_carbon.cb
+    !new dimension
+    INTEGER(i_std),DIMENSION(npts)               :: ibare
+    INTEGER(i_std),DIMENSION(npts)               :: iroot
+    INTEGER(i_std),DIMENSION(npts)               :: isoil
+!new dimension
+    REAL(r_std),DIMENSION(npts)                   :: tveg
+!new dimension
+    REAL(r_std),DIMENSION(npts)                   :: tmean
+!    REAL(r_std),DIMENSION(npts)                   :: std
+!    REAL(r_std),DIMENSION(npts)                   :: std3
+!    REAL(r_std),DIMENSION(npts)                   :: std4
+!    REAL(r_std),DIMENSION(npts)                   :: std5
+    !new dimension
+    REAL(r_std),DIMENSION(npts)                   :: quotient
+    REAL(r_std)                                   :: ihelp
+!redondance et pas meme dimension    
+!new dimension
+    REAL(r_std),DIMENSION(npts,nvert)                 :: root
+!new dimension
+    REAL(r_std),DIMENSION(npts,ns)                 :: sou
+    !ancien Soutput
+!new dimension
+    REAL(r_std),DIMENSION(npts)                                   :: fdiffday
+    REAL(r_std),DIMENSION(npts)                                     :: fluxbub
+    REAL(r_std),DIMENSION(npts)                                    :: fluxplant
+    REAL(r_std),DIMENSION(npts)                                     :: fluxtot
+    !ancien Vmodel.var --> s y rapporter pour voir les variables que l on a supprime
+!new dimension
+    INTEGER(i_std),DIMENSION(npts)               :: nw
+    INTEGER(i_std),DIMENSION(npts)               :: n0
+    INTEGER(i_std),DIMENSION(npts)               :: n1
+    INTEGER(i_std)                               :: n2
+    INTEGER(i_std)                               :: n3
+!new dimension
+    INTEGER(i_std),DIMENSION(npts)               :: nwater
+    INTEGER(i_std)                               :: nthaw
+!redondance    INTEGER(i_std)                               :: nroot
+    INTEGER(i_std),DIMENSION(npts)                               :: j1
+    INTEGER(i_std),DIMENSION(npts)                               :: j2
+    INTEGER(i_std),DIMENSION(npts)                               :: j3
+!new dimension
+    INTEGER(i_std),DIMENSION(npts)                               :: ijump
+    INTEGER(i_std),DIMENSION(npts)                               :: ndim
+    INTEGER(i_std)                               :: iday
+!new dimension    
+    REAL(r_std),DIMENSION(npts)                   :: rwater
+    REAL(r_std)                                   :: diffsw
+    REAL(r_std)                                   :: diffsa
+    REAL(r_std)                                   :: diffwa
+!new dimension    
+    REAL(r_std),DIMENSION(npts)                                   :: diffup
+    REAL(r_std),DIMENSION(npts)                                   :: diffdo
+    REAL(r_std)                                   :: amhalf
+    REAL(r_std)                                   :: aphalf
+    REAL(r_std)                                   :: source
+    REAL(r_std)                                   :: rexp
+    REAL(r_std)                                   :: q
+    REAL(r_std)                                   :: p
+!new dimension    
+    REAL(r_std),DIMENSION(npts)                                   :: rvmax
+    REAL(r_std)                                   :: aold1
+    REAL(r_std)                                   :: aold2
+    REAL(r_std)                                   :: aold3
+    REAL(r_std)                                   :: aold4
+    REAL(r_std)                                   :: diffgrdo
+    REAL(r_std)                                   :: diffgrup
+    REAL(r_std)                                   :: aoldm2
+    REAL(r_std)                                   :: aoldm1
+    REAL(r_std)                                   :: aoldn
+!new dimension    
+    REAL(r_std),DIMENSION(npts)                                   :: negconc
+    REAL(r_std)                                   :: cdiff
+!new dimension    
+    REAL(r_std),DIMENSION(npts)                                   :: tmax
+    REAL(r_std)                                   :: cplant
+!new dimension    
+    REAL(r_std),DIMENSION(npts)                                    :: tplant
+!new dimension
+    REAL(r_std),DIMENSION(npts)                   :: fgrow
+    REAL(r_std)                                   :: cbub
+!new dimension
+    REAL(r_std),DIMENSION(npts)                                   :: wpro
+    REAL(r_std),DIMENSION(npts)                                   :: tout
+    REAL(r_std),DIMENSION(npts)                                   :: goxid
+    REAL(r_std),DIMENSION(npts)                                   :: dplant
+    REAL(r_std)                                   :: fdiffgrad
+    REAL(r_std)                                   :: wtdiff
+    REAL(r_std)                                   :: uwp0
+    REAL(r_std)                                   :: uwp1
+    REAL(r_std)                                   :: uwp2
+    REAL(r_std)                                   :: xgrow
+!new dimension
+    REAL(r_std),DIMENSION(npts,nvert,nvert)                          :: a 
+    REAL(r_std),DIMENSION(npts,nvert)                                :: b
+    REAL(r_std),DIMENSION(npts,nvert)                                :: uout
+!new dimension
+!    REAL(r_std),DIMENSION(npts,nvert)                           :: uold2
+    REAL(r_std),DIMENSION(npts,nvert)                                :: tria
+    REAL(r_std),DIMENSION(npts,nvert)                                :: trib
+    REAL(r_std),DIMENSION(npts,nvert)                                :: tric
+    REAL(r_std),DIMENSION(npts,nvert)                                :: trir
+    REAL(r_std),DIMENSION(npts,nvert)                                :: triu
+!new dimension
+    REAL(r_std),DIMENSION(npts,nvert)                           :: fpart
+    REAL(r_std),DIMENSION(npts,nday)                                :: flplant
+!new dimension
+    REAL(r_std),DIMENSION(npts,nday)                                :: flbub
+    REAL(r_std),DIMENSION(npts,nday)                                :: fdifftime
+!new dimension
+    REAL(r_std),DIMENSION(npts,nday)                                :: flbubdiff
+    REAL(r_std),DIMENSION(npts)                               :: fluxbubdiff
+    REAL(r_std),DIMENSION(npts)                                :: fbubdiff
+    REAL(r_std),DIMENSION(npts)                                :: fluxdiff
+    REAL(r_std)                                                :: pwater
+
+!variable necessaire depuis l incoporation de la subrooutine tridag (cf. fin du programme) au code
+    REAL(r_std),DIMENSION(npts,500)                :: gam
+    REAL(r_std),DIMENSION(npts)                                     :: bet
+!    REAL(r_std),DIMENSION(npts)                                     :: sum_veget
+    REAL(r_std),DIMENSION(npts)                                     :: sum_veget_nat
+    REAL(r_std),DIMENSION(npts)                                     :: sum_veget_nat_ss_nu
+!alpha est le pourcentage de carbone labile pouvant subir la methanogenese
+    REAL(r_std),DIMENSION(npts)                                     :: alpha_PFT
+    REAL(r_std),DIMENSION(3)                                     :: repart_PFT  !1:boreaux, 2:temperes, 3:tropciaux
+
+!! Vars initialization
+    tria(:,:) = undef
+    trib(:,:) = undef
+    tric(:,:) = undef
+    trir(:,:) = undef
+    triu(:,:) = undef
+
+    diffsa = diffair*0.66 * rpv      !! Soil air
+    diffsw = (10.**(-4.)) * diffsa   !! Soil water
+    diffwa = (10.**(-4.)) * diffair  !! Standing water
+
+!!si je veux rajouter le cas ou je peux avoir de l eau au-dessus du sol 
+!=>  je dois modifier la valeur max d indices des boucles  n2,n3=f(ipoint)
+
+
+    !CALL ftrace_region_begin("Sread")
+    
+    !2   Ancien Sread
+    !attribue les variables d'ORCHIDEE a celles de Walter
+    sum_veget_nat(:)=0.
+    DO i=1,nvm
+      DO ipoint = 1,npts
+        IF (natural(i)) THEN ! for natural PFTs
+          sum_veget_nat(ipoint) = sum_veget_nat(ipoint) + veget_max(ipoint,i)
+        ENDIF
+      ENDDO
+    END DO
+    sum_veget_nat_ss_nu(:)=0.
+    DO i=2,nvm
+      DO ipoint = 1,npts
+        IF ( natural(i) ) THEN ! for natural PFTs
+          sum_veget_nat_ss_nu(ipoint) = sum_veget_nat_ss_nu(ipoint) + veget_max(ipoint,i)
+        ENDIF
+      ENDDO
+    END DO
+    !l indice de boucle va jusque 11 pour ne prendre en compte que les PFT naturels
+    !! a changer en etiquette "naturels"
+
+    !arrondi par defaut (pas de round)
+    ibare(:) = INT(100*veget_max(:,1))
+
+
+    !introduit une variation du alpha selon le type de PFT
+!!!!pss adapt pft_to_mtc style, need to know whether PFT is boreal, temperate or
+!!!!tropical PFT
+    repart_PFT(:) = zero
+    DO ipoint = 1,npts   
+      DO j = 2,nvm
+        IF ( pft_to_mtc(j)==4 .OR. pft_to_mtc(j)==5 .OR. pft_to_mtc(j)==6 ) THEN
+        !temperate
+        repart_PFT(2) = repart_PFT(2) + veget_max(ipoint,j)
+        ELSEIF ( is_tropical(j) ) THEN
+        !tropical
+        repart_PFT(3) = repart_PFT(3) + veget_max(ipoint,j)
+        ELSE
+        !boreal
+        repart_PFT(1) = repart_PFT(1) + veget_max(ipoint,j)
+        ENDIF
+      END DO
+      IF ((repart_PFT(1) .GT. repart_PFT(2)) .AND. (repart_PFT(1) .GE. repart_PFT(3))) THEN
+          alpha_PFT(ipoint)=alpha_CH4(1)
+      ELSEIF ((repart_PFT(2) .GT. repart_PFT(1)) .AND. (repart_PFT(2) .GE. repart_PFT(3))) THEN
+          alpha_PFT(ipoint)=alpha_CH4(2)
+      ELSEIF ((repart_PFT(3) .GE. repart_PFT(1)) .AND. (repart_PFT(3) .GE. repart_PFT(2))) THEN
+          alpha_PFT(ipoint)=alpha_CH4(3)
+      elseif ((repart_PFT(2) .EQ. repart_PFT(1)) .AND. &
+         & ((repart_PFT(1) .GE. repart_PFT(3)) .OR. (repart_PFT(2) .GE. repart_PFT(3)))) THEN
+          alpha_PFT(ipoint)=alpha_CH4(1)
+      ENDIF   
+
+    
+    END DO
+
+
+
+    iroot(:) = 0
+    quotient(:) = 0
+    DO i=1,11
+      DO ipoint = 1,npts
+        iroot(ipoint) = iroot(ipoint) + veget_max(ipoint,i)*rdepth_v(i)*tveg_v(i)
+        quotient(ipoint) = quotient(ipoint) + veget_max(ipoint,i)*tveg_v(i)
+      ENDDO
+    END DO
+
+
+    DO ipoint = 1,npts
+      IF ((veget_max(ipoint,1) .LE. 0.95) .AND. (sum_veget_nat_ss_nu(ipoint) .NE. 0.)) THEN
+          iroot(ipoint) = iroot(ipoint)/quotient(ipoint)
+      ELSE
+          iroot(ipoint) = 0.0
+      ENDIF
+    ENDDO
+    !non necessaire de diviser numerateur et denominateur par sum_veget_nat
+
+
+    isoil(:)=0
+    DO i=1,11
+      DO ipoint = 1,npts
+        isoil(ipoint)=isoil(ipoint)+veget_max(ipoint,i)*sdepth_v(i)
+      ENDDO
+    ENDDO
+    DO ipoint = 1,npts
+      IF (sum_veget_nat(ipoint) .NE. 0.) THEN
+          isoil(ipoint) = isoil(ipoint)/sum_veget_nat(ipoint)
+      ENDIF
+    ENDDO
+    
+    tveg(:)=0
+    DO  i=1,11
+      DO ipoint = 1,npts
+        tveg(ipoint) = tveg(ipoint)+veget_max(ipoint,i)*tveg_v(i)
+      ENDDO
+    ENDDO
+    DO ipoint = 1,npts
+      IF (sum_veget_nat(ipoint) .NE. 0.) THEN
+          tveg(ipoint) = tveg(ipoint)/sum_veget_nat(ipoint)
+      ENDIF
+    ENDDO
+    tveg(:) = 0.5*tveg(:)/15.
+
+
+    !ATTENTION: TRES IMPORTANT
+    !il n est pas clair dans la publi de Walter et al. si Tmean varie au cours du temps ou non
+    !=>cf. ma these
+    !cf. stomate_season.f90 
+    DO ipoint = 1,npts
+      tmean(ipoint) = tsurf_year(ipoint)-273.16
+    ENDDO
+
+
+    !std,std3,std4,std5: supprimees lors du couplage avec ORCHIDEE => prend directement les temperatures
+    !du sol d'ORCHIDEE
+
+    pwater=0.0 !VALEUR DE LA WTD; en principe, entree du modele de Walter; ici constante
+    rwater(:) = pwater
+    !nwater = NINT(rwater)
+    DO ipoint = 1,npts
+      nwater(ipoint) = NINT(rwater(ipoint))
+    ENDDO
+
+
+    substrat(:) = 0.0
+    DO i=1,11
+      DO ipoint = 1,npts
+        substrat(ipoint) = substrat(ipoint) + veget_max(ipoint,i)*carbon_surf(ipoint,1,i)
+      ENDDO
+    ENDDO
+    DO ipoint = 1,npts
+      IF (sum_veget_nat(ipoint) .NE. 0.) THEN
+          substrat(ipoint) = substrat(ipoint)/sum_veget_nat(ipoint)
+      ENDIF
+    ENDDO
+
+
+!impose valeurs par defaut pour eviter que le modele s arrete dans le cas d un grid-cell 
+!où iroot,isoil et tveg seraient nuls
+    WHERE ((veget_max(:,1) .GT. 0.95) .OR. (sum_veget_nat_ss_nu(:) .LE. 0.1)) 
+        iroot(:)=1*64*1/1
+        isoil(:)=129
+        tveg(:)=0.5*1/15.
+    ENDWHERE
+
+    !************************************
+    !**ANCIEN Scalc**********************
+    !************************************
+
+    rcmax(:)=scmax+(ibare(:)/100.)*scmax
+
+    forg(:,:)=0.
+
+    DO i=1,ns
+        DO ipoint = 1,npts
+        nsoil=ns-isoil(ipoint)
+        nroot=ns-iroot(ipoint)
+        ihelp=(nroot-nsoil)+1
+        IF ((i .GE. nsoil) .AND. (i .LE. nroot)) THEN
+            ihelp=ihelp-1
+            forg(ipoint,i)=EXP((-(ihelp*1.))/10.)
+        ELSEIF (i .GE. nroot+1) THEN
+            forg(ipoint,i)=1.
+        ENDIF
+      ENDDO
+    ENDDO
+
+
+
+!**************ANCIEN Smodel
+
+
+    !1   Initialisation
+    !
+    !
+    !
+
+    IF ( firstcall ) THEN
+        
+        ! initialize tridiagonal coefficient matrix 
+        b(:,:)=0.
+        a(:,:,:)=0.
+        
+! initialize fpart(i) (see below)
+! Bunsen solubility coefficient (for air-water interface)
+! (transformation coefficient for concentration<-->partial pressure
+
+        fpart(:,:)=1.
+        
+!partie du code initial qui initialisait le profil de concentration en CH4
+!-> cf. stomate_io
+!dans stomate_io, je ne connais pas rcmax => remplace par scmax
+!!$        DO i=1,nvert
+!!$          DO ipoint = 1,npts
+!!$            mwater=ns+NINT(pwater)
+!!$            IF (i .LE. mwater) THEN
+!!$                uo(ipoint,i)=rcmax(ipoint)
+!!$            ELSE
+!!$                uo(ipoint,i)=catm
+!!$            ENDIF
+!!$            uold2(ipoint,i)=uo(ipoint,i)
+!!$          ENDDO
+!!$        ENDDO
+
+      !mwater=ns+NINT(pwater)
+
+        firstcall = .FALSE.
+    ENDIF
+
+
+    b(:,:)=0.
+    a(:,:,:)=0.
+    
+    j_point(:)=0
+    DO i=1,ns
+      DO ipoint = 1,npts
+        nroot=ns-iroot(ipoint)
+        IF (i .LE. nroot-1) THEN
+            !(a): no plant transport below rooting depth nroot
+            root(ipoint,i)=0.
+        ELSEIF ((i .GE. nroot) .and. (iroot(ipoint) .EQ. 0)) THEN
+            root(ipoint,i)=0
+        ELSEIF ((i .GE. nroot) .and. (iroot(ipoint) .NE. 0)) THEN
+            ! (b): efficiency of plant-mediated transportlinearly increasing with 
+            ! decreasing soil depth (gets larger when going up)
+            j_point(ipoint)=j_point(ipoint)+1
+            root(ipoint,i)=j_point(ipoint)*2./iroot(ipoint)
+        ENDIF
+      ENDDO
+    ENDDO
+
+    ! (c): no plant transport above soil surface
+    DO i=ns+1,nvert
+      DO ipoint = 1,npts
+        root(ipoint,i)=0.
+      ENDDO
+    ENDDO
+
+
+!! define vertical root distribution root(ns) for plant-mediated transport
+!! (a): no plant transport below rooting depth nroot
+!    nroot=ns-iroot
+!    DO i=1,nroot-1
+!      root(i)=0.
+!    ENDDO
+!! (b): efficiency of plant-mediated transportlinearly increasing with 
+!! decreasing soil depth (gets larger when going up)
+!    j=0
+!    DO i=nroot,ns
+!      IF (iroot .NE. 0) THEN 
+!          j=j+1
+!          root(i)=j*2./iroot
+!      ELSE
+!          root(i)=0.
+!      ENDIF
+!    ENDDO
+!! (c): no plant transport above soil surface
+!    DO i=ns+1,nvert
+!      root(i)=0.
+!    ENDDO
+
+!ancienne subroutine Sinter**********************************************
+! interpolates Tsoil ==> value for each cm
+! interpolate soil temperature from input soil layers to 1cm-thick
+! model soil layers ==> sou(i)
+
+!plus d interpolation necessaire entre les temperatures du sol de differents niveaux mises en entree du modele de Walter
+!met directement les temperatures des differentes couches de sol d'ORCHIDEE
+!ATTENTION si dpu_cste varie!? => a changer
+    DO i=1,75
+      DO ipoint = 1,npts
+        sou(ipoint,i)=stempdiag(ipoint,10)-273.16
+      ENDDO
+    ENDDO
+    DO i=76,113
+      DO ipoint = 1,npts
+        sou(ipoint,i)=stempdiag(ipoint,9)-273.16
+      ENDDO
+    ENDDO
+    DO i=114,131
+      DO ipoint = 1,npts
+        sou(ipoint,i)=stempdiag(ipoint,8)-273.16
+      ENDDO
+    ENDDO
+    DO i=132,141
+      DO ipoint = 1,npts
+        sou(ipoint,i)=stempdiag(ipoint,7)-273.16
+      ENDDO
+    ENDDO
+    DO i=142,146
+      DO ipoint = 1,npts
+        sou(ipoint,i)=stempdiag(ipoint,6)-273.16
+      ENDDO
+    ENDDO
+    DO i=147,148
+      DO ipoint = 1,npts
+        sou(ipoint,i)=stempdiag(ipoint,5)-273.16
+      ENDDO
+    ENDDO
+
+    sou(:,149)=stempdiag(:,4)-273.16
+
+    DO i=150,ns
+      DO ipoint = 1,npts
+        sou(ipoint,i)=stempdiag(ipoint,3)-273.16
+      ENDDO
+    ENDDO
+
+           
+!!$    DO i=1,71
+!!$      DO ipoint = 1,npts
+!!$        sou(ipoint,i)=std(ipoint)+((193.+i)/265.)*(std5(ipoint)-std(ipoint))
+!!$      ENDDO
+!!$    ENDDO
+!!$
+!!$    j=0
+!!$    DO i=72,137
+!!$      j=j+1
+!!$      DO ipoint = 1,npts
+!!$        sou(ipoint,i)=std5(ipoint)+((j-1.)/66.)*(std4(ipoint)-std5(ipoint))
+!!$      ENDDO
+!!$    ENDDO
+!!$
+!!$    j=0
+!!$    DO i=138,149
+!!$      j=j+1
+!!$      DO ipoint = 1,npts
+!!$        sou(ipoint,i)=std4(ipoint)+((j-1.)/12.)*(std3(ipoint)-std4(ipoint))
+!!$      ENDDO
+!!$    ENDDO
+!!$
+!!$    DO i=150,ns
+!!$      DO ipoint = 1,npts
+!!$        sou(ipoint,i)=std3(ipoint)
+!!$      ENDDO
+!!$    ENDDO
+
+!!ancienne subroutine Sinter**********************************************
+!! interpolates Tsoil ==> value for each cm
+!! interpolate soil temperature from input soil layers to 1cm-thick
+!! model soil layers ==> sou(i)
+!       do i=1,71
+!          sou(i)=std+((193.+i)/265.)*(std5-std)
+!       enddo
+!       j=0
+!       do i=72,137
+!          j=j+1
+!          sou(i)=std5+((j-1.)/66.)*(std4-std5)
+!       enddo
+!       j=0
+!       do i=138,149
+!          j=j+1
+!          sou(i)=std4+((j-1.)/12.)*(std3-std4)
+!       enddo
+!       do i=150,ns
+!          sou(i)=std3
+!       enddo
+!!************************************************************************
+
+!utilise le LAI calcule par ORCHIDEE plutot que de calculer son propre LAI comme dans le modele
+!de Walter initial
+
+! define fgrow: growing stage of plants (LAI, after (Dickinson, 1993))
+! different thresholds for regions with different annual mean temperature 
+! tmean
+!       if (tmean .le. 5.) then
+!          xgrow=2.
+!       else
+!          xgrow=7.
+!       endif
+!       if (sou(101) .le. xgrow) then
+!          fgrow=0.0001
+!       else
+!! maximum for regions with large tmean
+!          if (sou(101) .ge. (xgrow+10.)) then
+!             fgrow=4.
+!          else
+!             fgrow=0.0001+3.999*(1-((((xgrow+10.)-sou(101))/10.)**2.))
+!          endif
+!      endif
+
+
+    fgrow(:) = 0.0
+    DO i=1,11
+      DO ipoint = 1,npts
+        fgrow(ipoint) = fgrow(ipoint) + veget_max(ipoint,i)*lai(ipoint,i)
+      ENDDO
+    ENDDO
+    DO ipoint = 1,npts
+      IF (sum_veget_nat(ipoint) .NE. 0.) THEN
+          fgrow(ipoint) = fgrow(ipoint)/sum_veget_nat(ipoint)
+      ELSE
+          fgrow(ipoint) = 0.0
+      ENDIF
+    ENDDO
+
+
+! calculation of n0,n1,n2 / determine coefficients of diffusion
+! n0: lower boundary (soil depth or thaw depth)
+! n1: water table (if water<soil surface), else soil surface
+! n2: soil surface ( "     "        "   ), "    water table
+! n3: upper boundary (fixed: n3=n2+4)
+! global model: NO thaw depth (set nthaw=max soil depth [=150])
+! for 1-dim model: read thaw depth in Sread.f & comment line 'nthaw=150' out
+! instead write: 'nthat=pthaw(itime)'
+      !nthaw=150
+    nthaw=150 !modifie nthaw car j ai modiife ns dans stomate_cste_wetlands.f90
+    
+    DO ipoint = 1,npts
+      n0(ipoint)=ns-MIN(isoil(ipoint),nthaw)
+      nw(ipoint)=MAX(n0(ipoint),ns+nwater(ipoint))
+      nw(ipoint)=MIN(nw(ipoint),(nvert-4))
+    ENDDO
+
+
+    DO ipoint = 1,npts ! boucle la plus externe 
+
+!le cas suivant n arrive jamais!!!: la WTD est toujours en-dessous ou au niveau du sol 
+!au niveau de la vectorisation=>n2 vaut toujours ns
+! if water table is above soil surface
+!      IF (nw(ipoint) .GT. ns) THEN
+!          n1(ipoint)=ns
+!          n2(ipoint)=nw(ipoint)
+!          diffdo(ipoint)=diffsw
+!          diffup(ipoint)=diffwa
+!          rvmax(ipoint)=0.
+!      ENDIF
+
+!!$! if water table is below soil surface
+!!$      IF (nw(ipoint) .LT. ns) THEN
+!!$          n1(ipoint)=nw(ipoint)
+!!$          n2=ns
+!!$          diffdo(ipoint)=diffsw
+!!$          diffup(ipoint)=diffsa
+!!$          rvmax(ipoint)=xvmax
+!!$      ENDIF
+
+! if water table is at soil surface
+      IF (nw(ipoint) .EQ. ns) THEN
+          n1(ipoint)=nw(ipoint)
+          n2=nw(ipoint)
+          diffdo(ipoint)=diffsw
+          diffup(ipoint)=diffsw
+          rvmax(ipoint)=0.    
+      endif
+    ENDDO
+
+    !n3 est constant finalement car pour tous les pixels n2=ns et ns=171(ou151)
+    n3=n2+4
+
+    !ijump(:)=1
+    DO ipoint = 1,npts
+! make sure that n0<n1<n2
+      IF ((n0(ipoint) .EQ. n2) .OR. (n0(ipoint)+1 .EQ. n2)) THEN
+          ijump(ipoint)=0
+      ELSE
+          ijump(ipoint)=1
+      ENDIF
+      IF ((n1(ipoint) .EQ. n0(ipoint)) .AND. (n2 .GT. n0(ipoint)+1)) THEN
+          n1(ipoint)=n0(ipoint)+1
+          diffdo(ipoint)=diffup(ipoint)
+          sou(ipoint,n0(ipoint))=0.
+          sou(ipoint,n1(ipoint))=0.
+      ENDIF
+    ENDDO
+
+! Bunsen solubility coefficient (air-water interface)
+! (transformation coefficient for concentration<-->partial pressure
+! transformtion in water (do i=1,nw) and air (do i=nw+1,n))
+
+!inverse l ordre des boucles pour ameliorer le vectorissation
+    DO i=1,nvert
+      DO ipoint = 1,npts
+        IF (i .LE. nw(ipoint))THEN
+            fpart(ipoint,i)=1.
+        ELSE
+            fpart(ipoint,i)=1./23.
+        ENDIF
+      ENDDO
+    ENDDO
+
+
+!    DO i=1,nw
+!      fpart(i)=1.
+!    ENDDO
+!    DO i=nw+1,nvert
+!      fpart(i)=1./23.
+!    ENDDO
+
+
+
+! calculate total daily production [wpro] / oxidation rate [goxid], 
+! difference in conc(day)-conc(day-1) [tout] / 
+! daily amount of CH4 transported through plants [dplant]
+! necessary for calculation of diffusive flux from mass balance
+    DO ipoint = 1,npts
+      wpro(ipoint)=0.
+      goxid(ipoint)=0.
+      tout(ipoint)=0.
+      dplant(ipoint)=0.
+      negconc(ipoint)=0.
+    ENDDO
+
+! if water table falls (i.e. nw (new water tabel) < nwtm1 (old water table)):
+    wtdiff=0.
+!supprime boucle if sur ijump: dans l approche choisie WTD=cste au cours du temps
+!perform calculation only if n0<n1<n2
+!!!      IF (ijump .EQ. 1) THEN
+
+! update old u-values after change of water table/thaw depth
+! water-air interface: conc ==> partial pressure
+! transform from concentration into partial pressure unit
+
+    DO i=1,n3   
+      DO ipoint = 1,npts
+        IF (i .GE. n0(ipoint)) THEN
+            uo(ipoint,i)=uo(ipoint,i)*fpart(ipoint,i) 
+        ENDIF
+      ENDDO
+    ENDDO
+    
+!
+! solve diffusion equation (Crank-Nicholson)
+! Schwarz, Numerische Mathematik, Teubner, Stuttgart, p.476)
+! Press et al., Numerical Recepies, FORTRAN, p. 838)
+!*************************************************************
+
+! left hand side coefficient matrix:
+!************************************
+
+! left boundary
+
+
+    p=0.
+    DO ipoint = 1,npts
+      amhalf=diffdo(ipoint)
+      aphalf=diffdo(ipoint)
+      a(ipoint,n0(ipoint),n0(ipoint))=2.+rkh*(amhalf+aphalf-h**2*p)
+      a(ipoint,n0(ipoint),n0(ipoint)+1)=-rkh*(aphalf+amhalf)
+    ENDDO
+
+
+! inner points
+    DO ipoint = 1,npts
+      j1(ipoint)=n0(ipoint)-1
+      j2(ipoint)=j1(ipoint)+1
+      j3(ipoint)=j2(ipoint)+1 
+    ENDDO
+
+    DO  i=1,n2 !idem que precedement: sur-calcul
+      DO ipoint = 1,npts
+        IF ((i .GE. n0(ipoint)+1) .AND. (i .LE. n1(ipoint)-1)) THEN
+            j1(ipoint)=j1(ipoint)+1
+            j2(ipoint)=j2(ipoint)+1
+            j3(ipoint)=j3(ipoint)+1
+            amhalf=diffdo(ipoint)
+            aphalf=diffdo(ipoint)
+            p=0.
+            a(ipoint, i,j1(ipoint))=-rkh*amhalf
+            a(ipoint,i,j2(ipoint))=2.+rkh*(amhalf+aphalf-h**2*p)
+            a(ipoint,i,j3(ipoint))=-rkh*aphalf
+        ENDIF
+      ENDDO
+    ENDDO
+
+
+    diffgrdo=0.57*0.66*rpv
+    diffgrup=0.0248*0.66*rpv
+
+!les parties suivantes sont differentes entre stomate_wet_ch4_pt_ter_0 et stomate_wet_ch4_pt_ter_m10
+
+    DO i = 1,n3-1
+      !sur-calcul: au depart j avais  = n0,n3-1
+      !mais les nouvelles bornes choisies permettent d ameliorer le vectorisation
+      DO ipoint = 1,npts
+
+        !par defaut ici on a toujours (nw(ipoint) .EQ. ns)
+
+!!$        !1er CAS: (nw(ipoint) .LT. ns-1)
+!!$        !diffusion coefficients water-air INTERFACE (soil water --> soil air)
+!!$        IF ((nw(ipoint) .LT. ns-1) .AND. (i .EQ. n1(ipoint))) THEN
+!!$            !i=n1
+!!$            j1(ipoint)=n1(ipoint)-1
+!!$            j2(ipoint)=n1(ipoint)
+!!$            j3(ipoint)=n1(ipoint)+1
+!!$            amhalf=diffdo(ipoint)
+!!$            aphalf=diffgrdo
+!!$            p=0.
+!!$            a(ipoint,i,j1(ipoint))=-rkh*amhalf
+!!$            a(ipoint,i,j2(ipoint))=2.+rkh*(amhalf+aphalf-h**2*p)
+!!$            a(ipoint,i,j3(ipoint))=-rkh*aphalf 
+!!$        ELSEIF ((nw(ipoint) .LT. ns-1) .AND. (i .EQ. n1(ipoint)+1)) THEN
+!!$            !i=n1+1
+!!$            j1(ipoint)=n1(ipoint)
+!!$            j2(ipoint)=n1(ipoint)+1
+!!$            j3(ipoint)=n1(ipoint)+2
+!!$            amhalf=diffgrup
+!!$            aphalf=diffup(ipoint)
+!!$            p=0.
+!!$            a(ipoint,i,j1(ipoint))=-rkh*amhalf
+!!$            a(ipoint,i,j2(ipoint))=2.+rkh*(amhalf+aphalf-h**2*p)
+!!$            a(ipoint,i,j3(ipoint))=-rkh*aphalf 
+!!$        ELSEIF ((nw(ipoint) .LT. ns-1) .AND. (i .GE. n1(ipoint)+2) .AND. (i .LE. n2-1)) THEN            
+!!$            !DO i=n1+2,n2-1
+!!$            j1(ipoint)=j1(ipoint)+1
+!!$            j2(ipoint)=j2(ipoint)+1
+!!$            j3(ipoint)=j3(ipoint)+1
+!!$            amhalf=diffup(ipoint)
+!!$            aphalf=diffup(ipoint)
+!!$            p=0.
+!!$            a(ipoint,i,j1(ipoint))=-rkh*amhalf
+!!$            a(ipoint,i,j2(ipoint))=2.+rkh*(amhalf+aphalf-h**2*p)
+!!$            a(ipoint,i,j3(ipoint))=-rkh*aphalf
+!!$            !ENDDO        
+!!$        ELSEIF ((nw(ipoint) .LT. ns-1) .AND. (i .EQ. n2)) THEN
+!!$            !i=n2
+!!$            j1(ipoint)=n2-1
+!!$            j2(ipoint)=n2
+!!$            j3(ipoint)=n2+1
+!!$            amhalf=diffup(ipoint)
+!!$            aphalf=diffair
+!!$            p=0.
+!!$            a(ipoint,i,j1(ipoint))=-rkh*amhalf
+!!$            a(ipoint,i,j2(ipoint))=2.+rkh*(amhalf+aphalf-h**2*p)
+!!$            a(ipoint,i,j3(ipoint))=-rkh*aphalf          
+!!$        ELSEIF ((nw(ipoint) .LT. ns-1) .AND. (i .GE. n2+1) .AND. (i .LE. n3-1)) THEN
+!!$            !DO i=n2+1,n3-1
+!!$            j1(ipoint)=j1(ipoint)+1
+!!$            j2(ipoint)=j2(ipoint)+1
+!!$            j3(ipoint)=j3(ipoint)+1
+!!$            amhalf=diffair
+!!$            aphalf=diffair
+!!$            p=0.
+!!$            a(ipoint,i,j1(ipoint))=-rkh*amhalf
+!!$            a(ipoint,i,j2(ipoint))=2.+rkh*(amhalf+aphalf-h**2*p)
+!!$            a(ipoint,i,j3(ipoint))=-rkh*aphalf
+!!$            !ENDDO
+!!$
+!!$            !2eme CAS: (nw .EQ. ns-1)
+!!$            ! diffusion coefficients water-air interface (soil water --> soil air)
+!!$        ELSEIF ((nw(ipoint) .EQ. ns-1) .AND. (i .EQ. n1(ipoint))) THEN       
+!!$            !i=n1
+!!$            j1(ipoint)=n1(ipoint)-1
+!!$            j2(ipoint)=n1(ipoint)
+!!$            j3(ipoint)=n1(ipoint)+1
+!!$            amhalf=diffdo(ipoint)
+!!$            aphalf=diffgrdo
+!!$            p=0.
+!!$            a(ipoint,i,j1(ipoint))=-rkh*amhalf
+!!$            a(ipoint,i,j2(ipoint))=2.+rkh*(amhalf+aphalf-h**2*p)
+!!$            a(ipoint,i,j3(ipoint))=-rkh*aphalf                
+!!$        ELSEIF ((nw(ipoint) .EQ. ns-1) .AND. (i .EQ. n2)) THEN    
+!!$            !i=n2
+!!$            j1(ipoint)=n2-1
+!!$            j2(ipoint)=n2
+!!$            j3(ipoint)=n2+1
+!!$            amhalf=diffgrup
+!!$            aphalf=diffup(ipoint)
+!!$            p=0.
+!!$            a(ipoint,i,j1(ipoint))=-rkh*amhalf
+!!$            a(ipoint,i,j2(ipoint))=2.+rkh*(amhalf+aphalf-h**2*p)
+!!$            a(ipoint,i,j3(ipoint))=-rkh*aphalf         
+!!$        ELSEIF ((nw(ipoint) .EQ. ns-1) .AND. (i .EQ. n2+1)) THEN
+!!$            !i=n2+1
+!!$            j1(ipoint)=n2
+!!$            j2(ipoint)=n2+1
+!!$            j3(ipoint)=n2+2
+!!$            amhalf=diffup(ipoint)
+!!$            aphalf=diffair
+!!$            p=0.
+!!$            a(ipoint,i,j1(ipoint))=-rkh*amhalf
+!!$            a(ipoint,i,j2(ipoint))=2.+rkh*(amhalf+aphalf-h**2*p)
+!!$            a(ipoint,i,j3(ipoint))=-rkh*aphalf
+!!$        ELSEIF  ((nw(ipoint) .EQ. ns-1) .AND. (i .GE. n2+2) .AND. (i .LE. n3-1)) THEN  
+!!$            !DO i=n2+2,n3-1
+!!$            j1(ipoint)=j1(ipoint)+1
+!!$            j2(ipoint)=j2(ipoint)+1
+!!$            j3(ipoint)=j3(ipoint)+1
+!!$            amhalf=diffair
+!!$            aphalf=diffair
+!!$            p=0.
+!!$            a(ipoint,i,j1(ipoint))=-rkh*amhalf
+!!$            a(ipoint,i,j2(ipoint))=2.+rkh*(amhalf+aphalf-h**2*p)
+!!$            a(ipoint,i,j3(ipoint))=-rkh*aphalf
+!!$            !enddo
+!!$        !3eme CAS: (nw .EQ. ns)
+!!$        ! diffusion coefficients water-air interface (soil water --> soil air)
+!!$        ELSEIF ((nw(ipoint) .EQ. ns) .AND. (i .EQ. n1(ipoint))) THEN
+
+        IF (i .EQ. n1(ipoint)) THEN
+            !i=n1
+            j1(ipoint)=n1(ipoint)-1
+            j2(ipoint)=n1(ipoint)
+            j3(ipoint)=n1(ipoint)+1
+            amhalf=diffdo(ipoint)
+            aphalf=diffgrdo
+            p=0.
+            a(ipoint,i,j1(ipoint))=-rkh*amhalf
+            a(ipoint,i,j2(ipoint))=2.+rkh*(amhalf+aphalf-h**2*p)
+            a(ipoint,i,j3(ipoint))=-rkh*aphalf 
+        ELSEIF (i .EQ. n1(ipoint)+1) THEN
+            !i=n1+1
+            j1(ipoint)=n1(ipoint)
+            j2(ipoint)=n1(ipoint)+1
+            j3(ipoint)=n1(ipoint)+2
+            amhalf=diffgrup
+            aphalf=diffair
+            p=0.
+            a(ipoint,i,j1(ipoint))=-rkh*amhalf
+            a(ipoint,i,j2(ipoint))=2.+rkh*(amhalf+aphalf-h**2*p)
+            a(ipoint,i,j3(ipoint))=-rkh*aphalf              
+        ELSEIF ((i .GE. n1(ipoint)+2) .AND.(i .LE. n3-1)) THEN
+            ! do i=n1+2,n3-1
+            j1(ipoint)=j1(ipoint)+1
+            j2(ipoint)=j2(ipoint)+1
+            j3(ipoint)=j3(ipoint)+1
+            amhalf=diffair
+            aphalf=diffair
+            p=0.
+            a(ipoint,i,j1(ipoint))=-rkh*amhalf
+            a(ipoint,i,j2(ipoint))=2.+rkh*(amhalf+aphalf-h**2*p)
+            a(ipoint,i,j3(ipoint))=-rkh*aphalf
+            !ENDDO
+
+            !4eme CAS: (nw .GE. ns): non traite dans ORCHIDEE! la WTD n est jamais au-dessus de la surface
+            !de toute facon pas d oxydation dans ce cas dans le modele de Wlater (juste modif du transport)
+        ENDIF
+      ENDDO
+    ENDDO
+    
+    
+
+! right boundary
+
+    DO ipoint = 1,npts
+      amhalf=diffair
+      aphalf=diffair
+      p=0.
+      a(ipoint,n3,n3-1)=-rkh*amhalf
+      a(ipoint,n3,n3)=2.+rkh*(amhalf+aphalf-h**2*p)
+    ENDDO
+
+      
+
+! begin of time loop (time steps per day)
+!*****************************************
+
+      DO iday=1,nday
+
+!*****************************************
+
+! right hand side coefficient matrix:
+!************************************
+
+! left boundary
+   
+        DO ipoint = 1,npts
+          i=n0(ipoint)
+          amhalf=diffdo(ipoint)
+          aphalf=diffdo(ipoint)
+          p=0.
+! q10 dependent production rate (no production if T<0oC, i.e.sou(i)<=0oC)
+! forg(i): vertical distribution of substrate in soil (calculated in Scalc.f)
+! fin(itime): describes seasonality of NPP
+! rq10: Q10 value of production rate (from para.h)
+! r0pl: tuning parameter sr0pl (scaled in Scalc.f)
+          IF (sou(ipoint,n0(ipoint)) .GT. 0.) THEN
+              rexp=(sou(ipoint,n0(ipoint))-MAX(0.,tmean(ipoint)))/10.
+!             source=forg(n0)*r0pl*(rq10**rexp)*fin(itime)
+!             source=forg(n0)*(rq10**rexp)*carbon(itime)*(0.001239567)
+!             source=forg(n0)*(rq10**rexp)*carbon(itime)*r0pl*(0.0012)
+!             source=5.0*(rq10**rexp)
+              source=forg(ipoint,n0(ipoint))*(rq10**rexp)*substrat(ipoint)*alpha_PFT(ipoint)
+          ELSE
+              source=0.
+          ENDIF
+          q=source
+          wpro(ipoint)=wpro(ipoint)+q
+! transform from concentration into partial pressure unit
+          q=q*fpart(ipoint,i)
+          aold1=2.-rkh*(amhalf+aphalf-h**2*p)
+          aold2=rkh*(aphalf+amhalf)
+          aold3=2.*rk*q
+          b(ipoint,n0(ipoint))=aold1*uo(ipoint,n0(ipoint))+aold2*uo(ipoint,n0(ipoint)+1)+aold3
+        ENDDO
+
+        !DO ipoint =1,npts
+        !  IF (iday .EQ. 2) THEN
+        !      WRITE(*,*) 'matrice b apres left boundary',b(ipoint,:)
+        !  ENDIF
+        !ENDDO
+
+! inner points (from left to right)
+
+        !do i=n0+1,n1-1
+        DO i = 1,n2 !sur calcul
+          DO ipoint = 1,npts
+            IF ((i .GE. n0(ipoint)+1) .AND. (i .LE. n1(ipoint)-1)) THEN
+                amhalf=diffdo(ipoint)
+                aphalf=diffdo(ipoint)
+                p=0.
+! q10 dependent production rate (no production if T<0oC, i.e.sou(i)<=0oC)
+! forg(i): vertical distribution of substrate in soil (calculated in Scalc.f)
+! fin(itime): describes seasonality of NPP
+! rq10: Q10 value of production rate (from para.h)
+! r0pl: tuning parameter sr0pl (scaled in Scalc.f)
+                IF (sou(ipoint,i) .GT. 0.) THEN
+                    rexp=(sou(ipoint,i)-MAX(0.,tmean(ipoint)))/10.
+!              source=forg(i)*r0pl*(rq10**rexp)*fin(itime)
+!              source=forg(i)*(rq10**rexp)*carbon(itime)*(0.001239567)
+                    !modifie le calcul de la production --> utilise le carbone comme proxi du substrat
+                    source=forg(ipoint,i)*(rq10**rexp)*substrat(ipoint)*alpha_PFT(ipoint) 
+                ELSE
+                    source=0.
+                ENDIF
+                q=source
+                wpro(ipoint)=wpro(ipoint)+q
+! transform from concentration into partial pressure unit
+                q=q*fpart(ipoint,i)
+                aold1=rkh*amhalf
+                aold2=2.-rkh*(amhalf+aphalf-h**2*p)
+                aold3=rkh*aphalf
+                aold4=2.*rk*q
+                b(ipoint,i)=aold1*uo(ipoint,i-1)+aold2*uo(ipoint,i)+aold3*uo(ipoint,i+1)+aold4
+            ENDIF
+          ENDDO
+        ENDDO
+
+        !DO ipoint =1,npts
+        !  IF (iday .EQ. 2) THEN
+        !      WRITE(*,*) 'matrice b apres inner point avant cas',b(ipoint,:)
+        !  ENDIF
+        !ENDDO
+
+        diffgrdo=0.57*0.66*rpv
+        diffgrup=0.0248*0.66*rpv
+
+!!$        DO i = 1,n3-1          !sur-calcul: au depart j avais  i = n0,n3-1
+!!$          DO ipoint = 1,npts
+!!$
+!!$            !1er CAS: (nw(ipoint) .LT. ns-1)
+!!$            !diffusion coefficients water-air INTERFACE (soil water --> soil air)
+!!$            IF ((nw(ipoint) .LT. ns-1) .AND. (i .EQ. n1(ipoint))) THEN
+!!$                ! diffusion coefficients water-air interface (soil water --> soil air)
+!!$                !i=n1
+!!$                amhalf=diffdo(ipoint)
+!!$                aphalf=diffgrdo
+!!$                p=0.
+!!$! q10 dependent production rate (no production if T<0oC, i.e.sou(i)<=0oC)
+!!$! forg(i): vertical distribution of substrate in soil (calculated in Scalc.f)
+!!$! fin(itime): describes seasonality of NPP
+!!$! rq10: Q10 value of production rate (from para.h)
+!!$! r0pl: tuning parameter sr0pl (scaled in Scalc.f)
+!!$                IF (sou(ipoint,i) .GT. 0.) THEN
+!!$                    rexp=(sou(ipoint,i)-MAX(0.,tmean(ipoint)))/10.
+!!$                    !source=forg(i)*r0pl*(rq10**rexp)*fin(itime)
+!!$                    source=forg(ipoint,i)*(rq10**rexp)*substrat(ipoint)*alpha_CH4
+!!$                ELSE
+!!$                    source=0.
+!!$                ENDIF
+!!$                q=source
+!!$                wpro(ipoint)=wpro(ipoint)+q
+!!$! transform from concentration into partial pressure unit
+!!$                q=q*fpart(ipoint,i)
+!!$                aold1=rkh*amhalf
+!!$                aold2=2.-rkh*(amhalf+aphalf-h**2*p)
+!!$                aold3=rkh*aphalf     
+!!$                aold4=2.*rk*q
+!!$                b(ipoint,i)=aold1*uo(ipoint,i-1)+aold2*uo(ipoint,i)+aold3*uo(ipoint,i+1)+aold4
+!!$            
+!!$
+!!$            ELSEIF ((nw(ipoint) .LT. ns-1) .AND. (i .EQ. n1(ipoint)+1)) THEN
+!!$                !i=n1+1
+!!$                amhalf=diffgrup
+!!$                aphalf=diffup(ipoint)
+!!$                p=0.
+!!$! oxidation following Michaelis-Menten kinetics
+!!$                IF (uo(ipoint,i) .GT. 0.) THEN
+!!$! transform from partial pressure into concentration unit 
+!!$                    uo(ipoint,i)=uo(ipoint,i)/fpart(ipoint,i)
+!!$! Michaelis Menten Equation
+!!$                    q=-rvmax(ipoint)*uo(ipoint,i)/(uo(ipoint,i)+rkm)
+!!$! temperature dependence (oxq10 from para.h)
+!!$                    q=(q/oxq10)*(oxq10**((sou(ipoint,i)-MAX(0.,tmean(ipoint)))/10.))
+!!$                    goxid(ipoint)=goxid(ipoint)+q
+!!$! transform from concentration into partial pressure unit
+!!$                    uo(ipoint,i)=uo(ipoint,i)*fpart(ipoint,i)
+!!$! in case of negative concentrations: no oxidation
+!!$! (can occur if number of time steps per day (nday) is small and water
+!!$! table varies strongly) (help: increase nday (or change numerical scheme!))
+!!$                ELSE
+!!$                    q=0.
+!!$                    goxid(ipoint)=goxid(ipoint)+q
+!!$                ENDIF
+!!$! transform from concentration into partial pressure unit
+!!$                q=q*fpart(ipoint,i)
+!!$                aold1=rkh*amhalf
+!!$                aold2=2.-rkh*(amhalf+aphalf-h**2*p)
+!!$                aold3=rkh*aphalf     
+!!$                aold4=2.*rk*q
+!!$                b(ipoint,i)=aold1*uo(ipoint,i-1)+aold2*uo(ipoint,i)+aold3*uo(ipoint,i+1)+aold4
+!!$                    
+!!$
+!!$            ELSEIF ((nw(ipoint) .LT. ns-1) .AND. (i .GE. n1(ipoint)+2) .AND. (i .LE. n2-1)) THEN
+!!$                !do i=n1+2,n2-1
+!!$                amhalf=diffup(ipoint)
+!!$                aphalf=diffup(ipoint)
+!!$                p=0.
+!!$! oxidation following Michaelis-Menten kinetics
+!!$                IF (uo(ipoint,i) .GT. 0.) THEN
+!!$! transform from partial pressure into concentration unit
+!!$                    uo(ipoint,i)=uo(ipoint,i)/fpart(ipoint,i)
+!!$! Michaelis Menten Equation
+!!$                    q=-rvmax(ipoint)*uo(ipoint,i)/(uo(ipoint,i)+rkm)
+!!$! temperature dependence (oxq10 from para.h)
+!!$                    q=(q/oxq10)*(oxq10**((sou(ipoint,i)-MAX(0.,tmean(ipoint)))/10.))
+!!$                    goxid(ipoint)=goxid(ipoint)+q
+!!$! transform from concentration into partial pressure unit
+!!$                    uo(ipoint,i)=uo(ipoint,i)*fpart(ipoint,i)
+!!$! in case of negative concentrations: no oxidation
+!!$! (can occur if number of time steps per day (nday) is small and water
+!!$! table varies strongly) (help: increase nday (or change numerical scheme!))
+!!$                ELSE
+!!$                    q=0.
+!!$                    goxid(ipoint)=goxid(ipoint)+q
+!!$                ENDIF
+!!$! transform from concentration into partial pressure unit
+!!$                q=q*fpart(ipoint,i)
+!!$                aold1=rkh*amhalf
+!!$                aold2=2.-rkh*(amhalf+aphalf-h**2*p)
+!!$                aold3=rkh*aphalf
+!!$                aold4=2.*rk*q
+!!$                b(ipoint,i)=aold1*uo(ipoint,i-1)+aold2*uo(ipoint,i)+aold3*uo(ipoint,i+1)+aold4
+!!$
+!!$            ELSEIF ((nw(ipoint) .LT. ns-1) .AND. (i .EQ. n2)) THEN
+!!$                !i=n2
+!!$                amhalf=diffup(ipoint)
+!!$                aphalf=diffair
+!!$                p=0.
+!!$! oxidation following Michaelis-Menten kinetics
+!!$                IF (uo(ipoint,i) .GT. 0.) THEN
+!!$! transform from partial pressure into concentration unit
+!!$                    uo(ipoint,i)=uo(ipoint,i)/fpart(ipoint,i)
+!!$! Michaelis Menten Equation
+!!$                    q=-rvmax(ipoint)*uo(ipoint,i)/(uo(ipoint,i)+rkm)
+!!$! temperature dependence (oxq10 from para.h)
+!!$                    q=(q/oxq10)*(oxq10**((sou(ipoint,i)-MAX(0.,tmean(ipoint)))/10.))
+!!$                    goxid(ipoint)=goxid(ipoint)+q
+!!$! transform from concentration into partial pressure unit
+!!$                    uo(ipoint,i)=uo(ipoint,i)*fpart(ipoint,i)
+!!$! in case of negative concentrations: no oxidation
+!!$! (can occur if number of time steps per day (nday) is small and water
+!!$! table varies strongly) (help: increase nday (or change numerical scheme!))
+!!$                ELSE
+!!$                    q=0.
+!!$                    goxid(ipoint)=goxid(ipoint)+q
+!!$                ENDIF
+!!$! transform from concentration into partial pressure unit
+!!$                q=q*fpart(ipoint,i)
+!!$                aold1=rkh*amhalf
+!!$                aold2=2.-rkh*(amhalf+aphalf-h**2*p)
+!!$                aold3=rkh*aphalf     
+!!$                aold4=2.*rk*q
+!!$                b(ipoint,i)=aold1*uo(ipoint,i-1)+aold2*uo(ipoint,i)+aold3*uo(ipoint,i+1)+aold4
+!!$
+!!$            ELSEIF ((nw(ipoint) .LT. ns-1) .AND. (i .GE. n2+1) .AND. (i .LE. n3-1)) THEN
+!!$                !DO i=n2+1,n3-1
+!!$                amhalf=diffair
+!!$                aphalf=diffair
+!!$                p=0.
+!!$                q=0.
+!!$                aold1=rkh*amhalf
+!!$                aold2=2.-rkh*(amhalf+aphalf-h**2*p)
+!!$                aold3=rkh*aphalf
+!!$                aold4=2.*rk*q
+!!$                b(ipoint,i)=aold1*uo(ipoint,i-1)+aold2*uo(ipoint,i)+aold3*uo(ipoint,i+1)+aold4
+!!$
+!!$            ENDIF
+!!$          ENDDO
+!!$        ENDDO
+
+
+!toujours vrai ici: nw(ipoint) .EQ. ns)
+        DO i = 1,n3-1          !sur-calcul: au depart j avais mis i = n0,n3-1
+          DO ipoint = 1,npts
+
+            !2nd CAS: (nw(ipoint) .EQ. ns)
+            !diffusion coefficients water-air INTERFACE (soil water --> soil air)
+            IF (i .EQ. n1(ipoint)) THEN
+                !i=n1
+                amhalf=diffdo(ipoint)
+                aphalf=diffgrdo
+                p=0.
+! q10 dependent production rate (no production if T<0oC, i.e.sou(i)<=0oC)
+! forg(i): vertical distribution of substrate in soil (calculated in Scalc.f)
+! fin(itime): describes seasonality of NPP
+! rq10: Q10 value of production rate (from para.h)
+! r0pl: tuning parameter sr0pl (scaled in Scalc.f)
+                IF (sou(ipoint,i) .GT. 0.) THEN
+                    rexp=(sou(ipoint,i)-MAX(0.,tmean(ipoint)))/10.
+!              source=forg(i)*r0pl*(rq10**rexp)*fin(itime)
+!              source=forg(i)*(rq10**rexp)*carbon(itime)*(0.001239567)
+!            source=5.0*(rq10**rexp)
+                    source=forg(ipoint,i)*(rq10**rexp)*substrat(ipoint)*alpha_PFT(ipoint)
+                ELSE
+                    source=0.
+                ENDIF
+                q=source
+                wpro(ipoint)=wpro(ipoint)+q
+! transform from concentration into partial pressure unit
+                q=q*fpart(ipoint,i)
+                aold1=rkh*amhalf
+                aold2=2.-rkh*(amhalf+aphalf-h**2*p)
+                aold3=rkh*aphalf     
+                aold4=2.*rk*q
+                b(ipoint,i)=aold1*uo(ipoint,i-1)+aold2*uo(ipoint,i)+aold3*uo(ipoint,i+1)+aold4
+
+            ELSEIF (i .EQ. n1(ipoint)+1) THEN
+                !i=n1+1
+                amhalf=diffgrup
+                aphalf=diffair
+                p=0.
+                q=0.
+                aold1=rkh*amhalf
+                aold2=2.-rkh*(amhalf+aphalf-h**2*p)
+                aold3=rkh*aphalf     
+                aold4=2.*rk*q
+                b(ipoint,i)=aold1*uo(ipoint,i-1)+aold2*uo(ipoint,i)+aold3*uo(ipoint,i+1)+aold4
+           
+            ELSEIF ((i .GE. n1(ipoint)+2) .AND. (i .LE. n3-1)) THEN
+                !DO i=n1+2,n3-1
+                amhalf=diffair
+                aphalf=diffair
+                p=0.
+                q=0.
+                aold1=rkh*amhalf
+                aold2=2.-rkh*(amhalf+aphalf-h**2*p)
+                aold3=rkh*aphalf
+                aold4=2.*rk*q
+                b(ipoint,i)=aold1*uo(ipoint,i-1)+aold2*uo(ipoint,i)+aold3*uo(ipoint,i+1)+aold4
+                !ENDDO
+
+            ENDIF
+          ENDDO
+        ENDDO
+
+
+!!$        DO i = 1,n3-1          !sur-calcul: au depart j avais mis i = n0,n3-1
+!!$          DO ipoint = 1,npts
+!!$
+!!$            !3eme CAS: (nw(ipoint) .EQ. ns-1)
+!!$            !diffusion coefficients water-air INTERFACE (soil water --> soil air)
+!!$            IF ((nw(ipoint) .EQ. ns-1) .AND. (i .EQ. n1(ipoint))) THEN
+!!$                !i=n1
+!!$                amhalf=diffdo(ipoint)
+!!$                aphalf=diffgrdo
+!!$                p=0.
+!!$! q10 dependent production rate (no production if T<0oC, i.e.sou(i)<=0oC)
+!!$! forg(i): vertical distribution of substrate in soil (calculated in Scalc.f)
+!!$! fin(itime): describes seasonality of NPP
+!!$! rq10: Q10 value of production rate (from para.h)
+!!$! r0pl: tuning parameter sr0pl (scaled in Scalc.f)
+!!$                IF (sou(ipoint,i) .GT. 0.) THEN
+!!$                    rexp=(sou(ipoint,i)-MAX(0.,tmean(ipoint)))/10.
+!!$                    !source=forg(i)*r0pl*(rq10**rexp)*fin(itime)
+!!$                    source=forg(ipoint,i)*(rq10**rexp)*substrat(ipoint)*alpha_CH4
+!!$                ELSE
+!!$                    source=0.
+!!$                ENDIF
+!!$                q=source
+!!$                wpro(ipoint)=wpro(ipoint)+q
+!!$! transform from concentration into partial pressure unit
+!!$                q=q*fpart(ipoint,i)
+!!$                aold1=rkh*amhalf
+!!$                aold2=2.-rkh*(amhalf+aphalf-h**2*p)
+!!$                aold3=rkh*aphalf     
+!!$                aold4=2.*rk*q
+!!$                b(ipoint,i)=aold1*uo(ipoint,i-1)+aold2*uo(ipoint,i)+aold3*uo(ipoint,i+1)+aold4
+!!$
+!!$
+!!$            ELSEIF ((nw(ipoint) .EQ. ns-1) .AND. (i .EQ. n2)) THEN
+!!$                !i=n2
+!!$                amhalf=diffgrup
+!!$                aphalf=diffup(ipoint)
+!!$                p=0.
+!!$! oxidation following Michaelis-Menten kinetics
+!!$                IF (uo(ipoint,i) .GT. 0.) THEN
+!!$! transform from partial pressure into concentration unit
+!!$                    uo(ipoint,i)=uo(ipoint,i)/fpart(ipoint,i)
+!!$! Michaelis Menten Equation
+!!$                    q=-rvmax(ipoint)*uo(ipoint,i)/(uo(ipoint,i)+rkm)
+!!$! temperature dependence (oxq10 from para.h)
+!!$                    q=(q/oxq10)*(oxq10**((sou(ipoint,i)-MAX(0.,tmean(ipoint)))/10.))
+!!$                    goxid(ipoint)=goxid(ipoint)+q
+!!$! transform from concentration into partial pressure unit
+!!$                    uo(ipoint,i)=uo(ipoint,i)*fpart(ipoint,i)
+!!$! in case of negative concentrations: no oxidation
+!!$! (can occur if number of time steps per day (nday) is small and water
+!!$! table varies strongly) (help: increase nday (or change numerical scheme!))
+!!$                ELSE  
+!!$                    q=0.
+!!$                    goxid(ipoint)=goxid(ipoint)+q
+!!$                ENDIF
+!!$                ! transform from concentration into partial pressure unit
+!!$                q=q*fpart(ipoint,i)
+!!$                aold1=rkh*amhalf
+!!$                aold2=2.-rkh*(amhalf+aphalf-h**2*p)
+!!$                aold3=rkh*aphalf     
+!!$                aold4=2.*rk*q
+!!$                b(ipoint,i)=aold1*uo(ipoint,i-1)+aold2*uo(ipoint,i)+aold3*uo(ipoint,i+1)+aold4
+!!$
+!!$            ELSEIF ((nw(ipoint) .EQ. ns-1) .AND. (i .EQ. n2+1)) THEN
+!!$                !i=n2+1
+!!$                amhalf=diffup(ipoint)
+!!$                aphalf=diffair
+!!$                p=0.
+!!$                q=0.
+!!$                goxid(ipoint)=goxid(ipoint)+q
+!!$                aold1=rkh*amhalf
+!!$                aold2=2.-rkh*(amhalf+aphalf-h**2*p)
+!!$                aold3=rkh*aphalf     
+!!$                aold4=2.*rk*q
+!!$                b(ipoint,i)=aold1*uo(ipoint,i-1)+aold2*uo(ipoint,i)+aold3*uo(ipoint,i+1)+aold4
+!!$                
+!!$            ELSEIF ((nw(ipoint) .EQ. ns-1) .AND. (i .GE. n2+2) .AND. (i .LE. n3-1)) THEN             
+!!$                
+!!$                !DO i=n2+2,n3-1
+!!$                amhalf=diffair
+!!$                aphalf=diffair
+!!$                p=0.
+!!$                q=0.
+!!$                aold1=rkh*amhalf
+!!$                aold2=2.-rkh*(amhalf+aphalf-h**2*p)
+!!$                aold3=rkh*aphalf
+!!$                aold4=2.*rk*q
+!!$                b(ipoint,i)=aold1*uo(ipoint,i-1)+aold2*uo(ipoint,i)+aold3*uo(ipoint,i+1)+aold4
+!!$                !ENDDO
+!!$
+!!$            ENDIF
+!!$          ENDDO
+!!$        ENDDO
+
+        !4eme CAS: (nw .GE. ns): non traite! ma water table ne va jamais au-dessus de la
+        !surface en ce qui me concerne. de toute facon, jamais d oxydation dans Walter dans 
+        !la colonne d eau au-dessus de la surface: cala modifie juste le transport
+        
+
+        !DO ipoint =1,npts
+        !  IF (iday .EQ. 2) THEN
+        !      WRITE(*,*) 'matrice b apres inner point apres cas',b(ipoint,:)
+        !  ENDIF
+        !ENDDO
+
+! right boundary
+        DO ipoint = 1,npts
+          amhalf=diffair
+          aphalf=diffair
+          p=0.
+          q=0.
+          aoldm2=rkh*amhalf
+          aoldm1=2.-rkh*(amhalf+aphalf-h**2*p)
+          aoldn=2.*(rkh*aphalf*catm+rk*q)
+          b(ipoint,n3)=aoldm2*uo(ipoint,n3-1)+aoldm1*uo(ipoint,n3)+aoldn
+        ENDDO
+
+
+
+
+
+!*********************************************************
+! solution of tridiagonal system using subroutine tridag
+! calculate NEW concentration profiles uo(i)
+
+
+        !DO i=n0,n3
+        DO i=1,n3
+          DO ipoint =1,npts
+            IF (i .GE. n0(ipoint)) THEN
+                tria(ipoint,i-n0(ipoint)+1)=0.
+                trib(ipoint,i-n0(ipoint)+1)=0.
+                tric(ipoint,i-n0(ipoint)+1)=0.
+                trir(ipoint,i-n0(ipoint)+1)=0.
+                triu(ipoint,i-n0(ipoint)+1)=0.
+            ENDIF
+          ENDDO
+        enddo
+
+
+        !do i=n0,n3
+        DO i=1,n3
+          DO ipoint =1,npts
+            IF (i .GE. n0(ipoint)) THEN
+                trib(ipoint,i-n0(ipoint)+1)=a(ipoint,i,i)
+            ENDIF
+          ENDDO
+        ENDDO
+
+        !do i=n0+1,n3
+        DO i=1,n3
+          DO ipoint =1,npts
+            IF (i .GE. n0(ipoint)+1) THEN
+                tria(ipoint,i-n0(ipoint)+1)=a(ipoint,i,i-1)
+            ENDIF
+          ENDDO
+        ENDDO
+
+        !do i=n0,n3-1      
+        DO i=1,n3-1
+          DO ipoint =1,npts
+            IF (i .GE. n0(ipoint)) THEN
+                tric(ipoint,i-n0(ipoint)+1)=a(ipoint,i,i+1)
+            ENDIF
+          ENDDO
+        ENDDO
+
+        ! do i=n0,n3
+        DO i=1,n3
+          DO ipoint =1,npts
+            IF (i .GE. n0(ipoint)) THEN
+                trir(ipoint,i-n0(ipoint)+1)=b(ipoint,i)
+            ENDIF
+          ENDDO
+        ENDDO
+ 
+        DO ipoint =1,npts
+          ndim(ipoint)=n3-n0(ipoint)+1
+        ENDDO
+
+        !WRITE(*,*) ' '
+        !CALL tridiag(tria,trib,tric,trir,triu,ndim)
+        !REMPLACEMENT DE LA ROUTINE TRIDAG
+        !WRITE(*,*) ' '
+
+        DO ipoint =1,npts
+          bet(ipoint)=trib(ipoint,1)
+          triu(ipoint,1)=trir(ipoint,1)/bet(ipoint)
+        ENDDO
+
+        !DO j=2,ndim
+        !enleve j=2,500 et met a la place j=2,n3
+        DO j=2,n3
+          DO ipoint =1,npts
+            IF (j .LE. ndim(ipoint)) THEN
+                gam(ipoint,j)=tric(ipoint,j-1)/bet(ipoint)
+                IF ((trib(ipoint,j)-tria(ipoint,j)*gam(ipoint,j)) .EQ. 0) THEN
+                    bet(ipoint)=trib(ipoint,j)-tria(ipoint,j)*gam(ipoint,j) + 10
+                ELSE
+                    bet(ipoint)=trib(ipoint,j)-tria(ipoint,j)*gam(ipoint,j)
+                ENDIF
+!!pss
+!                write (2, *) 'peng debug, n3, n1, j, ipoint, bet, gam, tria, trib, trir, triu', n3, n1(ipoint), j, ipoint, bet(ipoint), gam(ipoint, j), tria(ipoint, j), trib(ipoint, j), trir(ipoint, j), triu(ipoint, j-1)
+                triu(ipoint,j)=(trir(ipoint,j)-tria(ipoint,j)*triu(ipoint,j-1))/bet(ipoint)
+            ENDIF
+          ENDDO
+        ENDDO
+        
+        !DO j=ndim-1,1,-1
+        DO j=n3-1,1,-1
+          DO ipoint =1,npts  
+            IF (j .LE. ndim(ipoint)-1) THEN
+                triu(ipoint,j)=triu(ipoint,j)-gam(ipoint,j+1)*triu(ipoint,j+1)
+            ENDIF
+          ENDDO
+        ENDDO      
+        !FIN DE REMPLACEMENT DE LA ROUTINE TRIDAG
+
+
+        !DO i=n0,n3
+        DO i=1,n3
+          DO ipoint =1,npts  
+            IF (i .GE. n0(ipoint)) THEN
+                uo(ipoint,i)=triu(ipoint,i-n0(ipoint)+1)
+! if (due to small number of time steps per day and strong variation in
+! water table (i.e. large change in vertical profile of diffusion coefficient)
+! negative methane concentrations occur: set to zero
+! should usually not happen - can be avoided by increasing nday (from 24 to
+! 240 or 2400 or ...) or possibly using a different numerical scheme
+                IF (uo(ipoint,i) .LT. 0.) THEN
+                    negconc(ipoint)=negconc(ipoint)-(uo(ipoint,i)/fpart(ipoint,i))
+                ENDIF
+                uo(ipoint,i)=MAX(0.,triu(ipoint,i-n0(ipoint)+1))
+! transform from partial pressure into concentration unit
+                uo(ipoint,i)=uo(ipoint,i)/fpart(ipoint,i)
+            ENDIF
+          ENDDO
+        ENDDO
+     
+
+!la nouvelle valeur de uo va etre utilisée comme valeur initiale au pas de temps suivant....
+!************************************
+!************************************
+
+
+
+!**************************************************************
+
+! plant-mediated transport:
+!**************************
+        
+        DO ipoint =1,npts  
+          tplant(ipoint)=0.
+        ENDDO
+        
+        !DO i=n0,n3
+        DO i=1,n3
+          DO ipoint =1,npts  
+            IF (i .GE. n0(ipoint)) THEN
+! calculated fraction of methane that enters plants:
+! tveg: vegetation type from Sread.f
+! dveg: scaling factor from para.h
+! fgrow: growing stage of plants as calculated above (LAI)
+! root(i): vertical root distribution as calculated above
+                cplant=MIN(tveg(ipoint)*dveg*fgrow(ipoint)*root(ipoint,i)*10.*rk,1.)
+! amount (concentration) of methane that enters plants
+                cplant=cplant*uo(ipoint,i)
+                dplant(ipoint)=dplant(ipoint)+cplant
+! amount (concentration) of methane that remains in soil
+                uo(ipoint,i)=uo(ipoint,i)-cplant
+! only fraction (1.-pox) of methane entering plants is emitted
+! to the atmosphere - the rest (pox) is oxidized in the rhizosphere
+                tplant(ipoint)=tplant(ipoint)+cplant*(1.-pox)
+            ENDIF
+          ENDDO
+        ENDDO
+! transform amount (concentration) into flux unit (mg/m^2*d)
+        flplant(:,iday)=tplant(:)*funit
+
+        !DO ipoint =1,npts
+        ! IF (iday .EQ. 1) THEN
+        !     WRITE(*,*) 'tveg',tveg,'fgrow',fgrow
+        !     WRITE(*,*) 'root',root
+        ! ENDIF
+        !ENDDO       
+
+        !DO ipoint =1,npts
+        ! IF (iday .EQ. 1) THEN
+        !     WRITE(*,*) 'matrice uo apres plante',uo
+        ! ENDIF
+        ! ENDDO
+
+
+
+
+
+! bubble transport:
+!******************
+
+        DO ipoint =1,npts  
+          tmax(ipoint)=0.
+        ENDDO
+
+        !DO i=n0,nw
+        DO i=1,n2
+          DO ipoint =1,npts  
+            IF ((i .GE. n0(ipoint)) .AND. (i .LE. nw(ipoint))) THEN
+! methane in water: if concentration above threshold concentration rcmax 
+! (calculated in Scalc.f): bubble formation
+                cdiff=uo(ipoint,i)-rcmax(ipoint)
+                cbub=MAX(0.,cdiff)
+                tmax(ipoint)=tmax(ipoint)+cbub
+                uo(ipoint,i)=MIN(uo(ipoint,i),rcmax(ipoint))
+            ENDIF
+          ENDDO
+        ENDDO
+     
+
+!test Estelle
+!       IF (tmax .GT. 0.) then
+!       WRITE(*,*) 'check', tmax, n0, nw, uo(nw), cdiff
+!       ENDIF
+! if water table is above soil surface: bubble flux is emitted directly 
+! to atmosphere (mg/m^2*d)
+
+        DO ipoint =1,npts  
+          IF (nw(ipoint) .GE. ns) THEN
+              flbub(ipoint,iday)=tmax(ipoint)*funit
+              flbubdiff(ipoint,iday)=0.
+              tmax(ipoint)=0.
+! if water table is below soil surface:
+          ELSE
+              flbub(ipoint,iday)=0.
+              flbubdiff(ipoint,iday)=0.
+! 1. if water table is 5 or less cm below soil surface: flbubdiff is
+! calculated in the same way as flbub and added to the total flux (mg/m^2*d)
+              IF (nw(ipoint) .GE. ns-5) THEN
+                  flbubdiff(ipoint,iday)=tmax(ipoint)*funit
+                  tmax(ipoint)=0.
+              ENDIF
+          ENDIF
+        ENDDO
+
+!test Estelle
+!       IF (flbub(iday) .gt. 0.) then
+!       WRITE(*,*) 'buble', iday,flbub(iday),tmax, cdiff, cbub, nw
+!       ENDIF 
+
+
+! 2. if water table is more than 5 cm below soil surface: no bubble flux
+! is directly emitted to the atmosphere, BUT methane amount from bubble is
+! added to the first layer above the soil surface
+! (the distinction more/less than 5 cm below soil has been made, because
+! adding tmax to uo(nw+1) if the water table is less than 5cm below the soil 
+! surface 'disturbed' the system too much and more time steps per day (larger
+! nday) is needed) (this solution avoids this)
+        DO ipoint =1,npts  
+          uo(ipoint,nw(ipoint)+1)=uo(ipoint,nw(ipoint)+1)+tmax(ipoint)
+        ENDDO
+
+        !DO ipoint =1,npts
+        ! IF (iday .EQ. 1) THEN
+        !     WRITE(*,*) 'matrice uo apres bubble',uo
+        ! ENDIF
+        !ENDDO
+
+! calculate diffusive flux from the concentration gradient (mg/m^2*d):
+!**********************************************************************
+        DO ipoint =1,npts  
+          fdifftime(ipoint,iday)=((uo(ipoint,n3-2)-uo(ipoint,n3-1))/0.1)*38.4*diffair
+        ENDDO
+
+! transform from concentration into partial pressure unit
+       !do i=n0,n3
+        DO i=1,n3
+         DO ipoint =1,npts  
+           IF (i .GE. n0(ipoint)) THEN
+               uo(ipoint,i)=uo(ipoint,i)*fpart(ipoint,i)
+           ENDIF
+         ENDDO
+       enddo
+       
+
+
+      ! DO ipoint =1,npts
+      !   IF (iday .EQ. 1) THEN
+      !       WRITE(*,*) 'matrice uo FIN TIMELOOP',uo
+      !   ENDIF
+      ! ENDDO
+
+!
+! end of (iday=1,nday) loop, i.e. time step per day
+!***************************************************
+
+     ENDDO
+
+!***************************************************
+
+
+! water-air interface
+! transform from partial pressure into concentration unit
+       !do i=n0,n3
+     DO i=1,n3
+       DO ipoint =1,npts  
+         IF (i .GE. n0(ipoint)) THEN
+             uo(ipoint,i)=uo(ipoint,i)/fpart(ipoint,i)
+         ENDIF
+       ENDDO
+     ENDDO
+
+
+! calculate conc kept in soil - 
+! necessary to calculate fluxdiff (diffusive flux from mass balance)
+     DO i=1,nvert
+       DO ipoint =1,npts  
+         uout(ipoint,i)=uo(ipoint,i)
+       ENDDO
+     ENDDO
+
+     !do i=n0,n3
+     DO i=1,n3
+       DO ipoint =1,npts  
+         IF (i .GE. n0(ipoint)) THEN
+             tout(ipoint)=tout(ipoint)+(uout(ipoint,i)-uold2(ipoint,i))
+         ENDIF
+       ENDDO
+     ENDDO
+ 
+     !DO ipoint =1,npts  
+     !  tout(ipoint)=0.
+     !ENDDO
+     
+     tout(:)=0.
+
+     !do i=n0,n3
+     DO i=1,n3
+       DO ipoint =1,npts  
+         IF (i .GE. n0(ipoint)) THEN
+             tout(ipoint)=tout(ipoint)+(uout(ipoint,i)-uold2(ipoint,i))
+         ENDIF
+       ENDDO
+     ENDDO
+
+
+     DO i=1,nvert
+       DO ipoint =1,npts  
+         uold2(ipoint,i)=uout(ipoint,i)
+       ENDDO
+     ENDDO
+
+
+!*****************************
+!vire concout
+
+! write CH4conc to varible concout after each time interval (at iday=nday)
+! concout(i,itime) is needed to write CH4conc profiles in Soutput.f
+!      do i=1,n3
+!          concout(i,itime)=uout(i)
+!      enddo
+!      do i=n3+1,n
+! transform from partial pressure into concentration unit
+!          concout(i,itime)=catm/fpart(i)
+!      enddo
+
+! calculate daily means of bubble flux, fluxbubdiff, plant flux, and
+! diffusive flux (from concentration gradient) (mg/m^2*d)
+
+!*******************************
+!la j enleve la dimension temps des sorties...
+!*******************************
+
+
+
+     DO ipoint =1,npts  
+       fluxbub(ipoint)=0.
+       fluxbubdiff(ipoint)=0.
+       fluxplant(ipoint)=0.
+       fdiffday(ipoint)=0.
+     ENDDO
+
+
+     DO i=1,nday
+       DO ipoint =1,npts  
+         fluxbub(ipoint)=fluxbub(ipoint)+flbub(ipoint,i)
+         fluxbubdiff(ipoint)=fluxbubdiff(ipoint)+flbubdiff(ipoint,i)
+         fluxplant(ipoint)=fluxplant(ipoint)+flplant(ipoint,i)
+         fdiffday(ipoint)=fdiffday(ipoint)+fdifftime(ipoint,i)
+       ENDDO
+     ENDDO
+         
+     fluxbub(:)=fluxbub(:)/nday
+     fluxbubdiff(:)=fluxbubdiff(:)/nday
+     fluxplant(:)=fluxplant(:)/nday
+     fdiffday(:)=fdiffday(:)/nday
+         
+       
+!
+! calculate diffusive flux ( from mass balance):
+!************************************************
+! use amounts in concentration unit and tranform in flux unit (mg/m^2*d)
+! wpro: amount of methane produced during entire day
+! goxid: amount of methane oxidized during entire day
+! mutiply by rk (depending on number of time steps per day)
+! dplant: amount of methane that entered plants during entire day
+!  (includes both: methane emitted through plants AND oxidized in rhizosphere)
+! tout: additional methane stored in soil during entire day
+! wtdiff: see above
+! fluxbub: bubble flux (if water table > soil surface)
+! bubble flux (if water table less than 5 cm below soil surface (see above))
+! negconc: see above
+     fluxdiff(:)= ((rk*(wpro(:)+goxid(:)) - dplant(:)-tout(:)-wtdiff)/nday)*funit &
+        & - fluxbub(:) - fluxbubdiff(:) + negconc(:)*(funit/nday)
+
+! fluxbubdiff is added to diffusive flux (mg/m^2*d)
+
+     
+     fluxdiff(:) = fluxdiff(:)+fluxbubdiff(:)
+     fdiffday(:) = fdiffday(:)+fluxbubdiff(:)
+
+
+! to calculate wtdiff (see above)
+! define uwp1
+
+!non necessaire: la WTD ne se modifie pas d un pas de tps a l autre 
+
+!         uwp0=uo(ipoint,nw)
+!         uwp1=uo(ipoint,nw+1)
+!         uwp2=uo(ipoint,nw+2)
+
+
+! calculate total flux fluxtot (using diffusive flux from mass balance)
+! and sum of diffusive flux from mass balance and bubble flux (for plots)
+! (mg/m^2*d)
+!      do i=1,ntime
+
+     fluxtot(:)=fluxdiff(:)+fluxbub(:)+fluxplant(:)
+     fbubdiff(:)=fluxdiff(:)+fluxbub(:)
+
+     
+     DO ipoint =1,npts
+       ch4_flux_density_dif(ipoint) = fluxdiff(ipoint)
+       ch4_flux_density_bub(ipoint) = fluxbub(ipoint)
+       ch4_flux_density_pla(ipoint) = fluxplant(ipoint)  
+     ENDDO
+
+
+     WHERE (fluxtot(:) .LE. 0.0)
+         ch4_flux_density_tot(:) = 0.0 
+     ELSEWHERE
+         ch4_flux_density_tot(:) = fluxtot(:)
+     endwhere
+     
+     !pour contrebalancer valeur par defaut mise pour les grid-cells ou veget_max=0
+     WHERE ((veget_max(:,1) .LE. 0.95) .AND. (sum_veget_nat_ss_nu(:) .GT. 0.1)) 
+         ch4_flux_density_tot(:) = ch4_flux_density_tot(:)
+     ELSEWHERE
+         ch4_flux_density_tot(:) = 0.0 
+     ENDWHERE
+
+
+END SUBROUTINE ch4_wet_flux_density_0
+!********************************************************************
+!!$
+!!$SUBROUTINE tridag(a,b,c,r,u,n)
+!!$!
+!!$! Press et al., Numerical Recipes, FORTRAN, p.43
+!!$!************************************************
+!!$
+!!$    ! Domain size
+!!$    INTEGER(i_std), INTENT(in)                                 :: n
+!!$    REAL(r_std),DIMENSION(n), INTENT(in)                        :: a
+!!$    REAL(r_std),DIMENSION(n), INTENT(in)                        :: b
+!!$    REAL(r_std),DIMENSION(n), INTENT(in)                       :: c
+!!$    REAL(r_std),DIMENSION(n), INTENT(in)                       :: r
+!!$    REAL(r_std),DIMENSION(n), INTENT(out)                       :: u
+!!$    INTEGER(stnd),PARAMETER                           :: nmax=500
+!!$    INTEGER(i_std)                                 :: j
+!!$    REAL(r_std),DIMENSION(nmax)                :: gam
+!!$    REAL(r_std)                                    :: bet
+!!$
+!!$      bet=b(1)
+!!$
+!!$      u(1)=r(1)/bet
+!!$
+!!$      do j=2,n
+!!$        gam(j)=c(j-1)/bet
+!!$        bet=b(j)-a(j)*gam(j)
+!!$        u(j)=(r(j)-a(j)*u(j-1))/bet
+!!$      enddo
+!!$
+!!$      do j=n-1,1,-1
+!!$        u(j)=u(j)-gam(j+1)*u(j+1)
+!!$      enddo
+!!$
+!!$END SUBROUTINE tridag
+
+
+END MODULE stomate_wet_ch4_pt_ter_0
Index: /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_stomate/stomate_wet_ch4_pt_ter_wet.f90
===================================================================
--- /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_stomate/stomate_wet_ch4_pt_ter_wet.f90	(revision 6940)
+++ /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_stomate/stomate_wet_ch4_pt_ter_wet.f90	(revision 6940)
@@ -0,0 +1,1959 @@
+  !Bruno Ringeval; routines de calcul des densites de flux de CH4 a l interface surface/atmo
+  !routines inspirées TRES fortement du modèle de Walter et al.
+  !j indique quand c'est possible les routines du modele initial de Walter a laquelle appartiennent les differents "bouts" ci-dessous
+  !modifications principales: modif du calcul du substrat de la methanogenèse
+  !couplage avec ORCHIDEE
+
+  !Cette routine calcule les densites de flux de CH4 pour un wetlands dont la water table depth est constante dans le temps et situee à pwater_wt cm EN-DESSOUS de la surface du sol
+  !=> simplification par rapport au modele original (WTD variable) ; les parties inutiles ont ete mises en commentaires quand cela a ete possible (ces parties sont differentes dans stomate_*_ter_0.f90 et stomate_*_ter_weti.f90)
+  !Dans cette routine, il y a un calcul d oxydation (sur la partie 0;pwater_wt)
+ 
+MODULE stomate_wet_ch4_pt_ter_wet
+  ! modules used:
+!  USE ioipsl
+  USE pft_parameters
+  USE stomate_wet_ch4_constantes_var
+
+  IMPLICIT NONE
+
+  ! private & public routines
+
+  PRIVATE
+  PUBLIC ch4_wet_flux_density_wet,ch4_wet_flux_density_clear_wet
+
+    ! first call
+    LOGICAL, SAVE                                              :: firstcall = .TRUE.
+
+CONTAINS
+
+  SUBROUTINE ch4_wet_flux_density_clear_wet
+    firstcall=.TRUE.
+  END SUBROUTINE ch4_wet_flux_density_clear_wet
+
+
+  SUBROUTINE ch4_wet_flux_density_wet ( npts,stempdiag,tsurf,tsurf_year,veget_max,veget,&
+     & carbon_surf,lai,uo,uold2,ch4_flux_density_tot, ch4_flux_density_dif, & 
+     & ch4_flux_density_bub, ch4_flux_density_pla, catm, pwater_wet)  
+
+
+!BR: certaines variables du modele de Walter ne sont pas "consistent" avec
+!celles d ORCHIDEE: rprof (root depth, rprof), 
+!pr le moment conserve le calcul fait au sein du modele de Walter
+!le travail de coherence entre les 2 modoles a ete fait pour le LAI (j ai enlevé
+!le calcul du LAI au sein du modele de Walter)
+
+    !
+    ! 0 declarations
+    !
+
+    ! 0.1 input
+
+    ! Domain size
+    INTEGER(i_std), INTENT(in)                                 :: npts
+     ! natural space
+    !REAL(r_std), DIMENSION(npts), INTENT(in)                    :: space_nat
+    ! Soil temperature (K)
+!    REAL(r_std),DIMENSION (npts,nslm), INTENT (in)              :: tsoil
+
+    REAL(r_std),DIMENSION (npts,nslm), INTENT (in)              :: stempdiag
+
+    ! "maximal" coverage fraction of a PFT (LAI -> infinity) on nat/agri ground
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: veget_max
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: veget
+    ! carbon pool: active, slow, or passive, natural and agricultural (gC/m**2 of
+    !   natural or agricultural ground)
+    ! modified by Shushi Peng for active carbon in the top 2 m soil
+    !pss+++++
+    REAL(r_std), DIMENSION(npts,ncarb,nvm), INTENT(in)        :: carbon_surf
+!    REAL(r_std), DIMENSION(npts,ncarb,nvm), INTENT(in)        :: carbon
+    !pss-----
+
+    ! temperature (K) at the surface
+    REAL(r_std), DIMENSION(npts), INTENT(in)                           :: tsurf
+
+!modif bruno
+    ! temperature (K) at the surface
+    REAL(r_std), DIMENSION(npts), INTENT(in)                           :: tsurf_year
+!end modif bruno
+
+    ! LAI
+    REAL(r_std), DIMENSION(npts,nvm), INTENT(in)               :: lai
+
+
+    REAL(r_std),INTENT (in)              :: catm
+    REAL(r_std), INTENT(in)                   :: pwater_wet
+
+    ! 0.2 modified fields
+
+!BR: a faire: rajouter le carbone du sol dans les variables modifiees
+
+    REAL(r_std), DIMENSION(npts,nvert), INTENT(inout)                      :: uo
+    REAL(r_std), DIMENSION(npts,nvert), INTENT(inout)                      :: uold2
+
+    ! 0.3 output
+
+    ! density flux of methane calculated for entire pixel (gCH4/dt/m**2)
+    REAL(r_std), DIMENSION(npts), INTENT(out)             :: ch4_flux_density_tot
+    REAL(r_std), DIMENSION(npts), INTENT(out)             :: ch4_flux_density_dif
+    REAL(r_std), DIMENSION(npts), INTENT(out)             :: ch4_flux_density_bub
+    REAL(r_std), DIMENSION(npts), INTENT(out)             :: ch4_flux_density_pla
+
+    ! 0.4 local
+
+    ! ajout
+    REAL(r_std), DIMENSION(npts)                 :: substrat
+    REAL(r_std)                                   :: mwater
+
+    ! Index
+    INTEGER(i_std)                                              :: i
+    INTEGER(i_std)                                              :: j
+    INTEGER(i_std), DIMENSION(npts)                            :: j_point    
+    INTEGER(i_std)                                              :: ipoint
+
+    !variables appelees dans l ancien Scalc
+    !Vcalc.var
+    INTEGER(i_std)                               :: nsoil
+    INTEGER(i_std)                               :: nroot
+!    INTEGER(i_std)                               :: ihelp
+    !Cmodel.cb
+!new dimension
+    REAL(r_std), DIMENSION(npts)                  :: rcmax
+    REAL(r_std),DIMENSION(npts, ns)               :: forg
+    !on definit uo  dans modified fields: doit etre conserve d une iteration a l autre
+    !Cread_carbon.cb
+    !new dimension
+    INTEGER(i_std),DIMENSION(npts)               :: ibare
+    INTEGER(i_std),DIMENSION(npts)               :: iroot
+    INTEGER(i_std),DIMENSION(npts)               :: isoil
+!new dimension
+    REAL(r_std),DIMENSION(npts)                   :: tveg
+!new dimension
+    REAL(r_std),DIMENSION(npts)                   :: tmean
+!    REAL(r_std),DIMENSION(npts)                   :: std
+!    REAL(r_std),DIMENSION(npts)                   :: std3
+!    REAL(r_std),DIMENSION(npts)                   :: std4
+!    REAL(r_std),DIMENSION(npts)                   :: std5
+    !new dimension
+    REAL(r_std),DIMENSION(npts)                   :: quotient
+    REAL(r_std)                                   :: ihelp
+!redondance et pas meme dimension    
+!new dimension
+    REAL(r_std),DIMENSION(npts,nvert)                 :: root
+!new dimension
+    REAL(r_std),DIMENSION(npts,ns)                 :: sou
+    !ancien Soutput
+!new dimension
+    REAL(r_std),DIMENSION(npts)                                   :: fdiffday
+    REAL(r_std),DIMENSION(npts)                                     :: fluxbub
+    REAL(r_std),DIMENSION(npts)                                    :: fluxplant
+    REAL(r_std),DIMENSION(npts)                                     :: fluxtot
+    !ancien Vmodel.var --> s y rapporter pour voir les variables que l on a supprime
+!new dimension
+    INTEGER(i_std),DIMENSION(npts)               :: nw
+    INTEGER(i_std),DIMENSION(npts)               :: n0
+    INTEGER(i_std),DIMENSION(npts)               :: n1
+    INTEGER(i_std)                               :: n2
+    INTEGER(i_std)                               :: n3
+!new dimension
+    INTEGER(i_std),DIMENSION(npts)               :: nwater
+    INTEGER(i_std)                               :: nthaw
+!redondance    INTEGER(i_std)                               :: nroot
+    INTEGER(i_std),DIMENSION(npts)                               :: j1
+    INTEGER(i_std),DIMENSION(npts)                               :: j2
+    INTEGER(i_std),DIMENSION(npts)                               :: j3
+!new dimension
+    INTEGER(i_std),DIMENSION(npts)                               :: ijump
+    INTEGER(i_std),DIMENSION(npts)                               :: ndim
+    INTEGER(i_std)                               :: iday
+!new dimension    
+    REAL(r_std),DIMENSION(npts)                   :: rwater
+    REAL(r_std)                                   :: diffsw
+    REAL(r_std)                                   :: diffsa
+    REAL(r_std)                                   :: diffwa
+!new dimension    
+    REAL(r_std),DIMENSION(npts)                                   :: diffup
+    REAL(r_std),DIMENSION(npts)                                   :: diffdo
+    REAL(r_std)                                   :: amhalf
+    REAL(r_std)                                   :: aphalf
+    REAL(r_std)                                   :: source
+    REAL(r_std)                                   :: rexp
+    REAL(r_std)                                   :: q
+    REAL(r_std)                                   :: p
+!new dimension    
+    REAL(r_std),DIMENSION(npts)                                   :: rvmax
+    REAL(r_std)                                   :: aold1
+    REAL(r_std)                                   :: aold2
+    REAL(r_std)                                   :: aold3
+    REAL(r_std)                                   :: aold4
+    REAL(r_std)                                   :: diffgrdo
+    REAL(r_std)                                   :: diffgrup
+    REAL(r_std)                                   :: aoldm2
+    REAL(r_std)                                   :: aoldm1
+    REAL(r_std)                                   :: aoldn
+!new dimension    
+    REAL(r_std),DIMENSION(npts)                                   :: negconc
+    REAL(r_std)                                   :: cdiff
+!new dimension    
+    REAL(r_std),DIMENSION(npts)                                   :: tmax
+    REAL(r_std)                                   :: cplant
+!new dimension    
+    REAL(r_std),DIMENSION(npts)                                    :: tplant
+!new dimension
+    REAL(r_std),DIMENSION(npts)                   :: fgrow
+    REAL(r_std)                                   :: cbub
+!new dimension
+    REAL(r_std),DIMENSION(npts)                                   :: wpro
+    REAL(r_std),DIMENSION(npts)                                   :: tout
+    REAL(r_std),DIMENSION(npts)                                   :: goxid
+    REAL(r_std),DIMENSION(npts)                                   :: dplant
+    REAL(r_std)                                   :: fdiffgrad
+    REAL(r_std)                                   :: wtdiff
+    REAL(r_std)                                   :: uwp0
+    REAL(r_std)                                   :: uwp1
+    REAL(r_std)                                   :: uwp2
+    REAL(r_std)                                   :: xgrow
+!new dimension
+    REAL(r_std),DIMENSION(npts,nvert,nvert)                          :: a 
+    REAL(r_std),DIMENSION(npts,nvert)                                :: b
+    REAL(r_std),DIMENSION(npts,nvert)                                :: uout
+!new dimension
+!    REAL(r_std),DIMENSION(npts,nvert)                           :: uold2
+    REAL(r_std),DIMENSION(npts,nvert)                                :: tria
+    REAL(r_std),DIMENSION(npts,nvert)                                :: trib
+    REAL(r_std),DIMENSION(npts,nvert)                                :: tric
+    REAL(r_std),DIMENSION(npts,nvert)                                :: trir
+    REAL(r_std),DIMENSION(npts,nvert)                                :: triu
+!new dimension
+    REAL(r_std),DIMENSION(npts,nvert)                           :: fpart
+    REAL(r_std),DIMENSION(npts,nday)                                :: flplant
+!new dimension
+    REAL(r_std),DIMENSION(npts,nday)                                :: flbub
+    REAL(r_std),DIMENSION(npts,nday)                                :: fdifftime
+!new dimension
+    REAL(r_std),DIMENSION(npts,nday)                                :: flbubdiff
+    REAL(r_std),DIMENSION(npts)                               :: fluxbubdiff
+    REAL(r_std),DIMENSION(npts)                                :: fbubdiff
+    REAL(r_std),DIMENSION(npts)                                :: fluxdiff
+!    REAL(r_std)                                                :: pwater
+
+!variable necessaire depuis l incoporation de la subrooutine tridag (cf. fin du programme) au code
+    REAL(r_std),DIMENSION(npts,500)                :: gam
+    REAL(r_std),DIMENSION(npts)                                     :: bet
+!    REAL(r_std),DIMENSION(npts)                                     :: sum_veget
+    REAL(r_std),DIMENSION(npts)                                     :: sum_veget_nat
+    REAL(r_std),DIMENSION(npts)                                     :: sum_veget_nat_ss_nu
+!alpha est le pourcentage de carbone labile pouvant subir la methanogenese
+    REAL(r_std),DIMENSION(npts)                                     :: alpha_PFT
+    REAL(r_std),DIMENSION(3)                                     :: repart_PFT  !1:boreaux, 2:temperes, 3:tropciaux
+
+
+!!si je veux rajouter le cas ou je peux avoir de l eau au-dessus du sol 
+!=>  je dois modifier la valeur max d indices des boucles  n2,n3=f(ipoint)
+
+
+
+    !2   Ancien Sread
+    !attribue les variables d'ORCHIDEE a celles de Walter
+    sum_veget_nat(:)=0.
+    DO ipoint = 1,npts
+      DO j=1,nvm
+        IF ( natural(j) ) THEN ! for natural PFTs
+          sum_veget_nat(ipoint) = sum_veget_nat(ipoint) + veget_max(ipoint,j)
+        ENDIF
+      END DO
+    END DO
+    sum_veget_nat_ss_nu(:)=0.
+    DO ipoint = 1,npts
+      DO j=2,nvm
+        IF ( natural(j) ) THEN ! for natural PFTs
+          sum_veget_nat_ss_nu(ipoint) = sum_veget_nat_ss_nu(ipoint) + veget_max(ipoint,j)
+        ENDIF
+      END DO
+    END DO
+    !l indice de boucle va jusque 11 pour ne prendre en compte que les PFT naturels
+    !! a changer en etiquette "naturels"
+
+    !arrondi par defaut (pas de round)
+    ibare(:) = INT(100*veget_max(:,1))
+
+    !introduit une variation du alpha selon le type de PFT
+!!!!pss adapt pft_to_mtc style, need to know whether PFT is boreal, temperate or
+!!!!tropical PFT
+    repart_PFT(:) = zero
+    DO ipoint = 1,npts   
+      DO j = 2,nvm
+        IF ( pft_to_mtc(j)==4 .OR. pft_to_mtc(j)==5 .OR. pft_to_mtc(j)==6 ) THEN
+        !temperate
+        repart_PFT(2) = repart_PFT(2) + veget_max(ipoint,j)
+        ELSEIF ( is_tropical(j) ) THEN
+        !tropical
+        repart_PFT(3) = repart_PFT(3) + veget_max(ipoint,j)
+        ELSE
+        !boreal
+        repart_PFT(1) = repart_PFT(1) + veget_max(ipoint,j)
+        ENDIF
+      END DO
+      IF ((repart_PFT(1) .GT. repart_PFT(2)) .AND. (repart_PFT(1) .GE. repart_PFT(3))) THEN
+          alpha_PFT(ipoint)=alpha_CH4(1)
+      ELSEIF ((repart_PFT(2) .GT. repart_PFT(1)) .AND. (repart_PFT(2) .GE. repart_PFT(3))) THEN
+          alpha_PFT(ipoint)=alpha_CH4(2)
+      ELSEIF ((repart_PFT(3) .GE. repart_PFT(1)) .AND. (repart_PFT(3) .GE. repart_PFT(2))) THEN
+          alpha_PFT(ipoint)=alpha_CH4(3)
+      elseif ((repart_PFT(2) .EQ. repart_PFT(1)) .AND. &
+         & ((repart_PFT(1) .GE. repart_PFT(3)) .OR. (repart_PFT(2) .GE. repart_PFT(3)))) THEN
+          alpha_PFT(ipoint)=alpha_CH4(1)
+      ENDIF   
+
+
+    END DO
+
+    iroot(:) = 0
+    quotient(:) = 0
+    DO i=1,11
+      DO ipoint = 1,npts
+        iroot(ipoint) = iroot(ipoint) + veget_max(ipoint,i)*rdepth_v(i)*tveg_v(i)
+        quotient(ipoint) = quotient(ipoint) + veget_max(ipoint,i)*tveg_v(i)
+      ENDDO
+    END DO
+
+    DO ipoint = 1,npts
+      IF ((veget_max(ipoint,1) .LE. 0.95) .AND. (sum_veget_nat_ss_nu(ipoint) .NE. 0.)) THEN
+          iroot(ipoint) = iroot(ipoint)/quotient(ipoint)
+      ELSE
+          iroot(ipoint) = 0.0
+      ENDIF
+    ENDDO
+    !non necessaire de diviser numerateur et denominateur par sum_veget_nat
+
+    isoil(:)=0
+    DO i=1,11
+      DO ipoint = 1,npts
+        isoil(ipoint)=isoil(ipoint)+veget_max(ipoint,i)*sdepth_v(i)
+      ENDDO
+    ENDDO
+    DO ipoint = 1,npts
+      IF (sum_veget_nat(ipoint) .NE. 0.) THEN
+          isoil(ipoint) = isoil(ipoint)/sum_veget_nat(ipoint)
+      ENDIF
+    ENDDO
+
+
+    tveg(:)=0
+    DO  i=1,11
+      DO ipoint = 1,npts
+        tveg(ipoint) = tveg(ipoint)+veget_max(ipoint,i)*tveg_v(i)
+      ENDDO
+    ENDDO
+    DO ipoint = 1,npts
+      IF (sum_veget_nat(ipoint) .NE. 0.) THEN
+          tveg(ipoint) = tveg(ipoint)/sum_veget_nat(ipoint)
+      ENDIF
+    ENDDO
+    tveg(:) = 0.5*tveg(:)/15.
+
+    !ATTENTION: TRES IMPORTANT
+    !il n est pas clair dans la publi de Walter et al. si Tmean varie au cours du temps ou non
+    !=>cf. ma these
+    !cf. stomate_season.f90         
+    DO ipoint = 1,npts
+      tmean(ipoint) = tsurf_year(ipoint)-273.16
+    ENDDO
+
+    !std,std3,std4,std5: supprimees lors du couplage avec ORCHIDEE => prend directement les temperatures
+    !du sol d'ORCHIDEE
+
+!    pwater=-3
+    rwater(:) = pwater_wet
+    !nwater = NINT(rwater)
+    DO ipoint = 1,npts
+      nwater(ipoint) = NINT(rwater(ipoint))
+    ENDDO
+   
+    
+    substrat(:) = 0.0
+    DO i=1,11
+      DO ipoint = 1,npts
+        substrat(ipoint) = substrat(ipoint) + veget_max(ipoint,i)*carbon_surf(ipoint,1,i)
+      ENDDO
+    ENDDO
+    DO ipoint = 1,npts
+      IF (sum_veget_nat(ipoint) .NE. 0.) THEN
+          substrat(ipoint) = substrat(ipoint)/sum_veget_nat(ipoint)
+      ENDIF
+    ENDDO
+
+
+
+!impose valeurs par defaut pour eviter que le modele s arrete dans le cas d un grid-cell 
+!où iroot,isoil et tveg seraient nuls
+    WHERE ((veget_max(:,1) .GT. 0.95) .OR. (sum_veget_nat_ss_nu(:) .LE. 0.1)) 
+        iroot(:)=1*64*1/1
+        isoil(:)=129
+        tveg(:)=0.5*1/15.
+    ENDWHERE
+
+    !************************************
+    !**ANCIEN Scalc**********************
+    !************************************
+
+    rcmax(:)=scmax+(ibare(:)/100.)*scmax
+
+    forg(:,:)=0.
+
+    DO i=1,ns
+        DO ipoint = 1,npts
+        nsoil=ns-isoil(ipoint)
+        nroot=ns-iroot(ipoint)
+        ihelp=(nroot-nsoil)+1
+        IF ((i .GE. nsoil) .AND. (i .LE. nroot)) THEN
+            ihelp=ihelp-1
+            forg(ipoint,i)=EXP((-(ihelp*1.))/10.)
+        ELSEIF (i .GE. nroot+1) THEN
+            forg(ipoint,i)=1.
+        ENDIF
+      ENDDO
+    ENDDO
+
+
+
+!**************ANCIEN Smodel
+
+    !1   Initialisation
+    !
+    !
+    !
+
+    IF ( firstcall ) THEN
+        
+        ! initialize tridiagonal coefficient matrix 
+
+        b(:,:)=0.
+        a(:,:,:)=0.
+
+! initialize fpart(i) (see below)
+! Bunsen solubility coefficient (for air-water interface)
+! (transformation coefficient for concentration<-->partial pressure
+
+        fpart(:,:)=1.
+        
+!partie du code initial qui initialisait le profil de concentration en CH4
+!-> cf. stomate_io
+!dans stomate_io, je ne connais pas rcmax => remplace par scmax
+!!$        DO i=1,nvert
+!!$          DO ipoint = 1,npts
+!!$            mwater=ns+NINT(pwater)
+!!$            IF (i .LE. mwater) THEN
+!!$                uo(ipoint,i)=rcmax(ipoint)
+!!$            ELSE
+!!$                uo(ipoint,i)=catm
+!!$            ENDIF
+!!$            uold2(ipoint,i)=uo(ipoint,i)
+!!$          ENDDO
+!!$        ENDDO
+
+      !mwater=ns+NINT(pwater)
+
+        firstcall = .FALSE.
+    ENDIF
+
+    b(:,:)=0.
+    a(:,:,:)=0.
+ 
+
+    j_point(:)=0
+    DO i=1,ns
+      DO ipoint = 1,npts
+        nroot=ns-iroot(ipoint)
+        IF (i .LE. nroot-1) THEN
+            !(a): no plant transport below rooting depth nroot
+            root(ipoint,i)=0.
+        ELSEIF ((i .GE. nroot) .and. (iroot(ipoint) .EQ. 0)) THEN
+            root(ipoint,i)=0
+        ELSEIF ((i .GE. nroot) .and. (iroot(ipoint) .NE. 0)) THEN
+            ! (b): efficiency of plant-mediated transportlinearly increasing with 
+            ! decreasing soil depth (gets larger when going up)
+            j_point(ipoint)=j_point(ipoint)+1
+            root(ipoint,i)=j_point(ipoint)*2./iroot(ipoint)
+        ENDIF
+      ENDDO
+    ENDDO
+
+    ! (c): no plant transport above soil surface
+    DO i=ns+1,nvert
+      DO ipoint = 1,npts
+        root(ipoint,i)=0.
+      ENDDO
+    ENDDO
+
+!! define vertical root distribution root(ns) for plant-mediated transport
+!! (a): no plant transport below rooting depth nroot
+!    nroot=ns-iroot
+!    DO i=1,nroot-1
+!      root(i)=0.
+!    ENDDO
+!! (b): efficiency of plant-mediated transportlinearly increasing with 
+!! decreasing soil depth (gets larger when going up)
+!    j=0
+!    DO i=nroot,ns
+!      IF (iroot .NE. 0) THEN 
+!          j=j+1
+!          root(i)=j*2./iroot
+!      ELSE
+!          root(i)=0.
+!      ENDIF
+!    ENDDO
+!! (c): no plant transport above soil surface
+!    DO i=ns+1,nvert
+!      root(i)=0.
+!    ENDDO
+
+!ancienne subroutine Sinter**********************************************
+! interpolates Tsoil ==> value for each cm
+! interpolate soil temperature from input soil layers to 1cm-thick
+! model soil layers ==> sou(i)
+
+
+!plus d interpolation necessaire entre les temperatures du sol de differents niveaux mises en entree du modele de Walter
+!met directement les temperatures des differentes couches de sol d'ORCHIDEE
+!ATTENTION si dpu_cste varie!? => a changer
+    DO i=1,75
+      DO ipoint = 1,npts
+        sou(ipoint,i)=stempdiag(ipoint,10)-273.16
+      ENDDO
+    ENDDO
+    DO i=76,113
+      DO ipoint = 1,npts
+        sou(ipoint,i)=stempdiag(ipoint,9)-273.16
+      ENDDO
+    ENDDO
+    DO i=114,131
+      DO ipoint = 1,npts
+        sou(ipoint,i)=stempdiag(ipoint,8)-273.16
+      ENDDO
+    ENDDO
+    DO i=132,141
+      DO ipoint = 1,npts
+        sou(ipoint,i)=stempdiag(ipoint,7)-273.16
+      ENDDO
+    ENDDO
+    DO i=142,146
+      DO ipoint = 1,npts
+        sou(ipoint,i)=stempdiag(ipoint,6)-273.16
+      ENDDO
+    ENDDO
+    DO i=147,148
+      DO ipoint = 1,npts
+        sou(ipoint,i)=stempdiag(ipoint,5)-273.16
+      ENDDO
+    ENDDO
+
+    sou(:,149)=stempdiag(:,4)-273.16
+
+    DO i=150,ns
+      DO ipoint = 1,npts
+        sou(ipoint,i)=stempdiag(ipoint,3)-273.16
+      ENDDO
+    ENDDO
+
+
+
+!!$    DO i=1,71
+!!$      DO ipoint = 1,npts
+!!$        sou(ipoint,i)=std(ipoint)+((193.+i)/265.)*(std5(ipoint)-std(ipoint))
+!!$      ENDDO
+!!$    ENDDO
+!!$
+!!$    j=0
+!!$    DO i=72,137
+!!$      j=j+1
+!!$      DO ipoint = 1,npts
+!!$        sou(ipoint,i)=std5(ipoint)+((j-1.)/66.)*(std4(ipoint)-std5(ipoint))
+!!$      ENDDO
+!!$    ENDDO
+!!$
+!!$    j=0
+!!$    DO i=138,149
+!!$      j=j+1
+!!$      DO ipoint = 1,npts
+!!$        sou(ipoint,i)=std4(ipoint)+((j-1.)/12.)*(std3(ipoint)-std4(ipoint))
+!!$      ENDDO
+!!$    ENDDO
+!!$
+!!$    DO i=150,ns
+!!$      DO ipoint = 1,npts
+!!$        sou(ipoint,i)=std3(ipoint)
+!!$      ENDDO
+!!$    ENDDO
+
+
+!!ancienne subroutine Sinter**********************************************
+!! interpolates Tsoil ==> value for each cm
+!! interpolate soil temperature from input soil layers to 1cm-thick
+!! model soil layers ==> sou(i)
+!       do i=1,71
+!          sou(i)=std+((193.+i)/265.)*(std5-std)
+!       enddo
+!       j=0
+!       do i=72,137
+!          j=j+1
+!          sou(i)=std5+((j-1.)/66.)*(std4-std5)
+!       enddo
+!       j=0
+!       do i=138,149
+!          j=j+1
+!          sou(i)=std4+((j-1.)/12.)*(std3-std4)
+!       enddo
+!       do i=150,ns
+!          sou(i)=std3
+!       enddo
+!!************************************************************************
+
+!utilise le LAI calcule par ORCHIDEE plutot que de calculer son propre LAI comme dans le modele
+!de Walter initial
+
+! define fgrow: growing stage of plants (LAI, after (Dickinson, 1993))
+! different thresholds for regions with different annual mean temperature 
+! tmean
+!       if (tmean .le. 5.) then
+!          xgrow=2.
+!       else
+!          xgrow=7.
+!       endif
+!       if (sou(101) .le. xgrow) then
+!          fgrow=0.0001
+!       else
+!! maximum for regions with large tmean
+!          if (sou(101) .ge. (xgrow+10.)) then
+!             fgrow=4.
+!          else
+!             fgrow=0.0001+3.999*(1-((((xgrow+10.)-sou(101))/10.)**2.))
+!          endif
+!      endif
+
+    !WRITE(*,*) 'veget', veget
+    !WRITE(*,*) 'veget_max', veget_max
+        
+    fgrow(:) = 0.0
+    DO i=1,11
+      DO ipoint = 1,npts
+        fgrow(ipoint) = fgrow(ipoint) + veget_max(ipoint,i)*lai(ipoint,i)
+      ENDDO
+    ENDDO
+    DO ipoint = 1,npts
+      IF (sum_veget_nat(ipoint) .NE. 0.) THEN
+          fgrow(ipoint) = fgrow(ipoint)/sum_veget_nat(ipoint)
+      ELSE
+          fgrow(ipoint) = 0.0
+      ENDIF
+    ENDDO
+
+
+! calculation of n0,n1,n2 / determine coefficients of diffusion
+! n0: lower boundary (soil depth or thaw depth)
+! n1: water table (if water<soil surface), else soil surface
+! n2: soil surface ( "     "        "   ), "    water table
+! n3: upper boundary (fixed: n3=n2+4)
+! global model: NO thaw depth (set nthaw=max soil depth [=150])
+! for 1-dim model: read thaw depth in Sread.f & comment line 'nthaw=150' out
+! instead write: 'nthat=pthaw(itime)'
+      !nthaw=150
+    nthaw=150 !modifie nthaw car j ai modiife ns dans stomate_cste_wetlands.f90
+
+    DO ipoint = 1,npts
+      n0(ipoint)=ns-MIN(isoil(ipoint),nthaw)
+      nw(ipoint)=MAX(n0(ipoint),ns+nwater(ipoint))
+      nw(ipoint)=MIN(nw(ipoint),(nvert-4))
+    ENDDO
+
+
+    DO ipoint = 1,npts ! boucle la plus externe
+
+!le cas suivant n arrive jamais!!!: la WTD est toujours en-dessous ou au niveau du sol 
+!au niveau de la vectorisation=>n2 vaut toujours ns
+! if water table is above soil surface
+!      IF (nw(ipoint) .GT. ns) THEN
+!          n1(ipoint)=ns
+!          n2(ipoint)=nw(ipoint)
+!          diffdo(ipoint)=diffsw
+!          diffup(ipoint)=diffwa
+!          rvmax(ipoint)=0.
+!      ENDIF
+
+! if water table is below soil surface
+ 
+!!!psstry+
+       ! define diffusion coefficients (after Penman)
+       ! soil air
+         diffsa=diffair*0.66*rpv
+       ! soil water
+         diffsw=0.0001*diffsa
+       ! standing water
+         diffwa=0.0001*diffair
+!!!psstry-
+
+      IF (nw(ipoint) .LT. ns) THEN
+          n1(ipoint)=nw(ipoint)
+          n2=ns
+          diffdo(ipoint)=diffsw
+          diffup(ipoint)=diffsa
+!!!pssdebug +
+!          write(2, *) 'pssdebug, nw(ipoint), ipoint, n1(ipoint), n2, diffdo(ipoint), diffup(ipoint), diffsw, diffsa', nw(ipoint), ipoint, n1(ipoint), n2, diffdo(ipoint), diffup(ipoint), diffsw, diffsa 
+!!!pssdebug-
+          rvmax(ipoint)=xvmax
+      ENDIF
+
+      !WRITE(*,*) 'n2','ipoint',ipoint, n2, n0(ipoint), ns, n1(ipoint), n3
+
+!!$! if water table is at soil surface
+!!$      IF (nw(ipoint) .EQ. ns) THEN
+!!$          n1(ipoint)=nw(ipoint)
+!!$          n2=nw(ipoint)
+!!$          diffdo(ipoint)=diffsw
+!!$          diffup(ipoint)=diffsw
+!!$          rvmax(ipoint)=0.    
+!!$      endif
+    ENDDO
+
+    !n3 est constant finalement car pour tous les pixels n2=ns et ns=171(ou151)
+    n3=n2+4
+
+    !ijump(:)=1
+    DO ipoint = 1,npts
+! make sure that n0<n1<n2
+      IF ((n0(ipoint) .EQ. n2) .OR. (n0(ipoint)+1 .EQ. n2)) THEN
+          ijump(ipoint)=0
+      ELSE
+          ijump(ipoint)=1
+      ENDIF
+      IF ((n1(ipoint) .EQ. n0(ipoint)) .AND. (n2 .GT. n0(ipoint)+1)) THEN
+          n1(ipoint)=n0(ipoint)+1
+          diffdo(ipoint)=diffup(ipoint)
+          sou(ipoint,n0(ipoint))=0.
+          sou(ipoint,n1(ipoint))=0.
+      ENDIF
+    ENDDO
+
+
+! Bunsen solubility coefficient (air-water interface)
+! (transformation coefficient for concentration<-->partial pressure
+! transformtion in water (do i=1,nw) and air (do i=nw+1,n))
+
+!inverse l ordre des boucles pour ameliorer le vectorissation
+    DO i=1,nvert
+      DO ipoint = 1,npts
+        IF (i .LE. nw(ipoint))THEN
+            fpart(ipoint,i)=1.
+        ELSE
+            fpart(ipoint,i)=1./23.
+        ENDIF
+      ENDDO
+    ENDDO
+
+
+!    DO i=1,nw
+!      fpart(i)=1.
+!    ENDDO
+!    DO i=nw+1,nvert
+!      fpart(i)=1./23.
+!    ENDDO
+
+
+
+! calculate total daily production [wpro] / oxidation rate [goxid], 
+! difference in conc(day)-conc(day-1) [tout] / 
+! daily amount of CH4 transported through plants [dplant]
+! necessary for calculation of diffusive flux from mass balance
+    DO ipoint = 1,npts
+      wpro(ipoint)=0.
+      goxid(ipoint)=0.
+      tout(ipoint)=0.
+      dplant(ipoint)=0.
+      negconc(ipoint)=0.
+    ENDDO
+
+! if water table falls (i.e. nw (new water tabel) < nwtm1 (old water table)):
+    wtdiff=0.
+!supprime boucle if sur ijump: dans l approche choisie WTD=cste au cours du temps
+!perform calculation only if n0<n1<n2
+!!!      IF (ijump .EQ. 1) THEN
+
+! update old u-values after change of water table/thaw depth
+! water-air interface: conc ==> partial pressure
+! transform from concentration into partial pressure unit
+
+    DO i=1,n3   
+      DO ipoint = 1,npts
+        IF (i .GE. n0(ipoint)) THEN
+            uo(ipoint,i)=uo(ipoint,i)*fpart(ipoint,i) 
+        ENDIF
+      ENDDO
+    ENDDO
+    
+
+
+!
+! solve diffusion equation (Crank-Nicholson)
+! Schwarz, Numerische Mathematik, Teubner, Stuttgart, p.476)
+! Press et al., Numerical Recepies, FORTRAN, p. 838)
+!*************************************************************
+
+! left hand side coefficient matrix:
+!************************************
+
+! left boundary
+
+
+    p=0.
+    DO ipoint = 1,npts
+      amhalf=diffdo(ipoint)
+      aphalf=diffdo(ipoint)
+      a(ipoint,n0(ipoint),n0(ipoint))=2.+rkh*(amhalf+aphalf-h**2*p)
+      a(ipoint,n0(ipoint),n0(ipoint)+1)=-rkh*(aphalf+amhalf)
+    ENDDO
+
+
+! inner points
+    DO ipoint = 1,npts
+      j1(ipoint)=n0(ipoint)-1
+      j2(ipoint)=j1(ipoint)+1
+      j3(ipoint)=j2(ipoint)+1 
+    ENDDO
+
+    DO  i=1,n2 !idem que precedement: sur-calcul
+      DO ipoint = 1,npts
+        IF ((i .GE. n0(ipoint)+1) .AND. (i .LE. n1(ipoint)-1)) THEN
+            j1(ipoint)=j1(ipoint)+1
+            j2(ipoint)=j2(ipoint)+1
+            j3(ipoint)=j3(ipoint)+1
+            amhalf=diffdo(ipoint)
+            aphalf=diffdo(ipoint)
+            p=0.
+            a(ipoint, i,j1(ipoint))=-rkh*amhalf
+            a(ipoint,i,j2(ipoint))=2.+rkh*(amhalf+aphalf-h**2*p)
+            a(ipoint,i,j3(ipoint))=-rkh*aphalf
+        ENDIF
+      ENDDO
+    ENDDO
+  
+!      j1=n0-1
+!      j2=j1+1
+!      j3=j2+1      
+!      do i=n0+1,n1-1
+!         j1=j1+1
+!         j2=j2+1
+!         j3=j3+1
+!         amhalf=diffdo
+!         aphalf=diffdo
+!         p=0.
+!         a(i,j1)=-rkh*amhalf
+!         a(i,j2)=2.+rkh*(amhalf+aphalf-h**2*p)
+!         a(i,j3)=-rkh*aphalf
+!      enddo
+
+
+    diffgrdo=0.57*0.66*rpv
+    diffgrup=0.0248*0.66*rpv
+
+!les parties suivantes sont differentes entre stomate_wet_ch4_pt_ter_0 et stomate_wet_ch4_pt_ter_m10
+
+    DO i = 1,n3-1
+      !sur-calcul: au depart j avais  = n0,n3-1
+      !mais les nouvelles bornes choisies permettent d ameliorer le vectorisation
+      DO ipoint = 1,npts
+
+        !1er CAS: (nw(ipoint) .LT. ns-1)
+        !diffusion coefficients water-air INTERFACE (soil water --> soil air)        
+        !par defaut ici on a toujours (nw(ipoint) .LT. ns-1)
+
+        IF (i .EQ. n1(ipoint)) THEN
+            !i=n1
+            j1(ipoint)=n1(ipoint)-1
+            j2(ipoint)=n1(ipoint)
+            j3(ipoint)=n1(ipoint)+1
+            amhalf=diffdo(ipoint)
+            aphalf=diffgrdo
+            p=0.
+            a(ipoint,i,j1(ipoint))=-rkh*amhalf
+            a(ipoint,i,j2(ipoint))=2.+rkh*(amhalf+aphalf-h**2*p)
+            a(ipoint,i,j3(ipoint))=-rkh*aphalf 
+        ELSEIF (i .EQ. n1(ipoint)+1) THEN
+            !i=n1+1
+            j1(ipoint)=n1(ipoint)
+            j2(ipoint)=n1(ipoint)+1
+            j3(ipoint)=n1(ipoint)+2
+            amhalf=diffgrup
+            aphalf=diffup(ipoint)
+            p=0.
+            a(ipoint,i,j1(ipoint))=-rkh*amhalf
+            a(ipoint,i,j2(ipoint))=2.+rkh*(amhalf+aphalf-h**2*p)
+            a(ipoint,i,j3(ipoint))=-rkh*aphalf 
+        ELSEIF ((i .GE. n1(ipoint)+2) .AND. (i .LE. n2-1)) THEN            
+            !DO i=n1+2,n2-1
+            j1(ipoint)=j1(ipoint)+1
+            j2(ipoint)=j2(ipoint)+1
+            j3(ipoint)=j3(ipoint)+1
+            amhalf=diffup(ipoint)
+            aphalf=diffup(ipoint)
+            p=0.
+            a(ipoint,i,j1(ipoint))=-rkh*amhalf
+            a(ipoint,i,j2(ipoint))=2.+rkh*(amhalf+aphalf-h**2*p)
+            a(ipoint,i,j3(ipoint))=-rkh*aphalf
+            !ENDDO        
+        ELSEIF (i .EQ. n2) THEN
+            !i=n2
+            j1(ipoint)=n2-1
+            j2(ipoint)=n2
+            j3(ipoint)=n2+1
+            amhalf=diffup(ipoint)
+            aphalf=diffair
+            p=0.
+            a(ipoint,i,j1(ipoint))=-rkh*amhalf
+            a(ipoint,i,j2(ipoint))=2.+rkh*(amhalf+aphalf-h**2*p)
+            a(ipoint,i,j3(ipoint))=-rkh*aphalf          
+        ELSEIF ((i .GE. n2+1) .AND. (i .LE. n3-1)) THEN
+            !DO i=n2+1,n3-1
+            j1(ipoint)=j1(ipoint)+1
+            j2(ipoint)=j2(ipoint)+1
+            j3(ipoint)=j3(ipoint)+1
+            amhalf=diffair
+            aphalf=diffair
+            p=0.
+            a(ipoint,i,j1(ipoint))=-rkh*amhalf
+            a(ipoint,i,j2(ipoint))=2.+rkh*(amhalf+aphalf-h**2*p)
+            a(ipoint,i,j3(ipoint))=-rkh*aphalf
+            !ENDDO
+
+!!$            !2eme CAS: (nw .EQ. ns-1)
+!!$            ! diffusion coefficients water-air interface (soil water --> soil air)
+!!$        ELSEIF ((nw(ipoint) .EQ. ns-1) .AND. (i .EQ. n1(ipoint))) THEN       
+!!$            !i=n1
+!!$            j1(ipoint)=n1(ipoint)-1
+!!$            j2(ipoint)=n1(ipoint)
+!!$            j3(ipoint)=n1(ipoint)+1
+!!$            amhalf=diffdo(ipoint)
+!!$            aphalf=diffgrdo
+!!$            p=0.
+!!$            a(ipoint,i,j1(ipoint))=-rkh*amhalf
+!!$            a(ipoint,i,j2(ipoint))=2.+rkh*(amhalf+aphalf-h**2*p)
+!!$            a(ipoint,i,j3(ipoint))=-rkh*aphalf                
+!!$        ELSEIF ((nw(ipoint) .EQ. ns-1) .AND. (i .EQ. n2)) THEN    
+!!$            !i=n2
+!!$            j1(ipoint)=n2-1
+!!$            j2(ipoint)=n2
+!!$            j3(ipoint)=n2+1
+!!$            amhalf=diffgrup
+!!$            aphalf=diffup(ipoint)
+!!$            p=0.
+!!$            a(ipoint,i,j1(ipoint))=-rkh*amhalf
+!!$            a(ipoint,i,j2(ipoint))=2.+rkh*(amhalf+aphalf-h**2*p)
+!!$            a(ipoint,i,j3(ipoint))=-rkh*aphalf         
+!!$        ELSEIF ((nw(ipoint) .EQ. ns-1) .AND. (i .EQ. n2+1)) THEN
+!!$            !i=n2+1
+!!$            j1(ipoint)=n2
+!!$            j2(ipoint)=n2+1
+!!$            j3(ipoint)=n2+2
+!!$            amhalf=diffup(ipoint)
+!!$            aphalf=diffair
+!!$            p=0.
+!!$            a(ipoint,i,j1(ipoint))=-rkh*amhalf
+!!$            a(ipoint,i,j2(ipoint))=2.+rkh*(amhalf+aphalf-h**2*p)
+!!$            a(ipoint,i,j3(ipoint))=-rkh*aphalf
+!!$        ELSEIF  ((nw(ipoint) .EQ. ns-1) .AND. (i .GE. n2+2) .AND. (i .LE. n3-1)) THEN  
+!!$            !DO i=n2+2,n3-1
+!!$            j1(ipoint)=j1(ipoint)+1
+!!$            j2(ipoint)=j2(ipoint)+1
+!!$            j3(ipoint)=j3(ipoint)+1
+!!$            amhalf=diffair
+!!$            aphalf=diffair
+!!$            p=0.
+!!$            a(ipoint,i,j1(ipoint))=-rkh*amhalf
+!!$            a(ipoint,i,j2(ipoint))=2.+rkh*(amhalf+aphalf-h**2*p)
+!!$            a(ipoint,i,j3(ipoint))=-rkh*aphalf
+!!$            !enddo
+!!$
+!!$            !3eme CAS: (nw .EQ. ns)
+!!$            ! diffusion coefficients water-air interface (soil water --> soil air)
+!!$        ELSEIF ((nw(ipoint) .EQ. ns) .AND. (i .EQ. n1(ipoint))) THEN
+!!$            !i=n1
+!!$            j1(ipoint)=n1(ipoint)-1
+!!$            j2(ipoint)=n1(ipoint)
+!!$            j3(ipoint)=n1(ipoint)+1
+!!$            amhalf=diffdo(ipoint)
+!!$            aphalf=diffgrdo
+!!$            p=0.
+!!$            a(ipoint,i,j1(ipoint))=-rkh*amhalf
+!!$            a(ipoint,i,j2(ipoint))=2.+rkh*(amhalf+aphalf-h**2*p)
+!!$            a(ipoint,i,j3(ipoint))=-rkh*aphalf 
+!!$        ELSEIF ((nw(ipoint) .EQ. ns) .AND. (i .EQ. n1(ipoint)+1)) THEN
+!!$            !i=n1+1
+!!$            j1(ipoint)=n1(ipoint)
+!!$            j2(ipoint)=n1(ipoint)+1
+!!$            j3(ipoint)=n1(ipoint)+2
+!!$            amhalf=diffgrup
+!!$            aphalf=diffair
+!!$            p=0.
+!!$            a(ipoint,i,j1(ipoint))=-rkh*amhalf
+!!$            a(ipoint,i,j2(ipoint))=2.+rkh*(amhalf+aphalf-h**2*p)
+!!$            a(ipoint,i,j3(ipoint))=-rkh*aphalf              
+!!$        ELSEIF ((nw(ipoint) .EQ. ns) .AND. (i .GE. n1(ipoint)+2) .AND. (i .LE. n3-1)) THEN
+!!$            ! do i=n1+2,n3-1
+!!$            j1(ipoint)=j1(ipoint)+1
+!!$            j2(ipoint)=j2(ipoint)+1
+!!$            j3(ipoint)=j3(ipoint)+1
+!!$            amhalf=diffair
+!!$            aphalf=diffair
+!!$            p=0.
+!!$            a(ipoint,i,j1(ipoint))=-rkh*amhalf
+!!$            a(ipoint,i,j2(ipoint))=2.+rkh*(amhalf+aphalf-h**2*p)
+!!$            a(ipoint,i,j3(ipoint))=-rkh*aphalf
+!!$            !ENDDO
+            
+            !4eme CAS: (nw .GE. ns): non traite dans ORCHIDEE! la  WTD n est jamais au-dessus de la surface
+            !de toute facon pas d oxydation dans ce cas dans le modele de Wlater (juste modif du transport)
+        ENDIF
+      ENDDO
+    ENDDO
+
+
+! right boundary
+
+    DO ipoint = 1,npts
+      amhalf=diffair
+      aphalf=diffair
+      p=0.
+      a(ipoint,n3,n3-1)=-rkh*amhalf
+      a(ipoint,n3,n3)=2.+rkh*(amhalf+aphalf-h**2*p)
+    ENDDO
+    
+        
+!
+! begin of time loop (time steps per day)
+!*****************************************
+
+      DO iday=1,nday
+
+
+
+!*****************************************
+
+! right hand side coefficient matrix:
+!************************************
+
+! left boundary
+   
+        DO ipoint = 1,npts
+          i=n0(ipoint)
+          amhalf=diffdo(ipoint)
+          aphalf=diffdo(ipoint)
+          p=0.
+! q10 dependent production rate (no production if T<0oC, i.e.sou(i)<=0oC)
+! forg(i): vertical distribution of substrate in soil (calculated in Scalc.f)
+! fin(itime): describes seasonality of NPP
+! rq10: Q10 value of production rate (from para.h)
+! r0pl: tuning parameter sr0pl (scaled in Scalc.f)
+          IF (sou(ipoint,n0(ipoint)) .GT. 0.) THEN
+              rexp=(sou(ipoint,n0(ipoint))-MAX(0.,tmean(ipoint)))/10.
+!             source=forg(n0)*r0pl*(rq10**rexp)*fin(itime)
+!             source=forg(n0)*(rq10**rexp)*carbon(itime)*(0.001239567)
+!             source=forg(n0)*(rq10**rexp)*carbon(itime)*r0pl*(0.0012)
+!             source=5.0*(rq10**rexp)
+              source=forg(ipoint,n0(ipoint))*(rq10**rexp)*substrat(ipoint)*alpha_PFT(ipoint)
+          ELSE
+              source=0.
+          ENDIF
+          q=source
+          wpro(ipoint)=wpro(ipoint)+q
+! transform from concentration into partial pressure unit
+          q=q*fpart(ipoint,i)
+          aold1=2.-rkh*(amhalf+aphalf-h**2*p)
+          aold2=rkh*(aphalf+amhalf)
+          aold3=2.*rk*q
+          b(ipoint,n0(ipoint))=aold1*uo(ipoint,n0(ipoint))+aold2*uo(ipoint,n0(ipoint)+1)+aold3
+        ENDDO
+
+        !DO ipoint =1,npts
+        !  IF (iday .EQ. 2) THEN
+        !      WRITE(*,*) 'matrice b apres left boundary',b(ipoint,:)
+        !  ENDIF
+        !ENDDO
+
+
+! inner points (from left to right)
+
+        !do i=n0+1,n1-1
+        DO i = 1,n2 !sur calcul
+          DO ipoint = 1,npts
+            IF ((i .GE. n0(ipoint)+1) .AND. (i .LE. n1(ipoint)-1)) THEN
+                amhalf=diffdo(ipoint)
+                aphalf=diffdo(ipoint)
+                p=0.
+! q10 dependent production rate (no production if T<0oC, i.e.sou(i)<=0oC)
+! forg(i): vertical distribution of substrate in soil (calculated in Scalc.f)
+! fin(itime): describes seasonality of NPP
+! rq10: Q10 value of production rate (from para.h)
+! r0pl: tuning parameter sr0pl (scaled in Scalc.f)
+                IF (sou(ipoint,i) .GT. 0.) THEN
+                    rexp=(sou(ipoint,i)-MAX(0.,tmean(ipoint)))/10.
+!              source=forg(i)*r0pl*(rq10**rexp)*fin(itime)
+!              source=forg(i)*(rq10**rexp)*carbon(itime)*(0.001239567)
+                    !modifie le calcul de la production --> utilise le carbone comme proxi du substrat
+                    source=forg(ipoint,i)*(rq10**rexp)*substrat(ipoint)*alpha_PFT(ipoint) 
+                ELSE
+                    source=0.
+                ENDIF
+                q=source
+                wpro(ipoint)=wpro(ipoint)+q
+! transform from concentration into partial pressure unit
+                q=q*fpart(ipoint,i)
+                aold1=rkh*amhalf
+                aold2=2.-rkh*(amhalf+aphalf-h**2*p)
+                aold3=rkh*aphalf
+                aold4=2.*rk*q
+                b(ipoint,i)=aold1*uo(ipoint,i-1)+aold2*uo(ipoint,i)+aold3*uo(ipoint,i+1)+aold4
+            ENDIF
+          ENDDO
+        ENDDO
+
+        !DO ipoint =1,npts
+        !  IF (iday .EQ. 2) THEN
+        !      WRITE(*,*) 'matrice b apres inner point avant cas',b(ipoint,:)
+        !  ENDIF
+        !ENDDO
+
+        diffgrdo=0.57*0.66*rpv
+        diffgrup=0.0248*0.66*rpv
+
+!toujours vrai ici: nw(ipoint) .LT. ns-1)
+
+        DO i = 1,n3-1          !sur-calcul: au depart j avais  i = n0,n3-1
+          DO ipoint = 1,npts
+
+            !1er CAS: (nw(ipoint) .LT. ns-1)
+            !diffusion coefficients water-air INTERFACE (soil water --> soil air)
+!!$            IF ((nw(ipoint) .LT. ns-1) .AND. (i .EQ. n1(ipoint))) THEN
+            
+           IF (i .EQ. n1(ipoint)) THEN
+ ! diffusion coefficients water-air interface (soil water --> soil air)
+                !i=n1
+                amhalf=diffdo(ipoint)
+                aphalf=diffgrdo
+                p=0.
+! q10 dependent production rate (no production if T<0oC, i.e.sou(i)<=0oC)
+! forg(i): vertical distribution of substrate in soil (calculated in Scalc.f)
+! fin(itime): describes seasonality of NPP
+! rq10: Q10 value of production rate (from para.h)
+! r0pl: tuning parameter sr0pl (scaled in Scalc.f)
+                IF (sou(ipoint,i) .GT. 0.) THEN
+                    rexp=(sou(ipoint,i)-MAX(0.,tmean(ipoint)))/10.
+                    !source=forg(i)*r0pl*(rq10**rexp)*fin(itime)
+                    source=forg(ipoint,i)*(rq10**rexp)*substrat(ipoint)*alpha_PFT(ipoint)
+                ELSE
+                    source=0.
+                ENDIF
+                q=source
+                wpro(ipoint)=wpro(ipoint)+q
+! transform from concentration into partial pressure unit
+                q=q*fpart(ipoint,i)
+                aold1=rkh*amhalf
+                aold2=2.-rkh*(amhalf+aphalf-h**2*p)
+                aold3=rkh*aphalf     
+                aold4=2.*rk*q
+                b(ipoint,i)=aold1*uo(ipoint,i-1)+aold2*uo(ipoint,i)+aold3*uo(ipoint,i+1)+aold4
+            
+
+            ELSEIF (i .EQ. n1(ipoint)+1) THEN
+                !i=n1+1
+                amhalf=diffgrup
+                aphalf=diffup(ipoint)
+                p=0.
+! oxidation following Michaelis-Menten kinetics
+                IF (uo(ipoint,i) .GT. 0.) THEN
+! transform from partial pressure into concentration unit 
+                    uo(ipoint,i)=uo(ipoint,i)/fpart(ipoint,i)
+! Michaelis Menten Equation
+                    q=-rvmax(ipoint)*uo(ipoint,i)/(uo(ipoint,i)+rkm)
+! temperature dependence (oxq10 from para.h)
+                    q=(q/oxq10)*(oxq10**((sou(ipoint,i)-MAX(0.,tmean(ipoint)))/10.))
+                    goxid(ipoint)=goxid(ipoint)+q
+! transform from concentration into partial pressure unit
+                    uo(ipoint,i)=uo(ipoint,i)*fpart(ipoint,i)
+! in case of negative concentrations: no oxidation
+! (can occur if number of time steps per day (nday) is small and water
+! table varies strongly) (help: increase nday (or change numerical scheme!))
+                ELSE
+                    q=0.
+                    goxid(ipoint)=goxid(ipoint)+q
+                ENDIF
+! transform from concentration into partial pressure unit
+                q=q*fpart(ipoint,i)
+                aold1=rkh*amhalf
+                aold2=2.-rkh*(amhalf+aphalf-h**2*p)
+                aold3=rkh*aphalf     
+                aold4=2.*rk*q
+                b(ipoint,i)=aold1*uo(ipoint,i-1)+aold2*uo(ipoint,i)+aold3*uo(ipoint,i+1)+aold4
+                    
+
+            ELSEIF ((i .GE. n1(ipoint)+2) .AND. (i .LE. n2-1)) THEN
+                !do i=n1+2,n2-1
+                amhalf=diffup(ipoint)
+                aphalf=diffup(ipoint)
+                p=0.
+! oxidation following Michaelis-Menten kinetics
+                IF (uo(ipoint,i) .GT. 0.) THEN
+! transform from partial pressure into concentration unit
+                    uo(ipoint,i)=uo(ipoint,i)/fpart(ipoint,i)
+! Michaelis Menten Equation
+                    q=-rvmax(ipoint)*uo(ipoint,i)/(uo(ipoint,i)+rkm)
+! temperature dependence (oxq10 from para.h)
+                    q=(q/oxq10)*(oxq10**((sou(ipoint,i)-MAX(0.,tmean(ipoint)))/10.))
+                    goxid(ipoint)=goxid(ipoint)+q
+! transform from concentration into partial pressure unit
+                    uo(ipoint,i)=uo(ipoint,i)*fpart(ipoint,i)
+! in case of negative concentrations: no oxidation
+! (can occur if number of time steps per day (nday) is small and water
+! table varies strongly) (help: increase nday (or change numerical scheme!))
+                ELSE
+                    q=0.
+                    goxid(ipoint)=goxid(ipoint)+q
+                ENDIF
+! transform from concentration into partial pressure unit
+                q=q*fpart(ipoint,i)
+                aold1=rkh*amhalf
+                aold2=2.-rkh*(amhalf+aphalf-h**2*p)
+                aold3=rkh*aphalf
+                aold4=2.*rk*q
+                b(ipoint,i)=aold1*uo(ipoint,i-1)+aold2*uo(ipoint,i)+aold3*uo(ipoint,i+1)+aold4
+
+            ELSEIF (i .EQ. n2) THEN
+                !i=n2
+                amhalf=diffup(ipoint)
+                aphalf=diffair
+                p=0.
+! oxidation following Michaelis-Menten kinetics
+                IF (uo(ipoint,i) .GT. 0.) THEN
+! transform from partial pressure into concentration unit
+                    uo(ipoint,i)=uo(ipoint,i)/fpart(ipoint,i)
+! Michaelis Menten Equation
+                    q=-rvmax(ipoint)*uo(ipoint,i)/(uo(ipoint,i)+rkm)
+! temperature dependence (oxq10 from para.h)
+                    q=(q/oxq10)*(oxq10**((sou(ipoint,i)-MAX(0.,tmean(ipoint)))/10.))
+                    goxid(ipoint)=goxid(ipoint)+q
+! transform from concentration into partial pressure unit
+                    uo(ipoint,i)=uo(ipoint,i)*fpart(ipoint,i)
+! in case of negative concentrations: no oxidation
+! (can occur if number of time steps per day (nday) is small and water
+! table varies strongly) (help: increase nday (or change numerical scheme!))
+                ELSE
+                    q=0.
+                    goxid(ipoint)=goxid(ipoint)+q
+                ENDIF
+! transform from concentration into partial pressure unit
+                q=q*fpart(ipoint,i)
+                aold1=rkh*amhalf
+                aold2=2.-rkh*(amhalf+aphalf-h**2*p)
+                aold3=rkh*aphalf     
+                aold4=2.*rk*q
+                b(ipoint,i)=aold1*uo(ipoint,i-1)+aold2*uo(ipoint,i)+aold3*uo(ipoint,i+1)+aold4
+
+            ELSEIF ((i .GE. n2+1) .AND. (i .LE. n3-1)) THEN
+                !DO i=n2+1,n3-1
+                amhalf=diffair
+                aphalf=diffair
+                p=0.
+                q=0.
+                aold1=rkh*amhalf
+                aold2=2.-rkh*(amhalf+aphalf-h**2*p)
+                aold3=rkh*aphalf
+                aold4=2.*rk*q
+                b(ipoint,i)=aold1*uo(ipoint,i-1)+aold2*uo(ipoint,i)+aold3*uo(ipoint,i+1)+aold4
+
+            ENDIF
+          ENDDO
+        ENDDO
+
+!!$
+!!$
+!!$        DO i = 1,n3-1          !sur-calcul: au depart j avais mis i = n0,n3-1
+!!$          DO ipoint = 1,npts
+!!$
+!!$            !2nd CAS: (nw(ipoint) .EQ. ns)
+!!$            !diffusion coefficients water-air INTERFACE (soil water --> soil air)
+!!$            IF ((nw(ipoint) .EQ. ns) .AND. (i .EQ. n1(ipoint))) THEN
+!!$                !i=n1
+!!$                amhalf=diffdo(ipoint)
+!!$                aphalf=diffgrdo
+!!$                p=0.
+!!$! q10 dependent production rate (no production if T<0oC, i.e.sou(i)<=0oC)
+!!$! forg(i): vertical distribution of substrate in soil (calculated in Scalc.f)
+!!$! fin(itime): describes seasonality of NPP
+!!$! rq10: Q10 value of production rate (from para.h)
+!!$! r0pl: tuning parameter sr0pl (scaled in Scalc.f)
+!!$                IF (sou(ipoint,i) .GT. 0.) THEN
+!!$                    rexp=(sou(ipoint,i)-MAX(0.,tmean(ipoint)))/10.
+!!$!              source=forg(i)*r0pl*(rq10**rexp)*fin(itime)
+!!$!              source=forg(i)*(rq10**rexp)*carbon(itime)*(0.001239567)
+!!$!            source=5.0*(rq10**rexp)
+!!$                    source=forg(ipoint,i)*(rq10**rexp)*substrat(ipoint)*alpha_CH4
+!!$                ELSE
+!!$                    source=0.
+!!$                ENDIF
+!!$                q=source
+!!$                wpro(ipoint)=wpro(ipoint)+q
+!!$! transform from concentration into partial pressure unit
+!!$                q=q*fpart(ipoint,i)
+!!$                aold1=rkh*amhalf
+!!$                aold2=2.-rkh*(amhalf+aphalf-h**2*p)
+!!$                aold3=rkh*aphalf     
+!!$                aold4=2.*rk*q
+!!$                b(ipoint,i)=aold1*uo(ipoint,i-1)+aold2*uo(ipoint,i)+aold3*uo(ipoint,i+1)+aold4
+!!$
+!!$            ELSEIF ((nw(ipoint) .EQ. ns) .AND. (i .EQ. n1(ipoint)+1)) THEN
+!!$                !i=n1+1
+!!$                amhalf=diffgrup
+!!$                aphalf=diffair
+!!$                p=0.
+!!$                q=0.
+!!$                aold1=rkh*amhalf
+!!$                aold2=2.-rkh*(amhalf+aphalf-h**2*p)
+!!$                aold3=rkh*aphalf     
+!!$                aold4=2.*rk*q
+!!$                b(ipoint,i)=aold1*uo(ipoint,i-1)+aold2*uo(ipoint,i)+aold3*uo(ipoint,i+1)+aold4
+!!$           
+!!$            ELSEIF ((nw(ipoint) .EQ. ns) .AND. (i .GE. n1(ipoint)+2) .AND. (i .LE. n3-1)) THEN
+!!$                !DO i=n1+2,n3-1
+!!$                amhalf=diffair
+!!$                aphalf=diffair
+!!$                p=0.
+!!$                q=0.
+!!$                aold1=rkh*amhalf
+!!$                aold2=2.-rkh*(amhalf+aphalf-h**2*p)
+!!$                aold3=rkh*aphalf
+!!$                aold4=2.*rk*q
+!!$                b(ipoint,i)=aold1*uo(ipoint,i-1)+aold2*uo(ipoint,i)+aold3*uo(ipoint,i+1)+aold4
+!!$                !ENDDO
+!!$
+!!$            ENDIF
+!!$          ENDDO
+!!$        ENDDO
+!!$
+!!$
+
+
+
+!!$        DO i = 1,n3-1          !sur-calcul: au depart j avais mis i = n0,n3-1
+!!$          DO ipoint = 1,npts
+!!$
+!!$            !3eme CAS: (nw(ipoint) .EQ. ns-1)
+!!$            !diffusion coefficients water-air INTERFACE (soil water --> soil air)
+!!$            IF ((nw(ipoint) .EQ. ns-1) .AND. (i .EQ. n1(ipoint))) THEN
+!!$                !i=n1
+!!$                amhalf=diffdo(ipoint)
+!!$                aphalf=diffgrdo
+!!$                p=0.
+!!$! q10 dependent production rate (no production if T<0oC, i.e.sou(i)<=0oC)
+!!$! forg(i): vertical distribution of substrate in soil (calculated in Scalc.f)
+!!$! fin(itime): describes seasonality of NPP
+!!$! rq10: Q10 value of production rate (from para.h)
+!!$! r0pl: tuning parameter sr0pl (scaled in Scalc.f)
+!!$                IF (sou(ipoint,i) .GT. 0.) THEN
+!!$                    rexp=(sou(ipoint,i)-MAX(0.,tmean(ipoint)))/10.
+!!$                    !source=forg(i)*r0pl*(rq10**rexp)*fin(itime)
+!!$                    source=forg(ipoint,i)*(rq10**rexp)*substrat(ipoint)*alpha_CH4
+!!$                ELSE
+!!$                    source=0.
+!!$                ENDIF
+!!$                q=source
+!!$                wpro(ipoint)=wpro(ipoint)+q
+!!$! transform from concentration into partial pressure unit
+!!$                q=q*fpart(ipoint,i)
+!!$                aold1=rkh*amhalf
+!!$                aold2=2.-rkh*(amhalf+aphalf-h**2*p)
+!!$                aold3=rkh*aphalf     
+!!$                aold4=2.*rk*q
+!!$                b(ipoint,i)=aold1*uo(ipoint,i-1)+aold2*uo(ipoint,i)+aold3*uo(ipoint,i+1)+aold4
+!!$
+!!$
+!!$            ELSEIF ((nw(ipoint) .EQ. ns-1) .AND. (i .EQ. n2)) THEN
+!!$                !i=n2
+!!$                amhalf=diffgrup
+!!$                aphalf=diffup(ipoint)
+!!$                p=0.
+!!$! oxidation following Michaelis-Menten kinetics
+!!$                IF (uo(ipoint,i) .GT. 0.) THEN
+!!$! transform from partial pressure into concentration unit
+!!$                    uo(ipoint,i)=uo(ipoint,i)/fpart(ipoint,i)
+!!$! Michaelis Menten Equation
+!!$                    q=-rvmax(ipoint)*uo(ipoint,i)/(uo(ipoint,i)+rkm)
+!!$! temperature dependence (oxq10 from para.h)
+!!$                    q=(q/oxq10)*(oxq10**((sou(ipoint,i)-MAX(0.,tmean(ipoint)))/10.))
+!!$                    goxid(ipoint)=goxid(ipoint)+q
+!!$! transform from concentration into partial pressure unit
+!!$                    uo(ipoint,i)=uo(ipoint,i)*fpart(ipoint,i)
+!!$! in case of negative concentrations: no oxidation
+!!$! (can occur if number of time steps per day (nday) is small and water
+!!$! table varies strongly) (help: increase nday (or change numerical scheme!))
+!!$                ELSE  
+!!$                    q=0.
+!!$                    goxid(ipoint)=goxid(ipoint)+q
+!!$                ENDIF
+!!$                ! transform from concentration into partial pressure unit
+!!$                q=q*fpart(ipoint,i)
+!!$                aold1=rkh*amhalf
+!!$                aold2=2.-rkh*(amhalf+aphalf-h**2*p)
+!!$                aold3=rkh*aphalf     
+!!$                aold4=2.*rk*q
+!!$                b(ipoint,i)=aold1*uo(ipoint,i-1)+aold2*uo(ipoint,i)+aold3*uo(ipoint,i+1)+aold4
+!!$
+!!$            ELSEIF ((nw(ipoint) .EQ. ns-1) .AND. (i .EQ. n2+1)) THEN
+!!$                !i=n2+1
+!!$                amhalf=diffup(ipoint)
+!!$                aphalf=diffair
+!!$                p=0.
+!!$                q=0.
+!!$                goxid(ipoint)=goxid(ipoint)+q
+!!$                aold1=rkh*amhalf
+!!$                aold2=2.-rkh*(amhalf+aphalf-h**2*p)
+!!$                aold3=rkh*aphalf     
+!!$                aold4=2.*rk*q
+!!$                b(ipoint,i)=aold1*uo(ipoint,i-1)+aold2*uo(ipoint,i)+aold3*uo(ipoint,i+1)+aold4
+!!$                
+!!$            ELSEIF ((nw(ipoint) .EQ. ns-1) .AND. (i .GE. n2+2) .AND. (i .LE. n3-1)) THEN             
+!!$                
+!!$                !DO i=n2+2,n3-1
+!!$                amhalf=diffair
+!!$                aphalf=diffair
+!!$                p=0.
+!!$                q=0.
+!!$                aold1=rkh*amhalf
+!!$                aold2=2.-rkh*(amhalf+aphalf-h**2*p)
+!!$                aold3=rkh*aphalf
+!!$                aold4=2.*rk*q
+!!$                b(ipoint,i)=aold1*uo(ipoint,i-1)+aold2*uo(ipoint,i)+aold3*uo(ipoint,i+1)+aold4
+!!$                !ENDDO
+!!$
+!!$            ENDIF
+!!$          ENDDO
+!!$        ENDDO
+
+        !4eme CAS: (nw .GE. ns): non traite! ma water table ne va jamais au-dessus de la
+        !surface en ce qui me concerne. de toute facon, jamais d oxydation dans Walter dans 
+        !la colonne d eau au-dessus de la surface: cala modifie juste le transport
+        
+
+
+        !DO ipoint =1,npts
+        !  IF (iday .EQ. 2) THEN
+        !      WRITE(*,*) 'matrice b apres inner point apres cas',b(ipoint,:)
+        !  ENDIF
+        !ENDDO
+
+! right boundary
+        DO ipoint = 1,npts
+          amhalf=diffair
+          aphalf=diffair
+          p=0.
+          q=0.
+          aoldm2=rkh*amhalf
+          aoldm1=2.-rkh*(amhalf+aphalf-h**2*p)
+          aoldn=2.*(rkh*aphalf*catm+rk*q)
+          b(ipoint,n3)=aoldm2*uo(ipoint,n3-1)+aoldm1*uo(ipoint,n3)+aoldn
+        ENDDO
+
+
+
+
+!*********************************************************
+! solution of tridiagonal system using subroutine tridag
+! calculate NEW concentration profiles uo(i)
+
+
+        !DO i=n0,n3
+        DO i=1,n3
+          DO ipoint =1,npts
+            IF (i .GE. n0(ipoint)) THEN
+                tria(ipoint,i-n0(ipoint)+1)=0.
+                trib(ipoint,i-n0(ipoint)+1)=0.
+                tric(ipoint,i-n0(ipoint)+1)=0.
+                trir(ipoint,i-n0(ipoint)+1)=0.
+                triu(ipoint,i-n0(ipoint)+1)=0.
+            ENDIF
+          ENDDO
+        enddo
+
+
+        !do i=n0,n3
+        DO i=1,n3
+          DO ipoint =1,npts
+            IF (i .GE. n0(ipoint)) THEN
+                trib(ipoint,i-n0(ipoint)+1)=a(ipoint,i,i)
+            ENDIF
+          ENDDO
+        ENDDO
+
+        !do i=n0+1,n3
+        DO i=1,n3
+          DO ipoint =1,npts
+            IF (i .GE. n0(ipoint)+1) THEN
+                tria(ipoint,i-n0(ipoint)+1)=a(ipoint,i,i-1)
+            ENDIF
+          ENDDO
+        ENDDO
+
+        !do i=n0,n3-1      
+        DO i=1,n3-1
+          DO ipoint =1,npts
+            IF (i .GE. n0(ipoint)) THEN
+                tric(ipoint,i-n0(ipoint)+1)=a(ipoint,i,i+1)
+            ENDIF
+          ENDDO
+        ENDDO
+
+        ! do i=n0,n3
+        DO i=1,n3
+          DO ipoint =1,npts
+            IF (i .GE. n0(ipoint)) THEN
+                trir(ipoint,i-n0(ipoint)+1)=b(ipoint,i)
+            ENDIF
+          ENDDO
+        ENDDO
+ 
+        DO ipoint =1,npts
+          ndim(ipoint)=n3-n0(ipoint)+1
+        ENDDO
+
+        !WRITE(*,*) ' '
+        !CALL tridiag(tria,trib,tric,trir,triu,ndim)
+        !REMPLACEMENT DE LA ROUTINE TRIDAG
+        !WRITE(*,*) ' '
+
+        DO ipoint =1,npts
+          bet(ipoint)=trib(ipoint,1)
+          triu(ipoint,1)=trir(ipoint,1)/bet(ipoint)
+        ENDDO
+
+        !DO j=2,ndim
+        !enleve j=2,500 et met a la place j=2,n3
+        DO j=2,n3
+          DO ipoint =1,npts
+            IF (j .LE. ndim(ipoint)) THEN
+                gam(ipoint,j)=tric(ipoint,j-1)/bet(ipoint)
+!                bet(ipoint)=trib(ipoint,j)-tria(ipoint,j)*gam(ipoint,j)
+                IF ((trib(ipoint,j)-tria(ipoint,j)*gam(ipoint,j)) .EQ. 0) THEN
+                    bet(ipoint)=trib(ipoint,j)-tria(ipoint,j)*gam(ipoint,j) + 10
+                ELSE
+                    bet(ipoint)=trib(ipoint,j)-tria(ipoint,j)*gam(ipoint,j)
+                ENDIF
+                triu(ipoint,j)=(trir(ipoint,j)-tria(ipoint,j)*triu(ipoint,j-1))/bet(ipoint)
+            ENDIF
+          ENDDO
+        ENDDO
+        
+        !DO j=ndim-1,1,-1
+        DO j=n3-1,1,-1
+          DO ipoint =1,npts  
+            IF (j .LE. ndim(ipoint)-1) THEN
+                triu(ipoint,j)=triu(ipoint,j)-gam(ipoint,j+1)*triu(ipoint,j+1)
+            ENDIF
+          ENDDO
+        ENDDO      
+        !FIN DE REMPLACEMENT DE LA ROUTINE TRIDAG
+
+
+        !DO i=n0,n3
+        DO i=1,n3
+          DO ipoint =1,npts  
+            IF (i .GE. n0(ipoint)) THEN
+                uo(ipoint,i)=triu(ipoint,i-n0(ipoint)+1)
+! if (due to small number of time steps per day and strong variation in
+! water table (i.e. large change in vertical profile of diffusion coefficient)
+! negative methane concentrations occur: set to zero
+! should usually not happen - can be avoided by increasing nday (from 24 to
+! 240 or 2400 or ...) or possibly using a different numerical scheme
+                IF (uo(ipoint,i) .LT. 0.) THEN
+                    negconc(ipoint)=negconc(ipoint)-(uo(ipoint,i)/fpart(ipoint,i))
+                ENDIF
+                uo(ipoint,i)=MAX(0.,triu(ipoint,i-n0(ipoint)+1))
+! transform from partial pressure into concentration unit
+                uo(ipoint,i)=uo(ipoint,i)/fpart(ipoint,i)
+            ENDIF
+          ENDDO
+        ENDDO
+     
+
+
+!la nouvelle valeur de uo va etre utilisée comme valeur initiale au pas de temps suivant....
+!************************************
+!************************************
+
+
+!**************************************************************
+
+! plant-mediated transport:
+!**************************
+        
+        DO ipoint =1,npts  
+          tplant(ipoint)=0.
+        ENDDO
+        
+        !DO i=n0,n3
+        DO i=1,n3
+          DO ipoint =1,npts  
+            IF (i .GE. n0(ipoint)) THEN
+! calculated fraction of methane that enters plants:
+! tveg: vegetation type from Sread.f
+! dveg: scaling factor from para.h
+! fgrow: growing stage of plants as calculated above (LAI)
+! root(i): vertical root distribution as calculated above
+                cplant=MIN(tveg(ipoint)*dveg*fgrow(ipoint)*root(ipoint,i)*10.*rk,1.)
+! amount (concentration) of methane that enters plants
+                cplant=cplant*uo(ipoint,i)
+                dplant(ipoint)=dplant(ipoint)+cplant
+! amount (concentration) of methane that remains in soil
+                uo(ipoint,i)=uo(ipoint,i)-cplant
+! only fraction (1.-pox) of methane entering plants is emitted
+! to the atmosphere - the rest (pox) is oxidized in the rhizosphere
+                tplant(ipoint)=tplant(ipoint)+cplant*(1.-pox)
+            ENDIF
+          ENDDO
+        ENDDO
+! transform amount (concentration) into flux unit (mg/m^2*d)
+        flplant(:,iday)=tplant(:)*funit
+
+        !DO ipoint =1,npts
+        ! IF (iday .EQ. 1) THEN
+        !     WRITE(*,*) 'tveg',tveg,'fgrow',fgrow
+        !     WRITE(*,*) 'root',root
+        ! ENDIF
+        !ENDDO       
+
+        !DO ipoint =1,npts
+        ! IF (iday .EQ. 1) THEN
+        !     WRITE(*,*) 'matrice uo apres plante',uo
+        ! ENDIF
+        ! ENDDO
+
+
+! bubble transport:
+!******************
+
+        DO ipoint =1,npts  
+          tmax(ipoint)=0.
+        ENDDO
+
+        !DO i=n0,nw
+        DO i=1,n2
+          DO ipoint =1,npts  
+            IF ((i .GE. n0(ipoint)) .AND. (i .LE. nw(ipoint))) THEN
+! methane in water: if concentration above threshold concentration rcmax 
+! (calculated in Scalc.f): bubble formation
+                cdiff=uo(ipoint,i)-rcmax(ipoint)
+                cbub=MAX(0.,cdiff)
+                tmax(ipoint)=tmax(ipoint)+cbub
+                uo(ipoint,i)=MIN(uo(ipoint,i),rcmax(ipoint))
+            ENDIF
+          ENDDO
+        ENDDO
+     
+
+!test Estelle
+!       IF (tmax .GT. 0.) then
+!       WRITE(*,*) 'check', tmax, n0, nw, uo(nw), cdiff
+!       ENDIF
+! if water table is above soil surface: bubble flux is emitted directly 
+! to atmosphere (mg/m^2*d)
+
+        DO ipoint =1,npts  
+          IF (nw(ipoint) .GE. ns) THEN
+              flbub(ipoint,iday)=tmax(ipoint)*funit
+              flbubdiff(ipoint,iday)=0.
+              tmax(ipoint)=0.
+! if water table is below soil surface:
+          ELSE
+              flbub(ipoint,iday)=0.
+              flbubdiff(ipoint,iday)=0.
+! 1. if water table is 5 or less cm below soil surface: flbubdiff is
+! calculated in the same way as flbub and added to the total flux (mg/m^2*d)
+              IF (nw(ipoint) .GE. ns-5) THEN
+                  flbubdiff(ipoint,iday)=tmax(ipoint)*funit
+                  tmax(ipoint)=0.
+              ENDIF
+          ENDIF
+        ENDDO
+
+!test Estelle
+!       IF (flbub(iday) .gt. 0.) then
+!       WRITE(*,*) 'buble', iday,flbub(iday),tmax, cdiff, cbub, nw
+!       ENDIF 
+
+
+! 2. if water table is more than 5 cm below soil surface: no bubble flux
+! is directly emitted to the atmosphere, BUT methane amount from bubble is
+! added to the first layer above the soil surface
+! (the distinction more/less than 5 cm below soil has been made, because
+! adding tmax to uo(nw+1) if the water table is less than 5cm below the soil 
+! surface 'disturbed' the system too much and more time steps per day (larger
+! nday) is needed) (this solution avoids this)
+        DO ipoint =1,npts  
+          uo(ipoint,nw(ipoint)+1)=uo(ipoint,nw(ipoint)+1)+tmax(ipoint)
+        ENDDO
+
+        !DO ipoint =1,npts
+        ! IF (iday .EQ. 1) THEN
+        !     WRITE(*,*) 'matrice uo apres bubble',uo
+        ! ENDIF
+        !ENDDO
+
+! calculate diffusive flux from the concentration gradient (mg/m^2*d):
+!**********************************************************************
+        DO ipoint =1,npts  
+          fdifftime(ipoint,iday)=((uo(ipoint,n3-2)-uo(ipoint,n3-1))/0.1)*38.4*diffair
+        ENDDO
+
+! transform from concentration into partial pressure unit
+       !do i=n0,n3
+        DO i=1,n3
+         DO ipoint =1,npts  
+           IF (i .GE. n0(ipoint)) THEN
+               uo(ipoint,i)=uo(ipoint,i)*fpart(ipoint,i)
+           ENDIF
+         ENDDO
+       enddo
+       
+
+
+      ! DO ipoint =1,npts
+      !   IF (iday .EQ. 1) THEN
+      !       WRITE(*,*) 'matrice uo FIN TIMELOOP',uo
+      !   ENDIF
+      ! ENDDO
+
+!
+! end of (iday=1,nday) loop, i.e. time step per day
+!***************************************************
+
+     ENDDO
+
+!***************************************************
+
+
+! water-air interface
+! transform from partial pressure into concentration unit
+       !do i=n0,n3
+     DO i=1,n3
+       DO ipoint =1,npts  
+         IF (i .GE. n0(ipoint)) THEN
+             uo(ipoint,i)=uo(ipoint,i)/fpart(ipoint,i)
+         ENDIF
+       ENDDO
+     ENDDO
+
+
+! calculate conc kept in soil - 
+! necessary to calculate fluxdiff (diffusive flux from mass balance)
+     DO i=1,nvert
+       DO ipoint =1,npts  
+         uout(ipoint,i)=uo(ipoint,i)
+       ENDDO
+     ENDDO
+
+     !do i=n0,n3
+     DO i=1,n3
+       DO ipoint =1,npts  
+         IF (i .GE. n0(ipoint)) THEN
+             tout(ipoint)=tout(ipoint)+(uout(ipoint,i)-uold2(ipoint,i))
+         ENDIF
+       ENDDO
+     ENDDO
+ 
+     !DO ipoint =1,npts  
+     !  tout(ipoint)=0.
+     !ENDDO
+     
+     tout(:)=0.
+
+     !do i=n0,n3
+     DO i=1,n3
+       DO ipoint =1,npts  
+         IF (i .GE. n0(ipoint)) THEN
+             tout(ipoint)=tout(ipoint)+(uout(ipoint,i)-uold2(ipoint,i))
+         ENDIF
+       ENDDO
+     ENDDO
+
+
+     DO i=1,nvert
+       DO ipoint =1,npts  
+         uold2(ipoint,i)=uout(ipoint,i)
+       ENDDO
+     ENDDO
+
+
+!*****************************
+!vire concout
+
+! write CH4conc to varible concout after each time interval (at iday=nday)
+! concout(i,itime) is needed to write CH4conc profiles in Soutput.f
+!      do i=1,n3
+!          concout(i,itime)=uout(i)
+!      enddo
+!      do i=n3+1,n
+! transform from partial pressure into concentration unit
+!          concout(i,itime)=catm/fpart(i)
+!      enddo
+
+! calculate daily means of bubble flux, fluxbubdiff, plant flux, and
+! diffusive flux (from concentration gradient) (mg/m^2*d)
+
+!*******************************
+!la j enleve la dimension temps des sorties...
+!*******************************
+
+
+
+     DO ipoint =1,npts  
+       fluxbub(ipoint)=0.
+       fluxbubdiff(ipoint)=0.
+       fluxplant(ipoint)=0.
+       fdiffday(ipoint)=0.
+     ENDDO
+
+
+     DO i=1,nday
+       DO ipoint =1,npts  
+         fluxbub(ipoint)=fluxbub(ipoint)+flbub(ipoint,i)
+         fluxbubdiff(ipoint)=fluxbubdiff(ipoint)+flbubdiff(ipoint,i)
+         fluxplant(ipoint)=fluxplant(ipoint)+flplant(ipoint,i)
+         fdiffday(ipoint)=fdiffday(ipoint)+fdifftime(ipoint,i)
+       ENDDO
+     ENDDO
+         
+     fluxbub(:)=fluxbub(:)/nday
+     fluxbubdiff(:)=fluxbubdiff(:)/nday
+     fluxplant(:)=fluxplant(:)/nday
+     fdiffday(:)=fdiffday(:)/nday
+         
+  
+!
+! calculate diffusive flux ( from mass balance):
+!************************************************
+! use amounts in concentration unit and tranform in flux unit (mg/m^2*d)
+! wpro: amount of methane produced during entire day
+! goxid: amount of methane oxidized during entire day
+! mutiply by rk (depending on number of time steps per day)
+! dplant: amount of methane that entered plants during entire day
+!  (includes both: methane emitted through plants AND oxidized in rhizosphere)
+! tout: additional methane stored in soil during entire day
+! wtdiff: see above
+! fluxbub: bubble flux (if water table > soil surface)
+! bubble flux (if water table less than 5 cm below soil surface (see above))
+! negconc: see above
+     fluxdiff(:)= ((rk*(wpro(:)+goxid(:)) - dplant(:)-tout(:)-wtdiff)/nday)*funit &
+        & - fluxbub(:) - fluxbubdiff(:) + negconc(:)*(funit/nday)
+
+! fluxbubdiff is added to diffusive flux (mg/m^2*d)
+
+     
+     fluxdiff(:) = fluxdiff(:)+fluxbubdiff(:)
+     fdiffday(:) = fdiffday(:)+fluxbubdiff(:)
+
+
+!enleve boucle if sur ihump
+
+!      ELSE
+!          fluxdiff=0.
+!          fdiffday=0.
+!          fluxbub=0.
+!          fluxplant=0.
+!          fluxtot=0.
+!          !do i=1,n
+!          !   concout(i,itime)=0.
+!          !enddo
+!
+!! end of (if (ijump .eq. 1)) 'loop'
+!!***********************************
+!      ENDIF
+
+
+
+
+
+! to calculate wtdiff (see above)
+! define uwp1
+
+!non necessaire: la WTD ne se modifie pas d un pas de tps a l autre 
+
+!         uwp0=uo(ipoint,nw)
+!         uwp1=uo(ipoint,nw+1)
+!         uwp2=uo(ipoint,nw+2)
+
+
+
+! calculate total flux fluxtot (using diffusive flux from mass balance)
+! and sum of diffusive flux from mass balance and bubble flux (for plots)
+! (mg/m^2*d)
+!      do i=1,ntime
+
+     fluxtot(:)=fluxdiff(:)+fluxbub(:)+fluxplant(:)
+     fbubdiff(:)=fluxdiff(:)+fluxbub(:)
+
+
+     DO ipoint =1,npts
+       ch4_flux_density_dif(ipoint) = fluxdiff(ipoint)
+       ch4_flux_density_bub(ipoint) = fluxbub(ipoint)
+       ch4_flux_density_pla(ipoint) = fluxplant(ipoint)  
+     ENDDO
+
+
+     WHERE (fluxtot(:) .LE. 0.0)
+         ch4_flux_density_tot(:) = 0.0 
+     ELSEWHERE
+         ch4_flux_density_tot(:) = fluxtot(:)
+     endwhere
+     
+     !pour contrebalancer valeur par defaut mise pour les grid-cells ou veget_max=0
+     WHERE ((veget_max(:,1) .LE. 0.95) .AND. (sum_veget_nat_ss_nu(:) .GT. 0.1)) 
+         ch4_flux_density_tot(:) = ch4_flux_density_tot(:)
+     ELSEWHERE
+         ch4_flux_density_tot(:) = 0.0 
+     ENDWHERE
+
+
+
+END SUBROUTINE ch4_wet_flux_density_wet
+!********************************************************************
+!!$
+!!$SUBROUTINE tridag(a,b,c,r,u,n)
+!!$!
+!!$! Press et al., Numerical Recipes, FORTRAN, p.43
+!!$!************************************************
+!!$
+!!$    ! Domain size
+!!$    INTEGER(i_std), INTENT(in)                                 :: n
+!!$    REAL(r_std),DIMENSION(n), INTENT(in)                        :: a
+!!$    REAL(r_std),DIMENSION(n), INTENT(in)                        :: b
+!!$    REAL(r_std),DIMENSION(n), INTENT(in)                       :: c
+!!$    REAL(r_std),DIMENSION(n), INTENT(in)                       :: r
+!!$    REAL(r_std),DIMENSION(n), INTENT(out)                       :: u
+!!$    INTEGER(stnd),PARAMETER                           :: nmax=500
+!!$    INTEGER(i_std)                                 :: j
+!!$    REAL(r_std),DIMENSION(nmax)                :: gam
+!!$    REAL(r_std)                                    :: bet
+!!$
+!!$      bet=b(1)
+!!$
+!!$      u(1)=r(1)/bet
+!!$
+!!$      do j=2,n
+!!$        gam(j)=c(j-1)/bet
+!!$        bet=b(j)-a(j)*gam(j)
+!!$        u(j)=(r(j)-a(j)*u(j-1))/bet
+!!$      enddo
+!!$
+!!$      do j=n-1,1,-1
+!!$        u(j)=u(j)-gam(j+1)*u(j+1)
+!!$      enddo
+!!$
+!!$END SUBROUTINE tridag
+
+
+END MODULE stomate_wet_ch4_pt_ter_wet
Index: /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_xml/CMIP6_ping_land.xml
===================================================================
--- /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_xml/CMIP6_ping_land.xml	(revision 6940)
+++ /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_xml/CMIP6_ping_land.xml	(revision 6940)
@@ -0,0 +1,322 @@
+<!-- ==================================================================================================================== -->
+<!-- CMIP6_ping_land.xml                                                                                                  -->
+<!-- This file is not used while running the model. It is only here for preparing output for CMIP6 simulations.           -->
+<!-- This file contains all output variables in the data request for CMIP6 concerning ORCHIDEE.                           -->
+<!-- field id should not be changed. It is used by the tool dr2xml to produce specific file_def.xml files for CMIP6.      -->
+<!-- field_ref corresponds to field id in field_def_orchidee.xml.                                                         -->
+<!-- field_ref="dummy" means that the corresponding output variable in ORCHIDEE has not yet been identified or coded.     -->
+<!--                                                                                                                      -->
+<!-- $HeadURL: svn://forge.ipsl.jussieu.fr/orchidee/branches/ORCHIDEE-MICT/ORCHIDEE/src_xml/CMIP6_ping_land.xml $                          -->
+<!-- $Date: 2017-10-26 15:35:04 +0200 (Thu, 26 Oct 2017) $                                                              -->
+<!-- $Revision: 4719 $                                                                                                    -->
+<!-- ==================================================================================================================== -->
+<!-- Ping files generated by dr2xml 0.18 using Data Request 01.00.16 -->
+<!-- lrealms= ['land'] -->
+<!-- exact= False -->
+<!--  listof_home_vars : None
+ tierMax : 3
+ max_priority : 3
+ mips : set(['CORDEX', 'GMMIP', 'RFMIP', 'AerChemMIP', 'CMIP6', 'OMIP', 'GeoMIP', 'C4MIP', 'PDRMIP', 'DCPP', 'DECK', 'LUMIP', 'CMIP5', 'CFMIP', 'ScenarioMIP', 'DAMIP', 'CCMI', 'SolarMIP', 'VIACSAB', 'SIMIP', 'CMIP', 'ISMIP6', 'VolMIP', 'PMIP', 'FAFMIP', 'HighResMIP', 'LS3MIP', 'SPECS', 'DynVar'])
+ excluded_vars : []
+ realms_per_context : {'lmdz': ['atmos', 'atmos land'], 'nemo': ['seaIce', 'ocean', 'ocean seaIce', 'ocnBgchem', 'seaIce ocean'], 'orchidee': ['land', 'landIce land', 'land landIce', 'landIce']}
+ path_extra_tables : None
+ excluded_vars_file : None
+ ping_variables_prefix : CMIP6_
+ path_special_defs : None
+ orphan_variables : {}
+--> 
+
+<context id="land">
+<field_definition>
+<!-- for variables which realm equals one of _land-->
+   <field id="CMIP6_agesno_land"   field_ref="snowage_glob"     /> <!-- P1 (day) age_of_surface_snow : Age of Snow (when computing the time-mean here, the time samples, weighted by the mass of snow on the land portion of the grid cell, are accumulated and then divided by the sum of the weights.  Reported as missing data in regions free of snow on land. Warning: other snow-related fields ask for a 0 value when there is no snow, e.g. CMIP6_hfdsn and CMIP6_snd, we'll stick to this 0 value.-->
+   <field id="CMIP6_albc"          field_ref="vegalb_glob"      /> <!-- P1 (1.0) canopy_albedo : Canopy Albedo -->
+   <field id="CMIP6_albsn"         field_ref="albedo_snow"      /> <!-- P1 (1.0) snow_and_ice_albedo : Albedo of the snow-covered surface, averaged over the grid cell. -->
+   <field id="CMIP6_areacella"     field_ref="dummy_XY"         /> <!-- P1 (m2) cell_area : For atmospheres with more than 1 mesh (e.g., staggered grids), report areas that apply to surface vertical fluxes of energy. -->
+   <field id="CMIP6_areacellg"     field_ref="dummy_XY"         /> <!-- P1 (m2) cell_area : Area of the target grid (not the interpolated area of the source grid). -->
+   <field id="CMIP6_areacellr"     field_ref="dummy_XY"         /> <!-- P1 (m2) cell_area : For river routing model, if grid differs from the atmospheric grid. -->
+   <field id="CMIP6_ares"          field_ref="raero"            /> <!-- P1 (s m-1) aerodynamic_resistance : Aerodynamic resistance -->
+   <field id="CMIP6_baresoilFrac"  field_ref="baresoilFrac"     /> <!-- P2 (%) area_fraction : Percentage of entire grid cell  that is covered by bare soil. Warning: we do not include the bare soil fraction from the vegetated pft's -->
+   <field id="CMIP6_burntFractionAll" field_ref="dummy_XY"         /> <!-- P1 (%) area_fraction : Percentage of grid cell burned due to all fires including natural and anthropogenic fires and those associated with anthropogenic land use change -->
+   <field id="CMIP6_c13Land"       field_ref="dummy_XY"         /> <!-- P2 (kg m-2) total_land_c13 : Mass of 13C in all terrestrial carbon pools -->
+   <field id="CMIP6_c13Litter"     field_ref="dummy_XY"         /> <!-- P2 (kg m-2) litter_c13_content : Mass of 13C in Litter Pool -->
+   <field id="CMIP6_c13Soil"       field_ref="dummy_XY"         /> <!-- P2 (kg m-2) soil_c13_content : Mass of 13C in Soil Pool -->
+   <field id="CMIP6_c13Veg"        field_ref="dummy_XY"         /> <!-- P2 (kg m-2) vegetation_c13_content : Mass of 13C in Vegetation -->
+   <field id="CMIP6_c14Land"       field_ref="dummy_XY"         /> <!-- P2 (kg m-2) total_land_c14 : Mass of 14C in all terrestrial carbon pools -->
+   <field id="CMIP6_c14Litter"     field_ref="dummy_XY"         /> <!-- P2 (kg m-2) litter_c14_content : Mass of 14C in Litter Pool -->
+   <field id="CMIP6_c14Soil"       field_ref="dummy_XY"         /> <!-- P2 (kg m-2) soil_c14_content : Mass of 14C in Soil Pool -->
+   <field id="CMIP6_c14Veg"        field_ref="dummy_XY"         /> <!-- P2 (kg m-2) vegetation_c14_content : Mass of 14C in Vegetation -->
+   <field id="CMIP6_c3PftFrac"     field_ref="dummy_XY"         /> <!-- P1 (%) area_fraction : Percentage of entire grid cell  that is covered by C3 PFTs (including grass, crops, and trees). -->
+   <field id="CMIP6_c4PftFrac"     field_ref="dummy_XY"         /> <!-- P1 (%) area_fraction : Percentage of entire grid cell  that is covered by C4 PFTs (including grass and crops). -->
+   <field id="CMIP6_cCwd"          field_ref="dummy_XY"         /> <!-- P1 (kg m-2) wood_debris_carbon_content : Carbon mass per unit area in woody debris (dead organic matter composed of coarse wood.  It is distinct from litter) -->
+   <field id="CMIP6_cLand"         field_ref="dummy_XY"         /> <!-- P1 (kg m-2) cLand : Report missing data over ocean grid cells. For fractional land report value averaged over the land fraction. -->
+   <field id="CMIP6_cLeaf"         field_ref="dummy_XY"         /> <!-- P1 (kg m-2) leaf_carbon_content : Carbon mass per unit area in leaves. -->
+   <field id="CMIP6_cLitter"       field_ref="dummy_XY"         /> <!-- P1 (kg m-2) litter_carbon_content : unset -->
+   <field id="CMIP6_cLitterAbove"  field_ref="dummy_XY"         /> <!-- P1 (kg m-2) surface_litter_carbon_content : unset -->
+   <field id="CMIP6_cLitterBelow"  field_ref="dummy_XY"         /> <!-- P1 (kg m-2) subsurface_litter_carbon_content : unset -->
+   <field id="CMIP6_cLitterCwd"    field_ref="dummy_XY"         /> <!-- P2 (kg m-2) litter_wood_debris_carbon_content : Carbon Mass in Coarse Woody Debris -->
+   <field id="CMIP6_cLitterGrass"  field_ref="dummy_XY"         /> <!-- P2 (kg m-2) litter_carbon_content : Carbon mass in litter on grass tiles -->
+   <field id="CMIP6_cLitterLut"    field_ref="dummy_XY"         /> <!-- P1 (kg m-2) litter_carbon_content : end of year values (not annual mean) -->
+   <field id="CMIP6_cLitterShrub"  field_ref="dummy_XY"         /> <!-- P2 (kg m-2) litter_carbon_content : Carbon mass in litter on shrub tiles -->
+   <field id="CMIP6_cLitterSubSurf" field_ref="dummy_XY"         /> <!-- P2 (kg m-2) subsurface_litter_carbon_content : sub-surface litter pool fed by root inputs. -->
+   <field id="CMIP6_cLitterSurf"   field_ref="dummy_XY"         /> <!-- P2 (kg m-2) surface_litter_carbon_content : Surface or near-surface litter pool fed by leaf and above-ground litterfall -->
+   <field id="CMIP6_cLitterTree"   field_ref="dummy_XY"         /> <!-- P2 (kg m-2) litter_carbon_content : Carbon mass in litter on tree tiles -->
+   <field id="CMIP6_cMisc"         field_ref="dummy_XY"         /> <!-- P2 (kg m-2) miscellaneous_living_matter_carbon_content : e.g., labile, fruits, reserves, etc. -->
+   <field id="CMIP6_cOther"        field_ref="dummy_XY"         /> <!-- P2 (kg m-2) cOther : E.g. fruits, seeds, etc. -->
+   <field id="CMIP6_cProduct"      field_ref="dummy_XY"         /> <!-- P1 (kg m-2) carbon_content_of_products_of_anthropogenic_land_use_change : Carbon mass per unit area in that has been removed from the environment through  landuse change. -->
+   <field id="CMIP6_cProductLut"   field_ref="dummy_XY"         /> <!-- P1 (kg m-2) cProductLut : anthropogenic pools associated with land use tiles into which harvests and cleared carbon are deposited before release into atmosphere PLUS any remaining anthropogenic pools that may be associated with lands which were converted into land use tiles during reported period . Does NOT include residue which is deposited into soil or litter; end of year values (not annual mean) -->
+   <field id="CMIP6_cRoot"         field_ref="dummy_XY"         /> <!-- P1 (kg m-2) root_carbon_content : Carbon mass per unit area in roots, including fine and coarse roots. -->
+   <field id="CMIP6_cSoil"         field_ref="dummy_XY"         /> <!-- P1 (kg m-2) soil_carbon_content : Carbon mass in the full depth of the soil model. -->
+   <field id="CMIP6_cSoilAbove1m"  field_ref="dummy_XY"         /> <!-- P1 (kg m-2) soil_carbon_content_above_1m_depth : Report missing data over ocean grid cells. For fractional land report value averaged over the land fraction. -->
+   <field id="CMIP6_cSoilBelow1m"  field_ref="dummy_XY"         /> <!-- P1 (kg m-2) soil_carbon_content_below_1m_depth : Carbon Mass in Soil Pool below 1m Depth -->
+   <field id="CMIP6_cSoilFast"     field_ref="dummy_XY"         /> <!-- P1 (kg m-2) fast_soil_pool_carbon_content : Carbon mass per unit area in fast soil pool. Fast means a lifetime of less than 10 years for reference climate conditions (20th century) in the absence of water limitations. -->
+   <field id="CMIP6_cSoilGrass"    field_ref="dummy_XY"         /> <!-- P2 (kg m-2) soil_carbon_content : Carbon mass in soil on grass tiles -->
+   <field id="CMIP6_cSoilLevels"   field_ref="dummy_XY"         /> <!-- P2 (kg m-2) soil_carbon_content_on_model_levels : for models with vertically discretised soil carbon, report total soil carbon for each level -->
+   <field id="CMIP6_cSoilLut"      field_ref="dummy_XY"         /> <!-- P1 (kg m-2) soil_carbon_content : end of year values (not annual mean) -->
+   <field id="CMIP6_cSoilMedium"   field_ref="dummy_XY"         /> <!-- P1 (kg m-2) medium_soil_pool_carbon_content : Carbon mass per unit area in medium (rate) soil pool. Medium means a lifetime of more than than 10 years and less than 100 years for reference climate conditions (20th century) in the absence of water limitations. -->
+   <field id="CMIP6_cSoilPools"    field_ref="dummy_XY"         /> <!-- P2 (kg m-2) soil_carbon_content_by_pool : for models with multiple soil carbon pools, report each pool here. If models also have vertical discretaisation these should be aggregated -->
+   <field id="CMIP6_cSoilShrub"    field_ref="dummy_XY"         /> <!-- P2 (kg m-2) soil_carbon_content : Carbon mass in soil on shrub tiles -->
+   <field id="CMIP6_cSoilSlow"     field_ref="dummy_XY"         /> <!-- P1 (kg m-2) slow_soil_pool_carbon_content : Carbon mass per unit area in slow soil pool. Slow means a lifetime of more than 100 years for reference climate (20th century) in the absence of water limitations. -->
+   <field id="CMIP6_cSoilTree"     field_ref="dummy_XY"         /> <!-- P2 (kg m-2) soil_carbon_content : Carbon mass in soil on tree tiles -->
+   <field id="CMIP6_cStem"         field_ref="dummy_XY"         /> <!-- P2 (kg m-2) stem_carbon_content : including sapwood and hardwood. -->
+   <field id="CMIP6_cTotFireLut"   field_ref="dummy_XY"         /> <!-- P1 (kg m-2 s-1) missing : Different from LMON this flux should include all fires occurring on the land use tile, including natural, man-made and deforestation fires -->
+   <field id="CMIP6_cVeg"          field_ref="dummy_XY"         /> <!-- P1 (kg m-2) vegetation_carbon_content : Carbon mass per unit area in vegetation. -->
+   <field id="CMIP6_cVegGrass"     field_ref="dummy_XY"         /> <!-- P2 (kg m-2) vegetation_carbon_content : Carbon mass in vegetation on grass tiles -->
+   <field id="CMIP6_cVegLut"       field_ref="dummy_XY"         /> <!-- P1 (kg m-2) vegetation_carbon_content : end of year values (not annual mean) -->
+   <field id="CMIP6_cVegShrub"     field_ref="dummy_XY"         /> <!-- P2 (kg m-2) vegetation_carbon_content : Carbon mass in vegetation on shrub tiles -->
+   <field id="CMIP6_cVegTree"      field_ref="dummy_XY"         /> <!-- P2 (kg m-2) vegetation_carbon_content : Carbon mass in vegetation on tree tiles -->
+   <field id="CMIP6_cWood"         field_ref="dummy_XY"         /> <!-- P2 (kg m-2) wood_carbon_content : Carbon mass per unit area in wood, including sapwood and hardwood. -->
+   <field id="CMIP6_clayfrac"      field_ref="dummy_XYSo"       /> <!-- P1 (1.0) volume_fraction_of_clay_in_soil : Clay Fraction -->
+   <field id="CMIP6_cnc"           field_ref="dummy_XY"         /> <!-- P1 (%) vegetation_area_fraction : Canopy covered area percentage Warning: shall we take vegFrac or SUM(veget(2:))*100*contrfac ? -->
+   <field id="CMIP6_cropFrac"      field_ref="cropFrac"         /> <!-- P1 (%) area_fraction : Percentage of entire grid cell  that is covered by crop. Warning: Note: Multiplied in sechiba by contfrac because we need entire grid-cell-->
+   <field id="CMIP6_cropFracC3"    field_ref="dummy_XY"         /> <!-- P1 (%) area_fraction : Percentage of entire grid cell covered by C3 crops -->
+   <field id="CMIP6_cropFracC4"    field_ref="dummy_XY"         /> <!-- P1 (%) area_fraction : Percentage of entire grid cell covered by C4 crops -->
+   <field id="CMIP6_cw"            field_ref="qsintveg_tot"     /> <!-- P1 (kg m-2) canopy_water_amount : Total Canopy Water Storage -->
+   <field id="CMIP6_dcw"           field_ref="delintercept"     /> <!-- P1 (kg m-2) change_over_time_in_canopy_water_amount : Change in Interception Storage -->
+   <field id="CMIP6_dfr"           field_ref="dummy_XY"         /> <!-- P1 (m) depth_of_frozen_soil : Depth from surface to the first zero degree isotherm. Above this isotherm T < 0o, and below this line T > 0o. -->
+   <field id="CMIP6_dgw"           field_ref="delslowr"         /> <!-- P1 (kg m-2) change_over_time_in_groundwater : Change in Groundwater Warning: It can be either undef or delslowr. We take the second option for the moment. -->
+   <field id="CMIP6_dmlt"          field_ref="dummy_XY"         /> <!-- P1 (m) depth_of_subsurface_melting : Depth from surface to the zero degree isotherm. Above this isotherm T > 0o, and below this line T < 0o. -->
+   <field id="CMIP6_drivw"         field_ref="delriv"           /> <!-- P1 (kg m-2) change_over_time_in_river_water_amount : Change in River Storage Warning: we sum the stream and fast reservoir of the routing scheme. -->
+   <field id="CMIP6_dslw"          field_ref="delsoilmoist"     /> <!-- P1 (kg m-2) change_over_time_in_water_content_of_soil_layer : Change in soil moisture -->
+   <field id="CMIP6_dsn"           field_ref="delswe"           /> <!-- P1 (kg m-2) change_over_time_in_surface_snow_and_ice_amount : Change in snow water equivalent -->
+   <field id="CMIP6_dsw"           field_ref="delsurfwater"     /> <!-- P1 (kg m-2) change_over_time_in_surface_water_amount : Change in Surface Water Storage Warning: includes the fast reservoire-->
+   <field id="CMIP6_dtes"          field_ref="dummy_XY"         /> <!-- P1 (J m-2) change_over_time_in_thermal_energy_content_of_surface : Change in heat storage over the soil layer and the vegetation for which the energy balance is calculated, accumulated over the sampling time interval. -->
+   <field id="CMIP6_dtesn"         field_ref="del_snowheattot"  /> <!-- P1 (J m-2) change_over_time_in_thermal_energy_content_of_surface_snow_and_ice : Change in cold content over the snow layer for which the energy balance is calculated, accumulated over the sampling time interval. This should also include the energy contained in the liquid water in the snow pack.  Warning: Computed only for the layered scheme on vegetated and bare soil area -->
+   <field id="CMIP6_ec"            field_ref="evspsblveg"       /> <!-- P1 (kg m-2 s-1) liquid_water_evaporation_flux_from_canopy : Interception evaporation -->
+   <field id="CMIP6_eow"           field_ref="vevapflo"         /> <!-- P1 (kg m-2 s-1) liquid_water_evaporation_flux_from_open_water : Open Water Evaporation -->
+   <field id="CMIP6_es"            field_ref="vevapnu"          /> <!-- P1 (kg m-2 s-1) liquid_water_evaporation_flux_from_soil : Bare soil evaporation -->
+   <field id="CMIP6_esn"           field_ref="vevapsno"         /> <!-- P1 (kg m-2 s-1) liquid_water_evaporation_flux_from_surface_snow : Snow Evaporation -->
+   <field id="CMIP6_et"            field_ref="vevapp"           /> <!-- P1 (kg m-2 s-1) surface_evapotranspiration : Total Evapotranspiration -->
+   <field id="CMIP6_evspsblpot"    field_ref="evapot"           /> <!-- P1 (kg m-2 s-1) water_potential_evaporation_flux : at surface; potential flux of water into the atmosphere due to conversion of both liquid and solid phases to vapor (from underlying surface and vegetation) -->
+   <field id="CMIP6_evspsblsoi"    field_ref="evspsblsoi"       /> <!-- P1 (kg m-2 s-1) water_evaporation_flux_from_soil : Water evaporation from soil (including sublimation). -->
+   <field id="CMIP6_evspsblveg"    field_ref="evspsblveg"       /> <!-- P1 (kg m-2 s-1) water_evaporation_flux_from_canopy : The canopy evaporation and sublimation (if present in model); may include dew formation as a negative flux.Warning: No sublimation here for Orchidee  -->
+   <field id="CMIP6_fAnthDisturb"  field_ref="dummy_XY"         /> <!-- P1 (kg m-2 s-1) surface_upward_mass_flux_of_carbon_dioxide_expressed_as_carbon_due_to_anthrogpogenic_emission : will require some careful definition to make sure we capture everything - any human activity that releases carbon to the atmosphere instead of into product pool goes here. E.g. Deforestation fire, harvest assumed to decompose straight away, grazing... -->
+   <field id="CMIP6_fBNF"          field_ref="dummy_XY"         /> <!-- P1 (kg m-2 s-1) biological_nitrogen_fixation : biological nitrogen fixation -->
+   <field id="CMIP6_fCLandToOcean" field_ref="dummy_XY"         /> <!-- P1 (kg m-2 s-1) carbon_mass_flux_into_ocean_from_rivers : leached carbon etc that goes into run off or river routing and finds its way into ocean should be reported here. -->
+   <field id="CMIP6_fDeforestToAtmos" field_ref="dummy_XY"         /> <!-- P2 (kg m-2 s-1) surface_net_upward_mass_flux_of_carbon_dioxide_expressed_as_carbon_due_to_emission_from_anthropogenic_land_use_change : When land use change results in deforestation of natural vegetation (trees or grasslands) then natural biomass is removed. The treatment of deforested biomass differs significantly across models, but it should be straight-forward to compare deforested biomass across models. -->
+   <field id="CMIP6_fDeforestToProduct" field_ref="dummy_XY"         /> <!-- P1 (kg m-2 s-1) deforested_biomass_into_product_pool_due_to_anthorpogenic_land_use_change : When land use change results in deforestation of natural vegetation (trees or grasslands) then natural biomass is removed. The treatment of deforested biomass differs significantly across models, but it should be straight-forward to compare deforested biomass across models. -->
+   <field id="CMIP6_fFire"         field_ref="dummy_XY"         /> <!-- P1 (kg m-2 s-1) surface_upward_mass_flux_of_carbon_dioxide_expressed_as_carbon_due_to_emission_from_fires_excluding_anthropogenic_land_use_change : CO2 emissions (expressed as a carbon mass flux per unit area) from natural fires and human ignition fires as calculated by the fire module of the dynamic vegetation model, but excluding any CO2 flux from fire included in fLuc (CO2 Flux to Atmosphere from Land Use Change). -->
+   <field id="CMIP6_fFireAll"      field_ref="dummy_XY"         /> <!-- P2 (kg m-2 s-1) fire_CO2_emissions_from_all_sources : Only total fire emissions can be compared to observations. -->
+   <field id="CMIP6_fFireNat"      field_ref="dummy_XY"         /> <!-- P1 (kg m-2 s-1) fire_CO2_emissions_from_wildfire : CO2 emissions from natural fires -->
+   <field id="CMIP6_fGrazing"      field_ref="dummy_XY"         /> <!-- P1 (kg m-2 s-1) surface_upward_mass_flux_of_carbon_dioxide_expressed_as_carbon_due_to_emission_from_grazing : Carbon mass flux per unit area due to grazing on land Warning: variable not provided by ORCHIDEE.-->
+   <field id="CMIP6_fHarvest"      field_ref="fHarvest"         /> <!-- P1 (kg m-2 s-1) surface_upward_mass_flux_of_carbon_dioxide_expressed_as_carbon_due_to_emission_from_crop_harvesting : Carbon mass flux per unit area due to crop harvesting -->
+   <field id="CMIP6_fHarvestToAtmos" field_ref="dummy_XY"         /> <!-- P2 (kg m-2 s-1) surface_upward_mass_flux_of_carbon_dioxide_expressed_as_carbon_due_to_emission_from_crop_harvesting : any harvested carbon that is assumed to decompose immediately into the atmosphere is reported here -->
+   <field id="CMIP6_fHarvestToProduct" field_ref="dummy_XY"         /> <!-- P1 (kg m-2 s-1) harvested_biomass_into_product_pool : be it food or wood harvest, any carbon that is subsequently stored is reported here -->
+   <field id="CMIP6_fLitterFire"   field_ref="dummy_XY"         /> <!-- P2 (kg m-2 s-1) fire_CO2_emissions_from_litter_carbon : Required for unambiguous separation of vegetation and soil + litter turnover times, since total fire flux draws from both sources -->
+   <field id="CMIP6_fLitterSoil"   field_ref="dummy_XY"         /> <!-- P1 (kg m-2 s-1) carbon_mass_flux_into_soil_from_litter : Carbon mass flux per unit area into soil from litter (dead plant material in or above the soil). -->
+   <field id="CMIP6_fLuc"          field_ref="dummy_XY"         /> <!-- P1 (kg m-2 s-1) surface_net_upward_mass_flux_of_carbon_dioxide_expressed_as_carbon_due_to_emission_from_anthropogenic_land_use_change : Carbon mass flux per unit area into atmosphere due to human changes to land (excluding forest regrowth) accounting possibly for different time-scales related to fate of the wood, for example. -->
+   <field id="CMIP6_fLulccAtmLut"  field_ref="dummy_XY"         /> <!-- P1 (kg s-1) surface_upward_mass_flux_of_carbon_dioxide_expressed_as_carbon_direct_to_atmosphere_due_to_anthropogenic_land_use_land_cover_change : This annual mean flux refers to the transfer of carbon directly to the atmosphere due to any land-use or land-cover change activities.  Include carbon transferred due to deforestation or agricultural directly into atmosphere, and  emissions form anthropogenic pools into atmosphere -->
+   <field id="CMIP6_fLulccProductLut" field_ref="dummy_XY"         /> <!-- P1 (kg m-2 s-1) carbon_mass_flux_into_wood_and_agricultural_product_pools_due_to_anthropogenic_land_use_or_land_cover_change : This annual mean flux refers to the transfer of carbon primarily through harvesting land use into anthropogenic product pools, e.g.,deforestation or wood harvestingfrom primary or secondary lands, food harvesting on croplands, harvesting (grazing) by animals on pastures. -->
+   <field id="CMIP6_fLulccResidueLut" field_ref="dummy_XY"         /> <!-- P1 (kg m-2 s-1) carbon_mass_flux_into_soil_and_litter_due_to_anthropogenic_land_use_or_land_cover_change : This annual mean flux refers to the transfer of carbon into soil or litter pools due to any land use or land-cover change activities -->
+   <field id="CMIP6_fN2O"          field_ref="dummy_XY"         /> <!-- P1 (kg m-2 s-1) land_net_n2o_flux : Total land N2O flux -->
+   <field id="CMIP6_fNAnthDisturb" field_ref="dummy_XY"         /> <!-- P1 (kg m-2 s-1) nitrogen_flux_into_atmos_due_to_direct_human_disturbance : will require some careful definition to make sure we capture everything - any human activity that releases nitrogen from land  instead of into product pool goes here. E.g. Deforestation fire, harvest assumed to decompose straight away, grazing... -->
+   <field id="CMIP6_fNLandToOcean" field_ref="dummy_XY"         /> <!-- P1 (kg m-2 s-1) nitrogen_mass_flux_into_ocean_from_rivers : leached nitrogen etc that goes into run off or river routing and finds its way into ocean should be reported here. -->
+   <field id="CMIP6_fNLitterSoil"  field_ref="dummy_XY"         /> <!-- P1 (kg m-2 s-1) nitrogen_mass_flux_into_soil_from_litter : Total Nitrogen Mass Flux from Litter to Soil -->
+   <field id="CMIP6_fNOx"          field_ref="dummy_XY"         /> <!-- P2 (kg m-2 s-1) land_net_nox_flux : Total land NOx flux -->
+   <field id="CMIP6_fNProduct"     field_ref="dummy_XY"         /> <!-- P1 (kg m-2 s-1) nitrogen_mass_flux_to_product_pool_due_to_anthorpogenic_activity : When land use change results in deforestation of natural vegetation (trees or grasslands) then natural biomass is removed. The treatment of deforested biomass differs significantly across models, but it should be straight-forward to compare deforested biomass across models. -->
+   <field id="CMIP6_fNVegLitter"   field_ref="dummy_XY"         /> <!-- P1 (kg m-2 s-1) litter_nitrogen_flux : Total Nitrogen Mass Flux from Vegetation to Litter -->
+   <field id="CMIP6_fNVegSoil"     field_ref="dummy_XY"         /> <!-- P1 (kg m-2 s-1) nitrogen_mass_flux_into_soil_from_vegetation_excluding_litter : In some models part of nitrogen (e.g., root exudate) can go directly into the soil pool without entering litter. -->
+   <field id="CMIP6_fNdep"         field_ref="dummy_XY"         /> <!-- P1 (kg m-2 s-1) deposition_of_nitrogen_onto_land : Dry and Wet Deposition of Reactive Nitrogen onto Land -->
+   <field id="CMIP6_fNfert"        field_ref="dummy_XY"         /> <!-- P1 (kg m-2 s-1) fertiliser_of_nitrogen_onto_land : relative to total land area of a grid cell, not relative to agricultural area -->
+   <field id="CMIP6_fNgas"         field_ref="dummy_XY"         /> <!-- P1 (kg m-2 s-1) land_nitrogen_lost_to_atmosphere : Total Nitrogen lost to the atmosphere (sum of NHx, NOx, N2O, N2) -->
+   <field id="CMIP6_fNgasFire"     field_ref="dummy_XY"         /> <!-- P2 (kg m-2 s-1) land_nitrogen_lost_to_atmosphere_due_to_fire : Total N lost to the atmosphere (including NHx, NOx, N2O, N2) from fire. -->
+   <field id="CMIP6_fNgasNonFire"  field_ref="dummy_XY"         /> <!-- P2 (kg m-2 s-1) land_nitrogen_lost_to_atmosphere_not_due_to_fire : Total N lost to the atmosphere (including NHx, NOx, N2O, N2) from all processes except fire. -->
+   <field id="CMIP6_fNleach"       field_ref="dummy_XY"         /> <!-- P1 (kg m-2 s-1) land_nitrogen_lost_to_leaching : Total N loss to leaching or runoff (sum of ammonium, nitrite and nitrate) -->
+   <field id="CMIP6_fNloss"        field_ref="dummy_XY"         /> <!-- P1 (kg m-2 s-1) land_nitrogen_lost : Not all models split losses into gasesous and leaching -->
+   <field id="CMIP6_fNnetmin"      field_ref="dummy_XY"         /> <!-- P1 (kg m-2 s-1) net_nitrogen_mineralisation : Net nitrogen release from soil and litter as the outcome of nitrogen immobilisation and gross mineralisation -->
+   <field id="CMIP6_fNup"          field_ref="dummy_XY"         /> <!-- P1 (kg m-2 s-1) plant_nitrogen_uptake : total plant nitrogen uptake (sum of ammonium and nitrate), irrespective of the source of nitrogen -->
+   <field id="CMIP6_fProductDecomp" field_ref="dummy_XY"         /> <!-- P1 (kg m-2 s-1) Carbon_flux_out_of_storage_product_pools_into_atmos : Decomposition out of Product Pools to CO2 in Atmosphere -->
+   <field id="CMIP6_fProductDecompLut" field_ref="dummy_XY"         /> <!-- P1 (kg s-1) tendency_of_atmospheric_mass_content_of_carbon_dioxide_expressed_as_carbon_due_to_emission_from_wood_and_agricultural_product_pool : If  a model has explicit anthropogenic product pools by land use tile -->
+   <field id="CMIP6_fVegFire"      field_ref="dummy_XY"         /> <!-- P2 (kg m-2 s-1) fire_CO2_emissions_from_vegetation_carbon : Required for unambiguous separation of vegetation and soil + litter turnover times, since total fire flux draws from both sources -->
+   <field id="CMIP6_fVegLitter"    field_ref="dummy_XY"         /> <!-- P1 (kg m-2 s-1) litter_carbon_flux : unset -->
+   <field id="CMIP6_fVegLitterMortality" field_ref="dummy_XY"         /> <!-- P2 (kg m-2 s-1) mortality_litter_carbon_flux : needed to separate changing vegetation C turnover times resulting from changing allocation versus changing mortality -->
+   <field id="CMIP6_fVegLitterSenescence" field_ref="dummy_XY"         /> <!-- P2 (kg m-2 s-1) senescence_litter_carbon_flux : needed to separate changing vegetation C turnover times resulting from changing allocation versus changing mortality -->
+   <field id="CMIP6_fVegSoil"      field_ref="dummy_XY"         /> <!-- P1 (kg m-2 s-1) carbon_mass_flux_into_soil_from_vegetation_excluding_litter : Carbon mass flux per unit area from vegetation directly into soil, without intermediate conversion to litter.  Warning: variable not provided by ORCHIDEE.-->
+   <field id="CMIP6_fVegSoilMortality" field_ref="dummy_XY"         /> <!-- P2 (kg m-2 s-1) mortality_vegtosoil_carbon_flux : needed to separate changing vegetation C turnover times resulting from changing allocation versus changing mortality -->
+   <field id="CMIP6_fVegSoilSenescence" field_ref="dummy_XY"         /> <!-- P2 (kg m-2 s-1) senescence_vegtosoil_carbon_flux : needed to separate changing vegetation C turnover times resulting from changing allocation versus changing mortality -->
+   <field id="CMIP6_fahLut"        field_ref="dummy_XY"         /> <!-- P1 (W m-2) surface_upward_heat_flux_due_to_anthropogenic_energy_consumption : Anthropogenic heat flux generated from non-renewable human primary energy consumption, including energy use by vehicles, commercial and residential buildings, industry, and power plants.  Primary energy refers to energy in natural resources, fossil and nonfossil, before conversion into other forms, such as electricity. -->
+   <field id="CMIP6_fldcapacity"   field_ref="dummy_XYSo"       /> <!-- P1 (%) missing : Field Capacity Warning: AD will do it in link with SPMIP -->
+   <field id="CMIP6_fracInLut"     field_ref="dummy_XY"         /> <!-- P1 (%) area_fraction : cumulative fractional transitions over the year; note that fraction should be reported as fraction of atmospheric grid cell -->
+   <field id="CMIP6_fracLut"       field_ref="dummy_XY"         /> <!-- P1 (%) area_fraction : end of year values (not annual mean); note that fraction should be reported as fraction of land grid cell (example: frac_lnd = 0.5, frac_ocn = 0.5, frac_crop_lnd = 0.2 (of land portion of grid cell), then frac_lut(crop) = 0.5*0.2 = 0.1) -->
+   <field id="CMIP6_fracOutLut"    field_ref="dummy_XY"         /> <!-- P1 (%) area_fraction : cumulative fractional transitions over the year; note that fraction should be reported as fraction of atmospheric grid cell -->
+   <field id="CMIP6_gpp"           field_ref="gpp_ipcc2"        /> <!-- P1 (kg m-2 s-1) gross_primary_productivity_of_biomass_expressed_as_carbon : unset Warning: gpp_ipcc and GPP to be deleted in ORCHIDEE stompate_lpj because duplications.  -->
+   <field id="CMIP6_gppGrass"      field_ref="dummy_XY"         /> <!-- P2 (kg m-2 s-1) gross_primary_productivity_of_biomass_expressed_as_carbon : Total GPP of grass in the gridcell -->
+   <field id="CMIP6_gppLut"        field_ref="dummy_XY"         /> <!-- P1 (kg m-2 s-1) gross_primary_productivity_of_biomass_expressed_as_carbon : gross primary productivity on land use tile -->
+   <field id="CMIP6_gppShrub"      field_ref="dummy_XY"         /> <!-- P2 (kg m-2 s-1) gross_primary_productivity_of_biomass_expressed_as_carbon : Total GPP of shrubs in the gridcell -->
+   <field id="CMIP6_gppTree"       field_ref="dummy_XY"         /> <!-- P2 (kg m-2 s-1) gross_primary_productivity_of_biomass_expressed_as_carbon : Total GPP of trees in the gridcell -->
+   <field id="CMIP6_gppc13"        field_ref="dummy_XY"         /> <!-- P2 (kg m-2 s-1) gross_primary_productivity_of_c13 : Mass Flux of 13C out of Atmosphere due to Gross Primary Production on Land -->
+   <field id="CMIP6_gppc14"        field_ref="dummy_XY"         /> <!-- P2 (kg m-2 s-1) gross_primary_productivity_of_c14 : Mass Flux of 14C out of Atmosphere due to Gross Primary Production on Land -->
+   <field id="CMIP6_grassFrac"     field_ref="dummy_XY"         /> <!-- P1 (%) area_fraction : Percentage of entire grid cell that is covered by natural grass. -->
+   <field id="CMIP6_grassFracC3"   field_ref="dummy_XY"         /> <!-- P1 (%) area_fraction : Fraction of entire grid cell covered by C3 grass. -->
+   <field id="CMIP6_grassFracC4"   field_ref="dummy_XY"         /> <!-- P1 (%) area_fraction : Fraction of entire grid cell covered by C4 grass. -->
+   <field id="CMIP6_hfdsn"         field_ref="snowflxtot"       /> <!-- P1 (W m-2) surface_downward_heat_flux_in_snow : the net downward heat flux from the atmosphere into the snow that lies on land divided by the land area in the grid cell; reported as 0.0 for snow-free land regions or where the land fraction is 0. -->
+   <field id="CMIP6_hflsLut"       field_ref="fluxlat"          /> <!-- P1 (W m-2) surface_upward_latent_heat_flux : latent heat flux on land use tile Warning: 'land use tile' seems to be all PFTs and no nobio, but fluxlat is for the whole grid cell. -->
+   <field id="CMIP6_hfssLut"       field_ref="fluxsens"         /> <!-- P1 (W m-2) surface_upward_sensible_heat_flux : sensible heat flux on land use tile Warning: 'land use tile' seems to be all PFTs and no nobio, but fluxsens is for the whole grid cell. -->
+   <field id="CMIP6_hussLut"       field_ref="q2m"              /> <!-- P1 (1.0) specific_humidity : Normally, the specific humidity should be reported at the 2 meter height -->
+   <field id="CMIP6_irrLut"        field_ref="dummy_XY"         /> <!-- P1 (kg s-1) surface_downward_water_flux_due_to_irrigation : Irrigation flux including any irrigation for crops, trees, pasture, or urban lawns -->
+   <field id="CMIP6_ksat"          field_ref="ksat"             /> <!-- P1 (1e-6 m s-1) missing : Saturated Hydraulic Conductivity -->
+   <field id="CMIP6_lai"           field_ref="lai_ipcc"         /> <!-- P1 (1.0) leaf_area_index : Leaf Area Index  Warning: here we take the average over the entire land fraction; not sure it's ok with the DataRequest comment "a ratio obtained by dividing the total upper leaf surface area of vegetation by the (horizontal) surface area of the land on which it grows." PC+JG : lai_ipcc and laimean are related to the same land fraction(note veget_max in stomate_lpj is not the same veget_max in sechiba!). We see other differencies between these output variables coming mainly from pft3 and some from 6,8,9,12. -->
+   <field id="CMIP6_laiLut"        field_ref="dummy_XY"         /> <!-- P1 (1.0) missing : Note that if tile does not model lai, for example, on the urban tile, then should be reported as missing value -->
+   <field id="CMIP6_landCoverFrac" field_ref="landCoverFrac"    /> <!-- P1 (%) area_fraction : Percentage of grid cell area occupied by different model vegetation/land cover categories. The categories may differ from model to model, depending on each model's subgrid land cover category definitions. Categories may include natural vegetation, anthropogenic vegetation, bare soil, lakes, urban areas, glaciers, etc. Sum of all should equal the fraction of the grid-cell that is land. Warning: Note: here not multiplying by contfrac according to DR -->
+   <field id="CMIP6_lwsnl"         field_ref="snowliqtot"       /> <!-- P1 (kg m-2) liquid_water_content_of_snow_layer : The total mass of liquid water contained interstitially within the whole depth of the snow layer of the land portion of a grid cell divided by the area of the land portion of the cell.  Warning: Computed only for the layered scheme on vegetated and bare soil area. Warning: Does the mention 'divided by the area of the land portion of the cell' means we have to multiply by contfrac? -->
+   <field id="CMIP6_mrfso"         field_ref="humtot_frozen"    /> <!-- P1 (kg m-2) soil_frozen_water_content : The mass per unit area (summed over all model layers) of frozen water.  Warning: To be calculated. -->
+   <field id="CMIP6_mrfsofr"       field_ref="profil_froz_hydro"/> <!-- P1 (1.0) mass_fraction_of_frozen_water_in_soil_moisture : Fraction of soil moisture mass in the solid phase in each user-defined soil layer (3D variable) -->
+   <field id="CMIP6_mrlqso"        field_ref="profil_liquid_hydro"    /> <!-- P1 (1.0) mass_fraction_of_unfrozen_water_in_soil_moisture : Fraction of soil moisture mass in the liquid phase in each user-defined soil layer (3D variable) -->
+   <field id="CMIP6_mrlso"         field_ref="humtot_liquid"    /> <!-- P1 (kg m-2) soil_liquid_water_content : the mass (summed over all all layers) of liquid water. -->
+   <field id="CMIP6_mrro"          field_ref="mrro"             /> <!-- P1 (kg m-2 s-1) runoff_flux : The total run-off (including drainage through the base of the soil model) per unit area leaving the land portion of the grid cell. -->
+   <field id="CMIP6_mrroLut"       field_ref="dummy_XY"         /> <!-- P1 (kg m-2 s-1) runoff_flux : the total runoff (including "drainage" through the base of the soil model) leaving the land use tile portion of the grid cell -->
+   <field id="CMIP6_mrrob"         field_ref="drainage"         /> <!-- P1 (kg m-2 s-1) subsurface_runoff_flux : Subsurface runoff -->
+   <field id="CMIP6_mrros"         field_ref="runoff"           /> <!-- P1 (kg m-2 s-1) surface_runoff_flux : The total surface run off leaving the land portion of the grid cell (excluding drainage through the base of the soil model). -->
+   <field id="CMIP6_mrsfl"         field_ref="soilmoist_frozen" /> <!-- P1 (kg m-2) frozen_moisture_content_of_soil_layer : in each soil layer, the mass of water in ice phase.  Reported as "missing" for grid cells occupied entirely by "sea" -->
+   <field id="CMIP6_mrsll"         field_ref="soilmoist_liquid" /> <!-- P1 (kg m-2) liquid_moisture_content_of_soil_layer : in each soil layer, the mass of water in liquid phase.  Reported as "missing" for grid cells occupied entirely by "sea" -->
+   <field id="CMIP6_mrso"          field_ref="humtot"           /> <!-- P1 (kg m-2) soil_moisture_content : the mass per unit area  (summed over all soil layers) of water in all phases. -->
+   <field id="CMIP6_mrsoLut"       field_ref="dummy_XY"         /> <!-- P1 (kg m-2) soil_moisture_content : Total soil moisture -->
+   <field id="CMIP6_mrsofc"        field_ref="dummy_XY"         /> <!-- P1 (kg m-2) soil_moisture_content_at_field_capacity : The bulk water content retained by the soil at -33 J/kg of suction pressure, expressed as mass per unit land area; report as missing where there is no land  Warning: AD will do it in link with SPMIP" -->
+   <field id="CMIP6_mrsol"         field_ref="soilmoist"        /> <!-- P1 (kg m-2) moisture_content_of_soil_layer : in each soil layer, the mass of water in all phases, including ice.  Reported as "missing" for grid cells occupied entirely by "sea" -->
+   <field id="CMIP6_mrsos"         field_ref="humtot_top"       /> <!-- P1 (kg m-2) moisture_content_of_soil_layer : The mass of water in all phases in the upper 10cm of the  soil layer. -->
+   <field id="CMIP6_mrsosLut"      field_ref="dummy_XY"         /> <!-- P1 (kg m-2) moisture_content_of_soil_layer : the mass of water in all phases in a thin surface layer; integrate over uppermost 10cm -->
+   <field id="CMIP6_mrsow"         field_ref="mrsow"            /> <!-- P1 (1.0) volume_fraction_of_condensed_water_in_soil_at_field_capacity : Vertically integrated soil moisture divided by maximum allowable soil moisture above wilting point. Warning: weird mention to field capacity in the description, overlooked.  -->
+   <field id="CMIP6_mrtws"         field_ref="tws"              /> <!-- P2 (kg m-2) total_water_storage : Mass of water in all phases and in all components including soil, canopy, vegetation, ice sheets, rivers and ground water. Warning: this seems to be a duplication of CMIP6_tws  -->
+   <field id="CMIP6_nLand"         field_ref="dummy_XY"         /> <!-- P1 (kg m-2) total_land_nitrogen : Report missing data over ocean grid cells. For fractional land report value averaged over the land fraction. -->
+   <field id="CMIP6_nLeaf"         field_ref="dummy_XY"         /> <!-- P2 (kg m-2) leaf_nitrogen_content : Nitrogen Mass in Leaves -->
+   <field id="CMIP6_nLitter"       field_ref="dummy_XY"         /> <!-- P1 (kg m-2) litter_nitrogen_content : Report missing data over ocean grid cells. For fractional land report value averaged over the land fraction. -->
+   <field id="CMIP6_nLitterCwd"    field_ref="dummy_XY"         /> <!-- P2 (kg m-2) litter_wood_debris_nitrogen_content : Nitrogen Mass in Coarse Woody Debris -->
+   <field id="CMIP6_nLitterSubSurf" field_ref="dummy_XY"         /> <!-- P2 (kg m-2) subsurface_litter_nitrogen_content : Nitrogen Mass in below ground litter (non CWD) -->
+   <field id="CMIP6_nLitterSurf"   field_ref="dummy_XY"         /> <!-- P2 (kg m-2) surface_litter_nitrogen_content : Nitrogen Mass in above ground litter (non CWD) -->
+   <field id="CMIP6_nMineral"      field_ref="dummy_XY"         /> <!-- P1 (kg m-2) mineral_soil_nitrogen_content : SUM of ammonium, nitrite, nitrate, etc over all soil layers -->
+   <field id="CMIP6_nMineralNH4"   field_ref="dummy_XY"         /> <!-- P2 (kg m-2) mineral_nh4_soil_nitrogen_content : SUM of ammonium over all soil layers -->
+   <field id="CMIP6_nMineralNO3"   field_ref="dummy_XY"         /> <!-- P2 (kg m-2) mineral_no3_soil_nitrogen_content : SUM of nitrate over all soil layers -->
+   <field id="CMIP6_nOther"        field_ref="dummy_XY"         /> <!-- P2 (kg m-2) other_vegegtation_components_nitrogen_content : E.g. fruits, seeds, etc. -->
+   <field id="CMIP6_nProduct"      field_ref="dummy_XY"         /> <!-- P1 (kg m-2) nitrogen_content_of_products_of_anthropogenic_land_use_change : Report missing data over ocean grid cells. For fractional land report value averaged over the land fraction. -->
+   <field id="CMIP6_nRoot"         field_ref="dummy_XY"         /> <!-- P2 (kg m-2) root_nitrogen_content : including fine and coarse roots. -->
+   <field id="CMIP6_nSoil"         field_ref="dummy_XY"         /> <!-- P1 (kg m-2) soil_nitrogen_content : Report missing data over ocean grid cells. For fractional land report value averaged over the land fraction. -->
+   <field id="CMIP6_nStem"         field_ref="dummy_XY"         /> <!-- P2 (kg m-2) stem_nitrogen_content : including sapwood and hardwood. -->
+   <field id="CMIP6_nVeg"          field_ref="dummy_XY"         /> <!-- P1 (kg m-2) vegetation_nitrogen_content : Report missing data over ocean grid cells. For fractional land report value averaged over the land fraction. -->
+   <field id="CMIP6_nbp"           field_ref="dummy_XY"         /> <!-- P1 (kg m-2 s-1) surface_net_downward_mass_flux_of_carbon_dioxide_expressed_as_carbon_due_to_all_land_processes : This is the net mass flux of carbon from atmosphere into land, calculated as photosynthesis MINUS the sum of  plant and soil respiration, carbon fluxes from fire, harvest, grazing  and land use change. Positive flux is into the land. -->
+   <field id="CMIP6_necbLut"       field_ref="dummy_XY"         /> <!-- P1 (kg m-2 s-1) surface_net_downward_mass_flux_of_carbon_dioxide_expressed_as_carbon_due_to_all_land_processes : Computed as npp minus heterotrophic respiration minus fire minus C leaching minus harvesting/clearing. Positive rate is into the land, negative rate is from the land.  Do not include fluxes from anthropogenic product pools to atmosphere -->
+   <field id="CMIP6_nep"           field_ref="nep"              /> <!-- P1 (kg m-2 s-1) surface_net_downward_mass_flux_of_carbon_dioxide_expressed_as_carbon_due_to_all_land_processes_excluding_anthropogenic_land_use_change : Natural flux of CO2 (expressed as a mass flux of carbon) from the atmosphere to the land calculated as the difference between uptake associated will photosynthesis and the release of CO2 from the sum of plant and soil respiration and fire.  Positive flux is into the land.  emissions from natural fires and human ignition fires as calculated by the fire module of the dynamic vegetation model, but excluding any CO2 flux from fire included in fLuc (CO2 Flux to Atmosphere from Land Use Change). -->
+   <field id="CMIP6_netAtmosLandC13Flux" field_ref="dummy_XY"         /> <!-- P2 (kg m-2 s-1) net_atmos_to_land_C13_flux : Net Mass Flux of 13C between atmosphere and land (positive into land) as a result of all processes. -->
+   <field id="CMIP6_netAtmosLandC14Flux" field_ref="dummy_XY"         /> <!-- P2 (kg m-2 s-1) net_atmos_to_land_C14_flux : Net Mass Flux of 14C between atmosphere and land (positive into land) as a result of all processes. -->
+   <field id="CMIP6_netAtmosLandCO2Flux" field_ref="dummy_XY"         /> <!-- P1 (kg m-2 s-1) surface_net_downward_mass_flux_of_carbon_dioxide_expressed_as_carbon_due_to_all_land_processes : This flux should be reproducible by differencing the sum of all carbon pools (cVeg, cLitter, cSoil, and cProducts or equivalently cLand) from one time step to the next, except in the case of lateral transfer of carbon due to harvest, riverine transport of dissolved organic and/or inorganic carbon, or any other process (in which case the lateral_carbon_transfer_over_land term, see below, will be zero data). -->
+   <field id="CMIP6_npp"           field_ref="dummy_XY"         /> <!-- P1 (kg m-2 s-1) net_primary_productivity_of_biomass_expressed_as_carbon : unset -->
+   <field id="CMIP6_nppGrass"      field_ref="dummy_XY"         /> <!-- P2 (kg m-2 s-1) net_primary_productivity_of_biomass_expressed_as_carbon : Total NPP of grass in the gridcell -->
+   <field id="CMIP6_nppLeaf"       field_ref="dummy_XY"         /> <!-- P1 (kg m-2 s-1) net_primary_productivity_of_carbon_accumulated_in_leaves : This is the rate of carbon uptake by leaves due to NPP -->
+   <field id="CMIP6_nppLut"        field_ref="dummy_XY"         /> <!-- P1 (kg m-2 s-1) net_primary_productivity_of_biomass_expressed_as_carbon : net primary productivity on land use tile -->
+   <field id="CMIP6_nppOther"      field_ref="dummy_XY"         /> <!-- P2 (kg m-2 s-1) net_primary_production_allocated_to_other : added for completeness with npp_root -->
+   <field id="CMIP6_nppRoot"       field_ref="dummy_XY"         /> <!-- P1 (kg m-2 s-1) net_primary_productivity_of_carbon_accumulated_in_roots : This is the rate of carbon uptake by roots due to NPP -->
+   <field id="CMIP6_nppShrub"      field_ref="dummy_XY"         /> <!-- P2 (kg m-2 s-1) net_primary_productivity_of_biomass_expressed_as_carbon : Total NPP of shrubs in the gridcell -->
+   <field id="CMIP6_nppStem"       field_ref="dummy_XY"         /> <!-- P2 (kg m-2 s-1) net_primary_production_allocated_to_stem : added for completeness with npp_root -->
+   <field id="CMIP6_nppTree"       field_ref="dummy_XY"         /> <!-- P2 (kg m-2 s-1) net_primary_productivity_of_biomass_expressed_as_carbon : Total NPP of trees in the gridcell -->
+   <field id="CMIP6_nppWood"       field_ref="dummy_XY"         /> <!-- P1 (kg m-2 s-1) net_primary_productivity_of_carbon_accumulated_in_wood : This is the rate of carbon uptake by wood due to NPP -->
+   <field id="CMIP6_nudgincsm"     field_ref="nudgincsm"        /> <!-- P1 (kg m-2) nudging_increment_in_water_content_of_soil_layer : Nudging Increment of Water in Soil Moisture -->
+   <field id="CMIP6_nudgincswe"    field_ref="nudgincswe"       /> <!-- P1 (kg m-2) nudging_increment_in_surface_snow_and_ice_amount : Nudging Increment of Water in Snow -->
+   <field id="CMIP6_nwdFracLut"    field_ref="dummy_XY"         /> <!-- P1 (1) missing : fraction of land use tile tile that is non-woody vegetation ( e.g. herbaceous crops) -->
+   <field id="CMIP6_orog"          field_ref="dummy_XY"         /> <!-- P1 (m) surface_altitude : The surface called "surface" means the lower boundary of the atmosphere. Altitude is the (geometric) height above the geoid, which is the reference geopotential surface. The geoid is similar to mean sea level. -->
+   <field id="CMIP6_pastureFrac"   field_ref="dummy_XY"         /> <!-- P1 (%) area_fraction : Percentage of entire grid cell  that is covered by anthropogenic pasture. Warning: variable not provided by ORCHIDEE.  -->
+   <field id="CMIP6_pastureFracC3" field_ref="dummy_XY"         /> <!-- P2 (%) area_fraction : Percentage of entire grid cell covered by C3 pasture Warning: variable not provided by ORCHIDEE. -->
+   <field id="CMIP6_pastureFracC4" field_ref="dummy_XY"         /> <!-- P2 (%) area_fraction : Percentage of entire grid cell covered by C4 pasture Warning: variable not provided by ORCHIDEE. -->
+   <field id="CMIP6_pflw"          field_ref="dummy_XY"         /> <!-- P3 (kg m-2) liquid_water_content_of_permafrost_layer : *where land over land*, i.e., this is the total mass of liquid water contained within the permafrost layer within the land portion of a grid cell divided by the area of the land portion of the cell. -->
+   <field id="CMIP6_prveg"         field_ref="dummy_XY"         /> <!-- P1 (kg m-2 s-1) precipitation_flux_onto_canopy : The precipitation flux that is intercepted by the vegetation canopy (if present in model) before reaching the ground. -->
+   <field id="CMIP6_qgwr"          field_ref="drainage"         /> <!-- P1 (kg m-2 s-1) water_flux_from_soil_layer_to_groundwater : Groundwater recharge from soil layer  Warning: It can be either undef or drainage. We take the second option for the moment.  -->
+   <field id="CMIP6_rGrowth"       field_ref="dummy_XY"         /> <!-- P1 (kg m-2 s-1) surface_upward_carbon_mass_flux_due_to_plant_respiration_for_biomass_growth : unset Warning: to be consistent with ra forumlation and output freq -->
+   <field id="CMIP6_rMaint"        field_ref="dummy_XY"         /> <!-- P1 (kg m-2 s-1) surface_upward_carbon_mass_flux_due_to_plant_respiration_for_biomass_maintenance : unset Warning: to be consistent with ra forumlation and output freq -->
+   <field id="CMIP6_ra"            field_ref="dummy_XY"         /> <!-- P1 (kg m-2 s-1) plant_respiration_carbon_flux : Carbon mass flux per unit area into atmosphere due to autotrophic respiration on land (respiration by producers) [see rh for heterotrophic production] Warning:  Issue with duplicated variables resp_maint, resp_growth from sechiba and stomate but they are calculated differently. We here need the sechiba variable for 3h freq output. -->
+   <field id="CMIP6_raGrass"       field_ref="dummy_XY"         /> <!-- P2 (kg m-2 s-1) plant_respiration_carbon_flux : Total RA of grass in the gridcell -->
+   <field id="CMIP6_raLeaf"        field_ref="dummy_XY"         /> <!-- P2 (kg m-2 s-1) autotrophic_respiration_from_leaves : added for completeness with Ra_root -->
+   <field id="CMIP6_raLut"         field_ref="dummy_XY"         /> <!-- P1 (kg m-2 s-1) plant_respiration_carbon_flux : plant respiration on land use tile -->
+   <field id="CMIP6_raOther"       field_ref="dummy_XY"         /> <!-- P2 (kg m-2 s-1) autotrophic_respiration : added for completeness with Ra_root -->
+   <field id="CMIP6_raRoot"        field_ref="dummy_XY"         /> <!-- P2 (kg m-2 s-1) autotrophic_respiration_from_roots : Total autotrophic respiration from all belowground plant parts.  This has benchmarking value because the sum of Rh and root respiration can be compared to observations of total soil respiration. -->
+   <field id="CMIP6_raShrub"       field_ref="dummy_XY"         /> <!-- P2 (kg m-2 s-1) plant_respiration_carbon_flux : Total RA of shrubs in the gridcell -->
+   <field id="CMIP6_raStem"        field_ref="dummy_XY"         /> <!-- P2 (kg m-2 s-1) autotrophic_respiration_from_stem : added for completeness with Ra_root -->
+   <field id="CMIP6_raTree"        field_ref="dummy_XY"         /> <!-- P2 (kg m-2 s-1) plant_respiration_carbon_flux : Total RA of trees in the gridcell -->
+   <field id="CMIP6_rac13"         field_ref="dummy_XY"         /> <!-- P2 (kg m-2 s-1) plant_respiration_c13_flux : Mass Flux of 13C into Atmosphere due to Autotrophic (Plant) Respiration on Land -->
+   <field id="CMIP6_rac14"         field_ref="dummy_XY"         /> <!-- P2 (kg m-2 s-1) plant_respiration_c14_flux : Mass Flux of 14C into Atmosphere due to Autotrophic (Plant) Respiration on Land -->
+   <field id="CMIP6_residualFrac"  field_ref="residualFrac"     /> <!-- P1 (%) area_fraction : Percentage of entire grid cell  that is land and is covered by  neither vegetation nor bare-soil (e.g., urban, ice, lakes, etc.) -->
+   <field id="CMIP6_rh"            field_ref="dummy_XY"         /> <!-- P1 (kg m-2 s-1) heterotrophic_respiration_carbon_flux : Carbon mass flux per unit area into atmosphere due to heterotrophic respiration on land (respiration by consumers) Warning:  Issue with duplicated variables resp_hetero from sechiba and stomate but they are calculated differently. We here need the sechiba variable for 3h freq output. -->
+   <field id="CMIP6_rhGrass"       field_ref="dummy_XY"         /> <!-- P2 (kg m-2 s-1) heterotrophic_respiration_carbon_flux : Total RH of grass in the gridcell -->
+   <field id="CMIP6_rhLitter"      field_ref="dummy_XY"         /> <!-- P2 (kg m-2 s-1) heterotrophic_respiration_carbon_flux_from_litter : Needed to calculate litter bulk turnover time. Includes respiration from CWD as well. -->
+   <field id="CMIP6_rhLut"         field_ref="dummy_XY"         /> <!-- P1 (kg m-2 s-1) heterotrophic_respiration_carbon_flux : soil heterotrophic respiration on land use tile -->
+   <field id="CMIP6_rhShrub"       field_ref="dummy_XY"         /> <!-- P2 (kg m-2 s-1) heterotrophic_respiration_carbon_flux : Total RH of shrubs in the gridcell -->
+   <field id="CMIP6_rhSoil"        field_ref="dummy_XY"         /> <!-- P2 (kg m-2 s-1) heterotrophic_respiration_carbon_flux_from_soil : Needed to calculate soil bulk turnover time -->
+   <field id="CMIP6_rhTree"        field_ref="dummy_XY"         /> <!-- P2 (kg m-2 s-1) heterotrophic_respiration_carbon_flux : Total RH of trees in the gridcell -->
+   <field id="CMIP6_rhc13"         field_ref="dummy_XY"         /> <!-- P2 (kg m-2 s-1) heterotrophic_respiration_c13_flux : Mass Flux of 13C into Atmosphere due to Heterotrophic Respiration on Land -->
+   <field id="CMIP6_rhc14"         field_ref="dummy_XY"         /> <!-- P2 (kg m-2 s-1) heterotrophic_respiration_c14_flux : Mass Flux of 14C into Atmosphere due to Heterotrophic Respiration on Land -->
+   <field id="CMIP6_rivi"          field_ref="dummy_XY"         /> <!-- P1 (m3 s-1) water_flux_from_upstream : Inflow of River Water into Cell  Warning: Orchidee will not output this variable. -->
+   <field id="CMIP6_rivo"          field_ref="hydrographs"      /> <!-- P1 (m3 s-1) water_flux_to_downstream : Outflow of River Water from Cell -->
+   <field id="CMIP6_rlusLut"       field_ref="dummy_XY"         /> <!-- P1 (W m-2) surface_upwelling_longwave_flux_in_air : Surface Upwelling Longwave on Land Use Tile -->
+   <field id="CMIP6_rootd"         field_ref="zmaxh"            /> <!-- P1 (m) root_depth : report the maximum soil depth reachable by plant roots (if defined in model), i.e., the maximum soil depth from which they can extract moisture; report as *missing* where the land fraction is 0. -->
+   <field id="CMIP6_rootdsl"       field_ref="nroot"            /> <!-- P1 (kg m-3) missing : Root Distribution Warning: It's a relative root density per layer in Orchidee with no dimension.  -->
+   <field id="CMIP6_rsusLut"       field_ref="dummy_XY"         /> <!-- P1 (W m-2) surface_upwelling_shortwave_flux_in_air : Surface Upwelling Shortwave  on Land Use Tile -->
+   <field id="CMIP6_rzwc"          field_ref="humtot"           /> <!-- P1 (kg m-2) water_content_of_root_zone : Root zone soil moisture -->
+   <field id="CMIP6_sandfrac"      field_ref="dummy_XYSo"       /> <!-- P1 (1.0) missing : Sand Fraction -->
+   <field id="CMIP6_sftgif"        field_ref="dummy_XY"         /> <!-- P1 (%) land_ice_area_fraction : Fraction of grid cell covered by land ice (ice sheet, ice shelf, ice cap, glacier) -->
+   <field id="CMIP6_shrubFrac"     field_ref="dummy_XY"         /> <!-- P2 (%) area_fraction : Percentage of entire grid cell  that is covered by shrub. Warning: variable not provided by ORCHIDEE. -->
+   <field id="CMIP6_slthick"       field_ref="dlh"              /> <!-- P1 (m) missing : Thickness of Soil Layers -->
+   <field id="CMIP6_snc"           field_ref="frac_snow"        /> <!-- P1 (%) surface_snow_area_fraction : Fraction of each grid cell that is occupied by snow that rests on land portion of cell. -->
+   <field id="CMIP6_snd"           field_ref="snowdepth"         /> <!-- P1 (m) surface_snow_thickness : where land over land, this is computed as the mean thickness of snow in the land portion of the grid cell (averaging over the entire land portion, including the snow-free fraction).  Reported as 0.0 where the land fraction is 0. Warning: Computed and weigthed only for the layered scheme on vegetated and bare soil area. -->
+   <field id="CMIP6_snm_land"      field_ref="dummy_XY"         /> <!-- P1 (kg m-2 s-1) surface_snow_melt_flux : The total surface snow melt rate on the land portion of the grid cell divided by the land area in the grid cell; report as zero for snow-free land regions and missing where there is no land. Warning: Does the mention 'divided by the area of the land portion of the cell' means we have to multiply by contfrac? totmelt ? -->
+   <field id="CMIP6_snw"           field_ref="dummy_XY"         /> <!-- P3 (kg m-2) surface_snow_amount : The mass of surface snow on the land portion of the grid cell divided by the land area in the grid cell; reported as missing where the land fraction is 0; excludes snow on vegetation canopy or on sea ice.  Warning: This field is the same as the one above: CMIP6_snw. snow ? -->
+   <field id="CMIP6_sootsn"        field_ref="dummy_XY"         /> <!-- P1 (kg m-2) soot_content_of_surface_snow : the entire land portion of the grid cell is considered, with snow soot content set to 0.0 in regions free of snow. Warning: not computed because the process is not present in ORCHIDEE. -->
+   <field id="CMIP6_sw"            field_ref="surfwater"        /> <!-- P1 (kg m-2) surface_water_amount_assuming_no_snow : Total liquid water storage, other than soil, snow or interception storage (i.e. lakes, river channel or depression storage). Warning: includes the fast reservoire   -->
+   <field id="CMIP6_sweLut"        field_ref="dummy_XY"         /> <!-- P1 (m) missing : snow water equivalent on land use tile  Warning: 'land use tile' seems to be all PFTs and no nobio. -->
+   <field id="CMIP6_tSoilPools"    field_ref="dummy_XY"         /> <!-- P2 (s-1) soil_carbon_turnover_rate_by_pool : defined as 1/(turnover time) for each soil pool. Use the same pools reported under cSoilPools -->
+   <field id="CMIP6_tasLut"        field_ref="dummy_XY"         /> <!-- P1 (K) air_temperature : near-surface air temperature (2m above displacement height, i.e. t_ref) on land use tile -->
+   <field id="CMIP6_tasLut"        field_ref="dummy_XY"         /> <!-- P1 (K) air_temperature : near-surface air temperature (2m above displacement height, i.e. t_ref) on land use tile -->
+   <field id="CMIP6_tcs"           field_ref="dummy_XY"         /> <!-- P1 (K) canopy_temperature : Vegetation temperature, averaged over all vegetation types -->
+   <field id="CMIP6_tgs"           field_ref="dummy_XY"         /> <!-- P1 (K) surface_temperature : Surface bare soil temperature -->
+   <field id="CMIP6_tpf"           field_ref="dummy_XY"         /> <!-- P3 (m) permafrost_layer_thickness : The mean thickness of the permafrost layer in the land portion of the grid cell.  Reported as zero in permafrost-free regions. Warning: not yet computed but maybe doable following MICT -->
+   <field id="CMIP6_tran"          field_ref="tran"             /> <!-- P1 (kg m-2 s-1) transpiration_flux : Transpiration (may include dew formation as a negative flux). -->
+   <field id="CMIP6_treeFrac"      field_ref="dummy_XY"         /> <!-- P2 (%) area_fraction : Percentage of entire grid cell  that is covered by trees. -->
+   <field id="CMIP6_treeFracBdlDcd" field_ref="dummy_XY"         /> <!-- P1 (%) area_fraction : This is the fraction of the entire grid cell  that is covered by broadleaf deciduous trees. -->
+   <field id="CMIP6_treeFracBdlEvg" field_ref="dummy_XY"         /> <!-- P1 (%) area_fraction : This is the fraction of the entire grid cell  that is covered by broadleaf evergreen trees. -->
+   <field id="CMIP6_treeFracNdlDcd" field_ref="dummy_XY"         /> <!-- P1 (%) area_fraction : This is the fraction of the entire grid cell  that is covered by needleleaf deciduous trees. -->
+   <field id="CMIP6_treeFracNdlEvg" field_ref="dummy_XY"         /> <!-- P1 (%) area_fraction : This is the fraction of the entire grid cell  that is covered by needleleaf evergreen trees. -->
+   <field id="CMIP6_treeFracPrimDec" field_ref="dummy_XY"         /> <!-- P1 (%) area_fraction : Percentage of the entire grid cell  that is covered by total primary deciduous trees.  Warning: We will here take the variable from stomate_lpj but first it needs to be multiplied by contfrac in the code to be consistent with DR -->
+   <field id="CMIP6_treeFracPrimEver" field_ref="dummy_XY"         /> <!-- P1 (%) area_fraction : Percentage of entire grid cell  that is covered by primary evergreen trees. Warning: We will here take the variable from stomate_lpj but first it needs to be multiplied by contfrac in the code to be consistent with DR -->
+   <field id="CMIP6_treeFracSecDec" field_ref="dummy_XY"         /> <!-- P1 (%) area_fraction : Percentage of entire grid cell  that is covered by secondary deciduous trees.  Warning: variable not provided by ORCHIDEE. -->
+   <field id="CMIP6_treeFracSecEver" field_ref="dummy_XY"         /> <!-- P1 (%) area_fraction : Percentage of entire grid cell  that is covered by secondary evergreen trees. Warning: variable not provided by ORCHIDEE. -->
+   <field id="CMIP6_tsl"           field_ref="ptn"               /> <!-- P1 (K) soil_temperature : Temperature of each soil layer. Reported as missing for grid cells with no land. -->
+   <field id="CMIP6_tslsi"         field_ref="dummy_XY"         /> <!-- P1 (K) surface_temperature : Surface temperature of all surfaces except open ocean. -->
+   <field id="CMIP6_tslsiLut"      field_ref="dummy_XY"         /> <!-- P1 (K) surface_temperature : Surface temperature (i.e. temperature at which long-wave radiation emitted) -->
+   <field id="CMIP6_tsn_land"      field_ref="dummy_XY"         /> <!-- P1 (K) temperature_in_surface_snow : This temperature is averaged over all the snow in the grid cell that rests on land or land ice.  When computing the time-mean here, the time samples, weighted by the mass of snow on the land portion of the grid cell, are accumulated and then divided by the sum of the weights.   Reported as missing in regions free of snow on land. Warning: Doable but painful with the two different snow schemes. -->
+   <field id="CMIP6_tsnl"          field_ref="snowtemp"         /> <!-- P1 (K) snow_temperature : Temperature in the snow pack present in the grid-cell. 3D variable for multi-layer snow schemes. Warning: Computed only for the layered scheme on vegetated and bare soil area.  -->
+   <field id="CMIP6_tws"           field_ref="tws"              /> <!-- P1 (kg m-2) canopy_and_surface_and_subsurface_water_amount : Terrestrial Water Storage -->
+   <field id="CMIP6_vegFrac"       field_ref="vegFrac"          /> <!-- P1 (%) area_fraction : fraction of grid cell that is covered by vegetation.This SHOULD be the sum of tree, grass, crop and shrub fractions. -->
+   <field id="CMIP6_vegHeight_land" field_ref="dummy_XY"         /> <!-- P1 (m) canopy_height : Vegetation height averaged over all vegetation types and over the vegetated fraction of a grid cell. -->
+   <field id="CMIP6_vegHeightCrop" field_ref="dummy_XY"         /> <!-- P2 (m) canopy_height : Vegetation height averaged over the crop fraction of a grid cell. -->
+   <field id="CMIP6_vegHeightGrass" field_ref="dummy_XY"         /> <!-- P2 (m) canopy_height : Vegetation height averaged over the grass fraction of a grid cell. -->
+   <field id="CMIP6_vegHeightPasture" field_ref="dummy_XY"         /> <!-- P2 (m) canopy_height : Vegetation height averaged over the pasture fraction of a grid cell. -->
+   <field id="CMIP6_vegHeightShrub" field_ref="dummy_XY"         /> <!-- P2 (m) canopy_height : Vegetation height averaged over the shrub fraction of a grid cell. -->
+   <field id="CMIP6_vegHeightTree" field_ref="dummy_XY"         /> <!-- P2 (m) canopy_height : Vegetation height averaged over the tree fraction of a grid cell. -->
+   <field id="CMIP6_wetlandCH4"    field_ref="dummy_XY"         /> <!-- P2 (kg m-2 s-1) wetland_methane_emissions : Grid averaged methane emissions from wetlands -->
+   <field id="CMIP6_wetlandCH4cons" field_ref="dummy_XY"         /> <!-- P2 (kg m-2 s-1) wetland_methane_consumption : Grid Averaged Methane Consumption (Methanotrophy) from Wetlands -->
+   <field id="CMIP6_wetlandCH4prod" field_ref="dummy_XY"         /> <!-- P2 (kg m-2 s-1) wetland_methane_production : Grid averaged methane production (methanogenesis) from wetlands -->
+   <field id="CMIP6_wetlandFrac"   field_ref="dummy_XY"         /> <!-- P2 (%) wetland_fraction : Report only one year if specified fraction is used, or time series if values are determined dynamically. -->
+   <field id="CMIP6_wilt"          field_ref="dummy_XYSo"       /> <!-- P1 (%) missing : Wilting Point Warning: AD will do it in link with SPMIP -->
+   <field id="CMIP6_wtd"           field_ref="wtd"         /> <!-- P2 (m) depth_of_soil_moisture_saturation : Water table depth -->
+	<field id="CMIP6_ap" field_ref="dummy_hyb" /><!-- One of the hybrid coordinate arrays -->
+	<field id="CMIP6_ap_bnds" field_ref="dummy_hyb" /><!-- One of the hybrid coordinate arrays -->
+	<field id="CMIP6_b" field_ref="dummy_hyb" /><!-- One of the hybrid coordinate arrays -->
+	<field id="CMIP6_b_bnds" field_ref="dummy_hyb" /><!-- One of the hybrid coordinate arrays -->
+</field_definition>
+</context>
Index: /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_xml/file_def_input_orchidee.xml
===================================================================
--- /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_xml/file_def_input_orchidee.xml	(revision 6940)
+++ /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_xml/file_def_input_orchidee.xml	(revision 6940)
@@ -0,0 +1,36 @@
+<!-- =========================================================================================================== -->
+<!-- file_def_input_orchidee.xml : Definition of input files                                                     -->
+<!--                                                                                                             -->
+<!-- This file contains the definition of input files and there variables for ORCHIDEE read by XIOS.             -->
+<!-- The section for input files should not be modified. The model will enable true or false these files         -->
+<!-- according to if they are needed by the simulation set up.                                                   -->
+<!--                                                                                                             -->
+<!--                                                                                                             -->
+<!-- $HeadURL: svn://forge.ipsl.jussieu.fr/orchidee/branches/ORCHIDEE-MICT/ORCHIDEE/src_xml/file_def_input_orchidee.xml $         -->
+<!-- $Date: 2017-10-26 15:35:04 +0200 (Thu, 26 Oct 2017) $                                                       -->
+<!-- $Revision: 4719 $                                                                                           -->
+<!-- =========================================================================================================== -->
+
+<file_definition type="one_file" par_access="collective" enabled=".TRUE." min_digits="4">
+
+  <!-- ========================================================================================================= -->
+  <!-- Definition of input files                                                                                 -->
+  <!-- The input files are activated or desactivated from the source code depending on simulation set up.        -->
+  <!-- The variables are here on the input source grid.                                                          -->
+  <!-- Values higher than 1e10 are considered as missing and the field is then set to 0. A normalization using   -->
+  <!-- the fraction of the grid cell with valied values are done in the field_def_orchidee.xml. If only missing  -->
+  <!-- values are found for a grid cell, then a default value is set, also in field_def_orchidee.xml.            -->
+  <!-- ========================================================================================================= -->
+  <file id="nudge_moistc" name="nudge_moistc" type="one_file" mode="read" output_freq="1d">
+    <field  id="moistc_in" name="moistc" operation="instant" grid_ref="grid_inputfile_moistc" freq_offset="1ts" > (this &gt; 1e10) ? 0 : this </field>
+    <field  id="mask_moistc_in" name="moistc" operation="instant" grid_ref="grid_inputfile_moistc" freq_offset="1ts" > (this &gt; 1e10) ? 0 : 1 </field>
+  </file>
+
+  <file id="nudge_snow" name="nudge_snow" type="one_file" mode="read" output_freq="1d">
+    <field  id="snowdz_in" name="snowdz" operation="instant" grid_ref="grid_inputfile_snow" freq_offset="1ts" > (this &gt; 1e10) ? 0 : this </field>
+    <field  id="snowrho_in" name="snowrho" operation="instant" grid_ref="grid_inputfile_snow" freq_offset="1ts" > (this &gt; 1e10) ? 0 : this </field>
+    <field  id="snowtemp_in" name="snowtemp" operation="instant" grid_ref="grid_inputfile_snow" freq_offset="1ts" > (this &gt; 1e10) ? 0 : this </field>
+    <field  id="mask_snow_in" name="snowdz" operation="instant" grid_ref="grid_inputfile_snow" freq_offset="1ts" > (this &gt; 1e10) ? 0 : 1 </field>
+  </file>
+  
+</file_definition>
Index: /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_xml/iodef.xml
===================================================================
--- /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_xml/iodef.xml	(revision 6940)
+++ /branches/publications/ORCHIDEE-GMv3.2/ORCHIDEE/src_xml/iodef.xml	(revision 6940)
@@ -0,0 +1,32 @@
+<?xml version="1.0"?>
+<!-- =========================================================================================================== -->
+<!-- iodef.xml : Main configuration file for production of output files using XIOS                               -->
+<!--             A seperatate file context_orchidee.xml contains all specifications for ORCHIDEE                 -->
+<!--                                                                                                             -->
+<!-- $HeadURL: svn://forge.ipsl.jussieu.fr/orchidee/branches/ORCHIDEE-MICT/ORCHIDEE/src_xml/iodef.xml $                      -->
+<!-- $Date: 2017-04-07 17:54:23 +0200 (Fri, 07 Apr 2017) $                                                     -->
+<!-- $Revision: 4231 $                                                                                           -->
+<!-- =========================================================================================================== -->
+
+<simulation>
+
+  <!-- =========================================================================================================== -->
+  <!-- XIOS context                                                                                                -->
+  <!-- =========================================================================================================== -->
+  <context id="xios">
+    <variable_definition>
+	  <variable id="info_level"                type="int">1</variable>
+	  <variable id="using_server"              type="bool">false</variable>
+	  <variable id="using_oasis"               type="bool">false</variable>
+	  <variable id="oasis_codes_id"            type="string" >LMDZ,oceanx</variable>
+      </variable_definition>
+
+  </context>
+
+  <!-- =========================================================================================================== -->
+  <!-- ORCHIDEE context                                                                                            -->
+  <!-- The file context_orchidee.xml is included here. This file needs to exist during run time.                   -->
+  <!-- =========================================================================================================== -->
+  <context id="orchidee" src="./context_orchidee.xml"/>
+
+</simulation>
