diff --git a/src/ICCARE_BASE/allocate_physio.F90 b/src/ICCARE_BASE/allocate_physio.F90
new file mode 100644
index 0000000000000000000000000000000000000000..371a45d76c8dcbf86fb2d72cc6996d06c6bb047a
--- /dev/null
+++ b/src/ICCARE_BASE/allocate_physio.F90
@@ -0,0 +1,175 @@
+!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SFX_LIC for details. version 1.
+! #########
+ SUBROUTINE ALLOCATE_PHYSIO (IO, KK, PK, PEK, KVEGTYPE )
+! ##########################################################################
+!
+!!**** *ALLOCATE_PHYSIO* -
+!!
+!! PURPOSE
+!! -------
+!!
+!!** METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!!
+!! AUTHOR
+!! ------
+!!
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original xx/xxxx
+!! Modified 10/2014 P. Samuelsson MEB
+!
+!
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+USE MODD_ISBA_n, ONLY : ISBA_K_t, ISBA_P_t, ISBA_PE_t
+!
+USE MODD_TYPE_DATE_SURF
+!
+USE MODD_AGRI, ONLY : LAGRIP
+!
+USE MODD_TREEDRAG, ONLY : LTREEDRAG
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+IMPLICIT NONE
+!
+!
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+TYPE(ISBA_K_t), INTENT(INOUT) :: KK
+TYPE(ISBA_P_t), INTENT(INOUT) :: PK
+TYPE(ISBA_PE_t), INTENT(INOUT) :: PEK
+!
+INTEGER, INTENT(IN) :: KVEGTYPE
+!
+INTEGER :: ISIZE
+INTEGER :: ISIZE_LMEB_PATCH ! Number of patches with MEB=true
+!
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+!-------------------------------------------------------------------------------
+!
+! Mask and number of grid elements containing patches/tiles:
+!
+IF (LHOOK) CALL DR_HOOK('ALLOCATE_PHYSIO',0,ZHOOK_HANDLE)
+!
+ISIZE = PK%NSIZE_P
+!
+ISIZE_LMEB_PATCH=COUNT(IO%LMEB_PATCH(:))
+!
+ALLOCATE(PK%XDG (ISIZE,IO%NGROUND_LAYER))
+ALLOCATE(PK%XD_ICE (ISIZE ))
+!
+ALLOCATE(PEK%XLAI (ISIZE ))
+ALLOCATE(PEK%XLAIp (ISIZE ))
+ALLOCATE(PEK%XVEG (ISIZE ))
+ALLOCATE(PEK%XZ0 (ISIZE ))
+ALLOCATE(PEK%XEMIS (ISIZE ))
+!
+ALLOCATE(PEK%XRSMIN (ISIZE ))
+ALLOCATE(PEK%XGAMMA (ISIZE ))
+ALLOCATE(PEK%XWRMAX_CF (ISIZE ))
+ALLOCATE(PEK%XRGL (ISIZE ))
+ALLOCATE(PEK%XCV (ISIZE ))
+ALLOCATE(PEK%XALBNIR_VEG (ISIZE ))
+ALLOCATE(PEK%XALBVIS_VEG (ISIZE ))
+ALLOCATE(PEK%XALBUV_VEG (ISIZE ))
+!
+ALLOCATE(PK%XZ0_O_Z0H (ISIZE ))
+!
+IF (ISIZE_LMEB_PATCH>0 .OR. IO%CPHOTO/='NON') THEN
+ ALLOCATE(PEK%XBSLAI (ISIZE ))
+ELSE
+ ALLOCATE(PEK%XBSLAI (0))
+ENDIF
+! - vegetation: Ags parameters ('AGS', 'LAI', 'AST', 'LST', 'NIT' options)
+!
+IF (IO%CPHOTO/='NON'.OR.LTREEDRAG) THEN
+ ALLOCATE(PK%XH_TREE (ISIZE ))
+ELSE
+ ALLOCATE(PK%XH_TREE (0 ))
+ENDIF
+!
+IF (IO%CPHOTO/='NON') THEN
+ ALLOCATE(PK%XRE25 (ISIZE ))
+ ALLOCATE(PK%XDMAX (ISIZE ))
+ ALLOCATE(PEK%XLAIMIN (ISIZE ))
+ ALLOCATE(PEK%XSEFOLD (ISIZE ))
+ ALLOCATE(PEK%XGMES (ISIZE ))
+ ALLOCATE(PEK%XGC (ISIZE ))
+ ALLOCATE(PEK%XF2I (ISIZE ))
+ ALLOCATE(PEK%LSTRESS (ISIZE ))
+ IF (IO%CPHOTO=='NIT' .OR. IO%CPHOTO=='NCB') THEN
+ ALLOCATE(PEK%XCE_NITRO (ISIZE ))
+ ALLOCATE(PEK%XCF_NITRO (ISIZE ))
+ ALLOCATE(PEK%XCNA_NITRO (ISIZE ))
+ ELSE
+ ALLOCATE(PEK%XCE_NITRO (0))
+ ALLOCATE(PEK%XCF_NITRO (0))
+ ALLOCATE(PEK%XCNA_NITRO (0))
+ ENDIF
+ELSE
+ ALLOCATE(PK%XRE25 (0))
+ ALLOCATE(PK%XDMAX (0))
+ ALLOCATE(PEK%XLAIMIN (0))
+ ALLOCATE(PEK%XSEFOLD (0))
+ ALLOCATE(PEK%XGMES (0))
+ ALLOCATE(PEK%XGC (0))
+ ALLOCATE(PEK%XF2I (0))
+ ALLOCATE(PEK%LSTRESS (0))
+ ALLOCATE(PEK%XCE_NITRO (0))
+ ALLOCATE(PEK%XCF_NITRO (0))
+ ALLOCATE(PEK%XCNA_NITRO(0))
+ENDIF
+!
+! - Irrigation, seeding and reaping
+!
+IF (LAGRIP .AND. (IO%CPHOTO == 'NIT' .OR. IO%CPHOTO == 'NCB')) THEN
+ ALLOCATE(PEK%TSEED (ISIZE ))
+ ALLOCATE(PEK%TREAP (ISIZE ))
+ ALLOCATE(PEK%XWATSUP (ISIZE ))
+ ALLOCATE(PEK%XIRRIG (ISIZE ))
+ELSE
+ ALLOCATE(PEK%TSEED (0))
+ ALLOCATE(PEK%TREAP (0))
+ ALLOCATE(PEK%XWATSUP (0))
+ ALLOCATE(PEK%XIRRIG (0))
+ENDIF
+!
+! - ISBA-DF scheme
+!
+IF(IO%CISBA=='DIF')THEN
+ ALLOCATE(PK%XROOTFRAC (ISIZE,IO%NGROUND_LAYER))
+ ALLOCATE(PK%NWG_LAYER (ISIZE))
+ ALLOCATE(PK%XDROOT (ISIZE))
+ ALLOCATE(PK%XDG2 (ISIZE))
+ELSE
+ ALLOCATE(PK%XROOTFRAC (0,0))
+ ALLOCATE(PK%NWG_LAYER (0) )
+ ALLOCATE(PK%XDROOT (0) )
+ ALLOCATE(PK%XDG2 (0) )
+ENDIF
+!
+ALLOCATE(PEK%XGNDLITTER (ISIZE))
+ALLOCATE(PEK%XZ0LITTER (ISIZE))
+ALLOCATE(PEK%XH_VEG (ISIZE))
+!
+IF (LHOOK) CALL DR_HOOK('ALLOCATE_PHYSIO',1,ZHOOK_HANDLE)
+!
+END SUBROUTINE ALLOCATE_PHYSIO
diff --git a/src/ICCARE_BASE/allocate_teb_veg_pgd.F90 b/src/ICCARE_BASE/allocate_teb_veg_pgd.F90
new file mode 100644
index 0000000000000000000000000000000000000000..32bbfd37d394976ab2568deea7c74f23ddb66dc8
--- /dev/null
+++ b/src/ICCARE_BASE/allocate_teb_veg_pgd.F90
@@ -0,0 +1,139 @@
+!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SFX_LIC for details. version 1.
+! #########
+ SUBROUTINE ALLOCATE_TEB_VEG_PGD (PEK, S, K, P, OALLOC, KLU, KVEGTYPE, KGROUND_LAYER)
+! ##########################################################################
+!
+!
+USE MODD_ISBA_n, ONLY : ISBA_S_t, ISBA_PE_t, ISBA_P_t, ISBA_K_t
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+IMPLICIT NONE
+!
+TYPE(ISBA_PE_t), INTENT(INOUT) :: PEK
+TYPE(ISBA_S_t), INTENT(INOUT) :: S
+TYPE(ISBA_P_t), INTENT(INOUT) :: P
+TYPE(ISBA_K_t), INTENT(INOUT) :: K
+!
+LOGICAL, INTENT(IN) :: OALLOC ! True if constant PGD fields must be allocated
+INTEGER, INTENT(IN) :: KLU
+INTEGER, INTENT(IN) :: KVEGTYPE
+INTEGER, INTENT(IN) :: KGROUND_LAYER
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+!-------------------------------------------------------------------------------
+!
+IF (LHOOK) CALL DR_HOOK('ALLOCATE_TEB_VEG_PGD',0,ZHOOK_HANDLE)
+!
+!-------------------------------------------------------------------------------
+!
+! - Physiographic field that can evolve prognostically
+!
+ALLOCATE(PEK%XLAI (KLU))
+ALLOCATE(PEK%XLAIp (KLU))
+ALLOCATE(PEK%XVEG (KLU))
+ALLOCATE(PEK%XEMIS (KLU))
+ALLOCATE(PEK%XZ0 (KLU))
+!
+! - vegetation: default option (Jarvis) and general parameters:
+!
+ALLOCATE(PEK%XRSMIN (KLU))
+ALLOCATE(PEK%XGAMMA (KLU))
+ALLOCATE(PEK%XWRMAX_CF (KLU))
+ALLOCATE(PEK%XRGL (KLU))
+ALLOCATE(PEK%XCV (KLU))
+!
+ALLOCATE(PEK%XLAIMIN (KLU))
+ALLOCATE(PEK%XSEFOLD (KLU))
+ALLOCATE(PEK%XGMES (KLU))
+ALLOCATE(PEK%XGC (KLU))
+ALLOCATE(PEK%XF2I (KLU))
+ALLOCATE(PEK%XBSLAI (KLU))
+!
+! - vegetation:
+!
+ALLOCATE(PEK%XALBNIR_VEG (KLU))
+ALLOCATE(PEK%XALBVIS_VEG (KLU))
+ALLOCATE(PEK%XALBUV_VEG (KLU))
+!
+ALLOCATE(PEK%LSTRESS (KLU))
+!
+!-------------------------------------------------------------------------------
+!
+! - vegetation: Ags Nitrogen-model parameters ('NIT' option)
+!
+ALLOCATE(PEK%XCE_NITRO (KLU))
+ALLOCATE(PEK%XCF_NITRO (KLU))
+ALLOCATE(PEK%XCNA_NITRO (KLU))
+!
+IF (.NOT. OALLOC) THEN
+ IF (LHOOK) CALL DR_HOOK('ALLOCATE_TEB_VEG_PGD',1,ZHOOK_HANDLE)
+ RETURN
+END IF
+!-------------------------------------------------------------------------------
+!
+! Input Parameters:
+!
+! - vegetation + bare soil:
+!
+ALLOCATE(P%XZ0_O_Z0H (KLU))
+!
+ALLOCATE(P%XROOTFRAC (KLU,KGROUND_LAYER ))
+ALLOCATE(P%NWG_LAYER (KLU))
+ALLOCATE(P%XDROOT (KLU))
+ALLOCATE(P%XDG2 (KLU))
+!
+!-------------------------------------------------------------------------------
+!
+! - vegetation: Ags parameters ('AGS', 'LAI', 'AST', 'LST', 'NIT' options)
+!
+!
+ALLOCATE(P%XH_TREE (KLU))
+!
+!
+ALLOCATE(P%XRE25 (KLU))
+!
+!-------------------------------------------------------------------------------
+!
+! - vegetation: Ags Stress parameters ('AST', 'LST', 'NIT' options)
+!
+!
+ALLOCATE(P%XAH (KLU))
+ALLOCATE(P%XBH (KLU))
+!
+ALLOCATE(P%XDMAX (KLU))
+!
+!-------------------------------------------------------------------------------
+!
+! - soil: primary parameters
+!
+ALLOCATE(S%XSOC (KLU,KGROUND_LAYER ))
+!
+ALLOCATE(K%XSAND (KLU,KGROUND_LAYER ))
+ALLOCATE(K%XCLAY (KLU,KGROUND_LAYER ))
+ALLOCATE(K%XRUNOFFB (KLU ))
+ALLOCATE(K%XWDRAIN (KLU ))
+!
+ALLOCATE(P%XTAUICE (KLU ))
+!
+ALLOCATE(P%XDG (KLU,KGROUND_LAYER))
+!
+ALLOCATE(P%XRUNOFFD (KLU))
+!
+!-------------------------------------------------------------------------------
+!
+! - SGH scheme
+!
+ALLOCATE(P%XD_ICE (KLU))
+!
+ALLOCATE(K%XGAMMAT (KLU ))
+!
+!-------------------------------------------------------------------------------
+!
+IF (LHOOK) CALL DR_HOOK('ALLOCATE_TEB_VEG_PGD',1,ZHOOK_HANDLE)
+!
+END SUBROUTINE ALLOCATE_TEB_VEG_PGD
diff --git a/src/ICCARE_BASE/ch_aer_maattanen_neutral.f90 b/src/ICCARE_BASE/ch_aer_maattanen_neutral.f90
index 2ddea257e30827f2ccfb4c51249e73c9532e638b..8a9c8b5d3ed298541696d6f7eca74e11fe77a0a9 100644
--- a/src/ICCARE_BASE/ch_aer_maattanen_neutral.f90
+++ b/src/ICCARE_BASE/ch_aer_maattanen_neutral.f90
@@ -235,7 +235,8 @@ DO II = 1, SIZE(PSULF,1)
& -2.0199865087650833e-6 * PTEMP(II)**2 * LOG(ZSULF(II))**3 + &
& -3.0200284885763192e-9 * PTEMP(II)**3 * LOG(ZSULF(II))**3 + &
& (-6.9425267104126316e-3 * LOG(ZSULF(II))**3) / ZAL(II)
- !
+ !
+ PJNUCN(II)=MIN(5.0E1,PJNUCN(II))
PJNUCN(II)=EXP(PJNUCN(II))
!
! 3. Molecules number in the cluster calculation
@@ -303,6 +304,8 @@ DO II = 1, SIZE(PSULF,1)
!
IF (ZNACN(II) .lt. 1.) THEN
!
+ ! print *, 'Warning: number of acid molecules < 1 in nucleation regime, setting na_n=1'
+ !
ZNACN(II)=1.0
!
END IF
diff --git a/src/ICCARE_BASE/convert_patch_isba.F90 b/src/ICCARE_BASE/convert_patch_isba.F90
new file mode 100644
index 0000000000000000000000000000000000000000..a702572247f7d4bf0aa2967b1e2b19982c1734ad
--- /dev/null
+++ b/src/ICCARE_BASE/convert_patch_isba.F90
@@ -0,0 +1,1012 @@
+!SFX_LIC Copyright 2010-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SFX_LIC for details. version 1.
+! #########
+ SUBROUTINE CONVERT_PATCH_ISBA (DTCO, DTV, IO, KDEC, KDEC2, PCOVER, OCOVER,&
+ OAGRIP, HSFTYPE, KPATCH, KK, PK, PEK, OFIX, OTIME, &
+ OMEB, OIRR, OALB, OUPDATE_ALB, PSOILGRID, PWG1, PWSAT, PPERM )
+! ##############################################################
+!
+!!**** *CONVERT_PATCH_ISBA*
+!!
+!! PURPOSE
+!! -------
+!!
+!! METHOD
+!! ------
+!!
+!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!!
+!! S. Faroux Meteo-France
+!!
+!! MODIFICATION
+!! ------------
+!!
+!! Original 16/11/10
+!! V. Masson 04/14 Garden and Greenroofs can only be initialized by ecoclimap
+!! in this routine (not from user specified parameters from
+!! the nature tile, as the number of points is not the same)
+!! B. Decharme 04/2013 Add CDGAVG (method to average depth)
+!! Soil depth = Root depth with ISBA-DF
+!! except for bare soil pft (but limited to 1m)
+!! With TR_ML (new radiative transfert) and modis
+!! albedo, UV albedo not defined (conserv nrj when
+!! coupled to atmosphere)
+!! P Samuelsson 10/2014 MEB
+! P. Wautelet 15/02/2019: bugfix: allocate ZSTRESS only when its size has a meaning
+!! 11/2019 C.Lac correction in the drag formula and application to building in addition to tree
+!
+!----------------------------------------------------------------------------
+!
+!* 0. DECLARATION
+! -----------
+!
+!
+USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
+USE MODD_DATA_ISBA_n, ONLY : DATA_ISBA_t
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+!
+USE MODD_ISBA_n, ONLY : ISBA_P_t, ISBA_PE_t, ISBA_K_t
+!
+USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE, NVT_NO, NVT_ROCK, NVT_SNOW
+!
+USE MODD_TYPE_DATE_SURF
+!
+!
+USE MODD_DATA_COVER, ONLY : XDATA_LAI, XDATA_H_TREE, &
+ XDATA_VEG, XDATA_Z0, XDATA_Z0_O_Z0H, &
+ XDATA_EMIS_ECO, XDATA_GAMMA, XDATA_CV, &
+ XDATA_RGL, XDATA_RSMIN, &
+ XDATA_ALBNIR_VEG, XDATA_ALBVIS_VEG, &
+ XDATA_ALBUV_VEG, &
+ XDATA_ALB_VEG_NIR, XDATA_ALB_VEG_VIS, &
+ XDATA_ALB_SOIL_NIR, XDATA_ALB_SOIL_VIS, &
+ XDATA_GMES, XDATA_BSLAI, XDATA_LAIMIN, &
+ XDATA_SEFOLD, XDATA_GC, XDATA_WRMAX_CF, &
+ XDATA_STRESS, &
+ XDATA_DMAX, XDATA_F2I, XDATA_RE25, &
+ XDATA_CE_NITRO, XDATA_CF_NITRO, &
+ XDATA_CNA_NITRO, XDATA_DICE, &
+ XDATA_GMES_ST, XDATA_BSLAI_ST, &
+ XDATA_SEFOLD_ST, XDATA_GC_ST, &
+ XDATA_DMAX_ST, XDATA_WATSUP, &
+ XDATA_GNDLITTER, XDATA_Z0LITTER, XDATA_H_VEG, &
+ TDATA_SEED, TDATA_REAP,XDATA_IRRIG, &
+ XDATA_ROOT_DEPTH, XDATA_GROUND_DEPTH, &
+ XDATA_ROOT_EXTINCTION, XDATA_ROOT_LIN
+!
+!
+USE MODD_TREEDRAG, ONLY : LTREEDRAG
+!
+USE MODI_AV_PGD_PARAM
+USE MODI_AV_PGD_1P
+USE MODI_SOIL_ALBEDO
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+IMPLICIT NONE
+!
+!* 0.1 Declaration of arguments
+! ------------------------
+!
+!
+TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
+TYPE(DATA_ISBA_t), INTENT(INOUT) :: DTV
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+!
+INTEGER, INTENT(IN) :: KDEC
+INTEGER, INTENT(IN) :: KDEC2
+REAL, DIMENSION(:,:), INTENT(IN) :: PCOVER
+LOGICAL, DIMENSION(:), INTENT(IN) :: OCOVER
+LOGICAL, INTENT(IN) :: OAGRIP
+CHARACTER(LEN=*), INTENT(IN) :: HSFTYPE ! nature / garden
+INTEGER, INTENT(IN) :: KPATCH
+!
+TYPE(ISBA_K_t), INTENT(INOUT) :: KK
+TYPE(ISBA_P_t), INTENT(INOUT) :: PK
+TYPE(ISBA_PE_t), INTENT(INOUT) :: PEK
+!
+LOGICAL, INTENT(IN) :: OFIX
+LOGICAL, INTENT(IN) :: OTIME
+LOGICAL, INTENT(IN) :: OMEB
+LOGICAL, INTENT(IN) :: OIRR
+LOGICAL, INTENT(IN) :: OALB
+LOGICAL, INTENT(IN) :: OUPDATE_ALB
+!
+REAL, DIMENSION(:), OPTIONAL, INTENT(IN) :: PWG1
+REAL, DIMENSION(:,:), OPTIONAL, INTENT(IN) :: PWSAT
+REAL, DIMENSION(:), OPTIONAL, INTENT(IN) :: PPERM
+!
+REAL, DIMENSION(:) , OPTIONAL, INTENT(IN) :: PSOILGRID
+!
+!* 0.2 Declaration of local variables
+! ------------------------------
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZWORKI
+ CHARACTER(LEN=3) :: YTREE, YNAT, YLAI, YVEG, YBAR, YDIF
+!
+INTEGER :: JLAYER ! loop counter on layers
+INTEGER :: JVEG ! loop counter on vegtypes
+!
+LOGICAL :: GDATA ! Flag where initialization can be done
+! ! either with ecoclimap of data fields specified
+! ! by user on the natural points (GDTA=T)
+! ! For fields in town, only ecoclimap option
+! ! is treated in this routine (GDATA=F)
+INTEGER :: JJ ! loop counter
+!
+INTEGER :: ISIZE_LMEB_PATCH ! Number of patches with MEB=true
+!
+REAL, ALLOCATABLE, DIMENSION(:) :: ZH_VEG
+!
+!
+!* 0.3 Declaration of namelists
+! ------------------------
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!-------------------------------------------------------------------------------
+!
+!* 1. Initializations
+! ---------------
+!
+IF (LHOOK) CALL DR_HOOK('CONVERT_PATCH_ISBA',0,ZHOOK_HANDLE)
+!
+IF (ASSOCIATED(DTCO%XDATA_WEIGHT)) DEALLOCATE(DTCO%XDATA_WEIGHT)
+!
+IF (HSFTYPE=='NAT') THEN
+ YNAT='NAT'
+ YTREE='TRE'
+ YLAI='LAI'
+ YVEG='VEG'
+ YBAR='BAR'
+ YDIF='DVG'
+ GDATA=.TRUE.
+ ISIZE_LMEB_PATCH = COUNT(IO%LMEB_PATCH(:))
+ELSEIF (HSFTYPE=='GRD') THEN
+ YNAT='GRD'
+ YTREE='GRT'
+ YLAI='GRL'
+ YVEG='GRV'
+ YBAR='GRB'
+ YDIF='GDV'
+ GDATA=.FALSE.
+ ISIZE_LMEB_PATCH = 0
+ENDIF
+!
+IF (OFIX) THEN
+ !
+ !* soil layers and root fraction
+! -----------------------------
+ !
+ ! compute soil layers (and root fraction if DIF)
+ !
+ CALL SET_GRID_PARAM(SIZE(PK%XDG,1),SIZE(PK%XDG,2))
+!
+! D ICE
+! -----
+!
+ IF (IO%CISBA/='DIF') THEN
+ IF (GDATA .AND. ANY(DTV%LDATA_DICE)) THEN
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
+ PK%XD_ICE,DTV%XPAR_VEGTYPE,DTV%XPAR_DICE,YNAT,'ARI',PK%NR_P,IO%NPATCH,KPATCH)
+ ELSE
+ CALL AV_PGD_1P(DTCO, PK%XD_ICE,PCOVER,XDATA_DICE(:,:),YNAT,'ARI',OCOVER,&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
+ ENDIF
+ ENDIF
+!
+ IF (GDATA .AND. ANY(DTV%LDATA_Z0_O_Z0H)) THEN
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
+ PK%XZ0_O_Z0H,DTV%XPAR_VEGTYPE,DTV%XPAR_Z0_O_Z0H,YNAT,'ARI',PK%NR_P,IO%NPATCH,KPATCH)
+ ELSE
+ CALL AV_PGD_1P(DTCO, PK%XZ0_O_Z0H,PCOVER,XDATA_Z0_O_Z0H,YNAT,'ARI',OCOVER,&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
+ ENDIF
+!
+ IF (IO%CPHOTO/='NON'.OR.LTREEDRAG) THEN
+ IF (GDATA .AND. ANY(DTV%LDATA_H_TREE)) THEN
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
+ PK%XH_TREE,DTV%XPAR_VEGTYPE,DTV%XPAR_H_TREE,YTREE,'ARI',PK%NR_P,IO%NPATCH,KPATCH)
+ ELSE
+ CALL AV_PGD_1P(DTCO, PK%XH_TREE,PCOVER,XDATA_H_TREE(:,:),YTREE,'ARI',OCOVER,&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
+ ENDIF
+ ENDIF
+!
+ IF (GDATA .AND. ANY(DTV%LDATA_H_TREE)) THEN
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
+ PK%XH_TREE,DTV%XPAR_VEGTYPE,DTV%XPAR_H_TREE,YTREE,'ARI',PK%NR_P,IO%NPATCH,KPATCH)
+ ELSE
+ CALL AV_PGD_1P(DTCO, PK%XH_TREE,PCOVER,XDATA_H_TREE(:,:),YTREE,'ARI',OCOVER,&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
+ ENDIF
+!
+ IF (IO%CPHOTO/='NON') THEN
+ !
+ IF (SIZE(PK%XRE25)>0) THEN
+ IF (GDATA .AND. ANY(DTV%LDATA_RE25)) THEN
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
+ PK%XRE25,DTV%XPAR_VEGTYPE,DTV%XPAR_RE25,YNAT,'ARI',PK%NR_P,IO%NPATCH,KPATCH)
+ ELSE
+ CALL AV_PGD_1P(DTCO, PK%XRE25,PCOVER,XDATA_RE25,YNAT,'ARI',OCOVER,&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
+ ENDIF
+ ENDIF
+ !
+ IF (SIZE(PK%XDMAX)>0) THEN
+ IF (GDATA .AND. ANY(DTV%LDATA_DMAX)) THEN
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
+ PK%XDMAX,DTV%XPAR_VEGTYPE,DTV%XPAR_DMAX,YTREE,'ARI',PK%NR_P,IO%NPATCH,KPATCH)
+ ELSE
+ CALL AV_PGD_1P(DTCO, PK%XDMAX,PCOVER,XDATA_DMAX_ST,YTREE,'ARI',OCOVER,&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
+ ENDIF
+ ENDIF
+ !
+ ENDIF
+!
+ENDIF
+!
+IF (OTIME) THEN
+!
+ IF (.NOT.OUPDATE_ALB) THEN
+! VEG
+! ----
+ IF (GDATA .AND. ANY(DTV%LDATA_VEG)) THEN
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, PEK%XVEG,DTV%XPAR_VEGTYPE,DTV%XPAR_VEG(:,KDEC2,:),&
+ YNAT,'ARI',PK%NR_P,IO%NPATCH,KPATCH)
+ ELSE
+ CALL AV_PGD_1P(DTCO, PEK%XVEG,PCOVER,XDATA_VEG(:,KDEC,:),YNAT,'ARI',OCOVER,&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
+ ENDIF
+!
+! LAI
+! ----
+ IF (GDATA .AND. ANY(DTV%LDATA_LAI)) THEN
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
+ PEK%XLAI,DTV%XPAR_VEGTYPE,DTV%XPAR_LAI(:,KDEC2,:),YVEG,'ARI',&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2)
+ ELSE
+ CALL AV_PGD_1P(DTCO, PEK%XLAI,PCOVER,XDATA_LAI(:,KDEC,:),YVEG,'ARI',OCOVER,&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
+ ENDIF
+!
+! EMIS
+! ----
+!emis needs VEG by vegtypes is changed at this step
+ IF (GDATA .AND. ANY(DTV%LDATA_EMIS)) THEN
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
+ PEK%XEMIS ,DTV%XPAR_VEGTYPE,DTV%XPAR_EMIS(:,KDEC2,:),YNAT,'ARI',&
+ PK%NR_P,IO%NPATCH,KPATCH)
+ ELSE
+ CALL AV_PGD_1P(DTCO, PEK%XEMIS ,PCOVER ,XDATA_EMIS_ECO (:,KDEC,:),YNAT,'ARI',OCOVER,&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
+ ENDIF
+!
+! Z0V
+! ----
+ IF (GDATA .AND. ANY(DTV%LDATA_Z0)) THEN
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
+ PEK%XZ0,DTV%XPAR_VEGTYPE,DTV%XPAR_Z0(:,KDEC2,:),YNAT,'CDN',&
+ PK%NR_P,IO%NPATCH,KPATCH)
+ ELSE
+ CALL AV_PGD_1P(DTCO, PEK%XZ0 ,PCOVER ,XDATA_Z0 (:,KDEC,:),YNAT,'CDN',OCOVER,&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
+ ENDIF
+!
+ ENDIF
+
+ IF (GDATA .AND. ANY(DTV%LDATA_ALBNIR_VEG)) THEN
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
+ PEK%XALBNIR_VEG,DTV%XPAR_VEGTYPE,DTV%XPAR_ALBNIR_VEG(:,KDEC2,:),YVEG,'ARI',&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2)
+ ELSEIF (IO%CALBEDO=='CM13') THEN
+ CALL AV_PGD_1P(DTCO, PEK%XALBNIR_VEG,PCOVER,XDATA_ALB_VEG_NIR(:,KDEC,:),YVEG,'ARI', OCOVER,&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
+ ELSE
+ CALL AV_PGD_1P(DTCO, PEK%XALBNIR_VEG,PCOVER,XDATA_ALBNIR_VEG,YVEG,'ARI',OCOVER,&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
+ ENDIF
+!
+ IF (GDATA .AND. ANY(DTV%LDATA_ALBVIS_VEG)) THEN
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
+ PEK%XALBVIS_VEG,DTV%XPAR_VEGTYPE,DTV%XPAR_ALBVIS_VEG(:,KDEC2,:),YVEG,'ARI',&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2)
+ ELSEIF (IO%CALBEDO=='CM13') THEN
+ CALL AV_PGD_1P(DTCO, PEK%XALBVIS_VEG,PCOVER,XDATA_ALB_VEG_VIS(:,KDEC,:),YVEG,'ARI',OCOVER,&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
+ ELSE
+ CALL AV_PGD_1P(DTCO, PEK%XALBVIS_VEG,PCOVER,XDATA_ALBVIS_VEG,YVEG,'ARI',OCOVER,&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
+ ENDIF
+!
+ IF ((IO%CALBEDO=='CM13'.OR.IO%LTR_ML)) THEN
+ PEK%XALBUV_VEG(:)=PEK%XALBVIS_VEG(:)
+ ELSEIF (GDATA .AND. ANY(DTV%LDATA_ALBUV_VEG)) THEN
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
+ PEK%XALBUV_VEG,DTV%XPAR_VEGTYPE,DTV%XPAR_ALBUV_VEG(:,KDEC2,:),YVEG,'ARI',&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2)
+ ELSE
+ CALL AV_PGD_1P(DTCO, PEK%XALBUV_VEG,PCOVER,XDATA_ALBUV_VEG,YVEG,'ARI',OCOVER,&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
+ ENDIF
+!
+ IF (.NOT.OUPDATE_ALB) THEN
+! Other parameters
+! ----------------
+ IF( SIZE(PEK%XRSMIN)>0) THEN
+ IF (GDATA .AND. ANY(DTV%LDATA_RSMIN)) THEN
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
+ PEK%XRSMIN,DTV%XPAR_VEGTYPE,DTV%XPAR_RSMIN,YLAI,'INV',&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2)
+ ELSE
+ CALL AV_PGD_1P(DTCO, PEK%XRSMIN,PCOVER,XDATA_RSMIN,YLAI,'INV',&
+ OCOVER,PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
+ ENDIF
+ ENDIF
+!
+ IF (GDATA .AND. ANY(DTV%LDATA_GAMMA)) THEN
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
+ PEK%XGAMMA,DTV%XPAR_VEGTYPE,DTV%XPAR_GAMMA,YVEG,'ARI',&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2)
+ ELSE
+ CALL AV_PGD_1P(DTCO, PEK%XGAMMA,PCOVER,XDATA_GAMMA,YVEG,'ARI',OCOVER,&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
+ ENDIF
+!
+ IF (GDATA .AND. ANY(DTV%LDATA_WRMAX_CF)) THEN
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
+ PEK%XWRMAX_CF,DTV%XPAR_VEGTYPE,DTV%XPAR_WRMAX_CF,YVEG,'ARI',&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2)
+ ELSE
+ CALL AV_PGD_1P(DTCO, PEK%XWRMAX_CF,PCOVER,XDATA_WRMAX_CF,YVEG,'ARI',OCOVER,&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
+ ENDIF
+!
+ IF (GDATA .AND. ANY(DTV%LDATA_RGL)) THEN
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
+ PEK%XRGL,DTV%XPAR_VEGTYPE,DTV%XPAR_RGL,YVEG,'ARI',&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2)
+ ELSE
+ CALL AV_PGD_1P(DTCO, PEK%XRGL,PCOVER,XDATA_RGL,YVEG,'ARI',OCOVER,&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
+ ENDIF
+!
+ IF (GDATA .AND. ANY(DTV%LDATA_CV)) THEN
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
+ PEK%XCV,DTV%XPAR_VEGTYPE,DTV%XPAR_CV,YVEG,'INV',&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2)
+ ELSE
+ CALL AV_PGD_1P(DTCO, PEK%XCV,PCOVER,XDATA_CV,YVEG,'INV',OCOVER,&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
+ ENDIF
+!
+ IF (ISIZE_LMEB_PATCH>0 .OR. IO%CPHOTO/='NON') THEN
+
+ IF( SIZE(PEK%XBSLAI)>0) THEN
+ IF (GDATA .AND. ANY(DTV%LDATA_BSLAI)) THEN
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
+ PEK%XBSLAI,DTV%XPAR_VEGTYPE,DTV%XPAR_BSLAI,YVEG,'ARI',&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2)
+ ELSE
+ CALL AV_PGD_1P(DTCO, PEK%XBSLAI,PCOVER,XDATA_BSLAI_ST,YVEG,'ARI',OCOVER,&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
+ ENDIF
+ ENDIF
+ ENDIF
+!
+ IF (IO%CPHOTO/='NON') THEN
+ !
+ IF (SIZE(PEK%XLAIMIN)>0) THEN
+ IF (GDATA .AND. ANY(DTV%LDATA_LAIMIN)) THEN
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
+ PEK%XLAIMIN,DTV%XPAR_VEGTYPE,DTV%XPAR_LAIMIN,YVEG,'ARI',&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2)
+ ELSE
+ CALL AV_PGD_1P(DTCO, PEK%XLAIMIN,PCOVER,XDATA_LAIMIN,YVEG,'ARI',OCOVER,&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
+ ENDIF
+ ENDIF
+ !
+ IF (SIZE(PEK%XSEFOLD)>0) THEN
+ IF (GDATA .AND. ANY(DTV%LDATA_SEFOLD)) THEN
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
+ PEK%XSEFOLD,DTV%XPAR_VEGTYPE,DTV%XPAR_SEFOLD,YVEG,'ARI',&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2)
+ ELSE
+ CALL AV_PGD_1P(DTCO, PEK%XSEFOLD,PCOVER,XDATA_SEFOLD_ST,YVEG,'ARI',OCOVER,&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
+ ENDIF
+ ENDIF
+ !
+ IF ( SIZE(PEK%XGMES)>0) THEN
+ IF (GDATA .AND. ANY(DTV%LDATA_GMES)) THEN
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
+ PEK%XGMES,DTV%XPAR_VEGTYPE,DTV%XPAR_GMES,YVEG,'ARI',&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2)
+ ELSE
+ CALL AV_PGD_1P(DTCO, PEK%XGMES,PCOVER,XDATA_GMES_ST,YVEG,'ARI',OCOVER,&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
+ ENDIF
+ ENDIF
+ !
+ IF ( SIZE(PEK%XGC)>0) THEN
+ IF (GDATA .AND. ANY(DTV%LDATA_GC)) THEN
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
+ PEK%XGC,DTV%XPAR_VEGTYPE,DTV%XPAR_GC,YVEG,'ARI',&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2)
+ ELSE
+ CALL AV_PGD_1P(DTCO, PEK%XGC,PCOVER,XDATA_GC_ST,YVEG,'ARI',OCOVER,&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
+ ENDIF
+ ENDIF
+ !
+ IF (SIZE(PEK%XF2I)>0) THEN
+ IF (GDATA .AND. ANY(DTV%LDATA_F2I)) THEN
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
+ PEK%XF2I,DTV%XPAR_VEGTYPE,DTV%XPAR_F2I,YVEG,'ARI',&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2)
+ ELSE
+ CALL AV_PGD_1P(DTCO, PEK%XF2I,PCOVER,XDATA_F2I,YVEG,'ARI',OCOVER,&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
+ ENDIF
+ ENDIF
+ !
+ IF (IO%CPHOTO=='NIT' .OR. IO%CPHOTO=='NCB') THEN
+ !
+ IF (SIZE(PEK%XCE_NITRO)>0) THEN
+ IF (GDATA .AND. ANY(DTV%LDATA_CE_NITRO)) THEN
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
+ PEK%XCE_NITRO,DTV%XPAR_VEGTYPE,DTV%XPAR_CE_NITRO,YVEG,'ARI',&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2)
+ ELSE
+ CALL AV_PGD_1P(DTCO, PEK%XCE_NITRO,PCOVER,XDATA_CE_NITRO,YVEG,'ARI',OCOVER,&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
+ ENDIF
+ ENDIF
+ !
+ IF (SIZE(PEK%XCF_NITRO)>0) THEN
+ IF (GDATA .AND. ANY(DTV%LDATA_CF_NITRO)) THEN
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
+ PEK%XCF_NITRO,DTV%XPAR_VEGTYPE,DTV%XPAR_CF_NITRO,YVEG,'ARI',&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2)
+ ELSE
+ CALL AV_PGD_1P(DTCO, PEK%XCF_NITRO,PCOVER,XDATA_CF_NITRO,YVEG,'ARI',OCOVER,&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
+ ENDIF
+ ENDIF
+ !
+ IF (SIZE(PEK%XCNA_NITRO)>0) THEN
+ IF (GDATA .AND. ANY(DTV%LDATA_CNA_NITRO)) THEN
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
+ PEK%XCNA_NITRO,DTV%XPAR_VEGTYPE,DTV%XPAR_CNA_NITRO,YVEG,'ARI',&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2)
+ ELSE
+ CALL AV_PGD_1P(DTCO, PEK%XCNA_NITRO,PCOVER,XDATA_CNA_NITRO,YVEG,'ARI',OCOVER,&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
+ ENDIF
+ ENDIF
+ !
+ ENDIF
+ !
+ ENDIF
+!
+! STRESS
+! --------
+ IF (SIZE(PEK%LSTRESS)>0) THEN
+ CALL SET_STRESS
+ ENDIF
+!
+ ENDIF
+!
+ENDIF
+!
+IF (OMEB .AND. .NOT.OUPDATE_ALB) THEN
+ !
+! GNDLITTER
+! ---------
+ IF (GDATA .AND. ANY(DTV%LDATA_GNDLITTER)) THEN
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, PEK%XGNDLITTER,DTV%XPAR_VEGTYPE,&
+ DTV%XPAR_GNDLITTER(:,KDEC2,:),YNAT,'ARI',PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2)
+ ELSE
+ CALL AV_PGD_1P(DTCO, PEK%XGNDLITTER,PCOVER,XDATA_GNDLITTER(:,KDEC,:),YNAT,'ARI',OCOVER,&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
+ ENDIF
+!
+! H_VEG
+! -----
+ IF (GDATA .AND. ANY(DTV%LDATA_H_VEG)) THEN
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
+ PEK%XH_VEG,DTV%XPAR_VEGTYPE,DTV%XPAR_H_VEG(:,KDEC2,:),YVEG,'ARI',&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2)
+ ELSE
+ CALL AV_PGD_1P(DTCO, PEK%XH_VEG,PCOVER,XDATA_H_VEG(:,KDEC,:),YVEG,'ARI',OCOVER,&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
+ ENDIF
+! In case of MEB, force 0<PH_VEG<XUNDEF for those patches where LMEB_PATCH=.T.
+ IF(IO%LMEB_PATCH(KPATCH))THEN
+ ALLOCATE(ZH_VEG(SIZE(PEK%XH_VEG)))
+ ZH_VEG=PEK%XH_VEG(:)
+ WHERE(ZH_VEG>1000.) ZH_VEG=0.
+ ZH_VEG=MAX(ZH_VEG,1.0E-3)
+ PEK%XH_VEG(:)=ZH_VEG
+ DEALLOCATE(ZH_VEG)
+ ENDIF
+!
+! Z0LITTER
+! --------
+ IF (GDATA .AND. ANY(DTV%LDATA_Z0LITTER)) THEN
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
+ PEK%XZ0LITTER,DTV%XPAR_VEGTYPE,DTV%XPAR_Z0LITTER(:,KDEC2,:),YNAT,'CDN',&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2)
+ ELSE
+ CALL AV_PGD_1P(DTCO, PEK%XZ0LITTER ,PCOVER ,XDATA_Z0LITTER (:,KDEC,:),YNAT,'CDN',OCOVER,&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
+ ENDIF
+!
+ENDIF
+!
+IF (OIRR .AND. .NOT.OUPDATE_ALB) THEN
+!
+ IF ((IO%CPHOTO == 'NIT' .OR. IO%CPHOTO=='NCB') .AND. OAGRIP) THEN
+ !
+ ! date of seeding
+ ! ---------------
+ !
+ ALLOCATE(ZWORKI(SIZE(PEK%TSEED,1)))
+ !
+ IF(SIZE(PEK%TSEED)>0) THEN
+ IF (GDATA .AND. ANY(DTV%LDATA_SEED_M) .AND. ANY(DTV%LDATA_SEED_D)) THEN
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
+ ZWORKI,DTV%XPAR_VEGTYPE,DTV%XPAR_SEED_M(:,:),YVEG,'MAJ',&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2)
+ PEK%TSEED(:)%TDATE%MONTH = NINT(ZWORKI(:))
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
+ ZWORKI,DTV%XPAR_VEGTYPE,DTV%XPAR_SEED_D(:,:),YVEG,'MAJ',&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2)
+ PEK%TSEED(:)%TDATE%DAY = NINT(ZWORKI(:))
+ ELSE
+ CALL AV_PGD_1P (PEK%TSEED,PCOVER,TDATA_SEED(:,:),YVEG,'MAJ',OCOVER,&
+ PK%NR_P,IO%NPATCH, KPATCH, KDECADE=KDEC)
+ ENDIF
+ ENDIF
+ !
+ ! date of reaping
+ ! ---------------
+ !
+ IF (SIZE(PEK%TREAP)>0) THEN
+ IF (GDATA .AND. ANY(DTV%LDATA_REAP_M) .AND. ANY(DTV%LDATA_REAP_D)) THEN
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
+ ZWORKI,DTV%XPAR_VEGTYPE,DTV%XPAR_REAP_M(:,:),YVEG,'MAJ',&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2)
+ PEK%TREAP(:)%TDATE%MONTH = NINT(ZWORKI(:))
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
+ ZWORKI,DTV%XPAR_VEGTYPE,DTV%XPAR_REAP_D(:,:),YVEG,'MAJ',&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2)
+ PEK%TREAP(:)%TDATE%DAY = NINT(ZWORKI(:))
+ ELSE
+ CALL AV_PGD_1P (PEK%TREAP ,PCOVER,TDATA_REAP(:,:),YVEG,'MAJ',OCOVER,&
+ PK%NR_P,IO%NPATCH, KPATCH, KDECADE=KDEC)
+ ENDIF
+ ENDIF
+ !
+ DEALLOCATE(ZWORKI)
+ !
+ IF (SIZE(PEK%XIRRIG)>0) THEN
+ IF (GDATA .AND. ANY(DTV%LDATA_IRRIG)) THEN
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
+ PEK%XIRRIG,DTV%XPAR_VEGTYPE,DTV%XPAR_IRRIG(:,KDEC2,:),YVEG,'ARI',&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2)
+ ELSE
+ CALL AV_PGD_1P(DTCO, PEK%XIRRIG,PCOVER,XDATA_IRRIG,YVEG,'ARI',OCOVER,&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
+ ENDIF
+ ENDIF
+!
+ IF (SIZE(PEK%XWATSUP)>0) THEN
+ IF (GDATA .AND. ANY(DTV%LDATA_WATSUP)) THEN
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
+ PEK%XWATSUP,DTV%XPAR_VEGTYPE,DTV%XPAR_WATSUP(:,KDEC2,:),YVEG,'ARI',&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2)
+ ELSE
+ CALL AV_PGD_1P(DTCO, PEK%XWATSUP,PCOVER,XDATA_WATSUP,YVEG,'ARI',OCOVER,&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
+ ENDIF
+ ENDIF
+ !
+ ENDIF
+!
+ENDIF
+!
+IF (OALB) THEN
+!
+ IF (GDATA .AND. ANY(DTV%LDATA_ALBNIR_SOIL)) THEN
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
+ PEK%XALBNIR_SOIL,DTV%XPAR_VEGTYPE,DTV%XPAR_ALBNIR_SOIL(:,KDEC2,:),YBAR,'ARI',&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2)
+ ELSEIF (IO%CALBEDO=='CM13') THEN
+ CALL AV_PGD_1P(DTCO, PEK%XALBNIR_SOIL,PCOVER,XDATA_ALB_SOIL_NIR(:,KDEC,:),YBAR,'ARI',OCOVER,&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
+ ELSE
+ CALL SOIL_ALBEDO (IO%CALBEDO, PWSAT(:,1), PWG1, KK, PEK, "NIR" )
+ ENDIF
+!
+ IF (GDATA .AND. ANY(DTV%LDATA_ALBVIS_SOIL)) THEN
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
+ PEK%XALBVIS_SOIL,DTV%XPAR_VEGTYPE,DTV%XPAR_ALBVIS_SOIL(:,KDEC2,:),YBAR,'ARI',&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2)
+ ELSEIF (IO%CALBEDO=='CM13') THEN
+ CALL AV_PGD_1P(DTCO, PEK%XALBVIS_SOIL,PCOVER,XDATA_ALB_SOIL_VIS(:,KDEC,:),YBAR,'ARI',OCOVER,&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
+ ELSE
+ CALL SOIL_ALBEDO (IO%CALBEDO, PWSAT(:,1), PWG1, KK, PEK, "VIS" )
+ ENDIF
+!
+
+ IF (IO%CALBEDO=='CM13'.OR.IO%LTR_ML) THEN
+ PEK%XALBUV_SOIL(:)=PEK%XALBVIS_SOIL(:)
+ ELSEIF (GDATA .AND. ANY(DTV%LDATA_ALBUV_SOIL)) THEN
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
+ PEK%XALBUV_SOIL,DTV%XPAR_VEGTYPE,DTV%XPAR_ALBUV_SOIL(:,KDEC2,:),YNAT,'ARI',&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2)
+ ELSE
+ CALL SOIL_ALBEDO (IO%CALBEDO, PWSAT(:,1), PWG1, KK, PEK, "UV" )
+ ENDIF
+!
+ENDIF
+!
+IF (ASSOCIATED(DTCO%XDATA_WEIGHT)) DEALLOCATE(DTCO%XDATA_WEIGHT)
+!
+IF (LHOOK) CALL DR_HOOK('CONVERT_PATCH_ISBA',1,ZHOOK_HANDLE)
+!
+!-------------------------------------------------------------------------------
+CONTAINS
+!-------------------------------------------------------------------------------
+!
+SUBROUTINE SET_STRESS
+!
+IMPLICIT NONE
+!
+REAL, DIMENSION(PK%NSIZE_P) :: ZWORK
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZSTRESS
+INTEGER :: JI
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+IF (LHOOK) CALL DR_HOOK('CONVERT_PATCH_ISBA:SET_STRESS',0,ZHOOK_HANDLE)
+!
+IF (GDATA .AND. ANY(DTV%LDATA_STRESS)) THEN
+ ALLOCATE( ZSTRESS( SIZE(DTV%LPAR_STRESS,1),NVEGTYPE ) )
+ ZSTRESS(:,:)=0.
+ DO JVEG=1,NVEGTYPE
+ DO JI = 1,PK%NSIZE_P
+ IF (DTV%LPAR_STRESS(JI,JVEG)) ZSTRESS(PK%NR_P(JI),JVEG) = 1.
+ ENDDO
+ ENDDO
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
+ ZWORK,DTV%XPAR_VEGTYPE,ZSTRESS,YVEG,'ARI',PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC2)
+ DEALLOCATE( ZSTRESS )
+ELSE
+ CALL AV_PGD_1P(DTCO, ZWORK,PCOVER,XDATA_STRESS(:,:),YVEG,'ARI',OCOVER,PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
+ENDIF
+!
+WHERE (ZWORK(:)<0.5)
+ PEK%LSTRESS(:) = .FALSE.
+ELSEWHERE
+ PEK%LSTRESS(:) = .TRUE.
+END WHERE
+!
+IF (LHOOK) CALL DR_HOOK('CONVERT_PATCH_ISBA:SET_STRESS',1,ZHOOK_HANDLE)
+END SUBROUTINE SET_STRESS
+!
+!-------------------------------------------------------------------------------
+SUBROUTINE SET_GRID_PARAM(KNI,KGROUND)
+!
+USE MODD_PGDWORK, ONLY : XPREC
+!
+USE MODD_SURF_PAR, ONLY : XUNDEF, NUNDEF
+USE MODD_ISBA_PAR, ONLY : XPERMFRAC
+!
+USE MODD_REPROD_OPER, ONLY : CDGAVG, CDGDIF
+!
+USE MODI_INI_DATA_ROOTFRAC
+USE MODI_INI_DATA_SOIL
+USE MODI_PERMAFROST_DEPTH
+USE MODI_ABOR1_SFX
+!
+IMPLICIT NONE
+!
+INTEGER, INTENT(IN) :: KNI
+INTEGER, INTENT(IN) :: KGROUND
+!
+REAL, DIMENSION (SIZE(XDATA_GROUND_DEPTH,1),NVEGTYPE) :: ZDATA_GROUND_DEPTH
+!
+REAL, DIMENSION (KNI) :: ZDTOT, ZDG2, ZROOT_EXT, ZROOT_LIN
+!
+INTEGER :: JJ, JL
+!
+! flags taking general surface type flag into account
+LOGICAL :: GDATA_DG, GDATA_GROUND_DEPTH, GDATA_ROOT_DEPTH, GDATA_ROOTFRAC, &
+ GNOECO, GMEB
+!-------------------------------------------------------------------------!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+IF (LHOOK) CALL DR_HOOK('CONVERT_PATCH_ISBA:SET_GRID_PARAM',0,ZHOOK_HANDLE)
+!
+IF(IO%CISBA=='DIF')THEN
+ IF(.NOT.OFIX) CALL ABOR1_SFX('CONVERT_PATCH_ISBA: SET_GRID_PARAM: KWG_LAYER, PDROOT and PGD2 must be present with DIF')
+
+ENDIF
+!
+GMEB = (OMEB .AND. (ISIZE_LMEB_PATCH>0))
+!
+ZDTOT (:) = XUNDEF
+ZDG2 (:) = XUNDEF
+!
+PK%NWG_LAYER(:) = NUNDEF
+PK%XROOTFRAC(:,:) = XUNDEF
+!
+ZDATA_GROUND_DEPTH(:,:) = XDATA_GROUND_DEPTH(:,:)
+!
+GDATA_DG = GDATA .AND. ANY(DTV%LDATA_DG)
+GDATA_GROUND_DEPTH = GDATA .AND. ANY(DTV%LDATA_GROUND_DEPTH)
+GDATA_ROOT_DEPTH = GDATA .AND. ANY(DTV%LDATA_ROOT_DEPTH)
+GDATA_ROOTFRAC = GDATA .AND. ANY(DTV%LDATA_ROOTFRAC)
+!
+!####################################################################################
+!
+!CDGAVG : old for reprod = 'ARI' Arithmetic average for all depth
+! recommended = 'INV' Harmonic average for all depth (default)
+!
+!CDGDIF : old for reprod = 'SOIL' d3 soil depth from ecoclimap for isba-df
+! recommended = 'ROOT' d2 soil depth from ecoclimap for isba-df (default)
+!
+!####################################################################################
+!n
+!DG IN NAMELIST => GROUND_DEPTH KNOWN, ROOT_DEPTH UNKNOWN
+IF (GDATA_DG) THEN
+ !
+ DO JLAYER=1,KGROUND
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
+ PK%XDG(:,JLAYER),DTV%XPAR_VEGTYPE,DTV%XPAR_DG(:,JLAYER,:),YNAT,CDGAVG,&
+ PK%NR_P,IO%NPATCH,KPATCH)
+ ENDDO
+ !
+ENDIF
+!
+IF(.NOT.GDATA_GROUND_DEPTH.AND.IO%CISBA=='DIF'.AND.CDGDIF=='ROOT')THEN
+ !
+ DO JVEG=1,NVEGTYPE
+ IF(JVEG==NVT_NO)THEN
+ WHERE(XDATA_GROUND_DEPTH(:,JVEG)/=XUNDEF)
+ ZDATA_GROUND_DEPTH(:,JVEG) = MIN(1.0,XDATA_GROUND_DEPTH(:,JVEG))
+ ENDWHERE
+ ELSEIF(JVEG/=NVT_ROCK.AND.JVEG/=NVT_SNOW)THEN
+ ZDATA_GROUND_DEPTH(:,JVEG) = MAX(1.0,XDATA_ROOT_DEPTH(:,JVEG))
+ ELSE
+ ZDATA_GROUND_DEPTH(:,JVEG) = XDATA_ROOT_DEPTH(:,JVEG)
+ ENDIF
+ ENDDO
+ !
+ENDIF
+!
+!CALCULATION OF GROUND_DEPTH IN ZDTOT : ECOCLMAP OR LDATA_GROUND_DEPTH
+IF (IO%CISBA/='2-L') THEN
+ !
+ IF (GDATA_GROUND_DEPTH .AND. (IO%CISBA=='DIF' .OR. .NOT.GDATA_DG)) THEN
+ !GROUND DEPTH IN NAMELIST
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
+ ZDTOT(:),DTV%XPAR_VEGTYPE,DTV%XPAR_GROUND_DEPTH(:,:),YNAT,CDGAVG,&
+ PK%NR_P,IO%NPATCH,KPATCH)
+ !Error Due to machine precision
+ WHERE(ZDTOT(:)/=XUNDEF) ZDTOT(:)=NINT(ZDTOT(:)*XPREC)/XPREC
+ !CONSISTENCY CHECK
+ IF (GDATA_DG) ZDTOT(:) = MIN(ZDTOT(:),PK%XDG(:,KGROUND))
+ ELSEIF (GDATA_DG) THEN
+ !GROUND DEPTH FROM NAMELIST DG
+ ZDTOT(:) = PK%XDG(:,KGROUND)
+ ELSE
+ !GROUND DEPTH FROM ECOCLMAP
+ CALL AV_PGD_1P(DTCO, ZDTOT(:),PCOVER,ZDATA_GROUND_DEPTH(:,:),YNAT,CDGAVG,OCOVER,&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
+ IF(IO%CISBA=='DIF'.AND.CDGDIF=='ROOT')ZDG2(:)=ZDTOT(:)
+ ENDIF
+ !
+ENDIF
+!
+!CALCULATION OF GROUND_DEPTH : Permafrost depth put to 12m
+IF(IO%CISBA=='DIF'.AND.IO%LPERM) CALL PERMAFROST_DEPTH(PK%NSIZE_P,KPATCH,PPERM,ZDTOT)
+!
+!IN BOTH CASES, ROOT_DEPTH IS NEEDED: PUT IN DG2
+IF (IO%CISBA=='DIF' .OR. .NOT.GDATA_DG) THEN
+ !
+ GNOECO=(GDATA_ROOT_DEPTH .AND. .NOT.GDATA_ROOTFRAC)
+ IF (GNOECO) THEN
+ !ROOT_DEPTH IN NAMELIST
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
+ ZDG2(:),DTV%XPAR_VEGTYPE,DTV%XPAR_ROOT_DEPTH(:,:),YNAT,CDGAVG,&
+ PK%NR_P,IO%NPATCH,KPATCH)
+ !Error Due to machine precision
+ WHERE(ZDG2(:)/=XUNDEF) ZDG2(:)=NINT(ZDG2(:)*XPREC)/XPREC
+ !CONSISTENCY CHECKS
+ IF (ANY(DTV%LDATA_DG)) ZDG2(:) = MIN(ZDG2(:),PK%XDG(:,KGROUND))
+ ZDTOT(:) = MAX(ZDG2(:),ZDTOT(:))
+ IF (IO%CISBA=='DIF') THEN
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
+ PK%XDROOT(:),DTV%XPAR_VEGTYPE,DTV%XPAR_ROOT_DEPTH(:,:),YDIF,CDGAVG,&
+ PK%NR_P,IO%NPATCH,KPATCH)
+ !Error Due to machine precision
+ WHERE(PK%XDROOT(:)/=XUNDEF)
+ PK%XDROOT(:)=NINT(PK%XDROOT(:)*XPREC)/XPREC
+ ENDWHERE
+ IF(CDGDIF=='ROOT')THEN
+ WHERE(PK%XDROOT(:).NE.XUNDEF) ZDTOT(:) = MAX(PK%XDROOT(:),ZDTOT(:))
+ WHERE(PK%XDROOT(:).NE.XUNDEF) ZDG2 (:) = MAX(PK%XDROOT(:),ZDG2 (:))
+ ELSE
+ CALL AV_PGD_1P(DTCO, ZDG2(:),PCOVER,XDATA_ROOT_DEPTH(:,:),YNAT,CDGAVG,OCOVER,&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
+ ENDIF
+ !CONSISTENCY CHECKS
+ IF (GDATA_DG) WHERE (PK%XDROOT(:).NE.XUNDEF) PK%XDROOT(:) = MIN(PK%XDROOT(:),PK%XDG(:,KGROUND))
+ ENDIF
+ ELSE
+ !ROOT_DEPTH FROM ECOCLMAP
+ IF (IO%CISBA=='DIF')THEN
+ CALL AV_PGD_1P(DTCO, PK%XDROOT(:),PCOVER,XDATA_ROOT_DEPTH(:,:),YDIF,CDGAVG,OCOVER,&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
+ IF(CDGDIF=='ROOT')THEN
+ WHERE(PK%XDROOT(:).NE.XUNDEF) ZDTOT(:) = MAX(PK%XDROOT(:),ZDTOT(:))
+ WHERE(PK%XDROOT(:).NE.XUNDEF) ZDG2 (:) = MAX(PK%XDROOT(:),ZDG2 (:))
+ ELSE
+ CALL AV_PGD_1P(DTCO, ZDG2(:),PCOVER,XDATA_ROOT_DEPTH(:,:),YNAT,CDGAVG,OCOVER,&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
+ ENDIF
+ ELSE
+ CALL AV_PGD_1P(DTCO, ZDG2(:),PCOVER,XDATA_ROOT_DEPTH(:,:),YNAT,CDGAVG,OCOVER,&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
+ ENDIF
+ IF ( GDATA_GROUND_DEPTH .OR. GDATA_DG ) THEN
+ ZDG2 (:) = MIN(ZDG2 (:),ZDTOT(:))
+ IF (IO%CISBA=='DIF') WHERE (PK%XDROOT(:).NE.XUNDEF) PK%XDROOT(:) = MIN(PK%XDROOT(:),ZDTOT(:))
+ ENDIF
+ ENDIF
+ !
+ !CALCULATION OF DG IF NOT IN NAMELIST
+ IF (.NOT.GDATA_DG) THEN
+ !
+ IF (IO%CISBA=='DIF') THEN
+ IF( MAXVAL(ZDTOT,ZDTOT/=XUNDEF)>PSOILGRID(KGROUND) ) THEN
+ CALL ABOR1_SFX('CONVERT_PATCH_ISBA: not enough soil layer with optimized grid')
+ ENDIF
+ ENDIF
+ !
+ WHERE(ZDG2(:)==XUNDEF.AND.ZDTOT(:)/=XUNDEF) ZDG2(:)=0.0 !No vegetation
+ !
+ !IF CISBA=DIF CALCULATES ALSO KWG_LAYER WITH USE OF SOILGRID $
+ CALL INI_DATA_SOIL(IO%CISBA, PK%XDG,PROOTDEPTH=ZDG2, PSOILDEPTH=ZDTOT,&
+ PSOILGRID=PSOILGRID, KWG_LAYER=PK%NWG_LAYER )
+ IF (IO%CISBA=='DIF'.AND.CDGDIF=='ROOT')THEN
+ DO JJ=1,KNI
+ IF(IO%LPERM.AND.PK%NWG_LAYER(JJ)/=NUNDEF)THEN
+ IF(PPERM(JJ)<XPERMFRAC) ZDG2(JJ)=PK%XDG(JJ,PK%NWG_LAYER(JJ))
+ ELSEIF(PK%NWG_LAYER(JJ)/=NUNDEF)THEN
+ ZDG2(JJ)=PK%XDG(JJ,PK%NWG_LAYER(JJ))
+ ELSE
+ ZDG2(JJ)=XUNDEF
+ ENDIF
+ ENDDO
+ ENDIF
+
+ !
+ ELSEIF ( IO%CISBA=='DIF') THEN
+ !
+ !CALCULATION OF KWG_LAYER IF DG IN NAMELIST
+ IF(GDATA_GROUND_DEPTH)THEN
+ DO JJ=1,KNI
+ DO JL=1,KGROUND
+ IF( PK%XDG(JJ,JL) <= ZDTOT(JJ) .AND. ZDTOT(JJ) < XUNDEF ) &
+ PK%NWG_LAYER(JJ) = JL
+ ENDDO
+ ENDDO
+ ELSE
+ PK%NWG_LAYER(:) = KGROUND
+ ENDIF
+ !
+ ENDIF
+ !
+ ! DROOT AND DG2 LMITED BY KWG_LAYER
+ IF (IO%CISBA=='DIF' .AND. .NOT.ANY(DTV%LDATA_ROOTFRAC)) THEN
+ !
+ DO JJ=1,KNI
+ IF(PK%NWG_LAYER(JJ)/=NUNDEF) THEN
+ JL = PK%NWG_LAYER(JJ)
+ ZDG2 (JJ)=MIN(ZDG2 (JJ),PK%XDG(JJ,JL))
+ IF (PK%XDROOT(JJ)/=XUNDEF) PK%XDROOT(JJ)=MIN(PK%XDROOT(JJ),PK%XDG(JJ,JL))
+ ENDIF
+ ENDDO
+ !
+ ENDIF
+ !
+ENDIF
+!
+!CALCULATION OF ROOTFRAC
+IF (IO%CISBA=='DIF') THEN
+ !
+ IF (GDATA_ROOTFRAC) THEN
+ !
+ !ROOTFRAC IN NAMELIST
+ DO JL=1,KGROUND
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
+ PK%XROOTFRAC(:,JL),DTV%XPAR_VEGTYPE,DTV%XPAR_ROOTFRAC(:,JL,:),YNAT,'ARI',&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
+ ENDDO
+ !
+ ZDG2 (:)=0.0
+ PK%XDROOT(:)=0.0
+ DO JJ=1,KNI
+ !
+ !DROOT DEPENDS ON ROOTFRAC
+ DO JL=KGROUND,1,-1
+ IF( PK%XROOTFRAC(JJ,JL)>=1.0 )THEN
+ ZDG2 (JJ) = PK%XDG(JJ,JL)
+ PK%XDROOT(JJ) = PK%XDG(JJ,JL)
+ ELSEIF (JL<KGROUND.AND.PK%XROOTFRAC(JJ,JL)>0.0) THEN
+ IF (PK%NWG_LAYER(JJ)<=JL) PK%NWG_LAYER(JJ) = JL+1
+ EXIT
+ ENDIF
+ ENDDO
+ !
+ IF(PK%XDROOT(JJ)==0.0.AND.ZDG2(JJ)==0.0)THEN
+ JL=PK%NWG_LAYER(JJ)
+ ZDG2(JJ)=MIN(0.6,PK%XDG(JJ,JL))
+ ENDIF
+ !
+ ENDDO
+ !
+ ELSE
+ !
+ !DEPENDS ON DROOT
+ IF (GDATA .AND. ANY(DTV%LDATA_ROOT_LIN)) THEN
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
+ ZROOT_LIN(:),DTV%XPAR_VEGTYPE,DTV%XPAR_ROOT_LIN(:,:),YDIF,'ARI',&
+ PK%NR_P,IO%NPATCH,KPATCH)
+ ELSE
+ CALL AV_PGD_1P(DTCO, ZROOT_LIN(:),PCOVER,XDATA_ROOT_LIN(:,:),YDIF,'ARI',OCOVER,&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
+ ENDIF
+ !
+ IF (GDATA .AND. ANY(DTV%LDATA_ROOT_EXTINCTION)) THEN
+ CALL AV_PGD_PARAM(DTV%XPAR_LAI, DTV%XPAR_VEG, &
+ ZROOT_EXT(:),DTV%XPAR_VEGTYPE,DTV%XPAR_ROOT_EXTINCTION(:,:),YDIF,'ARI',&
+ PK%NR_P,IO%NPATCH,KPATCH)
+ ELSE
+ CALL AV_PGD_1P(DTCO, ZROOT_EXT(:),PCOVER,XDATA_ROOT_EXTINCTION(:,:),YDIF,'ARI',OCOVER,&
+ PK%NR_P,IO%NPATCH,KPATCH,KDECADE=KDEC)
+ ENDIF
+ !
+ CALL INI_DATA_ROOTFRAC(PK%XDG,PK%XDROOT,ZROOT_EXT,ZROOT_LIN,PK%XROOTFRAC)
+ ENDIF
+ !
+ WHERE(PK%XROOTFRAC(:,:)/=XUNDEF) PK%XROOTFRAC(:,:)=NINT(PK%XROOTFRAC(:,:)*XPREC)/XPREC
+ !
+ PK%XDG2(:) = ZDG2(:)
+ !
+ENDIF
+!
+IF (LHOOK) CALL DR_HOOK('CONVERT_PATCH_ISBA:SET_GRID_PARAM',1,ZHOOK_HANDLE)
+!
+END SUBROUTINE SET_GRID_PARAM
+!-------------------------------------------------------------------------------
+END SUBROUTINE CONVERT_PATCH_ISBA
diff --git a/src/ICCARE_BASE/coupling_isban.F90 b/src/ICCARE_BASE/coupling_isban.F90
index 3233dc4efa58d1c5f8255c45d9074e423b6146d1..044da5c75010a8a004053af94cb6c07810e0cdbc 100644
--- a/src/ICCARE_BASE/coupling_isban.F90
+++ b/src/ICCARE_BASE/coupling_isban.F90
@@ -11,7 +11,7 @@ SUBROUTINE COUPLING_ISBA_n (DTCO, UG, U, USS, NAG, CHI, NCHI, MGN, MSF, DTI, ID
PDIR_SW, PSCA_SW, PSW_BANDS, PPS, PPA, PSFTQ, PSFTH, PSFTS, &
PSFCO2, PSFU, PSFV, PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, &
PTSURF, PZ0, PZ0H, PQSURF, PPEW_A_COEF, PPEW_B_COEF, &
- PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, HTEST )
+ PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, HTEST )
! ###############################################################################
!
!!**** *COUPLING_ISBA_n * - Driver for ISBA time step
@@ -257,7 +257,8 @@ REAL, DIMENSION(KI), INTENT(IN) :: PPET_A_COEF
REAL, DIMENSION(KI), INTENT(IN) :: PPEQ_A_COEF
REAL, DIMENSION(KI), INTENT(IN) :: PPET_B_COEF
REAL, DIMENSION(KI), INTENT(IN) :: PPEQ_B_COEF
- CHARACTER(LEN=2), INTENT(IN) :: HTEST ! must be equal to 'OK'
+CHARACTER(LEN=2), INTENT(IN) :: HTEST ! must be equal to 'OK'
+
!
!
!* 0.2 declarations of local variables
@@ -567,6 +568,22 @@ ENDIF
ZSFCO2_TILE, ZSFU_TILE, ZSFV_TILE, PSFTH, PSFTQ,&
PSFTS, PSFCO2, PSFU, PSFV )
!
+! Get output megan flux if megan is activated
+
+
+IF (CHI%SVI%NBEQ>0 .AND. CHI%LCH_BIO_FLUX) THEN
+ IF (TRIM(CHI%CPARAMBVOC) == 'MEGAN') THEN
+ ! Get output Isoprene flux
+ DO II=1,SIZE(MGN%XBIOFLX,1)
+ IF ((S%XPATCH(II,1) + S%XPATCH(II,2) + S%XPATCH(II,3)) .LT. 1.) THEN
+ MGN%XBIOFLX(II) = PSFTS(II,MGN%NBIO)/(1. - S%XPATCH(II,1) - S%XPATCH(II,2) - S%XPATCH(II,3))
+ ELSE
+ MGN%XBIOFLX(:) = PSFTS(:,MGN%NBIO)
+ ENDIF
+ ENDDO
+ ENDIF
+ENDIF
+
!
!-------------------------------------------------------------------------------
!Physical properties see by the atmosphere in order to close the energy budget
@@ -705,7 +722,8 @@ REAL, DIMENSION(PK%NSIZE_P) :: ZP_TRAD ! radiative temperature
REAL, DIMENSION(PK%NSIZE_P) :: ZP_TSURF ! surface effective temperature (K)
REAL, DIMENSION(PK%NSIZE_P) :: ZP_Z0 ! roughness length for momentum (m)
REAL, DIMENSION(PK%NSIZE_P) :: ZP_Z0H ! roughness length for heat (m)
-REAL, DIMENSION(PK%NSIZE_P) :: ZP_QSURF ! specific humidity at surface (kg/kg)
+REAL, DIMENSION(PK%NSIZE_P):: ZP_QSURF ! specific humidity at surface (kg/kg)
+REAL, DIMENSION(PK%NSIZE_P) :: ZP_TEMP, ZP_PAR
!
!* other forcing variables (packed for each patch)
!
@@ -730,6 +748,7 @@ REAL, DIMENSION(PK%NSIZE_P) :: ZP_FFVNOS !Floodplain fraction over vegetation
!
REAL, DIMENSION(:,:),ALLOCATABLE :: ZP_PFT
REAL, DIMENSION(:,:),ALLOCATABLE :: ZP_EF
+REAL, DIMENSION(:), ALLOCATABLE :: ZP_T24, ZP_PFD24
INTEGER, DIMENSION(PK%NSIZE_P) :: IP_SLTYP
!
REAL, DIMENSION(PK%NSIZE_P,IO%NNBIOMASS) :: ZP_RESP_BIOMASS_INST ! instantaneous biomass respiration (kgCO2/kgair m/s)
@@ -787,6 +806,16 @@ IF (ASSOCIATED(MGN%XEF)) THEN
ELSE
ALLOCATE(ZP_EF(0,0))
ENDIF
+IF (ASSOCIATED(MGN%XPPFD24)) THEN
+ ALLOCATE(ZP_PFD24(PK%NSIZE_P))
+ELSE
+ ALLOCATE(ZP_PFD24(0))
+ENDIF
+IF (ASSOCIATED(MGN%XT24)) THEN
+ ALLOCATE(ZP_T24(PK%NSIZE_P))
+ELSE
+ ALLOCATE(ZP_T24(0))
+ENDIF
!--------------------------------------------------------------------------------------
!
! Pack isba forcing outputs
@@ -827,7 +856,10 @@ IF (IO%NPATCH==1) THEN
ZP_PFT(:,:) = MGN%XPFT (:,:)
ZP_EF(:,:) = MGN%XEF (:,:)
IP_SLTYP(:) = MGN%NSLTYP (:)
+ ZP_PFD24(:) = MGN%XPPFD24 (:)
+ ZP_T24(:) = MGN%XT24 (:)
END IF
+
ZP_RNSHADE(:) = ZRNSHADE (:)
ZP_RNSUNLIT(:) = ZRNSUNLIT (:)
@@ -890,6 +922,8 @@ ELSE
ZP_PFT(:,JJ) = MGN%XPFT (:,JI)
ZP_EF(:,JJ) = MGN%XEF (:,JI)
IP_SLTYP(JJ) = MGN%NSLTYP (JI)
+ ZP_PFD24(JJ) = MGN%XPPFD24 (JI)
+ ZP_T24(JJ) = MGN%XT24 (JI)
ENDDO
END IF
DO JJ=1,PK%NSIZE_P
@@ -1160,12 +1194,14 @@ IF (CHI%SVI%NBEQ>0 .AND. CHI%LCH_BIO_FLUX) THEN
GBK%XIACAN = 0.
END WHERE
!UPG*PT
+ IBEG = CHI%SVI%NSV_CHSBEG
+ IEND = CHI%SVI%NSV_CHSEND
- CALL COUPLING_MEGAN_n(MGN, CHI, GK, PEK, &
- KYEAR, KMONTH, KDAY, PTIME, IO%LTR_ML, &
- IP_SLTYP, ZP_PFT, ZP_EF, &
+ CALL COUPLING_MEGAN_n(MGN, CHI, GK, PEK, PTSTEP, &
+ KYEAR, KMONTH, KDAY, PTIME, S%TTIME%TIME, IO%LTR_ML, &
+ IP_SLTYP, ZP_PFT, ZP_EF, ZP_PFD24, ZP_T24, &
ZP_TA, GBK%XIACAN, ZP_TRAD, ZP_RNSUNLIT, ZP_RNSHADE, &
- ZP_WIND, ZP_PA, ZP_QA, ZP_SFTS)
+ ZP_WIND, ZP_PA, ZP_QA, ZP_SFTS(:,IBEG:IEND))
END IF
ENDIF
diff --git a/src/ICCARE_BASE/coupling_megann.F90 b/src/ICCARE_BASE/coupling_megann.F90
new file mode 100644
index 0000000000000000000000000000000000000000..11b5991bbe52ec3ae3d3bd1ddfc16c10777fc216
--- /dev/null
+++ b/src/ICCARE_BASE/coupling_megann.F90
@@ -0,0 +1,247 @@
+!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SFX_LIC for details. version 1.
+! ###############################
+ SUBROUTINE COUPLING_MEGAN_n(MGN, CHI, GK, PEK, PTSTEP, &
+ KYEAR, KMONTH, KDAY, PTIME, PTIME2, OTR_ML, &
+ KSLTYP, PPFT, PEF, PPFD24, PT24, &
+ PTEMP, PIACAN, PLEAFT, PRN_SUNLIT, PRN_SHADE, &
+ PWIND, PPRES, PQV, PSFTS)
+! ###############################
+!!
+!!*** *BVOCEM*
+!!
+!! PURPOSE
+!! -------
+!! Calculate the biogenic emission fluxes upon the MEGAN code
+!! http://lar.wsu.edu/megan/
+!!
+!! METHOD
+!! ------
+!!
+!!
+!! AUTHOR
+!! ------
+!! P. Tulet (LACy)
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original: 25/10/2014
+!! Modified: 06/07/2017, J. Pianezze, adaptation for SurfEx v8.0
+!! Modified: 06/07/2018, P. Tulet, correction for T leaf
+!! Modified: 06/02/2021, S. Oumami, off-line & daily averages use
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!
+USE MODD_MEGAN_n, ONLY : MEGAN_t
+USE MODD_CH_ISBA_n, ONLY : CH_ISBA_t
+USE MODD_ISBA_n, ONLY: ISBA_PE_t
+USE MODD_SFX_GRID_n, ONLY: GRID_t
+!
+USE MODD_CSTS, ONLY : XAVOGADRO, XDAY
+!
+#ifdef MNH_MEGAN
+USE MODD_MEGAN
+USE MODI_JULIAN
+USE MODI_EMPROC
+USE MODI_MGN2MECH
+#endif
+!
+!------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! -----------------
+!
+IMPLICIT NONE
+!
+TYPE(MEGAN_t), INTENT(INOUT) :: MGN
+TYPE(CH_ISBA_t), INTENT(INOUT) :: CHI
+TYPE(GRID_t), INTENT(INOUT) :: GK
+TYPE(ISBA_PE_t), INTENT(INOUT) :: PEK
+!
+!* 0.1 declaration of arguments
+!
+INTEGER, INTENT(IN) :: KYEAR ! I current year (UTC)
+INTEGER, INTENT(IN) :: KMONTH ! I current month (UTC)
+INTEGER, INTENT(IN) :: KDAY ! I current day (UTC)
+REAL, INTENT(IN) :: PTIME ! I current time since midnight (UTC, s)
+REAL, INTENT(IN) :: PTIME2 ! Time since simulation begin (s)
+LOGICAL, INTENT(IN) :: OTR_ML ! new radiation for leaves temperatures
+REAL, INTENT(IN) :: PTSTEP ! atmospheric time-step (s)
+!
+REAL, DIMENSION(:), INTENT(IN) :: PTEMP ! I Air temperature (K)
+REAL, DIMENSION(:,:),INTENT(IN) :: PIACAN ! I PAR (W/m2)
+REAL, DIMENSION(:), INTENT(IN) :: PLEAFT ! I Leaf temperature (K)
+REAL, DIMENSION(:), INTENT(IN) :: PRN_SUNLIT! I Leaf RN
+REAL, DIMENSION(:), INTENT(IN) :: PRN_SHADE ! I Leaf RN
+REAL, DIMENSION(:), INTENT(INOUT) :: PPFD24
+REAL, DIMENSION(:), INTENT(INOUT) :: PT24
+REAL, DIMENSION(:), INTENT(IN) :: PWIND
+REAL, DIMENSION(:), INTENT(IN) :: PPRES ! I Atmospheric pressure (Pa)
+REAL, DIMENSION(:), INTENT(IN) :: PQV ! I Air humidity (kg/kg)
+REAL, DIMENSION(:,:),INTENT(IN) :: PPFT, PEF
+INTEGER, DIMENSION(:), INTENT(IN) :: KSLTYP
+REAL, DIMENSION(:,:),INTENT(INOUT) :: PSFTS ! O Scalar flux in molecules/m2/s
+#ifdef MNH_MEGAN
+!* 0.1 Declaration of local variables
+!
+INTEGER, PARAMETER :: NROWS = 1
+INTEGER :: ITIME ! Time of the day HHMMSS
+INTEGER :: IDATE ! Date YYYYDDD
+INTEGER :: IDAY ! julian day
+REAL :: ZHOUR, ZMIN, ZSEC ! conversion ptime to itime format
+REAL, DIMENSION(SIZE(PTEMP)) :: ZLAIC ! Current monthly LAI
+REAL, DIMENSION(SIZE(PTEMP)) :: ZPFD ! Calculated PAR (umol/m2.s)
+REAL, DIMENSION(SIZE(PTEMP)) :: ZLSUT ! Leaf on sun temperature (K)
+REAL, DIMENSION(SIZE(PTEMP)) :: ZLSHT ! Leaf on shade temperature (K)
+REAL, DIMENSION(SIZE(PTEMP)) :: ZRN
+REAL, DIMENSION(SIZE(PTEMP)) :: ZCFNO ! NO correction factor
+REAL, DIMENSION(SIZE(PTEMP)) :: ZCFNOG ! NO correction factor for grass
+REAL, DIMENSION(N_MGN_SPC,SIZE(PTEMP)) :: ZCFSPEC ! Output emission buffer
+REAL, DIMENSION(MGN%NVARS3D,SIZE(PTEMP)) :: ZFLUX ! Output emission megan flux
+REAL, DIMENSION(SIZE(PTEMP)) :: ZD_TEMP, ZTSUM ! Daily temperature (K) and daily sum temperature
+
+!
+REAL :: ZDI ! Drought Index (0 normal, -2 moderate drought, -3 severe drought, -4 extreme drought)
+REAL :: ZREC_ADJ ! Rain adjustment factor
+!
+INTEGER,DIMENSION(SIZE(PTEMP)) :: ISLTYP !Soil category (function of silt, clay and sand))
+INTEGER :: JSV, JSM
+INTEGER, SAVE :: ICOUNTNEW, ICOUNT, INB_COUNT
+LOGICAL, SAVE :: GFIRSTCALL = .TRUE.
+
+!
+! Input parameters
+ZHOUR = FLOAT(INT(PTIME/3600.))
+ZMIN = FLOAT(INT((PTIME - ZHOUR*3600) / 60.))
+ZSEC = FLOAT(INT(PTIME - ZHOUR*3600. - ZMIN * 60.))
+ITIME = INT(ZHOUR)*10000 + INT(ZMIN)*100 + ZSEC
+IDAY = JULIAN(KYEAR, KMONTH, KDAY)
+IDATE = KYEAR*1000 + IDAY
+!
+! current = previous pour le LAI, a modifier si CPHOTO=LAI (evolutif)
+ZLAIC(:) = MIN(MAX(0.001,PEK%XLAI(:)),8.)
+!
+ZDI = MGN%XDROUGHT
+ZREC_ADJ = MGN%XMODPREC
+ZCFNO = 0.
+ZCFNOG = 0.
+ZCFSPEC = 0.
+
+! Compute PAR from the entire canopy and conversion W/m2 in micromol/m²/s
+ZPFD(:) = 0.
+DO JSM = 1,SIZE(PIACAN,2)
+ ZPFD(:) = ZPFD(:) + PIACAN(:, JSM) * 4.6
+END DO
+
+
+!INB_COUNT=INB_COUNT+1
+!ICOUNTNEW = INT(INB_COUNT*PTSTEP/XDAY)
+
+PT24(:) = PT24(:)*XDAY / (XDAY + PTSTEP) + PTEMP(:)* PTSTEP / (XDAY + PTSTEP)
+PPFD24(:) = PPFD24(:)*XDAY / (XDAY + PTSTEP) + ZPFD(:)*PTSTEP / (XDAY + PTSTEP)
+
+! UPG*PT en attendat un calcul propre. Temperature des feuilles à l'ombre egale a la
+! température de l'air. La temparature des feuilles au soleil egale a la valeur
+! max entre la temperature de l'air et la temperaure radiative.
+ZLSUT(:) = MAX(PLEAFT(:),PTEMP(:))
+ZLSHT(:) = PTEMP(:)
+!UPG*PT
+
+!
+! MEGAN : calcul des facteurs d'ajustement et de perte dans la canopée.
+! ZCFSPEC: classe de sorties MEGAN (voir SPC_NOCONVER.EXT)
+! 1: ISOP isoprene
+! 2: MYRC myrcene
+! 3: SABI sabinene
+! 4: LIMO limonene
+! 5: A_3CAR carene_3
+! 6: OCIM ocimene_t_b
+! 7: BPIN pinene_b
+! 8: APIN pinene_a
+! 9: OMTP A_2met_styrene + cymene_p + cymene_o + phellandrene_a + thujene_a + terpinene_a
+! + terpinene_g + terpinolene + phellandrene_b + camphene + bornene + fenchene_a
+! + ocimene_al + ....
+! 10: FARN
+! 11: BCAR
+! 12: OSQT
+! 13: MBO
+! 14: MEOH
+! 15: ACTO
+! 16: CO
+! 17: NO
+! 18: BIDER
+! 19: STRESS
+! 20: OTHER
+!
+
+CALL EMPROC(ITIME, IDATE, PPFD24, PT24, ZDI, ZREC_ADJ, &
+ GK%XLAT, GK%XLON, ZLAIC, ZLAIC, PTEMP, &
+ ZPFD, PWIND, PPRES, PQV, KSLTYP, &
+ PEK%XWG(:,1), PEK%XTG(:,1), PPFT, &
+ CHI%LSOILNOX, ZCFNO, ZCFNOG, ZCFSPEC)
+!
+! MEGAN : calcul des flux d'émission
+! Dans cette partie du programme les sorties des 20 catégories obtenues à l'issu de la partie
+!EMPROC sont multipliées par les valeurs des facteurs d'émissions correspondants, puis converties
+!en 150 espèces, et associées en différentes catégories chimiques en fonction du schéma de chimie
+!atmosphérique choisi parmi RADM2, RACM, SAPRCII, SAPRC99, CBMZ, SAPRC99X,
+!SAPRC99Q, CB05, CB6, SOAX .
+!
+CALL MGN2MECH(IDATE, GK%XLAT, PEF, PPFT, ZCFNO, ZCFNOG, ZCFSPEC, &
+ MGN%NSPMH_MAP, MGN%NMECH_MAP, MGN%XCONV_FAC, &
+ MGN%LCONVERSION, ZFLUX)
+!
+! Conversion ZFLUX from MEGAN mole/m2/s into molec/m2/s
+ZFLUX(:,:) = ZFLUX(:,:) * XAVOGADRO
+!
+! Case of the same species between megan and mesonh
+DO JSV=1, SIZE(CHI%SVI%CSV)
+ DO JSM=1, MGN%NVARS3D
+ IF (TRIM(CHI%SVI%CSV(JSV)) == TRIM(MGN%CVNAME3D(JSM))) THEN
+ PSFTS(:,JSV) = PSFTS(:,JSV) + ZFLUX(JSM,:)
+ END IF
+ END DO
+END DO
+!
+! Case of special treatment : ReLACS 1, 2, 3 scheme or CACM scheme
+! Megan conversion is upon SOAX species
+IF ( TRIM(MGN%CMECHANISM)=="RELACS" ) THEN
+ PSFTS(:,MGN%NBIO ) = PSFTS(:,MGN%NBIO ) + ZFLUX(MGN%NISOPRENE,:) + ZFLUX(MGN%NTRP1,:)
+ENDIF
+!
+IF ( TRIM(MGN%CMECHANISM)=="RELACS2") THEN
+ PSFTS(:,MGN%NORA1) = PSFTS(:,MGN%NORA1) + ZFLUX(MGN%NHCOOH,:)
+ PSFTS(:,MGN%NORA2) = PSFTS(:,MGN%NORA2) + ZFLUX(MGN%NCCO_OH,:)
+ PSFTS(:,MGN%NACID) = PSFTS(:,MGN%NACID) + ZFLUX(MGN%NRCO_OH,:)
+END IF
+!
+IF ( TRIM(MGN%CMECHANISM)=="CACM" ) THEN
+ PSFTS(:,MGN%NACID) = PSFTS(:,MGN%NACID) + ZFLUX(MGN%NHCOOH,:) + ZFLUX(MGN%NCCO_OH,:) + ZFLUX(MGN%NRCO_OH,:)
+ENDIF
+
+IF ( TRIM(MGN%CMECHANISM)=="CACM".OR.TRIM(MGN%CMECHANISM)=="RELACS2" ) THEN
+ PSFTS(:,MGN%NISOP) = PSFTS(:,MGN%NISOP) + ZFLUX(MGN%NISOPRENE,:)
+ PSFTS(:,MGN%NBIOH) = PSFTS(:,MGN%NBIOH) + 0.75*ZFLUX(MGN%NTRP1,:)
+ PSFTS(:,MGN%NBIOL) = PSFTS(:,MGN%NBIOL) + 0.25*ZFLUX(MGN%NTRP1,:)
+ PSFTS(:,MGN%NKETL) = PSFTS(:,MGN%NKETL) + ZFLUX(MGN%NACET,:) + ZFLUX(MGN%NMEK,:)
+ PSFTS(:,MGN%NARAL) = PSFTS(:,MGN%NARAL) + ZFLUX(MGN%NBALD,:)
+ PSFTS(:,MGN%NETHE) = PSFTS(:,MGN%NETHE) + ZFLUX(MGN%NETHENE,:)
+ PSFTS(:,MGN%NALKL) = PSFTS(:,MGN%NALKL) + ZFLUX(MGN%NALK4,:)
+ PSFTS(:,MGN%NALKM) = PSFTS(:,MGN%NALKM) + 0.5*ZFLUX(MGN%NALK5,:)
+ PSFTS(:,MGN%NALKH) = PSFTS(:,MGN%NALKH) + 0.5*ZFLUX(MGN%NALK5,:)
+ PSFTS(:,MGN%NAROH) = PSFTS(:,MGN%NAROH) + 0.5*ZFLUX(MGN%NARO1,:)
+ PSFTS(:,MGN%NAROL) = PSFTS(:,MGN%NAROL) + 0.5*ZFLUX(MGN%NARO1,:)
+ PSFTS(:,MGN%NAROO) = PSFTS(:,MGN%NAROO) + ZFLUX(MGN%NARO2,:)
+ PSFTS(:,MGN%NOLEL) = PSFTS(:,MGN%NOLEL) + 0.5*ZFLUX(MGN%NOLE1,:)
+ PSFTS(:,MGN%NOLEH) = PSFTS(:,MGN%NOLEH) + 0.5*ZFLUX(MGN%NOLE1,:)
+END IF
+!
+!
+#endif
+END SUBROUTINE COUPLING_MEGAN_n
diff --git a/src/ICCARE_BASE/coupling_surf_atmn.F90 b/src/ICCARE_BASE/coupling_surf_atmn.F90
new file mode 100644
index 0000000000000000000000000000000000000000..9a52eed46e1b6525e9e0ad2a000b97fc84ef205e
--- /dev/null
+++ b/src/ICCARE_BASE/coupling_surf_atmn.F90
@@ -0,0 +1,677 @@
+!SFX_LIC Copyright 2004-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SFX_LIC for details. version 1.
+! #################################################################################
+SUBROUTINE COUPLING_SURF_ATM_n (YSC, HPROGRAM, HCOUPLING, PTIMEC, PTSTEP, KYEAR, KMONTH, &
+ KDAY, PTIME, KI, KSV, KSW, PTSUN, PZENITH, PZENITH2, &
+ PAZIM, PZREF, PUREF, PZS, PU, PV, PQA, PTA, PRHOA, PSV, &
+ PCO2, HSV, PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, PSW_BANDS,&
+ PPS, PPA, PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, PTRAD, &
+ PDIR_ALB, PSCA_ALB, PEMIS, PTSURF, PZ0, PZ0H, PQSURF, &
+ PPEW_A_COEF, PPEW_B_COEF, PPET_A_COEF, PPEQ_A_COEF, &
+ PPET_B_COEF, PPEQ_B_COEF, PZWS, HTEST )
+! #################################################################################
+!
+!!**** *COUPLING_INLAND_WATER_n * - Driver to call the schemes for the
+!! four surface types (SEA, WATER, NATURE, TOWN)
+!!
+!! PURPOSE
+!! -------
+!
+!!** METHOD
+!! ------
+!!
+!! REFERENCE
+!! ---------
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Masson
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 01/2004
+!! Modified 09/2011 by S.Queguiner: Add total CO2 surface flux (anthropo+biogenic) as diagnostic
+!! Modified 11/2011 by S.Queguiner: Add total Chemical surface flux (anthropo) as diagnostic
+!! B. Decharme 04/2013 new coupling variables and replace RW_PRECIP_n by CPL_GCM_n
+!! Modified 06/2013 by J.Escobar : replace DOUBLE PRECISION by REAL to handle problem for promotion of real on IBM SP
+!! R. Séférian 03/2014 Adding decoupling between CO2 seen by photosynthesis and radiative CO2
+!! P. Wautelet 02/2019 bug correction KI->KSIZE for size of KMASK argument in TREAT_SURF
+!! Bielli S. 02/2019 Sea salt : significant sea wave height influences salt emission; 5 salt modes
+!!-------------------------------------------------------------
+!
+!
+USE MODD_SURFEX_n, ONLY : SURFEX_t
+!
+USE MODD_SURF_CONF, ONLY : CPROGNAME
+USE MODD_SURF_PAR, ONLY : XUNDEF
+USE MODD_CSTS, ONLY : XP00, XCPD, XRD, XAVOGADRO, XMD
+USE MODD_CO2V_PAR, ONLY : XMCO2
+USE MODD_SURF_ATM, ONLY : LCPL_GCM, XCO2UNCPL
+USE MODD_DATA_COVER_PAR, ONLY : NTILESFC
+!
+!
+USE MODD_SURFEX_MPI, ONLY : XTIME_SEA, XTIME_WATER, XTIME_NATURE, XTIME_TOWN
+!
+USE MODI_ADD_FORECAST_TO_DATE_SURF
+USE MODI_AVERAGE_FLUX
+USE MODI_AVERAGE_PHY
+USE MODI_AVERAGE_RAD
+USE MODI_DIAG_INLINE_SURF_ATM_n
+USE MODI_CH_EMISSION_FLUX_n
+USE MODI_CH_EMISSION_SNAP_n
+USE MODI_CH_EMISSION_TO_ATM_n
+USE MODI_SSO_Z0_FRICTION_n
+USE MODI_SSO_BE04_FRICTION_n
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+USE MODI_ABOR1_SFX
+!
+USE MODI_COUPLING_INLAND_WATER_n
+!
+USE MODI_COUPLING_NATURE_n
+!
+USE MODI_COUPLING_SEA_n
+!
+USE MODI_COUPLING_TOWN_n
+!
+USE MODI_CPL_GCM_n
+!
+IMPLICIT NONE
+!
+#ifdef SFX_MPI
+INCLUDE 'mpif.h'
+#endif
+!
+!* 0.1 declarations of arguments
+!
+TYPE(SURFEX_t), INTENT(INOUT) :: YSC
+!
+ CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
+ CHARACTER(LEN=1), INTENT(IN) :: HCOUPLING ! type of coupling
+ ! 'E' : explicit
+ ! 'I' : implicit
+REAL, INTENT(IN) :: PTIMEC ! cumulated time since beginning of simulation
+INTEGER, INTENT(IN) :: KYEAR ! current year (UTC)
+INTEGER, INTENT(IN) :: KMONTH ! current month (UTC)
+INTEGER, INTENT(IN) :: KDAY ! current day (UTC)
+REAL, INTENT(IN) :: PTIME ! current time since midnight (UTC, s)
+INTEGER, INTENT(IN) :: KI ! number of points
+INTEGER, INTENT(IN) :: KSV ! number of scalars
+INTEGER, INTENT(IN) :: KSW ! number of short-wave spectral bands
+REAL, DIMENSION(KI), INTENT(IN) :: PTSUN ! solar time (s from midnight)
+REAL, INTENT(IN) :: PTSTEP ! atmospheric time-step (s)
+REAL, DIMENSION(KI), INTENT(IN) :: PZREF ! height of T,q forcing (m)
+REAL, DIMENSION(KI), INTENT(IN) :: PUREF ! height of wind forcing (m)
+!
+REAL, DIMENSION(KI), INTENT(IN) :: PTA ! air temperature forcing (K)
+REAL, DIMENSION(KI), INTENT(IN) :: PQA ! air humidity forcing (kg/m3)
+REAL, DIMENSION(KI), INTENT(IN) :: PRHOA ! air density (kg/m3)
+REAL, DIMENSION(KI,KSV),INTENT(IN) :: PSV ! scalar variables
+! ! chemistry: first char. in HSV: '#' (molecule/m3)
+! !
+ CHARACTER(LEN=6), DIMENSION(KSV),INTENT(IN):: HSV ! name of all scalar variables
+REAL, DIMENSION(KI), INTENT(IN) :: PU ! zonal wind (m/s)
+REAL, DIMENSION(KI), INTENT(IN) :: PV ! meridian wind (m/s)
+REAL, DIMENSION(KI,KSW),INTENT(IN) :: PDIR_SW ! direct solar radiation (on horizontal surf.)
+! ! (W/m2)
+REAL, DIMENSION(KI,KSW),INTENT(IN) :: PSCA_SW ! diffuse solar radiation (on horizontal surf.)
+! ! (W/m2)
+REAL, DIMENSION(KSW),INTENT(IN) :: PSW_BANDS ! mean wavelength of each shortwave band (m)
+REAL, DIMENSION(KI), INTENT(IN) :: PZENITH ! zenithal angle at t (radian from the vertical)
+REAL, DIMENSION(KI), INTENT(IN) :: PZENITH2 ! zenithal angle at t+1(radian from the vertical)
+REAL, DIMENSION(KI), INTENT(IN) :: PAZIM ! azimuthal angle (radian from North, clockwise)
+REAL, DIMENSION(KI), INTENT(IN) :: PLW ! longwave radiation (on horizontal surf.)
+! ! (W/m2)
+REAL, DIMENSION(KI), INTENT(IN) :: PPS ! pressure at atmospheric model surface (Pa)
+REAL, DIMENSION(KI), INTENT(IN) :: PPA ! pressure at forcing level (Pa)
+REAL, DIMENSION(KI), INTENT(IN) :: PZWS ! significant sea wave (m)
+REAL, DIMENSION(KI), INTENT(IN) :: PZS ! atmospheric model orography (m)
+REAL, DIMENSION(KI), INTENT(IN) :: PCO2 ! CO2 concentration in the air (kg/m3)
+REAL, DIMENSION(KI), INTENT(IN) :: PSNOW ! snow precipitation (kg/m2/s)
+REAL, DIMENSION(KI), INTENT(IN) :: PRAIN ! liquid precipitation (kg/m2/s)
+!
+!
+REAL, DIMENSION(KI), INTENT(OUT) :: PSFTH ! flux of heat (W/m2)
+REAL, DIMENSION(KI), INTENT(OUT) :: PSFTQ ! flux of water vapor (kg/m2/s)
+REAL, DIMENSION(KI), INTENT(OUT) :: PSFU ! zonal momentum flux (Pa)
+REAL, DIMENSION(KI), INTENT(OUT) :: PSFV ! meridian momentum flux (Pa)
+REAL, DIMENSION(KI), INTENT(OUT) :: PSFCO2 ! flux of CO2 (m/s*kg_CO2/kg_air)
+REAL, DIMENSION(KI,KSV),INTENT(OUT):: PSFTS ! flux of scalar var. (kg/m2/s)
+!
+REAL, DIMENSION(KI), INTENT(INOUT) :: PTRAD ! radiative temperature (K)
+REAL, DIMENSION(KI,KSW),INTENT(OUT):: PDIR_ALB ! direct albedo for each spectral band (-)
+REAL, DIMENSION(KI,KSW),INTENT(OUT):: PSCA_ALB ! diffuse albedo for each spectral band (-)
+REAL, DIMENSION(KI), INTENT(INOUT) :: PEMIS ! emissivity (-)
+!
+REAL, DIMENSION(KI), INTENT(OUT) :: PTSURF ! surface effective temperature (K)
+REAL, DIMENSION(KI), INTENT(INOUT) :: PZ0 ! roughness length for momentum (m)
+REAL, DIMENSION(KI), INTENT(INOUT) :: PZ0H ! roughness length for heat (m)
+REAL, DIMENSION(KI), INTENT(INOUT) :: PQSURF ! specific humidity at surface (kg/kg)
+!
+REAL, DIMENSION(KI), INTENT(IN) :: PPEW_A_COEF! implicit coefficients
+REAL, DIMENSION(KI), INTENT(IN) :: PPEW_B_COEF! needed if HCOUPLING='I'
+REAL, DIMENSION(KI), INTENT(IN) :: PPET_A_COEF
+REAL, DIMENSION(KI), INTENT(IN) :: PPEQ_A_COEF
+REAL, DIMENSION(KI), INTENT(IN) :: PPET_B_COEF
+REAL, DIMENSION(KI), INTENT(IN) :: PPEQ_B_COEF
+CHARACTER(LEN=2), INTENT(IN) :: HTEST ! must be equal to 'OK'
+!
+!
+!* 0.2 declarations of local variables
+!
+INTEGER :: JTILE ! loop on type of surface
+LOGICAL :: GNATURE, GTOWN, GWATER, GSEA ! .T. if the corresponding surface is represented
+INTEGER :: ISWB ! number of shortwave spectral bands
+!
+REAL, DIMENSION(KI) :: ZPEW_A_COEF ! implicit coefficients
+REAL, DIMENSION(KI) :: ZPEW_B_COEF ! needed if HCOUPLING='I'
+REAL, DIMENSION(KI) :: ZPET_A_COEF
+REAL, DIMENSION(KI) :: ZPEQ_A_COEF
+REAL, DIMENSION(KI) :: ZPET_B_COEF
+REAL, DIMENSION(KI) :: ZPEQ_B_COEF
+!
+! Tile outputs:
+!
+REAL, DIMENSION(KI,NTILESFC) :: ZSFTH_TILE ! surface heat flux (Km/s)
+REAL, DIMENSION(KI,NTILESFC) :: ZSFTQ_TILE ! surface vapor flux (kgm/kg/s)
+REAL, DIMENSION(KI,KSV,NTILESFC) :: ZSFTS_TILE ! scalar surface flux
+REAL, DIMENSION(KI,NTILESFC) :: ZSFCO2_TILE ! surface CO2 flux
+REAL, DIMENSION(KI,NTILESFC) :: ZSFU_TILE ! zonal momentum flux
+REAL, DIMENSION(KI,NTILESFC) :: ZSFV_TILE ! meridian momentum flux
+REAL, DIMENSION(KI,NTILESFC) :: ZTRAD_TILE ! radiative surface temperature
+REAL, DIMENSION(KI,NTILESFC) :: ZEMIS_TILE ! emissivity
+REAL, DIMENSION(KI,NTILESFC) :: ZFRAC_TILE ! fraction of each surface type
+REAL, DIMENSION(KI,NTILESFC) :: ZTSURF_TILE ! surface effective temperature
+REAL, DIMENSION(KI,NTILESFC) :: ZZ0_TILE ! roughness length for momentum
+REAL, DIMENSION(KI,NTILESFC) :: ZZ0H_TILE ! roughness length for heat
+REAL, DIMENSION(KI,NTILESFC) :: ZQSURF_TILE ! specific humidity at surface
+!
+REAL, DIMENSION(KI,KSW,NTILESFC) :: ZDIR_ALB_TILE ! direct albedo
+REAL, DIMENSION(KI,KSW,NTILESFC) :: ZSCA_ALB_TILE ! diffuse albedo
+!
+REAL :: XTIME0
+!
+INTEGER :: IINDEXEND
+INTEGER :: INBTS, JI
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+!-------------------------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('COUPLING_SURF_ATM_N',0,ZHOOK_HANDLE)
+CPROGNAME=HPROGRAM
+!
+IF (HTEST/='OK') THEN
+ CALL ABOR1_SFX('COUPLING_SURF_ATMN: FATAL ERROR DURING ARGUMENT TRANSFER')
+END IF
+!
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+! Time evolution
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+!
+YSC%U%TTIME%TIME = YSC%U%TTIME%TIME + PTSTEP
+ CALL ADD_FORECAST_TO_DATE_SURF(YSC%U%TTIME%TDATE%YEAR,YSC%U%TTIME%TDATE%MONTH,&
+ YSC%U%TTIME%TDATE%DAY,YSC%U%TTIME%TIME)
+!
+!-------------------------------------------------------------------------------------
+! Preliminaries: Tile related operations
+!-------------------------------------------------------------------------------------
+! FLAGS for the various surfaces:
+!
+GSEA = YSC%U%NDIM_SEA >0
+GWATER = YSC%U%NDIM_WATER >0
+GTOWN = YSC%U%NDIM_TOWN >0
+GNATURE = YSC%U%NDIM_NATURE >0
+
+!
+! Tile counter:
+!
+JTILE = 0
+!
+! Number of shortwave spectral bands
+!
+ISWB = SIZE(PSW_BANDS)
+!
+! Initialization: Outputs to atmosphere over each tile:
+!
+ZSFTH_TILE(:,:) = XUNDEF
+ZTRAD_TILE(:,:) = XUNDEF
+ZDIR_ALB_TILE(:,:,:) = XUNDEF
+ZSCA_ALB_TILE(:,:,:) = XUNDEF
+ZEMIS_TILE(:,:) = XUNDEF
+ZSFTQ_TILE(:,:) = XUNDEF
+ZSFTS_TILE(:,:,:) = 0.
+ZSFCO2_TILE(:,:) = 0.
+ZSFU_TILE(:,:) = XUNDEF
+ZSFV_TILE(:,:) = XUNDEF
+ZTSURF_TILE(:,:) = XUNDEF
+ZZ0_TILE(:,:) = XUNDEF
+ZZ0H_TILE(:,:) = XUNDEF
+ZQSURF_TILE(:,:) = XUNDEF
+!
+! Fractions for each tile:
+!
+ZFRAC_TILE(:,:) = 0.0
+!
+! initialization of implicit coefficients:
+!
+IF (HCOUPLING=='I') THEN
+ ZPEW_A_COEF = PPEW_A_COEF
+ ZPEW_B_COEF = PPEW_B_COEF
+ ZPET_A_COEF = PPET_A_COEF
+ ZPEQ_A_COEF = PPEQ_A_COEF
+ ZPET_B_COEF = PPET_B_COEF
+ ZPEQ_B_COEF = PPEQ_B_COEF
+ELSE
+ ZPEW_A_COEF = 0.
+ ZPEW_B_COEF = SQRT(PU**2+PV**2)
+ ZPET_A_COEF = XUNDEF
+ ZPET_B_COEF = XUNDEF
+ ZPEQ_A_COEF = XUNDEF
+ ZPEQ_B_COEF = XUNDEF
+END IF
+!
+!--------------------------------------------------------------------------------------
+! Call ALMA interfaces for sea, water, nature and town here...
+!--------------------------------------------------------------------------------------
+!
+#ifdef SFX_MPI
+XTIME0 = MPI_WTIME()
+#endif
+!
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+! SEA Tile calculations:
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+!
+! first, pack vector...then call ALMA routine
+!
+JTILE = JTILE + 1
+!
+IF(GSEA)THEN
+!
+ ZFRAC_TILE(:,JTILE) = YSC%U%XSEA(:)
+!
+ CALL TREAT_SURF(JTILE,YSC%U%NSIZE_SEA,YSC%U%NR_SEA)
+!
+ENDIF
+!
+#ifdef SFX_MPI
+XTIME_SEA = XTIME_SEA + (MPI_WTIME() - XTIME0)*100./MAX(1,YSC%U%NSIZE_SEA)
+XTIME0 = MPI_WTIME()
+#endif
+!
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+! INLAND WATER Tile calculations:
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+!
+JTILE = JTILE + 1
+!
+IF(GWATER)THEN
+!
+ ZFRAC_TILE(:,JTILE) = YSC%U%XWATER(:)
+!
+ CALL TREAT_SURF(JTILE,YSC%U%NSIZE_WATER,YSC%U%NR_WATER)
+!
+ENDIF
+!
+#ifdef SFX_MPI
+XTIME_WATER = XTIME_WATER + (MPI_WTIME() - XTIME0)*100./MAX(1,YSC%U%NSIZE_WATER)
+XTIME0 = MPI_WTIME()
+#endif
+!
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+! NATURAL SURFACE Tile calculations:
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+!
+JTILE = JTILE + 1
+!
+IF(GNATURE)THEN
+!
+ ZFRAC_TILE(:,JTILE) = YSC%U%XNATURE(:)
+!
+ CALL TREAT_SURF(JTILE,YSC%U%NSIZE_NATURE,YSC%U%NR_NATURE)
+!
+ENDIF
+!
+#ifdef SFX_MPI
+XTIME_NATURE = XTIME_NATURE + (MPI_WTIME() - XTIME0)*100./MAX(1,YSC%U%NSIZE_NATURE)
+XTIME0 = MPI_WTIME()
+#endif
+!
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+! URBAN Tile calculations:
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+!
+JTILE = JTILE + 1
+!
+IF(GTOWN)THEN
+!
+ ZFRAC_TILE(:,JTILE) = YSC%U%XTOWN(:)
+!
+ CALL TREAT_SURF(JTILE,YSC%U%NSIZE_TOWN,YSC%U%NR_TOWN)
+!
+ENDIF
+!
+#ifdef SFX_MPI
+XTIME_TOWN = XTIME_TOWN + (MPI_WTIME() - XTIME0)*100./MAX(1,YSC%U%NSIZE_TOWN)
+#endif
+!
+! - - - - -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+! Grid box average fluxes/properties:
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+!
+ CALL AVERAGE_FLUX(ZFRAC_TILE, ZSFTH_TILE, ZSFTQ_TILE, ZSFTS_TILE, ZSFCO2_TILE, &
+ ZSFU_TILE, ZSFV_TILE, PSFTH, PSFTQ, PSFTS, PSFCO2, PSFU, PSFV )
+!
+! - - - - -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+! Chemical Emissions:
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+!
+IF ((YSC%SV%NBEQ > 0).AND.(YSC%CHU%LCH_SURF_EMIS)) THEN
+ IF (YSC%CHU%CCH_EMIS=='AGGR') THEN
+ IF (YSC%SV%NSV_AEREND < 0) THEN
+ IINDEXEND = YSC%SV%NSV_CHSEND ! case only gas chemistry
+ ELSE
+ IINDEXEND = YSC%SV%NSV_AEREND ! case aerosol + gas chemistry
+ ENDIF
+ INBTS=0
+ DO JI=1,SIZE(YSC%CHE%TSEMISS)
+ IF (SIZE(YSC%CHE%TSEMISS(JI)%NETIMES).GT.INBTS) INBTS=SIZE(YSC%CHE%TSEMISS(JI)%NETIMES)
+ ENDDO
+ CALL CH_EMISSION_FLUX_n(YSC%DTCO, YSC%U, YSC%CHE, YSC%SV, YSC%CHU, &
+ HPROGRAM,PTIME,PSFTS(:,YSC%SV%NSV_CHSBEG:IINDEXEND),PRHOA,PTSTEP,INBTS)
+ ELSE IF (YSC%CHU%CCH_EMIS=='SNAP') THEN
+ CALL CH_EMISSION_SNAP_n(YSC%CHN, HPROGRAM,YSC%U%NSIZE_FULL,PTIME,PTSUN,KYEAR,KMONTH,KDAY,PRHOA,YSC%UG%G%XLON)
+ CALL CH_EMISSION_TO_ATM_n(YSC%CHN, YSC%SV, PSFTS,PRHOA)
+ END IF
+END IF
+!
+WHERE(PSFTS(:,:)==XUNDEF) PSFTS(:,:)=0.
+! - - - - -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+! CO2 Flux : adds biogenic and anthropogenic emissions
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+! CO2 FLUXES : PSFTS in molecules/m2/s
+! PSFCO2 in kgCO2/kgair*m/s = *PRHOA kgCO2/m2/s
+! PSFCO2 in kgCO2/m2/s = *Navogadro*1E3/Mco2(44g/mol) molecules/m2/s
+!
+DO JI=1,SIZE(PSV,2)
+ IF(TRIM(ADJUSTL(YSC%SV%CSV(JI)))=="CO2") THEN
+ ! CO2 Flux (Antrop + biog) (molec*m2/s)
+ PSFTS(:,JI) = PSFTS(:,JI) + PSFCO2(:)*PRHOA(:)*(XAVOGADRO/44.)*1E3
+ ! CO2 Flux (Antrop + biog) (kgCO2/kgair*m/s)
+ PSFCO2(:) = PSFTS(:,JI)/(PRHOA(:)*(XAVOGADRO/44.)*1E3)
+ END IF
+END DO
+!
+! - - - - -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+! Radiative fluxes
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+ CALL AVERAGE_RAD(ZFRAC_TILE, ZDIR_ALB_TILE, ZSCA_ALB_TILE, &
+ ZEMIS_TILE, ZTRAD_TILE, PDIR_ALB, PSCA_ALB,&
+ PEMIS, PTRAD)
+!
+! - - - - -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+! Physical properties
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+ CALL AVERAGE_PHY(ZFRAC_TILE, ZTSURF_TILE, ZZ0_TILE, &
+ ZZ0H_TILE, ZQSURF_TILE, &
+ PUREF, PZREF, PTSURF, PZ0, PZ0H, PQSURF )
+!
+! store these field to write in restart file (important for AGCM)
+!
+IF(LCPL_GCM) CALL CPL_GCM_n(YSC%U, KI,PZ0=PZ0,PZ0H=PZ0H,PQSURF=PQSURF)
+!
+! - - - - -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+! Orographic friction
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+!
+!* adds friction due to subscale orography to momentum fluxes
+! but only over continental area
+!
+IF (YSC%USS%CROUGH=="Z01D" .OR. YSC%USS%CROUGH=="Z04D") THEN
+ CALL SSO_Z0_FRICTION_n(YSC%USS, YSC%U%XSEA,PUREF,PRHOA,PU,PV,ZPEW_A_COEF,ZPEW_B_COEF,PSFU,PSFV)
+ELSE IF (YSC%USS%CROUGH=="BE04") THEN
+ CALL SSO_BE04_FRICTION_n(YSC%SB, YSC%USS, PTSTEP,YSC%U%XSEA,PUREF,PRHOA,PU,PV,PSFU,PSFV)
+END IF
+!
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+! Inline diagnostics for full surface
+! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+!
+ CALL DIAG_INLINE_SURF_ATM_n(YSC%DUO, YSC%DU, &
+ PUREF, PZREF, PPS, PRHOA, PTRAD, PEMIS, PSFU, PSFV, PSFCO2)
+!
+IF (LHOOK) CALL DR_HOOK('COUPLING_SURF_ATM_N',1,ZHOOK_HANDLE)
+!
+!=======================================================================================
+CONTAINS
+!=======================================================================================
+SUBROUTINE TREAT_SURF(KTILE,KSIZE,KMASK)
+!
+IMPLICIT NONE
+!
+INTEGER, INTENT(IN) :: KTILE
+INTEGER, INTENT(IN) :: KSIZE
+INTEGER, INTENT(IN), DIMENSION(KSIZE) :: KMASK
+!
+REAL, DIMENSION(KSIZE) :: ZP_TSUN ! solar time (s from midnight)
+REAL, DIMENSION(KSIZE) :: ZP_ZREF ! height of T,q forcing (m)
+REAL, DIMENSION(KSIZE) :: ZP_UREF ! height of wind forcing (m)
+!
+REAL, DIMENSION(KSIZE) :: ZP_TA ! air temperature forcing (K)
+REAL, DIMENSION(KSIZE) :: ZP_QA ! air specific humidity forcing (kg/m3)
+REAL, DIMENSION(KSIZE) :: ZP_RHOA ! air density (kg/m3)
+REAL, DIMENSION(KSIZE) :: ZP_U ! zonal wind (m/s)
+REAL, DIMENSION(KSIZE) :: ZP_V ! meridian wind (m/s)
+REAL, DIMENSION(KSIZE,ISWB) :: ZP_DIR_SW ! direct solar radiation (on horizontal surf.)
+! ! (W/m2)
+REAL, DIMENSION(KSIZE,ISWB) :: ZP_SCA_SW ! diffuse solar radiation (on horizontal surf.)
+! ! (W/m2)
+REAL, DIMENSION(KSIZE) :: ZP_ZENITH ! zenithal angle at t (radian from the vertical)
+REAL, DIMENSION(KSIZE) :: ZP_ZENITH2 ! zenithal angle at t+1(radian from the vertical)
+REAL, DIMENSION(KSIZE) :: ZP_AZIM ! azimuthal angle (radian from North, clockwise)
+REAL, DIMENSION(KSIZE) :: ZP_LW ! longwave radiation (on horizontal surf.)
+! ! (W/m2)
+REAL, DIMENSION(KSIZE) :: ZP_PS ! pressure at atmospheric model surface (Pa)
+REAL, DIMENSION(KSIZE) :: ZP_PA ! pressure at forcing level (Pa)
+REAL, DIMENSION(KSIZE) :: ZP_ZWS ! significant sea wave (m)
+REAL, DIMENSION(KSIZE) :: ZP_ZS ! atmospheric model orography (m)
+REAL, DIMENSION(KSIZE) :: ZP_CO2 ! CO2 concentration in the air (kg/m3)
+REAL, DIMENSION(KSIZE,KSV) :: ZP_SV ! scalar concentration in the air
+REAL, DIMENSION(KSIZE) :: ZP_SNOW ! snow precipitation (kg/m2/s)
+REAL, DIMENSION(KSIZE) :: ZP_RAIN ! liquid precipitation (kg/m2/s)
+!
+REAL, DIMENSION(KSIZE) :: ZP_SFTH ! flux of heat (W/m2)
+REAL, DIMENSION(KSIZE) :: ZP_SFTQ ! flux of water vapor (kg/m2/s)
+REAL, DIMENSION(KSIZE) :: ZP_SFU ! zonal momentum flux (m/s)
+REAL, DIMENSION(KSIZE) :: ZP_SFV ! meridian momentum flux (m/s)
+REAL, DIMENSION(KSIZE) :: ZP_SFCO2 ! flux of CO2 (kg/m2/s)
+REAL, DIMENSION(KSIZE,KSV) :: ZP_SFTS ! flux of scalar
+!
+REAL, DIMENSION(KSIZE) :: ZP_TRAD ! radiative temperature (K)
+REAL, DIMENSION(KSIZE,ISWB) :: ZP_DIR_ALB ! direct albedo for each spectral band (-)
+REAL, DIMENSION(KSIZE,ISWB) :: ZP_SCA_ALB ! diffuse albedo for each spectral band (-)
+REAL, DIMENSION(KSIZE) :: ZP_EMIS ! emissivity
+!
+REAL, DIMENSION(KSIZE) :: ZP_TSURF ! surface effective temperature (K)
+REAL, DIMENSION(KSIZE) :: ZP_Z0 ! roughness length for momentum (m)
+REAL, DIMENSION(KSIZE) :: ZP_Z0H ! roughness length for heat (m)
+REAL, DIMENSION(KSIZE) :: ZP_QSURF ! specific humidity at surface (kg/kg)
+!
+REAL, DIMENSION(KSIZE) :: ZP_PEW_A_COEF ! implicit coefficients
+REAL, DIMENSION(KSIZE) :: ZP_PEW_B_COEF ! needed if HCOUPLING='I'
+REAL, DIMENSION(KSIZE) :: ZP_PET_A_COEF
+REAL, DIMENSION(KSIZE) :: ZP_PEQ_A_COEF
+REAL, DIMENSION(KSIZE) :: ZP_PET_B_COEF
+REAL, DIMENSION(KSIZE) :: ZP_PEQ_B_COEF
+INTEGER :: JJ, JK
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+IF (LHOOK) CALL DR_HOOK('COUPLING_SURF_ATM_n:TREAT_SURF',0,ZHOOK_HANDLE)
+!
+!--------------------------------------------------------------------------------------------
+!
+!cdir nodep
+!cdir unroll=8
+DO JJ=1,KSIZE
+ JI = KMASK(JJ)
+ ZP_TSUN(JJ) = PTSUN (JI)
+ ZP_ZENITH(JJ) = PZENITH (JI)
+ ZP_ZENITH2(JJ) = PZENITH2 (JI)
+ ZP_AZIM (JJ) = PAZIM (JI)
+ ZP_ZREF(JJ) = PZREF (JI)
+ ZP_UREF(JJ) = PUREF (JI)
+ ZP_U(JJ) = PU (JI)
+ ZP_V(JJ) = PV (JI)
+ ZP_QA(JJ) = PQA (JI)
+ ZP_TA(JJ) = PTA (JI)
+ ZP_RHOA(JJ) = PRHOA (JI)
+ ZP_CO2(JJ) = PCO2 (JI)
+ ZP_RAIN(JJ) = PRAIN (JI)
+ ZP_SNOW(JJ) = PSNOW (JI)
+ ZP_LW(JJ) = PLW (JI)
+ ZP_PS(JJ) = PPS (JI)
+ ZP_PA(JJ) = PPA (JI)
+ ZP_ZWS(JJ) = PZWS (JI)
+ ZP_ZS(JJ) = PZS (JI)
+ENDDO
+!
+!consider decoupling between CO2 emploied for photosynthesis and radiative CO2
+!recommended as C4MIP option (XCO2UNCPL in ppmv)
+IF(XCO2UNCPL/=XUNDEF)THEN
+ ZP_CO2(:) = ZP_RHOA(:) * XCO2UNCPL * 1.E-6 * XMCO2 / XMD
+ENDIF
+!
+DO JK=1,SIZE(PSV,2)
+!cdir nodep
+!cdir unroll=8
+ DO JJ=1,KSIZE
+ JI = KMASK(JJ)
+ ZP_SV(JJ,JK) = PSV (JI,JK)
+ ENDDO
+ENDDO
+!
+DO JK=1,ISWB
+!cdir nodep
+!cdir unroll=8
+ DO JJ=1,KSIZE
+ JI = KMASK(JJ)
+ ZP_DIR_SW(JJ,JK) = PDIR_SW (JI,JK)
+ ZP_SCA_SW(JJ,JK) = PSCA_SW (JI,JK)
+ ENDDO
+ENDDO
+!
+!cdir nodep
+!cdir unroll=8
+DO JJ=1,KSIZE
+ JI = KMASK(JJ)
+ ZP_PEW_A_COEF(JJ) = ZPEW_A_COEF (JI)
+ ZP_PEW_B_COEF(JJ) = ZPEW_B_COEF (JI)
+ ZP_PET_A_COEF(JJ) = ZPET_A_COEF (JI)
+ ZP_PET_B_COEF(JJ) = ZPET_B_COEF (JI)
+ ZP_PEQ_A_COEF(JJ) = ZPEQ_A_COEF (JI)
+ ZP_PEQ_B_COEF(JJ) = ZPEQ_B_COEF (JI)
+ENDDO
+!
+!--------------------------------------------------------------------------------------------
+!
+IF (KTILE==1) THEN
+ !
+ CALL COUPLING_SEA_n(YSC%SM, YSC%DLO, YSC%DL, YSC%DLC, YSC%U, YSC%NDST%AL(1), YSC%SLT, &
+ HPROGRAM, HCOUPLING, PTIMEC, PTSTEP, KYEAR, KMONTH, KDAY, PTIME, &
+ YSC%U%NSIZE_SEA, KSV, KSW, ZP_TSUN, ZP_ZENITH, ZP_ZENITH2,ZP_AZIM, &
+ ZP_ZREF, ZP_UREF, ZP_ZS, ZP_U, ZP_V, ZP_QA, ZP_TA, ZP_RHOA, ZP_SV, &
+ ZP_CO2, HSV, ZP_RAIN, ZP_SNOW, ZP_LW, ZP_DIR_SW, ZP_SCA_SW, PSW_BANDS, &
+ ZP_PS, ZP_PA, ZP_SFTQ, ZP_SFTH, ZP_SFTS, ZP_SFCO2, ZP_SFU, ZP_SFV, &
+ ZP_TRAD, ZP_DIR_ALB, ZP_SCA_ALB, ZP_EMIS, ZP_TSURF, ZP_Z0, ZP_Z0H, &
+ ZP_QSURF, ZP_PEW_A_COEF, ZP_PEW_B_COEF, ZP_PET_A_COEF, ZP_PEQ_A_COEF, &
+ ZP_PET_B_COEF, ZP_PEQ_B_COEF, ZP_ZWS, 'OK' )
+ !
+ELSEIF (KTILE==2) THEN
+ !
+ CALL COUPLING_INLAND_WATER_n(YSC%FM, YSC%WM, YSC%DLO, YSC%DL, YSC%DLC, YSC%U, &
+ YSC%NDST%AL(1), YSC%SLT, HPROGRAM, HCOUPLING, PTIMEC, PTSTEP, &
+ KYEAR, KMONTH, KDAY, PTIME, YSC%U%NSIZE_WATER, KSV, KSW, &
+ ZP_TSUN, ZP_ZENITH, ZP_ZENITH2, ZP_AZIM, ZP_ZREF, ZP_UREF, &
+ ZP_ZS, ZP_U, ZP_V, ZP_QA, ZP_TA, ZP_RHOA, ZP_SV, ZP_CO2, HSV, &
+ ZP_RAIN, ZP_SNOW, ZP_LW, ZP_DIR_SW, ZP_SCA_SW, PSW_BANDS, &
+ ZP_PS, ZP_PA, ZP_SFTQ, ZP_SFTH, ZP_SFTS, ZP_SFCO2, ZP_SFU, &
+ ZP_SFV, ZP_TRAD, ZP_DIR_ALB, ZP_SCA_ALB, ZP_EMIS, ZP_TSURF, &
+ ZP_Z0, ZP_Z0H, ZP_QSURF, ZP_PEW_A_COEF, ZP_PEW_B_COEF, &
+ ZP_PET_A_COEF, ZP_PEQ_A_COEF, ZP_PET_B_COEF, ZP_PEQ_B_COEF, &
+ 'OK' )
+ !
+ELSEIF (KTILE==3) THEN
+ !
+ CALL COUPLING_NATURE_n(YSC%DTCO, YSC%UG, YSC%U, YSC%USS, YSC%IM, YSC%DTZ, YSC%DLO, YSC%DL, &
+ YSC%DLC, YSC%NDST, YSC%SLT, YSC%BLOWSNW, &
+ HPROGRAM, HCOUPLING, PTIMEC, PTSTEP, &
+ KYEAR, KMONTH, KDAY, PTIME, YSC%U%NSIZE_NATURE, KSV, KSW, ZP_TSUN, &
+ ZP_ZENITH, ZP_ZENITH2, ZP_AZIM, ZP_ZREF, ZP_UREF, ZP_ZS, ZP_U, ZP_V, &
+ ZP_QA, ZP_TA, ZP_RHOA, ZP_SV, ZP_CO2, HSV, ZP_RAIN, ZP_SNOW, ZP_LW, &
+ ZP_DIR_SW, ZP_SCA_SW, PSW_BANDS, ZP_PS, ZP_PA, ZP_SFTQ, ZP_SFTH, &
+ ZP_SFTS, ZP_SFCO2, ZP_SFU, ZP_SFV, ZP_TRAD, ZP_DIR_ALB, ZP_SCA_ALB, &
+ ZP_EMIS, ZP_TSURF, ZP_Z0, ZP_Z0H, ZP_QSURF, ZP_PEW_A_COEF, &
+ ZP_PEW_B_COEF, ZP_PET_A_COEF, ZP_PEQ_A_COEF, ZP_PET_B_COEF, &
+ ZP_PEQ_B_COEF, 'OK' )
+ !
+ELSEIF (KTILE==4) THEN
+ !
+ CALL COUPLING_TOWN_n(YSC%DTCO, YSC%U, YSC%DLO, YSC%DL, YSC%DLC, YSC%NDST%AL(1), YSC%SLT, YSC%TM, &
+ YSC%GDM, YSC%GRM, HPROGRAM, HCOUPLING, PTIMEC, PTSTEP, KYEAR, KMONTH, &
+ KDAY, PTIME, YSC%U%NSIZE_TOWN, KSV, KSW, ZP_TSUN, ZP_ZENITH, ZP_AZIM, &
+ ZP_ZREF, ZP_UREF, ZP_ZS, ZP_U, ZP_V, ZP_QA, ZP_TA, ZP_RHOA, ZP_SV, &
+ ZP_CO2, HSV, ZP_RAIN, ZP_SNOW, ZP_LW, ZP_DIR_SW, ZP_SCA_SW, PSW_BANDS, &
+ ZP_PS, ZP_PA, ZP_SFTQ, ZP_SFTH, ZP_SFTS, ZP_SFCO2, ZP_SFU, ZP_SFV, &
+ ZP_TRAD, ZP_DIR_ALB, ZP_SCA_ALB, ZP_EMIS, ZP_TSURF, ZP_Z0, ZP_Z0H, &
+ ZP_QSURF, ZP_PEW_A_COEF, ZP_PEW_B_COEF, ZP_PET_A_COEF, ZP_PEQ_A_COEF, &
+ ZP_PET_B_COEF, ZP_PEQ_B_COEF, 'OK' )
+ !
+ENDIF
+!
+!----------------------------------------------------------------------------------------------
+!
+!cdir nodep
+!cdir unroll=8
+DO JJ=1,KSIZE
+ JI=KMASK(JJ)
+ ZSFTQ_TILE (JI,KTILE) = ZP_SFTQ (JJ)
+ ZSFTH_TILE (JI,KTILE) = ZP_SFTH (JJ)
+ ZSFCO2_TILE (JI,KTILE) = ZP_SFCO2 (JJ)
+ ZSFU_TILE (JI,KTILE) = ZP_SFU (JJ)
+ ZSFV_TILE (JI,KTILE) = ZP_SFV (JJ)
+ ZTRAD_TILE (JI,KTILE) = ZP_TRAD (JJ)
+ ZEMIS_TILE (JI,KTILE) = ZP_EMIS (JJ)
+ ZTSURF_TILE (JI,KTILE) = ZP_TSURF (JJ)
+ ZZ0_TILE (JI,KTILE) = ZP_Z0 (JJ)
+ ZZ0H_TILE (JI,KTILE) = ZP_Z0H (JJ)
+ ZQSURF_TILE (JI,KTILE) = ZP_QSURF (JJ)
+ENDDO
+!
+DO JI=1,SIZE(ZP_SFTS,2)
+!cdir nodep
+!cdir unroll=8
+ DO JJ=1,KSIZE
+ ZSFTS_TILE (KMASK(JJ),JI,KTILE)= ZP_SFTS (JJ,JI)
+ ENDDO
+ENDDO
+!
+DO JI=1,SIZE(ZP_DIR_ALB,2)
+!cdir nodep
+!cdir unroll=8
+ DO JJ=1,KSIZE
+ ZDIR_ALB_TILE (KMASK(JJ),JI,KTILE)= ZP_DIR_ALB (JJ,JI)
+ ZSCA_ALB_TILE (KMASK(JJ),JI,KTILE)= ZP_SCA_ALB (JJ,JI)
+ ENDDO
+ENDDO
+!
+!----------------------------------------------------------------------------------------------
+!
+IF (LHOOK) CALL DR_HOOK('COUPLING_SURF_ATM_n:TREAT_SURF',1,ZHOOK_HANDLE)
+!
+END SUBROUTINE TREAT_SURF
+!=======================================================================================
+END SUBROUTINE COUPLING_SURF_ATM_n
diff --git a/src/ICCARE_BASE/emproc.F90 b/src/ICCARE_BASE/emproc.F90
new file mode 100644
index 0000000000000000000000000000000000000000..7cb60b64fe78f2edf40e1ed4266b6fce9b213d96
--- /dev/null
+++ b/src/ICCARE_BASE/emproc.F90
@@ -0,0 +1,292 @@
+
+SUBROUTINE EMPROC(KTIME, KDATE, PPFD24, T24, PDI, PRECADJ, &
+ PLAT, PLONG, PLAIP, PLAIC, PTEMP, PPFD, &
+ PWIND, PRES, PQV, KSLTYP, PSOILM, PSOILT, &
+ PFTF, OSOIL, PCFNO, PCFNOG, PCFSPEC )
+
+!***********************************************************************
+! THIS PROGRAM COMPUTES BIOGENIC EMISSION USING INPUT EMISSION
+! CAPACITY MAPS AND MCIP OUTPUT VARIABLES.
+! THE EMISSION CAPACITY MAP (INPNAME) ARE GRIDDED IN NETCDF-IOAPI FORMAT
+! WITH ALL THE DAILY AVERAGE PPFD AND DAILY AVERAGE TEMPERATURE.
+!
+! NOTE: THE PROJECTION AND INPUT GRIDS OF THE TWO FILES MUST BE
+! IDENTICAL.
+!
+!
+! CALL:
+! CHECKMEM
+! MODULE GAMMA_ETC
+! GAMMA_LAI
+! GAMMA_P
+! GAMMA_TLD
+! GAMMA_TLI
+! GAMMA_A
+! GAMMA_S
+!
+! HISTORY:
+! CREATED BY JACK CHEN 11/04
+! MODIFIED BY TAN 11/21/06 FOR MEGAN V2.0
+! MODIFIED BY XUEMEI WANG 11/04/2007 FOR MEGAN2.1
+! MODIFIED BY JULIA LEE-TAYLOR 03/18/2008 FOR MEGAN2.1
+! MODIFIED BY XUEMEI WANG 09/30/2008 FOR MEGAN2.1
+! MODIFIED BY TAN 07/28/2011 FOR MEGAN2.1
+! MODIFIED BY P. TULET 01/11/2014 FOR COUPLING WITH ISBA (MESONH)
+! MODIFIED BY J. PIANEZZEJ 13/02/2019 BUG in FARCE case
+!
+!***********************************************************************
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+! SCIENTIFIC ALGORITHM
+!
+! EMISSION = [EF][GAMMA][RHO]
+! WHERE [EF] = EMISSION FACTOR (UG/M2H)
+! [GAMMA] = EMISSION ACTIVITY FACTOR (NON-DIMENSION)
+! [RHO] = PRODUCTION AND LOSS WITHIN PLANT CANOPIES
+! (NON-DIMENSIONAL)
+! ASSUMPTION: [RHO] = 1 (11/27/06) (SEE PDT_LOT_CP.EXT)
+!
+! GAMMA = [GAMMA_CE][GAMMA_AGE][GAMMA_SM]
+! WHERE [GAMMA_CE] = CANOPY CORRECTION FACTOR
+! [GAMMA_AGE] = LEAF AGE CORRECTION FACTOR
+! [GAMMA_SM] = SOIL MOISTURE CORRECTION FACTOR
+! ASSUMPTION: [GAMMA_SM] = 1 (11/27/06)
+
+! GAMMA_CE = [GAMMA_LAI][GAMMA_P][GAMMA_T]
+! WHERE [GAMMA_LAI] = LEAF AREA INDEX FACTOR
+! [GAMMA_P] = PPFD EMISSION ACTIVITY FACTOR
+! [GAMMA_T] = TEMPERATURE RESPONSE FACTOR
+!
+! EMISSION = [EF][GAMMA_LAI][GAMMA_P][GAMMA_T][GAMMA_AGE]
+! DERIVATION:
+! EMISSION = [EF][GAMMA](1-LDF) + [EF][GAMMA][LDF][GAMMA_P]
+! EMISSION = [EF][GAMMA]{ (1-LDF) + [LDF][GAMMA_P] }
+! EMISSION = [EF][GAMMA]{ (1-LDF) + [LDF][GAMMA_P] }
+! WHERE LDF = LIGHT DEPENDENT FUNCTION (NON-DIMENSION)
+! (SEE LD_FCT.EXT)
+!
+! FINAL EQUATION
+! EMISSION = [EF][GAMMA_LAI][GAMMA_AGE]*
+! { (1-LDF)[GAMMA_TLI] + [LDF][GAMMA_P][GAMMA_TLD] } !FOR MEGAN2.1 ZER(:) = ZGAM_AGE * ZGAM_SMT * ZRHO * ((1.-ZLDF) * ZGAM_TLI * ZGAM_LHT + ZLDF * ZGAM_TLD)
+! WHERE GAMMA_TLI IS LIGHT INDEPENDENT
+! GAMMA_TLD IS LIGHT DEPENDENT
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+USE MODD_MEGAN
+
+USE MODI_INDEX1
+USE MODI_SOILNOX
+!
+USE MODE_MEGAN
+USE MODE_GAMMA_ETC ! MODULE CONTAINING GAMMA FUNCTIONS
+!
+IMPLICIT NONE
+
+INTEGER, INTENT(IN) :: KTIME !I TIME OF THE DAY HHMMSS
+INTEGER, INTENT(IN) :: KDATE !I DATE YYYYDDD
+!
+!REAL, INTENT(IN) :: PPFD_D !I DAILY PAR (UMOL/M2.S)
+REAL, DIMENSION(:), INTENT(IN) :: T24, PPFD24 !I DAILY TEMPERATURE (K)
+REAL, INTENT(IN) :: PDI !I DROUGHT INDEX (0 NORMAL, -2 MODERATE DROUGHT, -3 SEVERE DROUGHT, -4 EXTREME DROUGHT)
+REAL, INTENT(IN) :: PRECADJ !I RAIN ADJUSTMENT FACTOR
+!
+REAL, DIMENSION(:), INTENT(IN) :: PLAT !I LATITUDE OF GRID CELL
+REAL, DIMENSION(:), INTENT(IN) :: PLONG !I LONGITUDE OF GRID CELL
+REAL, DIMENSION(:), INTENT(IN) :: PLAIP !I PREVIOUS MONTHLY LAI
+REAL, DIMENSION(:), INTENT(IN) :: PLAIC !I CURRENT MONTHLY LAI
+REAL, DIMENSION(:), INTENT(IN) :: PTEMP !I TEMPERATURE (K)
+REAL, DIMENSION(:), INTENT(INOUT) :: PPFD !I CALCULATED PAR (UMOL/M2.S)
+REAL, DIMENSION(:), INTENT(IN) :: PWIND !I WIND VELOCITY (M/S)
+REAL, DIMENSION(:), INTENT(IN) :: PRES !I ATMOSPHERIC PRESSURE (PA)
+REAL, DIMENSION(:), INTENT(IN) :: PQV !I AIR HUMIDITY (KG/KG)
+INTEGER,DIMENSION(:),INTENT(IN) :: KSLTYP !I SOIL CATEGORY (FUNCTION OF SILT, CLAY AND SAND))
+REAL, DIMENSION(:), INTENT(IN) :: PSOILM !I SOIL MOISTURE (M3/M3)
+REAL, DIMENSION(:), INTENT(IN) :: PSOILT !I SOIL TEMPERATURE (K)
+REAL, DIMENSION(:,:),INTENT(IN) :: PFTF ! PFT FACTOR ARRAY (NRTYP 1-16 IN THE FIRST DIM)
+LOGICAL, INTENT(IN) :: OSOIL !I LOGICAL FOR ACTIVE NO CORRECTION FACTOR
+REAL, DIMENSION(:), INTENT(INOUT) :: PCFNO !O NO CORRECTION FACTOR
+REAL, DIMENSION(:), INTENT(INOUT) :: PCFNOG !O NO CORRECTION FACTOR FOR GRASS
+REAL, DIMENSION(:,:),INTENT(INOUT) :: PCFSPEC !O OUTPUT EMISSION BUFFER
+
+! LOCAL VARIABLES AND THEIR DESCRIPTIONS:
+REAL, DIMENSION(SIZE(PSOILM)) :: ZGAM_LHT ! LAI CORRECTION FACTOR
+REAL, DIMENSION(SIZE(PSOILM)) :: ZGAM_AGE ! LEAF AGE CORRECTION FACTOR
+REAL, DIMENSION(SIZE(PSOILM)) :: ZGAM_SMT ! SOIL MOISTURE CORRECTION FACTOR
+REAL, DIMENSION(SIZE(PSOILM)) :: ZER ! EMISSION BUFFER
+! NUMBER OF LAT, LONG, AND PFT FACTOR VARIABLES
+REAL, DIMENSION(SIZE(PSOILM)) :: ZGAM_TLD
+REAL, DIMENSION(SIZE(PSOILM)) :: ZGAM_TLI
+!
+CHARACTER(LEN=100), DIMENSION(N_MGN_SPC+7) :: YVNAME3D
+!
+REAL, DIMENSION(SIZE(PSOILM)) :: ZADJUST_FACTOR_LD, ZADJUST_FACTOR_LI
+REAL, DIMENSION(SIZE(PSOILM)) :: ZGAMMA_TD, ZGAMMA_TI, ZTOTALPFT
+
+REAL :: ZLDF ! LIGHT DEPENDENT FACTOR
+REAL :: ZRHO ! PRODUCTION AND LOSS WITHIN CANOPY
+!REAL :: ZPFD_D
+!
+INTEGER :: I_PFT
+INTEGER :: ILAIP_DY, ILAIP_HR, ILAIC_DY, ILAIC_HR
+INTEGER :: IMXPFT, IMXLAI
+
+! LOOP INDICES
+INTEGER :: JT, JS, JI, JJ , JK, JN, INP, JL ! COUNTERS
+INTEGER :: INMAP ! INDEX
+INTEGER :: INVARS3D
+
+!***********************************************************************
+
+!--=====================================================================
+!... BEGIN PROGRAM
+!--=====================================================================
+
+!-----------------------------------------------------------------------
+!.....1) INITIALIZATION
+!-----------------------------------------------------------------------
+!
+
+INVARS3D = N_MGN_SPC + 7
+!
+DO JS = 1,N_MGN_SPC
+ YVNAME3D(JS) = TRIM( CMGN_SPC(JS) )
+! VDESC3D(S) = 'ENVIRONMENTAL ACTIVITY FACTOR FOR '//
+! & TRIM( MGN_SPC(S) )
+! UNITS3D(S) = 'NON-DIMENSION '
+! VTYPE3D(S) = M3REAL
+ENDDO
+
+YVNAME3D(N_MGN_SPC+1) = 'D_TEMP'
+! UNITS3D(N_MGN_SPC+1) = 'K'
+! VTYPE3D(N_MGN_SPC+1) = M3REAL
+! VDESC3D(N_MGN_SPC+1) = 'VARIABLE '//'K'
+
+YVNAME3D(N_MGN_SPC+2) = 'D_PPFD'
+! UNITS3D(N_MGN_SPC+2) = 'UMOL/M2.S'
+! VTYPE3D(N_MGN_SPC+2) = M3REAL
+! VDESC3D(N_MGN_SPC+2) = 'VARIABLE '//'UMOL/M2.S'
+
+YVNAME3D(N_MGN_SPC+3) = 'LAT'
+! UNITS3D(N_MGN_SPC+3) = ' '
+! VTYPE3D(N_MGN_SPC+3) = M3REAL
+! VDESC3D(N_MGN_SPC+3) = ' '
+
+YVNAME3D(N_MGN_SPC+4) = 'LONG'
+! UNITS3D(N_MGN_SPC+4) = ' '
+! VTYPE3D(N_MGN_SPC+4) = M3REAL
+! VDESC3D(N_MGN_SPC+4) = ' '
+
+YVNAME3D(N_MGN_SPC+5) = 'CFNO'
+! UNITS3D(N_MGN_SPC+5) = ' '
+! VTYPE3D(N_MGN_SPC+5) = M3REAL
+! VDESC3D(N_MGN_SPC+5) = ' '
+
+YVNAME3D(N_MGN_SPC+6) = 'CFNOG'
+! UNITS3D(N_MGN_SPC+6) = ' '
+! VTYPE3D(N_MGN_SPC+6) = M3REAL
+! VDESC3D(N_MGN_SPC+6) = ' '
+
+YVNAME3D(N_MGN_SPC+7) = 'SLTYP'
+! UNITS3D(N_MGN_SPC+7) = ' '
+! VTYPE3D(N_MGN_SPC+7) = M3INT
+! VDESC3D(N_MGN_SPC+7) = ' '
+
+!-----------------------------------------------------------------------
+!.....2) PROCESS EMISSION RATES
+!-----------------------------------------------------------------------
+!
+INP = SIZE(PLAT)
+!
+! ************************************************************************************************
+
+! PPFD: SRAD - SHORT WAVE FROM SUN (W/M2)
+! ASSUMING 4.766 (UMOL M-2 S-1) PER (W M-2)
+! ASSUME 1/2 OF SRAD IS IN 400-700NM BAND
+!D_PPFD = D_PPFD * 4.766 * 0.5
+! UPG PT bug: SURFEX give PAR in UMOL M-2 S-1 : comment the lines above
+!ZPFD_D = PPFD_D * 4.5 * 0.5
+
+!ZPFD_D = PPFD24
+
+!PPFD = PPFD * 4.5
+!UPG PT end bug
+! *****************************************************************************************
+
+! GO OVER ALL THE CHEMICAL SPECIES
+DO JS = 1, N_MGN_SPC
+
+ ! INITIALIZE VARIABLES
+ ZER = 0.
+ ZGAM_LHT = 1.
+ ZGAM_AGE = 1.
+ ZGAM_SMT = 1.
+ ZGAM_TLD = 1.
+ ZGAM_TLI = 1.
+
+ PCFNO = 1.
+ PCFNOG = 1.
+
+ CALL GAMMA_LAI(PLAIC, ZGAM_LHT)
+
+! IF (JS == 1) print*, "ZGAM_LHT", ZGAM_LHT
+
+ CALL GAMMA_A(KDATE, KTIME, NTSTLEN, YVNAME3D(JS), T24, PLAIP, PLAIC, ZGAM_AGE)
+
+! IF (JS == 1) print*, "ZGAM_AGE", ZGAM_AGE
+
+ CALL GAMMA_S(ZGAM_SMT)
+
+ ZADJUST_FACTOR_LD(:) = 0.0
+ ZADJUST_FACTOR_LI(:) = 0.0
+ ZGAMMA_TD(:) = 0.0
+ ZGAMMA_TI(:) = 0.0
+ ZTOTALPFT(:) = 0.0
+
+ DO I_PFT = 1,N_MGN_PFT !CANOPY TYPES
+ ZTOTALPFT(:) = ZTOTALPFT(:) + PFTF(I_PFT,:) * 0.01 !!la division par 100 ZTOTALPFT(:) = ZTOTALPFT(:) + PFTF(I_PFT,:) * 0.01
+ ENDDO ! ENDDO I_PFT
+
+ DO I_PFT = 1,N_MGN_PFT !CANOPY TYPES
+
+ CALL GAMME_CE(KDATE, KTIME, XCANOPYCHAR, I_PFT, YVNAME3D(JS), &
+ PPFD24, PPFD24, T24, T24, PDI, &
+ PPFD, PLAT, PLONG, PTEMP, PWIND, PQV, PLAIC, &
+ PRES, ZGAMMA_TD, ZGAMMA_TI)
+
+ ZADJUST_FACTOR_LD(:) = ZADJUST_FACTOR_LD(:) + 0.01 * PFTF(I_PFT,:) * ZGAMMA_TD(:) !!ZADJUST_FACTOR_LD(:) = ZADJUST_FACTOR_LD(:) + 0.01 * PFTF(I_PFT,:) * ZGAMMA_TD(:)
+ ZADJUST_FACTOR_LI(:) = ZADJUST_FACTOR_LI(:) + 0.01 * PFTF(I_PFT,:) * ZGAMMA_TI(:) !! attention le 0.01 ZADJUST_FACTOR_LI(:) = ZADJUST_FACTOR_LI(:) + 0.01 * PFTF(I_PFT,:) * ZGAMMA_TI(:)
+ ENDDO ! ENDDO I_PFT
+
+ WHERE (ZTOTALPFT(:).GT.0.)
+ ZGAM_TLD(:) = ZADJUST_FACTOR_LD(:) / ZTOTALPFT(:)
+ ZGAM_TLI(:) = ZADJUST_FACTOR_LI(:) / ZTOTALPFT(:)
+ ELSEWHERE
+ ZGAM_TLD(:) = 1.
+ ZGAM_TLI(:) = 1.
+ END WHERE
+
+ !IF (JS == 1) print*, "ZGAM_TLD(:)", ZGAM_TLD(:)
+
+ INMAP = INDEX1(YVNAME3D(JS), CMGN_SPC)
+ ZLDF = XLDF_FCT(INMAP)
+ INMAP = INDEX1(YVNAME3D(JS), CMGN_SPC)
+ ZRHO = XMGN_MWT(INMAP)
+
+
+!... CALCULATE EMISSION
+ ZER(:) = ZGAM_AGE * ZGAM_SMT * ZRHO * ((1.-ZLDF) * ZGAM_TLI * ZGAM_LHT + ZLDF * ZGAM_TLD)
+ WHERE( ZER(:).GT.0. )
+ PCFSPEC(JS,:) = ZER(:)
+ ELSEWHERE
+ PCFSPEC(JS,:) = 0.0
+ END WHERE
+
+ENDDO
+
+!... ESTIATE CFNO AND CFNOG
+CALL SOILNOX(KDATE, KTIME, OSOIL, KSLTYP, PRECADJ, &
+ PLAT, PTEMP, PSOILM, PSOILT, PLAIC, PCFNO, PCFNOG )
+
+!--=====================================================================
+END SUBROUTINE EMPROC
+
diff --git a/src/ICCARE_BASE/ground_paramn.f90 b/src/ICCARE_BASE/ground_paramn.f90
index c6e1d894f9781e95a79e705b9de28f42fae618e7..876a976d4e3db0888894c4289d51aa448205b619 100644
--- a/src/ICCARE_BASE/ground_paramn.f90
+++ b/src/ICCARE_BASE/ground_paramn.f90
@@ -130,6 +130,7 @@ USE MODD_CST, ONLY : XP00, XCPD, XRD, XRV,XRHOLW, XDAY, XPI, XLVTT, XMD,
USE MODD_PARAMETERS, ONLY : JPVEXT, XUNDEF
USE MODD_DYN_n, ONLY : XTSTEP
USE MODD_CH_MNHC_n, ONLY : LUSECHEM
+USE MODD_CH_M9_n, ONLY : CNAMES
USE MODD_FIELD_n, ONLY : XUT, XVT, XWT, XTHT, XRT, XPABST, XSVT, XTKET, XZWS
USE MODD_METRICS_n, ONLY : XDXX, XDYY, XDZZ
USE MODD_DIM_n, ONLY : NKMAX
@@ -588,6 +589,7 @@ END IF
!
! Call to surface schemes
!
+
CALL COUPLING_SURF_ATM_n(YSURF_CUR,'MESONH', 'E',ZTIMEC, &
XTSTEP, TDTCUR%nyear, TDTCUR%nmonth, TDTCUR%nday, TDTCUR%xtime, &
IDIM1D,KSV_SURF,SIZE(XSW_BANDS), &
diff --git a/src/ICCARE_BASE/init_megann.F90 b/src/ICCARE_BASE/init_megann.F90
index 8829c5790d95a69f3dab809bf77fd3f8d9a8ca8b..6996a37b15eafb0f1c8f38424525ed3d90632a87 100644
--- a/src/ICCARE_BASE/init_megann.F90
+++ b/src/ICCARE_BASE/init_megann.F90
@@ -94,7 +94,11 @@ ALLOCATE(MGN%XEF (N_MGN_SPC,SIZE(K%XCLAY,1)))
ALLOCATE(MGN%XLAI (SIZE(K%XCLAY,1)))
ALLOCATE(MGN%NSLTYP (SIZE(K%XCLAY,1)))
ALLOCATE(MGN%XBIOFLX(SIZE(K%XCLAY,1)))
+ALLOCATE(MGN%XT24(SIZE(K%XCLAY,1)))
+ALLOCATE(MGN%XPPFD24(SIZE(K%XCLAY,1)))
MGN%XBIOFLX(:) = 0.
+MGN%XT24(:) = MGN%XDAILYTEMP
+MGN%XPPFD24(:) = MGN%XDAILYPAR
!
! Prepare the mechanism conversion between Megan and MesoNH
diff --git a/src/ICCARE_BASE/mgn2mech.F90 b/src/ICCARE_BASE/mgn2mech.F90
new file mode 100644
index 0000000000000000000000000000000000000000..f6c19ec072edb64c51c7edee483edd230aa6d4aa
--- /dev/null
+++ b/src/ICCARE_BASE/mgn2mech.F90
@@ -0,0 +1,323 @@
+SUBROUTINE MGN2MECH(KDATE, PLAT, PEF, PPFT, PCFNO, PCFNOG, PCFSPEC, &
+ KSPMH_MAP, KMECH_MAP, PCONV_FAC, OCONVERSION, PFLUX)
+
+!***********************************************************************
+! THIS PROGRAM DOES CHEMICAL SPECIATION AND MECHANISM CONVERSION.
+! THE OUTPUT FROM MEGAN.F IS CONVERTED FROM 20 TO 150 SPECIES WHICH
+! ARE THEN LUMPED ACCORDING TO THE MECHANISM ASSIGNED IN THE RUN SCRIPT.
+! THE PROGRAM LOOPS THROUGH ALL TIMESTEPS OF THE INPUT FILE.
+!
+! PROCEDURE
+! 1) FILE SET UP AND ASSIGN I/O PARAMETERS
+! 2) CONVERSION FROM MGN 20 TO SPECIATED 150
+! 3) CONVERSION FROM SPECIATED SPECIES TO MECHANISM SPECIES
+! 4) CONVERT TO TONNE/HOUR IF NEEDED
+!
+! THE INPUT FILE GIVES VARIABLES IN UNITS OF G-SPECIES/SEC.
+! ALL OUTPUTS ARE IN MOLE/SEC OR TONNE/HR DEPENDING ON ASSIGNMENT.
+!
+!
+! INPUT:
+! 1) MEGAN OUTPUT (NETCDF-IOAPI)
+!
+! OUTPUT:
+! 1) MEGAN SPECIATION OR MECHANISM SPECIES (NETCDF-IOAPI)
+!
+! REQUIREMENT:
+! REQUIRES LIBNETCDF.A AND LIBIOAPI.A TO COMPILE
+!
+! SETENV MGERFILE <DEFANGED_INPUT MEGAN OUTPUT FOR EMISSION ACTIVITY FACTORS>
+! SETENV OUTPFILE <OUTPUT SPECIATED EMISSION>
+!
+! CALLS: CHECKMEM
+!
+! ORIGINALLY CREATED BY JACK CHEN 11/04 FOR MEGAN V.0
+! FOR MEGAN V2.0 CREATED BY TAN 12/01/06
+! FOR MEGAN V2.1 CREATED BY XUEMEI WANG 11/04/07
+! FOR MEGAN V2.1 TO USE 150 SPECIES CREATED BY XUEMEI WANG 09/30/09
+!
+! HISTORY:
+! 08/14/07 TAN - MOVE TO MEGANV2.02 WITH NO UPDATE
+! 08/29/07 MODIFIED BY A. GUENTHER TO CORRECT ERROR IN ASSIGNING
+! EMISSION FACTOR. THIS VERSION IS CALLED MEGANV2.03
+! 10/29/07 MODIFIED BY A. GUENTHER TO CORRECT OMISSION OF DIURNAL VARIATION
+! FACTOR. THIS VERSION IS CALLED MEGANV2.04
+! 11/04/07 MODIFIED BY XUEMEI WANG TO GIVE TWO OPTIONS FOR MAP OR LOOKUP TABLE FOR
+! THE EMISSION FACTORS. ALSO GIVES OPTIONS FOR DIFFERENT CHEMICAL MECHANISMS
+! IN THE CODE: USER MODIFIES THE EXTERNAL SCRIPT TO ASSIGN MECHANISM.
+! THIS VERSION IS CALLED MEGANV2.1.0
+! 06/04/08 MODIFIED BY J. LEE-TAYLOR TO ACCEPT VEGETATION-DEPENDENT SPECIATION FACTORS
+! IN TABLE FORMAT (RESHAPE TABLES) RATHER THAN FROM DATA STATEMENTS.
+! 09/30/08 MODIFIED BY XUEMEI WANG TO GIVE OPTIONS FOR INPUT FILE AND TEST DIFFERENT MECHANISMS
+! 09/27/11 TAN&XUEMEI MEGANV2.10 INCLUDES SOIL NOX ADJUSTMENT AND A LOT OF UPDATES
+! 20/12/14 P. TULET - ON-LINE COUPLING IN THE ISBA/SURFEX SCHEME. ALL INIT VARIABLES HAS BEEN
+! MOVED IN INIT_MEGANN.F90.
+!***********************************************************************
+
+USE MODD_MGN2MECH
+USE MODD_MEGAN
+
+USE MODE_SOILNOX
+
+USE MODI_INDEX1
+
+IMPLICIT NONE
+
+INTEGER, INTENT(IN) :: KDATE ! DATE YYYYDDD
+REAL, DIMENSION(:), INTENT(IN) :: PLAT !I LATITUDE OF GRID CELL
+REAL, DIMENSION(:,:),INTENT(IN) :: PPFT !I PFT FACTOR ARRAY (NRTYP 1-16 IN THE FIRST DIM)
+REAL, DIMENSION(:,:),INTENT(IN) :: PEF !I PFT FACTOR ARRAY (NRTYP 1-16 IN THE FIRST DIM)
+REAL, DIMENSION(:), INTENT(IN) :: PCFNO !I NO CORRECTION FACTOR
+REAL, DIMENSION(:), INTENT(IN) :: PCFNOG !I NO CORRECTION FACTOR FOR GRASS
+REAL, DIMENSION(:,:), INTENT(IN) :: PCFSPEC
+LOGICAL, INTENT(IN) :: OCONVERSION
+INTEGER, DIMENSION(:), INTENT(IN) :: KSPMH_MAP
+INTEGER, DIMENSION(:), INTENT(IN) :: KMECH_MAP
+REAL, DIMENSION(:), INTENT(IN) :: PCONV_FAC
+REAL, DIMENSION(:,:),INTENT(INOUT) :: PFLUX !IO EMISSION FLUX IN MOL/M2/S
+
+!***********************************************************************
+! THIS PROGRAM DOES CHEMICAL SPECIATION AND MECHANISM CONVERSION.
+!... PROGRAM I/O FILES
+! PROGRAM NAME
+! INPUT MEGAN ER FILE
+! CHARACTER*16 :: MGNERS = 'MGNERS' ! INPUT MEGAN ER FILE LOGICAL NAME
+! NETCDF FILE
+! CHARACTER*16 :: EFMAPS = 'EFMAPS' ! EFMAP INPUT FILE NAME
+! CHARACTER*16 :: PFTS16 = 'PFTS16' ! INPUT PFT FILE LOGICAL
+! OUTPUT FILE
+! CHARACTER*16 :: MGNOUT = 'MGNOUT' ! OUTPUT FILE LOGICAL NAME
+! PARAMETERS FOR FILE UNITS
+! INTEGER :: LOGDEV ! LOGFILE UNIT NUMBER
+
+!... PROGRAM I/O PARAMETERS
+!... EXTERNAL PARAMETERS
+
+REAL, DIMENSION(N_SPCA_SPC,SIZE(PFLUX,2)) :: ZTMPER ! TEMP EMISSION BUFFER
+REAL, DIMENSION(SIZE(PFLUX,1),SIZE(PFLUX,2)) :: ZOUTER ! OUTPUT EMISSION BUFFER
+REAL, DIMENSION(SIZE(PLAT)) :: ZTMP1, ZTMP2, ZTMP3, ZTMP4
+REAL :: ZTMO1, ZTMO2, ZTMO3
+REAL :: Z2CRATIO
+
+!... INTERNAL PARAMETERS
+! INTERNAL PARAMTERS (STATUS AND BUFFER)
+INTEGER, DIMENSION(SIZE(PLAT)) :: ILEN, IDAY
+INTEGER :: JS, JJ, JI, JM, JN ! COUNTERS
+INTEGER :: JMPMG, JMPSP, JMPMC ! COUNTERS
+INTEGER :: INO
+INTEGER :: INP, IN_SCON_SPC
+
+!***********************************************************************
+
+!=======================================================================
+!... BEGIN PROGRAM
+!=======================================================================
+
+INP = SIZE(PLAT)
+IN_SCON_SPC = SIZE(KSPMH_MAP)
+
+! CHANGE THE UNIT ACCORDING TO TONPHR FLAG
+! IF ( TONPHR ) THEN
+! UNITS3D(1:NVARS3D) = 'TONS/HR'
+! ELSE
+! UNITS3D(1:NVARS3D) = 'MG/M*M/H'
+! ENDIF
+!
+! DO S = 1, NVARS3D
+! PRINT*,'OUTPUT VARIABLE:',VNAME3D(S),UNITS3D(S)
+! ENDDO
+
+! CALL NAMEVAL ( MGNERS , MESG ) ! GET INPUT FILE NAME AND PATH
+! FDESC3D( 2 ) = 'INPUT MEGAN FILE: '//TRIM(MESG)
+
+!... ALLOCATE MEMORY
+
+!.....2) CONVERSION FROM MGN 20 TO SPECIATED 150
+!-----------------------------------------------------------------------
+ZTMPER = 0.
+ZOUTER = 0.
+
+INO = INDEX1('NO',CMGN_SPC)
+
+!... LOOP THROUGH TIME
+DO JS = 1, N_SMAP_SPC
+
+ JMPMG = NMG20_MAP(JS)
+ JMPSP = NSPCA_MAP(JS)
+! PRINT*,'CONVERT '//MGN_SPC(NMPMG)//' TO '//SPCA_SPC(NMPSP)
+
+ IF ( JMPMG.NE.INO ) THEN
+
+ !... NOT NO
+ IF ( XEF_ALL(1,JMPMG).LT.0. ) THEN
+
+ !... USE EFMAPS
+ ZTMP1(:) = 0.
+ ZTMP2(:) = 0.
+ DO JM = 1,N_MGN_PFT
+ ZTMP1 = ZTMP1 + PPFT(JM,:)
+ ZTMP2 = ZTMP2 + XEFFS_ALL(JM,JMPSP) * PPFT(JM,:)
+ ENDDO
+ WHERE( ZTMP1(:).EQ.0. )
+ ZTMPER(JMPSP,:) = 0.
+ ELSEWHERE
+ ZTMPER(JMPSP,:) = PCFSPEC(JMPMG,:) * PEF(JMPMG,:) * ZTMP2(:)/ZTMP1(:)
+ ENDWHERE
+
+ ELSE
+
+ !... USE PFT-EF
+ ZTMP3(:) = 0.0
+ ZTMP4(:) = 0.0
+ DO JM = 1,N_MGN_PFT
+ !ZTMP3 = ZTMP3 + XEF_ALL(JM,JMPMG) * XEFFS_ALL(JM,JMPSP) * PPFT(JM,:)/100.
+ ZTMP4(:) = ZTMP4(:) + PPFT(JM,:)
+ ZTMP3(:) = ZTMP3(:) + XEF_ALL(JM,JMPMG) * XEFFS_ALL(JM,JMPSP) * PPFT(JM,:) ! bug S. Oumami
+ ENDDO
+ WHERE( ZTMP4(:).EQ.0. )
+ ZTMPER(JMPSP,:) = 0.
+ ELSEWHERE
+ ZTMPER(JMPSP,:) = PCFSPEC(JMPMG,:) * ZTMP3(:) / ZTMP4(:)
+ ENDWHERE
+
+
+ ENDIF
+
+ ELSE IF ( JMPMG.EQ.INO ) THEN
+
+!!-----------------NO STUFF-----------------------
+
+ CALL GROWSEASON(KDATE, PLAT, IDAY, ILEN)
+
+ DO JJ = 1,SIZE(PPFT,2)
+
+ ! CHECK FOR GROWING SEASON
+ IF ( IDAY(JJ).EQ.0 ) THEN
+
+ ! NON GROWING SEASON
+ ! CFNOG FOR EVERYWHERE
+ ! OVERRIDE CROP WITH GRASS WARM = 14
+ IF ( XEF_ALL(1,INO).LT.0. ) THEN
+
+ ! WITH EFMAPS
+ ZTMO1 = 0.
+ ZTMO2 = 0.
+ DO JM = 1,14
+ ZTMO1 = ZTMO1 + PPFT(JM,JJ)
+ ZTMO2 = ZTMO2 + XEFFS_ALL(JM,JMPSP) * PPFT(JM,JJ)
+ ENDDO
+ DO JM = 15,N_MGN_PFT
+ ZTMO1 = ZTMO1 + PPFT(JM,JJ)
+ Z2CRATIO = XEF_ALL(14,INO)/XEF_ALL(JM,INO)
+ ZTMO2 = ZTMO2 + XEFFS_ALL(JM,JMPSP) * PPFT(JM,JJ) * Z2CRATIO
+ ENDDO
+ IF ( ZTMO1.EQ.0. ) THEN
+ ZTMPER(JMPSP,JJ) = 0.
+ ELSE
+ !ZTMPER(JMPSP,JJ) = &
+ ! PCFSPEC(INO,JJ) * PEF(INO,JJ) * PCFNOG(JJ) * ZTMO2/ZTMO1
+ ZTMPER(JMPSP,JJ) = &
+ PCFSPEC(INO,JJ) * PEF(INO,JJ) * PCFNOG(JJ) * ZTMO2/ZTMO1 * XN2NO
+ ENDIF
+
+ ELSE
+
+ ! WITHOUT EFMAPS
+ ZTMO3 = 0.0
+ DO JM = 1,14
+ ZTMO3 = ZTMO3 + XEF_ALL(JM,INO) * XEFFS_ALL(JM,JMPSP) * PPFT(JM,JJ)/100.
+ ENDDO
+ DO JM = 15,N_MGN_PFT
+ ZTMO3 = ZTMO3 + XEF_ALL(14,INO) * XEFFS_ALL(JM,JMPSP) * PPFT(JM,JJ)/100.
+ ENDDO
+ !ZTMPER(JMPSP,JJ) = PCFSPEC(INO,JJ) * PCFNOG(JJ) * ZTMO3
+ ZTMPER(JMPSP,JJ) = PCFSPEC(INO,JJ) * PCFNOG(JJ) * ZTMO3 * XN2NO
+
+ ENDIF
+
+ ELSE IF ( IDAY(JJ).GT.0 .AND. IDAY(JJ).LE.366 ) THEN
+
+ ! GROWING SEASON
+ ! CFNOG FOR EVERYWHERE EXCEPT CROPS
+ ! CFNO FOR CROP AND CORN
+ IF ( XEF_ALL(1,INO).LT.0. ) THEN
+
+ ! WITH EFMAPS
+ ZTMO1 = 0.
+ ZTMO2 = 0.
+ DO JM = 1,14
+ ZTMO1 = ZTMO1 + PPFT(JM,JJ)
+ ZTMO2 = ZTMO2 + XEFFS_ALL(JM,JMPSP) * PPFT(JM,JJ) * PCFNOG(JJ)
+ ENDDO
+ DO JM = 15,N_MGN_PFT
+ ZTMO1 = ZTMO1 + PPFT(JM,JJ)
+ ZTMO2 = ZTMO2 + XEFFS_ALL(JM,JMPSP) * PPFT(JM,JJ) * PCFNO(JJ)
+ ENDDO
+ IF ( ZTMO1.EQ.0. ) THEN
+ ZTMPER(JMPSP,JJ) = 0.
+ ELSE
+ !ZTMPER(JMPSP,JJ) = PCFSPEC(INO,JJ) * PEF(INO,JJ) * ZTMO2/ZTMO1
+ ZTMPER(JMPSP,JJ) = PCFSPEC(INO,JJ) * PEF(INO,JJ) * ZTMO2/ZTMO1 * XN2NO
+ ENDIF
+
+ ELSE
+
+ ! WITHOUT EFMAPS
+ ZTMO3 = 0.0
+ DO JM = 1,14
+ ZTMO3 = ZTMO3 + &
+ XEF_ALL(JM,INO) * XEFFS_ALL(JM,JMPSP) * PPFT(JM,JJ)/100. * PCFNOG(JJ)
+ ENDDO
+ DO JM = 15,N_MGN_PFT
+ ZTMO3 = ZTMO3 + &
+ XEF_ALL(JM,INO) * XEFFS_ALL(JM,JMPSP) * PPFT(JM,JJ)/100. * PCFNO(JJ)
+ ENDDO
+ !ZTMPER(JMPSP,JJ) = PCFSPEC(INO,JJ) * ZTMO3
+ ZTMPER(JMPSP,JJ) = PCFSPEC(INO,JJ) * ZTMO3 * XN2NO
+ ENDIF
+
+ ELSE
+
+ WRITE(*,*) "MGN2MECH: BAD IDAY"
+ STOP
+
+ ENDIF
+
+ ENDDO !DO R = 1,NROWS
+
+!-----------------END OF NO----------------------
+ ENDIF !IF ( NMPMG .NE. INO ) THEN
+
+ENDDO ! END SPECIES LOOP
+
+!-----------------------------------------------------------------------
+!.....3) CONVERSION FROM SPECIATED SPECIES TO MECHANISM SPECIES
+!-----------------------------------------------------------------------
+! ! CONVERT FROM UG/M^2/HR TO MOL/M^2/S USING THEIR MW
+
+DO JS = 1, N_SPCA_SPC
+ ZTMPER(JS,:) = ZTMPER(JS,:) / XSPCA_MWT(JS) * XUG2G / XHR2SEC
+ENDDO
+!
+ ! LUMPING TO MECHANISM SPECIES
+!
+IF ( OCONVERSION ) THEN
+
+ DO JS = 1, IN_SCON_SPC
+
+ JMPSP = KSPMH_MAP(JS) ! MAPPING VALUE FOR SPCA
+ JMPMC = KMECH_MAP(JS) ! MAPPING VALUE FOR MECHANISM
+ ZOUTER(JMPMC,:) = ZOUTER(JMPMC,:) + ( ZTMPER(JMPSP,:) * PCONV_FAC(JS) )
+! ! UNITS OF THESE SPECIES ARE IN MOLE/S ------> MOLE/M²/S
+
+ ENDDO ! END SPECIES LOOP
+
+ELSE
+ ! ! GET ALL 150 SPECIES INTO THE OUTPUT ARRAY
+ ZOUTER(:,:) = ZTMPER(:,:)
+ ! ! UNITS OF THESE SPECIES ARE IN MOLE/M2/S
+
+ENDIF
+PFLUX(:,:) = ZOUTER(:,:)
+
+END SUBROUTINE MGN2MECH
diff --git a/src/ICCARE_BASE/modd_isban.F90 b/src/ICCARE_BASE/modd_isban.F90
new file mode 100644
index 0000000000000000000000000000000000000000..3c996c9c9cb1d460cd7eb055dacd835866c19d31
--- /dev/null
+++ b/src/ICCARE_BASE/modd_isban.F90
@@ -0,0 +1,820 @@
+!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SFX_LIC for details. version 1.
+!##################
+MODULE MODD_ISBA_n
+!##################
+!
+!!**** *MODD_ISBA - declaration of packed surface parameters for ISBA scheme
+!!
+!! PURPOSE
+!! -------
+!
+!!
+!!** IMPLICIT ARGUMENTS
+!! ------------------
+!! None
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!! A. Boone *Meteo France*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 20/09/02
+!! A.L. Gibelin 04/2009 : BIOMASS and RESP_BIOMASS arrays
+!! A.L. Gibelin 04/2009 : TAU_WOOD for NCB option
+!! A.L. Gibelin 05/2009 : Add carbon spinup
+!! A.L. Gibelin 06/2009 : Soil carbon variables for CNT option
+!! A.L. Gibelin 07/2009 : Suppress RDK and transform GPP as a diagnostic
+!! A.L. Gibelin 07/2009 : Suppress PPST and PPSTF as outputs
+!! P. Samuelsson 02/2012 : MEB
+!! B. Decharme 10/2016 bug surface/groundwater coupling
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_TYPE_SNOW
+USE MODD_TYPE_DATE_SURF
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+IMPLICIT NONE
+!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+TYPE ISBA_S_t
+!
+! General surface parameters:
+!
+REAL, POINTER, DIMENSION(:) :: XZS ! relief (m)
+REAL, POINTER, DIMENSION(:,:) :: XCOVER ! fraction of each ecosystem (-)
+LOGICAL, POINTER, DIMENSION(:):: LCOVER ! GCOVER(i)=T --> ith cover field is not 0.
+!
+! Topmodel statistics
+!
+REAL, POINTER, DIMENSION(:) :: XTI_MIN,XTI_MAX,XTI_MEAN,XTI_STD,XTI_SKEW
+!
+REAL, POINTER, DIMENSION(:,:) :: XSOC ! soil organic carbon content (kg/m2)
+REAL, POINTER, DIMENSION(:) :: XPH ! soil pH
+REAL, POINTER, DIMENSION(:) :: XFERT ! soil fertilisation rate (kgN/ha/h)
+!
+!
+REAL, POINTER, DIMENSION(:) :: XABC ! abscissa needed for integration
+! ! of net assimilation and stomatal
+! ! conductance over canopy depth (-)
+REAL, POINTER, DIMENSION(:) :: XPOI ! Gaussian weights for integration
+! ! of net assimilation and stomatal
+! ! conductance over canopy depth (-)
+!
+TYPE (DATE_TIME) :: TTIME
+!
+REAL, POINTER, DIMENSION(:,:) :: XTAB_FSAT !Satured fraction array
+REAL, POINTER, DIMENSION(:,:) :: XTAB_WTOP !Active TOPMODEL-layer array
+REAL, POINTER, DIMENSION(:,:) :: XTAB_QTOP !Subsurface flow TOPMODEL array
+!
+REAL, POINTER, DIMENSION(:) :: XF_PARAM
+REAL, POINTER, DIMENSION(:) :: XC_DEPTH_RATIO
+!
+! - Coupling with river routing model
+!
+REAL, POINTER, DIMENSION(:) :: XCPL_DRAIN ! Surface runoff
+REAL, POINTER, DIMENSION(:) :: XCPL_RUNOFF ! Deep drainage or gourdwater recharge
+REAL, POINTER, DIMENSION(:) :: XCPL_ICEFLUX ! Calving flux
+REAL, POINTER, DIMENSION(:) :: XCPL_EFLOOD ! floodplains evaporation
+REAL, POINTER, DIMENSION(:) :: XCPL_PFLOOD ! floodplains precipitation interception
+REAL, POINTER, DIMENSION(:) :: XCPL_IFLOOD ! floodplains infiltration
+!
+! - Random perturbations
+!
+REAL, POINTER, DIMENSION(:) :: XPERTVEG
+REAL, POINTER, DIMENSION(:) :: XPERTLAI
+REAL, POINTER, DIMENSION(:) :: XPERTCV
+REAL, POINTER, DIMENSION(:) :: XPERTALB
+REAL, POINTER, DIMENSION(:) :: XPERTZ0
+!
+REAL, POINTER, DIMENSION(:) :: XTSRAD_NAT ! patch averaged radiative temperature (K)
+!
+REAL, POINTER, DIMENSION(:) :: XEMIS_NAT ! patch averaged emissivity (-)
+!
+! - Assimilation: ENKF
+!
+REAL, POINTER, DIMENSION(:,:) :: XFRACSOC ! Fraction of organic carbon in each soil layer
+!
+REAL, POINTER, DIMENSION(:,:) :: XVEGTYPE
+!
+REAL, POINTER, DIMENSION(:,:) :: XPATCH ! fraction of each tile/patch (-)
+!
+! Mask and number of grid elements containing patches/tiles:
+!
+REAL, POINTER, DIMENSION(:,:,:) :: XVEGTYPE_PATCH ! fraction of each vegetation type for
+!
+REAL, POINTER, DIMENSION(:,:) :: XINNOV
+REAL, POINTER, DIMENSION(:,:) :: XRESID
+!
+REAL, POINTER, DIMENSION(:,:) :: XWORK_WR
+!
+REAL, POINTER, DIMENSION(:,:,:) :: XWSN_WR
+REAL, POINTER, DIMENSION(:,:,:) :: XRHO_WR
+REAL, POINTER, DIMENSION(:,:,:) :: XHEA_WR
+REAL, POINTER, DIMENSION(:,:,:) :: XAGE_WR
+REAL, POINTER, DIMENSION(:,:,:) :: XSG1_WR
+REAL, POINTER, DIMENSION(:,:,:) :: XSG2_WR
+REAL, POINTER, DIMENSION(:,:,:) :: XHIS_WR
+REAL, POINTER, DIMENSION(:,:,:) :: XT_WR
+REAL, POINTER, DIMENSION(:,:) :: XALB_WR
+!
+TYPE(DATE_TIME), POINTER, DIMENSION(:,:) :: TDATE_WR
+!
+END TYPE ISBA_S_t
+!
+!
+TYPE ISBA_K_t
+!
+REAL, POINTER, DIMENSION(:,:) :: XSAND ! sand fraction (-)
+REAL, POINTER, DIMENSION(:,:) :: XCLAY ! clay fraction (-)
+!
+REAL, POINTER, DIMENSION(:) :: XPERM ! permafrost distribution (-)
+!
+REAL, POINTER, DIMENSION(:) :: XRUNOFFB ! sub-grid dt92 surface runoff slope parameter (-)
+REAL, POINTER, DIMENSION(:) :: XWDRAIN ! continuous drainage parameter (-)
+!
+!
+REAL, POINTER, DIMENSION(:) :: XTDEEP ! prescribed deep soil temperature
+! ! (optional)
+REAL, POINTER, DIMENSION(:) :: XGAMMAT ! 'Force-Restore' timescale when using a
+! ! prescribed lower boundary temperature (1/days)
+!
+REAL, POINTER, DIMENSION(:,:) :: XMPOTSAT ! matric potential at saturation (m)
+REAL, POINTER, DIMENSION(:,:) :: XBCOEF ! soil water CH78 b-parameter (-)
+REAL, POINTER, DIMENSION(:,:) :: XWWILT ! wilting point volumetric water content
+! ! profile (m3/m3)
+REAL, POINTER, DIMENSION(:,:) :: XWFC ! field capacity volumetric water content
+! ! profile (m3/m3)
+REAL, POINTER, DIMENSION(:,:) :: XWSAT ! porosity profile (m3/m3)
+!
+REAL, POINTER, DIMENSION(:) :: XCGSAT ! soil thermal inertia coefficient at
+! ! saturation
+REAL, POINTER, DIMENSION(:) :: XC4B ! 'Force-Restore' sub-surface vertical
+! ! diffusion coefficient (slope parameter) (-)
+REAL, POINTER, DIMENSION(:) :: XACOEF ! 'Force-Restore' surface vertical
+! ! diffusion coefficient (-)
+REAL, POINTER, DIMENSION(:) :: XPCOEF ! 'Force-Restore' surface vertical
+! ! diffusion coefficient (-)
+REAL, POINTER, DIMENSION(:,:) :: XHCAPSOIL ! soil heat capacity (J/K/m3)
+REAL, POINTER, DIMENSION(:,:) :: XCONDDRY ! soil dry thermal conductivity (W/m/K)
+REAL, POINTER, DIMENSION(:,:) :: XCONDSLD ! soil solids thermal conductivity (W/m/K)
+!
+! - Water table depth coupling
+!
+REAL, POINTER, DIMENSION(:) :: XFWTD ! grid-cell fraction of water table rise
+REAL, POINTER, DIMENSION(:) :: XWTD ! water table depth (negative below soil surface) (m)
+!
+! * Physiographic radiative fields
+!
+REAL, POINTER, DIMENSION(:) :: XALBNIR_DRY ! dry soil near-infra-red albedo (-)
+REAL, POINTER, DIMENSION(:) :: XALBVIS_DRY ! dry soil visible albedo (-)
+REAL, POINTER, DIMENSION(:) :: XALBUV_DRY ! dry soil UV albedo (-)
+REAL, POINTER, DIMENSION(:) :: XALBNIR_WET ! wet soil near-infra-red albedo (-)
+REAL, POINTER, DIMENSION(:) :: XALBVIS_WET ! wet soil visible albedo (-)
+REAL, POINTER, DIMENSION(:) :: XALBUV_WET ! wet soil UV albedo (-)
+!
+! * SGH initializations
+!
+REAL, POINTER, DIMENSION(:,:) :: XWD0 ! water content equivalent to TOPMODEL maximum deficit
+REAL, POINTER, DIMENSION(:,:) :: XKANISO ! Anisotropy coeficient for hydraulic conductivity
+!
+REAL, POINTER, DIMENSION(:) :: XMUF ! fraction of the grid cell reached by the rainfall
+REAL, POINTER, DIMENSION(:) :: XFSAT ! Topmodel or dt92 saturated fracti
+!
+REAL, POINTER, DIMENSION(:) :: XFFLOOD ! Grid-cell flood fraction
+REAL, POINTER, DIMENSION(:) :: XPIFLOOD ! flood potential infiltration (kg/m2/s)
+!
+! - Flood scheme
+!
+REAL, POINTER, DIMENSION(:) :: XFF ! Total Flood fraction
+REAL, POINTER, DIMENSION(:) :: XFFG ! Flood fraction over ground
+REAL, POINTER, DIMENSION(:) :: XFFV ! Flood fraction over vegetation
+REAL, POINTER, DIMENSION(:) :: XFFROZEN ! Fraction of frozen floodplains
+REAL, POINTER, DIMENSION(:) :: XALBF ! Flood albedo
+REAL, POINTER, DIMENSION(:) :: XEMISF ! Flood emissivity
+!
+! - Snow and flood fractions and total albedo at time t: (-)
+!
+REAL, POINTER, DIMENSION(:,:) :: XDIR_ALB_WITH_SNOW ! total direct albedo by bands
+REAL, POINTER, DIMENSION(:,:) :: XSCA_ALB_WITH_SNOW ! total diffuse albedo by bands
+!
+REAL, POINTER, DIMENSION(:,:) :: XVEGTYPE
+!
+END TYPE ISBA_K_t
+!
+!
+TYPE ISBA_P_t
+!
+INTEGER :: NSIZE_P ! number of sub-patchs/tiles (-)
+!
+REAL, POINTER, DIMENSION(:) :: XPATCH ! fraction of each tile/patch (-)
+!
+! Mask and number of grid elements containing patches/tiles:
+!
+REAL, POINTER, DIMENSION(:,:) :: XVEGTYPE_PATCH ! fraction of each vegetation type for
+!
+INTEGER, POINTER, DIMENSION(:) :: NR_P ! patch/tile mask
+!
+REAL, POINTER, DIMENSION(:) :: XPATCH_OLD ! fraction of each tile/patchfor land use (-)
+!
+!
+REAL, POINTER, DIMENSION(:) :: XANMAX ! maximum photosynthesis rate (
+REAL, POINTER, DIMENSION(:) :: XFZERO ! ideal value of F, no photo-
+! ! respiration or saturation deficit
+REAL, POINTER, DIMENSION(:) :: XEPSO ! maximum initial quantum use
+! ! efficiency (mg J-1 PAR)
+REAL, POINTER, DIMENSION(:) :: XGAMM ! CO2 conpensation concentration (ppm)
+REAL, POINTER, DIMENSION(:) :: XQDGAMM ! Log of Q10 function for CO2 conpensation
+! ! concentration (-)
+REAL, POINTER, DIMENSION(:) :: XQDGMES ! Log of Q10 function for mesophyll conductance (-)
+REAL, POINTER, DIMENSION(:) :: XT1GMES ! reference temperature for computing
+! ! compensation concentration function for
+! ! mesophyll conductance: minimum
+! ! temperature (K)
+REAL, POINTER, DIMENSION(:) :: XT2GMES ! reference temperature for computing
+! ! compensation concentration function for
+! ! mesophyll conductance: maximum
+! ! temperature (K)
+REAL, POINTER, DIMENSION(:) :: XAMAX ! leaf photosynthetic capacity (mg m-2 s-1)
+REAL, POINTER, DIMENSION(:) :: XQDAMAX ! Log of Q10 function for leaf photosynthetic
+! ! capacity (-)
+REAL, POINTER, DIMENSION(:) :: XT1AMAX ! reference temperature for computing
+! ! compensation concentration function for
+! ! leaf photosynthetic capacity: minimum
+! ! temperature (K)
+REAL, POINTER, DIMENSION(:) :: XT2AMAX ! reference temperature for computing
+! ! compensation concentration function for
+! ! leaf photosynthetic capacity: maximum
+! ! temperature (K)
+REAL, POINTER, DIMENSION(:) :: XAH ! coefficients for herbaceous water stress
+! ! response (offensive or defensive) (log(mm/s))
+REAL, POINTER, DIMENSION(:) :: XBH ! coefficients for herbaceous water stress
+! ! response (offensive or defensive)
+REAL, POINTER, DIMENSION(:) :: XTAU_WOOD ! residence time in woody biomass (s)
+REAL, POINTER, DIMENSION(:,:) :: XINCREASE ! biomass increase (kg/m2/day)
+REAL, POINTER, DIMENSION(:,:) :: XTURNOVER ! turnover rates from biomass to litter (gC/m2/s)
+!
+! *Soil hydraulic characteristics
+!
+REAL, POINTER, DIMENSION(:,:) :: XCONDSAT ! hydraulic conductivity at saturation (m/s)
+!
+REAL, POINTER, DIMENSION(:) :: XTAUICE ! soil freezing characteristic timescale (s)
+!
+REAL, POINTER, DIMENSION(:) :: XC1SAT ! 'Force-Restore' C1 coefficient at
+! ! saturation (-)
+REAL, POINTER, DIMENSION(:) :: XC2REF ! 'Force-Restore' reference value of C2 (-)
+REAL, POINTER, DIMENSION(:,:) :: XC3 ! 'Force-Restore' C3 drainage coefficient (m)
+REAL, POINTER, DIMENSION(:) :: XC4REF ! 'Force-Restore' sub-surface vertical
+! ! for lateral drainage ('DIF' option)
+!
+REAL, POINTER, DIMENSION(:) :: XBSLAI_NITRO ! biomass/LAI ratio from nitrogen
+! ! decline theory (kg/m2)
+! * Soil thermal characteristics
+!
+REAL, POINTER, DIMENSION(:) :: XCPS
+REAL, POINTER, DIMENSION(:) :: XLVTT
+REAL, POINTER, DIMENSION(:) :: XLSTT
+!
+! * Initialize hydrology
+!
+ REAL, POINTER, DIMENSION(:) :: XRUNOFFD ! depth over which sub-grid runoff is
+! ! computed: in Force-Restore this is the
+! ! total soil column ('2-L'), or root zone
+! ! ('3-L'). For the 'DIF' option, it can
+! ! be any depth within soil column (m)
+!
+REAL, POINTER, DIMENSION(:,:) :: XDZG ! soil layers thicknesses (DIF option)
+REAL, POINTER, DIMENSION(:,:) :: XDZDIF ! distance between consecuative layer mid-points (DIF option)
+REAL, POINTER, DIMENSION(:,:) :: XSOILWGHT ! VEG-DIF: weights for vertical
+! ! integration of soil water and properties
+!
+REAL, POINTER, DIMENSION(:) :: XKSAT_ICE ! hydraulic conductivity at saturation
+! over frozen area (m s-1)
+!
+REAL, POINTER, DIMENSION(:,:) :: XTOPQS ! Topmodel subsurface flow by layer (m/s)
+!
+REAL, POINTER, DIMENSION(:,:) :: XDG ! soil layer depth (m)
+! ! NOTE: in Force-Restore mode, the
+! ! uppermost layer depth is superficial
+! ! and is only explicitly used for soil
+! ! water phase changes (m)
+!
+REAL, POINTER, DIMENSION(:,:) :: XDG_OLD ! For land use
+REAL, POINTER, DIMENSION(:) :: XDG2
+INTEGER, POINTER, DIMENSION(:) :: NWG_LAYER ! Number of soil moisture layers for DIF
+REAL, POINTER, DIMENSION(:) :: XDROOT ! effective root depth for DIF (m)
+REAL, POINTER, DIMENSION(:,:) :: XROOTFRAC ! root fraction profile ('DIF' option)
+!
+REAL, POINTER, DIMENSION(:) :: XD_ICE ! depth of the soil column for the calculation
+! of the frozen soil fraction (m)
+!
+REAL, POINTER, DIMENSION(:) :: XH_TREE ! height of trees (m)
+!
+REAL, POINTER, DIMENSION(:) :: XZ0_O_Z0H ! ratio of surface roughness lengths
+! ! (momentum to heat) (-)
+!
+REAL, POINTER, DIMENSION(:) :: XRE25 ! Ecosystem respiration parameter (kg/kg.m.s-1)
+!
+REAL, POINTER, DIMENSION(:) :: XDMAX ! maximum air saturation deficit
+! ! tolerate by vegetation
+! (kg/kg)
+!
+REAL, POINTER, DIMENSION(:,:) :: XRED_NOISE
+REAL, POINTER, DIMENSION(:,:) :: XINCR
+REAL, POINTER, DIMENSION(:,:,:) :: XHO
+!
+END TYPE ISBA_P_t
+!
+TYPE ISBA_PE_t
+!
+! Prognostic variables:
+!
+! - Soil and vegetation heat and water:
+!
+REAL, POINTER, DIMENSION(:,:) :: XWG ! soil volumetric water content profile (m3/m3)
+REAL, POINTER, DIMENSION(:,:) :: XWGI ! soil liquid water equivalent volumetric
+! ! ice content profile (m3/m3)
+REAL, POINTER, DIMENSION(:) :: XWR ! liquid water retained on the
+! ! foliage of the vegetation
+! ! canopy (kg/m2)
+REAL, POINTER, DIMENSION(:,:) :: XTG ! surface and sub-surface soil
+! ! temperature profile (K)
+!
+! - Snow Cover:
+!
+TYPE(SURF_SNOW) :: TSNOW ! snow state:
+! ! scheme type/option (-)
+! ! number of layers (-)
+! ! snow (& liq. water) content (kg/m2)
+! ! heat content (J/m2)
+! ! temperature (K)
+! ! density (kg m-3)
+!
+REAL, POINTER, DIMENSION(:) :: XICE_STO ! Glacier ice storage reservoir
+!
+! - For multi-energy balance:
+!
+REAL, POINTER, DIMENSION(:) :: XWRL ! liquid water retained on litter (kg/m2)
+REAL, POINTER, DIMENSION(:) :: XWRLI ! ice retained on litter (kg/m2)
+REAL, POINTER, DIMENSION(:) :: XWRVN ! snow retained on the foliage
+! ! of the canopy vegetation (kg/m2)
+REAL, POINTER, DIMENSION(:) :: XTV ! canopy vegetation temperature (K)
+REAL, POINTER, DIMENSION(:) :: XTL ! litter temperature (K)
+REAL, POINTER, DIMENSION(:) :: XTC ! canopy air temperature (K)
+REAL, POINTER, DIMENSION(:) :: XQC ! canopy air specific humidity (kg/kg)
+!
+! * Half prognostic fields
+!
+REAL, POINTER, DIMENSION(:) :: XRESA ! aerodynamic resistance (s/m)
+!
+! - Vegetation: Ags Prognostic (YPHOTO = 'AST', 'NIT', 'NCB')
+!
+REAL, POINTER, DIMENSION(:) :: XAN ! net CO2 assimilation (mg/m2/s)
+REAL, POINTER, DIMENSION(:) :: XANDAY ! daily net CO2 assimilation (mg/m2)
+REAL, POINTER, DIMENSION(:) :: XANFM ! maximum leaf assimilation (mg/m2/s)
+REAL, POINTER, DIMENSION(:) :: XLE ! evapotranspiration (W/m2)
+!
+REAL, POINTER, DIMENSION(:) :: XFAPARC ! Fapar of vegetation (cumul)
+REAL, POINTER, DIMENSION(:) :: XFAPIRC ! Fapir of vegetation (cumul)
+REAL, POINTER, DIMENSION(:) :: XLAI_EFFC ! Effective LAI (cumul)
+REAL, POINTER, DIMENSION(:) :: XMUS ! cos zenithal angle (cumul)
+!
+REAL, POINTER, DIMENSION(:,:) :: XRESP_BIOMASS ! daily cumulated respiration of
+! ! biomass (kg/m2/s)
+REAL, POINTER, DIMENSION(:,:) :: XBIOMASS ! biomass of previous day (kg/m2)
+!
+! - Soil carbon (ISBA-CC, YRESPSL = 'CNT')
+!
+REAL, POINTER, DIMENSION(:,:,:) :: XLITTER ! litter pools (gC/m2)
+REAL, POINTER, DIMENSION(:,:) :: XSOILCARB ! soil carbon pools (gC/m2)
+REAL, POINTER, DIMENSION(:,:) :: XLIGNIN_STRUC ! ratio Lignin/Carbon in structural
+! litter (gC/m2)
+!
+REAL, POINTER, DIMENSION(:) :: XPSNG ! Snow fraction over ground
+REAL, POINTER, DIMENSION(:) :: XPSNV ! Snow fraction over vegetation
+REAL, POINTER, DIMENSION(:) :: XPSNV_A ! Snow fraction over vegetation
+REAL, POINTER, DIMENSION(:) :: XPSN
+!
+REAL, POINTER, DIMENSION(:) :: XSNOWFREE_ALB ! snow free albedo (-)
+REAL, POINTER, DIMENSION(:) :: XSNOWFREE_ALB_VEG ! snow free albedo for vegetation (-)
+REAL, POINTER, DIMENSION(:) :: XSNOWFREE_ALB_SOIL! snow free albedo for soil
+!
+REAL, POINTER, DIMENSION(:) :: XVEG ! vegetation cover fraction (-)
+!
+REAL, POINTER, DIMENSION(:) :: XLAI ! Leaf Area Index (m2/m2)
+REAL, POINTER, DIMENSION(:) :: XLAIp ! Leaf Area Index previous (m2/m2)
+!
+REAL, POINTER, DIMENSION(:) :: XEMIS ! surface emissivity (-)
+REAL, POINTER, DIMENSION(:) :: XZ0 ! surface roughness length (m)
+!
+REAL, POINTER, DIMENSION(:) :: XRSMIN ! minimum stomatal resistance (s/m)
+REAL, POINTER, DIMENSION(:) :: XGAMMA ! coefficient for the calculation
+! ! of the surface stomatal
+! ! resistance
+REAL, POINTER, DIMENSION(:) :: XWRMAX_CF ! coefficient for maximum water
+! ! interception
+! ! storage capacity on the vegetation (-)
+REAL, POINTER, DIMENSION(:) :: XRGL ! maximum solar radiation
+! ! usable in photosynthesis
+REAL, POINTER, DIMENSION(:) :: XCV ! vegetation thermal inertia coefficient (K m2/J)
+REAL, POINTER, DIMENSION(:) :: XLAIMIN ! minimum LAI (Leaf Area Index) (m2/m2)
+REAL, POINTER, DIMENSION(:) :: XSEFOLD ! e-folding time for senescence (s)
+REAL, POINTER, DIMENSION(:) :: XGMES ! mesophyll conductance (m s-1)
+REAL, POINTER, DIMENSION(:) :: XGC ! cuticular conductance (m s-1)
+REAL, POINTER, DIMENSION(:) :: XF2I ! critical normilized soil water
+! ! content for stress parameterisation
+REAL, POINTER, DIMENSION(:) :: XBSLAI ! ratio d(biomass)/d(lai) (kg/m2)
+!
+REAL, POINTER, DIMENSION(:) :: XCE_NITRO ! leaf aera ratio sensitivity to
+! ! nitrogen concentration (m2/kg)
+REAL, POINTER, DIMENSION(:) :: XCF_NITRO ! lethal minimum value of leaf area
+! ! ratio (m2/kg)
+REAL, POINTER, DIMENSION(:) :: XCNA_NITRO ! nitrogen concentration of active
+! ! biomass
+LOGICAL, POINTER, DIMENSION(:) :: LSTRESS ! vegetation response type to water
+! ! stress (true:defensive false:offensive) (-)
+!
+REAL, POINTER, DIMENSION(:) :: XALBNIR_VEG ! vegetation near-infra-red albedo (-)
+REAL, POINTER, DIMENSION(:) :: XALBVIS_VEG ! vegetation visible albedo (-)
+REAL, POINTER, DIMENSION(:) :: XALBUV_VEG ! vegetation UV albedo (-)
+!
+REAL, POINTER, DIMENSION(:) :: XALBNIR ! near-infra-red albedo (-)
+REAL, POINTER, DIMENSION(:) :: XALBVIS ! visible albedo (-)
+REAL, POINTER, DIMENSION(:) :: XALBUV ! UV albedo
+!
+REAL, POINTER, DIMENSION(:) :: XGNDLITTER ! ground litter fraction (-)
+REAL, POINTER, DIMENSION(:) :: XH_VEG ! height of vegetation (m)
+REAL, POINTER, DIMENSION(:) :: XZ0LITTER ! ground litter roughness length (m)
+!
+REAL, POINTER, DIMENSION(:) :: XALBNIR_SOIL ! soil near-infra-red albedo (-)
+REAL, POINTER, DIMENSION(:) :: XALBVIS_SOIL ! soil visible albedo (-)
+REAL, POINTER, DIMENSION(:) :: XALBUV_SOIL ! soil UV albedo
+!
+TYPE (DATE_TIME), POINTER, DIMENSION(:) :: TSEED ! date of seeding
+TYPE (DATE_TIME), POINTER, DIMENSION(:) :: TREAP ! date of reaping
+REAL, POINTER, DIMENSION(:) :: XWATSUP ! water supply during irrigation process (mm)
+REAL, POINTER, DIMENSION(:) :: XIRRIG ! flag for irrigation (irrigation if >0.)
+!
+!
+END TYPE ISBA_PE_t
+!
+TYPE ISBA_NK_t
+!
+TYPE(ISBA_K_t), DIMENSION(:), POINTER :: AL=>NULL()
+!
+END TYPE ISBA_NK_t
+!
+TYPE ISBA_NP_t
+!
+TYPE(ISBA_P_t), DIMENSION(:), POINTER :: AL=>NULL()
+!
+END TYPE ISBA_NP_t
+!
+TYPE ISBA_NPE_t
+!
+TYPE(ISBA_PE_t), DIMENSION(:), POINTER :: AL=>NULL()
+!
+END TYPE ISBA_NPE_t
+!
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+CONTAINS
+!
+SUBROUTINE ISBA_S_INIT(YISBA_S)
+TYPE(ISBA_S_t), INTENT(INOUT) :: YISBA_S
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK("MODD_ISBA_N:ISBA_S_INIT",0,ZHOOK_HANDLE)
+!
+NULLIFY(YISBA_S%XZS)
+NULLIFY(YISBA_S%XCOVER)
+NULLIFY(YISBA_S%LCOVER)
+!
+NULLIFY(YISBA_S%XTI_MIN)
+NULLIFY(YISBA_S%XTI_MAX)
+NULLIFY(YISBA_S%XTI_MEAN)
+NULLIFY(YISBA_S%XTI_STD)
+NULLIFY(YISBA_S%XTI_SKEW)
+!
+NULLIFY(YISBA_S%XSOC)
+NULLIFY(YISBA_S%XPH)
+NULLIFY(YISBA_S%XFERT)
+!
+NULLIFY(YISBA_S%XABC)
+NULLIFY(YISBA_S%XPOI)
+!
+NULLIFY(YISBA_S%XFRACSOC)
+NULLIFY(YISBA_S%XTAB_FSAT)
+NULLIFY(YISBA_S%XTAB_WTOP)
+NULLIFY(YISBA_S%XTAB_QTOP)
+NULLIFY(YISBA_S%XF_PARAM)
+NULLIFY(YISBA_S%XC_DEPTH_RATIO)
+NULLIFY(YISBA_S%XCPL_DRAIN)
+NULLIFY(YISBA_S%XCPL_RUNOFF)
+NULLIFY(YISBA_S%XCPL_ICEFLUX)
+NULLIFY(YISBA_S%XCPL_EFLOOD)
+NULLIFY(YISBA_S%XCPL_PFLOOD)
+NULLIFY(YISBA_S%XCPL_IFLOOD)
+NULLIFY(YISBA_S%XPERTVEG)
+NULLIFY(YISBA_S%XPERTLAI)
+NULLIFY(YISBA_S%XPERTCV)
+NULLIFY(YISBA_S%XPERTALB)
+NULLIFY(YISBA_S%XPERTZ0)
+NULLIFY(YISBA_S%XEMIS_NAT)
+!
+NULLIFY(YISBA_S%XTSRAD_NAT)
+!
+NULLIFY(YISBA_S%XINNOV)
+NULLIFY(YISBA_S%XRESID)
+!
+NULLIFY(YISBA_S%XWORK_WR)
+!
+NULLIFY(YISBA_S%XWSN_WR)
+NULLIFY(YISBA_S%XRHO_WR)
+NULLIFY(YISBA_S%XALB_WR)
+NULLIFY(YISBA_S%XHEA_WR)
+NULLIFY(YISBA_S%XAGE_WR)
+NULLIFY(YISBA_S%XSG1_WR)
+NULLIFY(YISBA_S%XSG2_WR)
+NULLIFY(YISBA_S%XHIS_WR)
+!
+NULLIFY(YISBA_S%TDATE_WR)
+!
+IF (LHOOK) CALL DR_HOOK("MODD_ISBA_N:ISBA_S_INIT",1,ZHOOK_HANDLE)
+END SUBROUTINE ISBA_S_INIT
+!
+SUBROUTINE ISBA_K_INIT(YISBA_K)
+TYPE(ISBA_K_t), INTENT(INOUT) :: YISBA_K
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK("MODD_ISBA_N:ISBA_K_INIT",0,ZHOOK_HANDLE)
+!
+NULLIFY(YISBA_K%XSAND)
+NULLIFY(YISBA_K%XCLAY)
+NULLIFY(YISBA_K%XPERM)
+NULLIFY(YISBA_K%XRUNOFFB)
+NULLIFY(YISBA_K%XWDRAIN)
+!
+NULLIFY(YISBA_K%XTDEEP)
+NULLIFY(YISBA_K%XGAMMAT)
+NULLIFY(YISBA_K%XMPOTSAT)
+NULLIFY(YISBA_K%XBCOEF)
+NULLIFY(YISBA_K%XWWILT)
+NULLIFY(YISBA_K%XWFC)
+NULLIFY(YISBA_K%XWSAT)
+NULLIFY(YISBA_K%XCGSAT)
+NULLIFY(YISBA_K%XC4B)
+NULLIFY(YISBA_K%XACOEF)
+NULLIFY(YISBA_K%XPCOEF)
+NULLIFY(YISBA_K%XHCAPSOIL)
+NULLIFY(YISBA_K%XCONDDRY)
+NULLIFY(YISBA_K%XCONDSLD)
+NULLIFY(YISBA_K%XFWTD)
+NULLIFY(YISBA_K%XWTD)
+NULLIFY(YISBA_K%XALBNIR_DRY)
+NULLIFY(YISBA_K%XALBVIS_DRY)
+NULLIFY(YISBA_K%XALBUV_DRY)
+NULLIFY(YISBA_K%XALBNIR_WET)
+NULLIFY(YISBA_K%XALBVIS_WET)
+NULLIFY(YISBA_K%XALBUV_WET)
+NULLIFY(YISBA_K%XWD0)
+NULLIFY(YISBA_K%XKANISO)
+NULLIFY(YISBA_K%XMUF)
+NULLIFY(YISBA_K%XFSAT)
+NULLIFY(YISBA_K%XFFLOOD)
+NULLIFY(YISBA_K%XPIFLOOD)
+NULLIFY(YISBA_K%XFF)
+NULLIFY(YISBA_K%XFFG)
+NULLIFY(YISBA_K%XFFV)
+NULLIFY(YISBA_K%XFFROZEN)
+NULLIFY(YISBA_K%XALBF)
+NULLIFY(YISBA_K%XEMISF)
+NULLIFY(YISBA_K%XDIR_ALB_WITH_SNOW)
+NULLIFY(YISBA_K%XSCA_ALB_WITH_SNOW)
+!
+NULLIFY(YISBA_K%XVEGTYPE)
+!
+IF (LHOOK) CALL DR_HOOK("MODD_ISBA_N:ISBA_K_INIT",1,ZHOOK_HANDLE)
+END SUBROUTINE ISBA_K_INIT
+!
+SUBROUTINE ISBA_P_INIT(YISBA_P)
+TYPE(ISBA_P_t), INTENT(INOUT) :: YISBA_P
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK("MODD_ISBA_N:ISBA_P_INIT",0,ZHOOK_HANDLE)
+!
+YISBA_P%NSIZE_P = 0
+NULLIFY(YISBA_P%XPATCH)
+NULLIFY(YISBA_P%XVEGTYPE_PATCH)
+NULLIFY(YISBA_P%NR_P)
+NULLIFY(YISBA_P%XPATCH_OLD)
+NULLIFY(YISBA_P%XANMAX)
+NULLIFY(YISBA_P%XFZERO)
+NULLIFY(YISBA_P%XEPSO)
+NULLIFY(YISBA_P%XGAMM)
+NULLIFY(YISBA_P%XQDGAMM)
+NULLIFY(YISBA_P%XQDGMES)
+NULLIFY(YISBA_P%XT1GMES)
+NULLIFY(YISBA_P%XT2GMES)
+NULLIFY(YISBA_P%XAMAX)
+NULLIFY(YISBA_P%XQDAMAX)
+NULLIFY(YISBA_P%XT1AMAX)
+NULLIFY(YISBA_P%XT2AMAX)
+NULLIFY(YISBA_P%XAH)
+NULLIFY(YISBA_P%XBH)
+NULLIFY(YISBA_P%XTAU_WOOD)
+NULLIFY(YISBA_P%XINCREASE)
+NULLIFY(YISBA_P%XTURNOVER)
+NULLIFY(YISBA_P%XCONDSAT)
+NULLIFY(YISBA_P%XTAUICE)
+NULLIFY(YISBA_P%XC1SAT)
+NULLIFY(YISBA_P%XC2REF)
+NULLIFY(YISBA_P%XC3)
+NULLIFY(YISBA_P%XC4REF)
+NULLIFY(YISBA_P%XCPS)
+NULLIFY(YISBA_P%XLVTT)
+NULLIFY(YISBA_P%XLSTT)
+NULLIFY(YISBA_P%XRUNOFFD)
+NULLIFY(YISBA_P%XDZG)
+NULLIFY(YISBA_P%XDZDIF)
+NULLIFY(YISBA_P%XSOILWGHT)
+NULLIFY(YISBA_P%XKSAT_ICE)
+NULLIFY(YISBA_P%XBSLAI_NITRO)
+NULLIFY(YISBA_P%XTOPQS)
+!
+NULLIFY(YISBA_P%XDG)
+NULLIFY(YISBA_P%XDG_OLD)
+NULLIFY(YISBA_P%NWG_LAYER)
+NULLIFY(YISBA_P%XDROOT)
+NULLIFY(YISBA_P%XDG2)
+NULLIFY(YISBA_P%XROOTFRAC)
+NULLIFY(YISBA_P%XD_ICE)
+NULLIFY(YISBA_P%XH_TREE)
+NULLIFY(YISBA_P%XZ0_O_Z0H)
+NULLIFY(YISBA_P%XRE25)
+NULLIFY(YISBA_P%XDMAX)
+!
+NULLIFY(YISBA_P%XRED_NOISE)
+NULLIFY(YISBA_P%XINCR)
+NULLIFY(YISBA_P%XHO)
+!
+IF (LHOOK) CALL DR_HOOK("MODD_ISBA_N:ISBA_P_INIT",1,ZHOOK_HANDLE)
+END SUBROUTINE ISBA_P_INIT
+!
+SUBROUTINE ISBA_PE_INIT(YISBA_PE)
+TYPE(ISBA_PE_t), INTENT(INOUT) :: YISBA_PE
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK("MODD_ISBA_N:ISBA_PE_INIT",0,ZHOOK_HANDLE)
+!
+NULLIFY(YISBA_PE%XLAI)
+NULLIFY(YISBA_PE%XLAIp)
+NULLIFY(YISBA_PE%XVEG)
+NULLIFY(YISBA_PE%XEMIS)
+NULLIFY(YISBA_PE%XZ0)
+NULLIFY(YISBA_PE%XRSMIN)
+NULLIFY(YISBA_PE%XGAMMA)
+NULLIFY(YISBA_PE%XWRMAX_CF)
+NULLIFY(YISBA_PE%XRGL)
+NULLIFY(YISBA_PE%XCV)
+NULLIFY(YISBA_PE%XLAIMIN)
+NULLIFY(YISBA_PE%XSEFOLD)
+NULLIFY(YISBA_PE%XGMES)
+NULLIFY(YISBA_PE%XGC)
+NULLIFY(YISBA_PE%XF2I)
+NULLIFY(YISBA_PE%XBSLAI)
+NULLIFY(YISBA_PE%XCE_NITRO)
+NULLIFY(YISBA_PE%XCF_NITRO)
+NULLIFY(YISBA_PE%XCNA_NITRO)
+NULLIFY(YISBA_PE%LSTRESS)
+NULLIFY(YISBA_PE%XALBNIR_VEG)
+NULLIFY(YISBA_PE%XALBVIS_VEG)
+NULLIFY(YISBA_PE%XALBUV_VEG)
+NULLIFY(YISBA_PE%XALBNIR)
+NULLIFY(YISBA_PE%XALBVIS)
+NULLIFY(YISBA_PE%XALBUV)
+!
+NULLIFY(YISBA_PE%XGNDLITTER)
+NULLIFY(YISBA_PE%XH_VEG)
+NULLIFY(YISBA_PE%XZ0LITTER)
+!
+NULLIFY(YISBA_PE%XALBNIR_SOIL)
+NULLIFY(YISBA_PE%XALBVIS_SOIL)
+NULLIFY(YISBA_PE%XALBUV_SOIL)
+!
+NULLIFY(YISBA_PE%XWATSUP)
+NULLIFY(YISBA_PE%XIRRIG)
+!
+NULLIFY(YISBA_PE%XWG)
+NULLIFY(YISBA_PE%XWGI)
+NULLIFY(YISBA_PE%XWR)
+NULLIFY(YISBA_PE%XTG)
+NULLIFY(YISBA_PE%XICE_STO)
+NULLIFY(YISBA_PE%XWRL)
+NULLIFY(YISBA_PE%XWRLI)
+NULLIFY(YISBA_PE%XWRVN)
+NULLIFY(YISBA_PE%XTV)
+NULLIFY(YISBA_PE%XTL)
+NULLIFY(YISBA_PE%XTC)
+NULLIFY(YISBA_PE%XQC)
+NULLIFY(YISBA_PE%XRESA)
+NULLIFY(YISBA_PE%XAN)
+NULLIFY(YISBA_PE%XANDAY)
+NULLIFY(YISBA_PE%XANFM)
+NULLIFY(YISBA_PE%XLE)
+NULLIFY(YISBA_PE%XFAPARC)
+NULLIFY(YISBA_PE%XFAPIRC)
+NULLIFY(YISBA_PE%XLAI_EFFC)
+NULLIFY(YISBA_PE%XMUS)
+NULLIFY(YISBA_PE%XRESP_BIOMASS)
+NULLIFY(YISBA_PE%XBIOMASS)
+NULLIFY(YISBA_PE%XLITTER)
+NULLIFY(YISBA_PE%XSOILCARB)
+NULLIFY(YISBA_PE%XLIGNIN_STRUC)
+NULLIFY(YISBA_PE%XPSNG)
+NULLIFY(YISBA_PE%XPSNV)
+NULLIFY(YISBA_PE%XPSNV_A)
+NULLIFY(YISBA_PE%XSNOWFREE_ALB)
+NULLIFY(YISBA_PE%XSNOWFREE_ALB_VEG)
+NULLIFY(YISBA_PE%XSNOWFREE_ALB_SOIL)
+NULLIFY(YISBA_PE%XPSN)
+!
+IF (LHOOK) CALL DR_HOOK("MODD_ISBA_N:ISBA_PE_INIT",1,ZHOOK_HANDLE)
+END SUBROUTINE ISBA_PE_INIT
+!
+SUBROUTINE ISBA_NK_INIT(YISBA_NK,KPATCH)
+TYPE(ISBA_NK_t), INTENT(INOUT) :: YISBA_NK
+INTEGER, INTENT(IN) :: KPATCH
+INTEGER :: JP
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK("MODD_ISBA_N:ISBA_NK_INIT",0,ZHOOK_HANDLE)
+!
+IF (ASSOCIATED(YISBA_NK%AL)) THEN
+ DO JP = 1,KPATCH
+ CALL ISBA_K_INIT(YISBA_NK%AL(JP))
+ ENDDO
+ DEALLOCATE(YISBA_NK%AL)
+ELSE
+ ALLOCATE(YISBA_NK%AL(KPATCH))
+ DO JP = 1,KPATCH
+ CALL ISBA_K_INIT(YISBA_NK%AL(JP))
+ ENDDO
+ENDIF
+!
+IF (LHOOK) CALL DR_HOOK("MODD_ISBA_N:ISBA_NK_INIT",1,ZHOOK_HANDLE)
+END SUBROUTINE ISBA_NK_INIT
+!
+SUBROUTINE ISBA_NP_INIT(YISBA_NP,KPATCH)
+TYPE(ISBA_NP_t), INTENT(INOUT) :: YISBA_NP
+INTEGER, INTENT(IN) :: KPATCH
+INTEGER :: JP
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK("MODD_ISBA_N:ISBA_NP_INIT",0,ZHOOK_HANDLE)
+!
+IF (ASSOCIATED(YISBA_NP%AL)) THEN
+ DO JP = 1,KPATCH
+ CALL ISBA_P_INIT(YISBA_NP%AL(JP))
+ ENDDO
+ DEALLOCATE(YISBA_NP%AL)
+ELSE
+ ALLOCATE(YISBA_NP%AL(KPATCH))
+ DO JP = 1,KPATCH
+ CALL ISBA_P_INIT(YISBA_NP%AL(JP))
+ ENDDO
+ENDIF
+!
+IF (LHOOK) CALL DR_HOOK("MODD_ISBA_N:ISBA_NP_INIT",1,ZHOOK_HANDLE)
+END SUBROUTINE ISBA_NP_INIT
+!
+SUBROUTINE ISBA_NPE_INIT(YISBA_NPE,KPATCH)
+TYPE(ISBA_NPE_t), INTENT(INOUT) :: YISBA_NPE
+INTEGER, INTENT(IN) :: KPATCH
+INTEGER :: JP
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK("MODD_ISBA_N:ISBA_NPE_INIT",0,ZHOOK_HANDLE)
+!
+IF (ASSOCIATED(YISBA_NPE%AL)) THEN
+ DO JP = 1,KPATCH
+ CALL ISBA_PE_INIT(YISBA_NPE%AL(JP))
+ ENDDO
+ DEALLOCATE(YISBA_NPE%AL)
+ELSE
+ ALLOCATE(YISBA_NPE%AL(KPATCH))
+ DO JP = 1,KPATCH
+ CALL ISBA_PE_INIT(YISBA_NPE%AL(JP))
+ ENDDO
+ENDIF
+!
+IF (LHOOK) CALL DR_HOOK("MODD_ISBA_N:ISBA_NPE_INIT",1,ZHOOK_HANDLE)
+END SUBROUTINE ISBA_NPE_INIT
+
+END MODULE MODD_ISBA_n
diff --git a/src/ICCARE_BASE/modd_megann.F90 b/src/ICCARE_BASE/modd_megann.F90
index c5b333f696297488fbee6b879a1d86bb39602386..b862c93b75ed4382dcd3c927a4beaa4f344a993b 100644
--- a/src/ICCARE_BASE/modd_megann.F90
+++ b/src/ICCARE_BASE/modd_megann.F90
@@ -71,7 +71,11 @@ TYPE MEGAN_t
INTEGER, POINTER, DIMENSION(:) :: NMECH_MAP ! index map the mecanisum species
REAL, POINTER, DIMENSION(:) :: XCONV_FAC ! conversion factor of species
REAL, POINTER, DIMENSION(:) :: XMECH_MWT ! molecular weight of species
- REAL, POINTER, DIMENSION(:) ::XBIOFLX ! molecular weight of species
+ REAL, POINTER, DIMENSION(:) :: XBIOFLX ! molecular weight of species
+ REAL, POINTER, DIMENSION(:) :: XT24 !! average T over the past 24h
+ REAL, POINTER, DIMENSION(:) :: XPPFD24 !! average PAR over the past 24h
+ REAL, POINTER, DIMENSION(:) :: XPPFD !! par
+
!
END TYPE MEGAN_t
@@ -93,6 +97,9 @@ NULLIFY(YMEGAN%NMECH_MAP)
NULLIFY(YMEGAN%XCONV_FAC)
NULLIFY(YMEGAN%XMECH_MWT)
NULLIFY(YMEGAN%XBIOFLX)
+NULLIFY(YMEGAN%XPPFD24)
+NULLIFY(YMEGAN%XT24)
+NULLIFY(YMEGAN%XPPFD)
YMEGAN%NBIO=0
YMEGAN%NALKA=0
YMEGAN%NALKE=0
@@ -192,6 +199,7 @@ YMEGAN%XDROUGHT=0.
YMEGAN%XDAILYPAR=150.
YMEGAN%XDAILYTEMP=293.
YMEGAN%XMODPREC=0.
+
IF (LHOOK) CALL DR_HOOK("MODD_MEGAN_n:MEGAN_INIT",1,ZHOOK_HANDLE)
END SUBROUTINE MEGAN_INIT
diff --git a/src/ICCARE_BASE/modd_salt.f90 b/src/ICCARE_BASE/modd_salt.f90
index 6cd14718b588ed1a5eb42bc7be1233495ee7ca49..e111b15db085287e012c5afaf137f9be3bd03185 100644
--- a/src/ICCARE_BASE/modd_salt.f90
+++ b/src/ICCARE_BASE/modd_salt.f90
@@ -71,7 +71,7 @@ CHARACTER(LEN=6),DIMENSION(24), PARAMETER :: YPSALT_INI = &
INTEGER, DIMENSION(8),PARAMETER :: JPSALTORDER = (/1,2,3,4,5,6,7,8/)
-INTEGER :: NMODE_SLT= 5 ! number of sea salt modes (max 8; default = 3)
+INTEGER :: NMODE_SLT= 8 ! number of sea salt modes (default = 8)
!Test Thomas (definir rayons et sigma ici si on veut desactiver initialisation MACC)
diff --git a/src/ICCARE_BASE/mode_gamma_etc.F90 b/src/ICCARE_BASE/mode_gamma_etc.F90
new file mode 100644
index 0000000000000000000000000000000000000000..04a1b209106bbb8b2f8f99a5a2b731cc65fe9041
--- /dev/null
+++ b/src/ICCARE_BASE/mode_gamma_etc.F90
@@ -0,0 +1,554 @@
+!=======================================================================
+! MODULE GAMMA
+!
+! THIS MODULE CONTAIN FUNCTIONS TO CALCULATE
+! GAMMA_P, GAMMA_T, GAMMA_L, GAMMA_A FOR BVOCS.
+!
+! CONTAINS: 1)GAMMA_LAI
+! 2)GAMMA_P
+! 3)GAMMA_TLD
+! 4)GAMMA_TLI
+! 5)GAMMA_A
+! 6)GAMMA_S
+! 7)GAMMA_CO2
+! 8)GAMMA_LAIBIDIR
+!
+! NOTE:
+!
+! REQUIREMENT:
+!
+! CALLS: SOLARANGLE
+!
+! CREATED BY TAN 11/21/06 FOR MEGAN V2.0
+!
+! HISTORY:
+! 08/01/07 GUENTHER A. - MOVE TO MEGANV2.02 WITH MODIFICATION TO
+! CORRECT CALCULATION OF GAMMA_P
+!
+!=======================================================================
+
+MODULE MODE_GAMMA_ETC
+!
+USE MODD_MEGAN
+!
+!USE MODI_SOLARANGLE
+USE MODI_INDEX1
+!
+IMPLICIT NONE
+
+!... PROGRAM I/O PARAMETERS
+
+!... EXTERNAL PARAMETERS
+
+CONTAINS
+!***********************************************************************
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+! SCIENTIFIC ALGORITHM
+!
+! EMISSION = [EF][GAMMA][RHO]
+! WHERE [EF] = EMISSION FACTOR (UG/M2H)
+! [GAMMA] = EMISSION ACTIVITY FACTOR (NON-DIMENSION)
+! [RHO] = PRODUCTION AND LOSS WITHIN PLANT CANOPIES
+! (NON-DIMENSINO)
+! ASSUMPTION: [RHO] = 1 (11/27/06) (SEE PDT_LOT_CP.EXT)
+!
+! GAMMA = [GAMMA_CE][GAMMA_AGE][GAMMA_SM]
+! WHERE [GAMMA_CE] = CANOPY CORRECTION FACTOR
+! [GAMMA_AGE] = LEAF AGE CORRECTION FACTOR
+! [GAMMA_SM] = SOIL MOISTURE CORRECTION FACTOR
+! ASSUMPTION: [GAMMA_SM] = 1 (11/27/06)
+!
+! GAMMA_CE = [GAMMA_LAI][GAMMA_P][GAMMA_T]
+! WHERE [GAMMA_LAI] = LEAF AREA INDEX FACTOR
+! [GAMMA_P] = PPFD EMISSION ACTIVITY FACTOR
+! [GAMMA_T] = TEMPERATURE RESPONSE FACTOR
+!
+! EMISSION = [EF][GAMMA_LAI][GAMMA_P][GAMMA_T][GAMMA_AGE][GAMMA_SM]
+! DERIVATION:
+! EMISSION = [EF][GAMMA_ETC](1-LDF) + [EF][GAMMA_ETC][LDF][GAMMA_P]
+! EMISSION = [EF][GAMMA_ETC]{ (1-LDF) + [LDF][GAMMA_P] }
+! EMISSION = [EF][GAMMA_ECT]{ (1-LDF) + [LDF][GAMMA_P] }
+! WHERE LDF = LIGHT DEPENDENT FUNCTION (NON-DIMENSION)
+!
+! FOR ISOPRENE
+! ASSUMPTION: LDF = 1 FOR ISOPRENE (11/27/06)
+!
+! FINAL EQUATION
+! EMISSION = [EF][GAMMA_LAI][GAMMA_P][GAMMA_T][GAMMA_AGE][GAMMA_SM]
+!
+! FOR NON-ISOPRENE
+! FINAL EQUATION
+! EMISSION = [EF][GAMMA_LAI][GAMMA_T][GAMMA_AGE][GAMMA_SM]*
+! { (1-LDF) + [LDF][GAMMA_P] }
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+!=======================================================================
+!... BEGIN MODULE
+!=======================================================================
+
+
+!-----------------------------------------------------------------------
+!.....1) CALCULATE GAM_L (GAMMA_LAI)
+!-----------------------------------------------------------------------
+! 0.49[LAI]
+! GAMMA_LAI = ---------------- (NON-DIMENSION)
+! (1+0.2LAI^2)^0.5
+!
+! SUBROUTINE GAMMA_LAI RETURNS THE GAMMA_LAI VALUES
+!-----------------------------------------------------------------------
+SUBROUTINE GAMMA_LAI(PLAI, PGAM_L)
+
+IMPLICIT NONE
+! INPUT
+REAL,DIMENSION(:),INTENT(IN) :: PLAI
+! OUTPUT
+REAL,DIMENSION(:),INTENT(OUT) :: PGAM_L
+
+PGAM_L(:) = (0.49*PLAI(:)) / ( (1.+0.2*(PLAI(:)**2))**0.5 )
+
+END SUBROUTINE GAMMA_LAI
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!.....5) CALCULATE GAM_A (GAMMA_AGE)
+!-----------------------------------------------------------------------
+!
+! GAMMA_AGE = FNEW*ANEW + FGRO*AGRO + FMAT*AMAT + FOLD*AOLD
+! WHERE FNEW = NEW FOLIAGE FRACTION
+! FGRO = GROWING FOLIAGE FRACTION
+! FMAT = MATURE FOLIAGE FRACTION
+! FOLD = OLD FOLIAGE FRACTION
+! ANEW = RELATIVE EMISSION ACTIVITY FOR NEW FOLIAGE
+! AGRO = RELATIVE EMISSION ACTIVITY FOR GROWING FOLIAGE
+! AMAT = RELATIVE EMISSION ACTIVITY FOR MATURE FOLIAGE
+! AOLD = RELATIVE EMISSION ACTIVITY FOR OLD FOLIAGE
+!
+!
+! FOR FOLIAGE FRACTION
+! CASE 1) LAIC = LAIP
+! FNEW = 0.0 , FGRO = 0.1 , FMAT = 0.8 , FOLD = 0.1
+!
+! CASE 2) LAIP > LAIC
+! FNEW = 0.0 , FGRO = 0.0
+! FMAT = 1-FOLD
+! FOLD = (LAIP-LAIC)/LAIP
+!
+! CASE 3) LAIP < LAIC
+! FNEW = 1-(LAIP/LAIC) T <= TI
+! = (TI/T) * ( 1-(LAIP/LAIC) ) T > TI
+!
+! FMAT = LAIP/LAIC T <= TM
+! = (LAIP/LAIC) +
+! ( (T-TM)/T ) * ( 1-(LAIP/LAIC) ) T > TM
+!
+! FGRO = 1 - FNEW - FMAT
+! FOLD = 0.0
+!
+! WHERE
+! TI = 5 + (0.7*(300-TT)) TT <= 303
+! = 2.9 TT > 303
+! TM = 2.3*TI
+!
+! T = LENGTH OF THE TIME STEP (DAYS)
+! TI = NUMBER OF DAYS BETWEEN BUDBREAK AND THE INDUCTION OF
+! EMISSION
+! TM = NUMBER OF DAYS BETWEEN BUDBREAK AND THE INITIATION OF
+! PEAK EMISSIONS RATES
+! TT = AVERAGE TEMPERATURE (K) NEAR TOP OF THE CANOPY DURING
+! CURRENT TIME PERIOD (DAILY AVE TEMP FOR THIS CASE)
+!
+!
+! FOR RELATIVE EMISSION ACTIVITY
+! CASE 1) CONSTANT
+! ANEW = 1.0 , AGRO = 1.0 , AMAT = 1.0 , AOLD = 1.0
+!
+! CASE 2) MONOTERPENES
+! ANEW = 2.0 , AGRO = 1.8 , AMAT = 0.95 , AOLD = 1.0
+!
+! CASE 3) SESQUITERPENES
+! ANEW = 0.4 , AGRO = 0.6 , AMAT = 1.075, AOLD = 1.0
+!
+! CASE 4) METHANOL
+! ANEW = 3.0 , AGRO = 2.6 , AMAT = 0.85 , AOLD = 1.0
+!
+! CASE 5) ISOPRENE
+! ANEW = 0.05 , AGRO = 0.6 , AMAT = 1.125, AOLD = 1.0
+!
+! SUBROUTINE GAMMA_A RETURNS GAMMA_A
+!-----------------------------------------------------------------------
+SUBROUTINE GAMMA_A(KDATE, KTIME, KTSTLEN, HSPC_NAME, PTEMP_D, PLAIARP, PLAIARC, PGAM_A)
+
+IMPLICIT NONE
+
+! INPUT
+INTEGER, INTENT(IN) :: KDATE, KTIME, KTSTLEN
+CHARACTER(LEN=16), INTENT(IN) :: HSPC_NAME
+REAL, DIMENSION(:), INTENT(IN) :: PTEMP_D
+REAL, DIMENSION(:), INTENT(IN) :: PLAIARP, PLAIARC
+! OUTPUT
+REAL,DIMENSION(:),INTENT(OUT) :: PGAM_A
+
+! LOCAL PARAMETERS
+REAL :: ZFNEW, ZFGRO, ZFMAT, ZFOLD
+REAL :: ZTI, ZTM ! NUMBER OF DAYS BETWEEN BUDBREAK
+ ! AND INDUCTION OF EMISSION,
+ ! INITIATION OF PEAK EMISSIONS RATES
+INTEGER :: IAINDX ! RELATIVE EMISSION ACITIVITY INDEX
+INTEGER :: ISPCNUM
+INTEGER :: JJ
+
+!... CHOOSE RELATIVE EMISSION ACTIVITY
+!--------CODE BY XUEMEI WANG 11/04/2007----------------
+!
+ISPCNUM = INDEX1(HSPC_NAME, CMGN_SPC)
+IAINDX = NREA_INDEX(ISPCNUM)
+!
+!---------------------------------------------------
+! LOCAL PARAMETER ARRAYS
+DO JJ = 1,SIZE(PLAIARP)
+ IF ( PTEMP_D(JJ).LE.303. ) THEN
+ ZTI = 5.0 + 0.7*(300.-PTEMP_D(JJ))
+ ELSE
+ ZTI = 2.9
+ ENDIF
+ ZTM = 2.3 * ZTI
+!
+
+
+!... CALCULATE FOLIAGE FRACTION
+
+! PRINT*,'LAIP,LAIC, TT=',MINVAL(LAIP), MAXVAL(LAIP),
+! S MINVAL(LAIC), MAXVAL(LAIC), MINVAL(TT), MAXVAL(TT)
+
+! WHERE (LAIP .LT. LAIC)
+
+! CALCULATE TI AND TM
+ IF ( PLAIARP(JJ).EQ.PLAIARC(JJ) ) THEN
+
+ ZFNEW = 0.0
+ ZFGRO = 0.1
+ ZFMAT = 0.8
+ ZFOLD = 0.1
+
+ ELSEIF ( PLAIARP(JJ).GT.PLAIARC(JJ) ) THEN
+
+ ZFNEW = 0.0
+ ZFGRO = 0.0
+ ZFOLD = ( PLAIARP(JJ)-PLAIARC(JJ) ) / PLAIARP(JJ)
+ ZFMAT = 1. - ZFOLD
+
+ ELSE
+
+ ZFMAT = PLAIARP(JJ)/PLAIARC(JJ)
+ ! CALCULATE FNEW AND FMAT, THEN FGRO AND FOLD
+ ! FNEW
+ IF ( ZTI.GE.KTSTLEN ) THEN
+ ZFNEW = 1.0 - ZFMAT
+ ELSE
+ ZFNEW = (ZTI/KTSTLEN) * ( 1. - ZFMAT )
+ ENDIF
+! FMAT
+ IF ( ZTM.LT.KTSTLEN ) THEN
+ ZFMAT = ZFMAT + ( (KTSTLEN-ZTM)/KTSTLEN ) * ( 1.-ZFMAT )
+ ENDIF
+
+ ZFGRO = 1.0 - ZFNEW - ZFMAT
+ ZFOLD = 0.0
+
+ ENDIF
+
+ !... CALCULATE GAMMA_A
+ PGAM_A(JJ) = ZFNEW * XANEW(IAINDX) + ZFGRO * XAGRO(IAINDX) + &
+ ZFMAT * XAMAT(IAINDX) + ZFOLD * XAOLD(IAINDX)
+
+ENDDO
+
+END SUBROUTINE GAMMA_A
+
+!-----------------------------------------------------------------------
+!.....6) CALCULATE GAM_SMT (GAMMA_SM)
+!-----------------------------------------------------------------------
+!
+! GAMMA_SM = 1.0 (NON-DIMENSION)
+!
+!
+! SUBROUTINE GAMMA_S RETURNS THE GAMMA_SM VALUES
+!-----------------------------------------------------------------------
+SUBROUTINE GAMMA_S( PGAM_S )
+
+IMPLICIT NONE
+
+REAL,DIMENSION(:) :: PGAM_S
+
+PGAM_S = 1.0
+
+END SUBROUTINE GAMMA_S
+
+!-----------------------------------------------------------------------
+!.....2) CALCULATE GAM_P (GAMMA_P)
+!-----------------------------------------------------------------------
+! GAMMA_P = 0.0 A<=0, A>=180, SIN(A) <= 0.0
+!
+! GAMMA_P = SIN(A)[ 2.46*(1+0.0005(PDAILY-400))*PHI - 0.9*PHI^2 ]
+! 0<A<180, SIN(A) > 0.0
+! WHERE PHI = ABOVE CANOPY PPFD TRANSMISSION (NON-DIMENSION)
+! PDAILY = DAILY AVERAGE ABOVE CANOPY PPFD (UMOL/M2S)
+! A = SOLAR ANGLE (DEGREE)
+!
+! NOTE: AAA = 2.46*BBB*PHI - 0.9*PHI^2
+! BBB = (1+0.0005(PDAILY-400))
+! GAMMA_P = SIN(A)*AAA
+!
+! PAC
+! PHI = -----------
+! SIN(A)*PTOA
+! WHERE PAC = ABOVE CANOPY PPFD (UMOL/M2S)
+! PTOA = PPFD AT THE TOP OF ATMOSPHERE (UMOL/M2S)
+!
+! PAC = SRAD * 4.766 MMMOL/M2-S * 0.5
+!
+! PTOA = 3000 + 99*COS[2*3.14-( DOY-10)/365 )]
+! WHERE DOY = DAY OF YEAR
+!
+! SUBROUTINE GAMMA_P RETURNS THE GAMMA_P VALUES
+!-----------------------------------------------------------------------
+!SUBROUTINE GAMMA_P( KDATE, KTIME, PLAT, PLONG, PPFD, PPFD_D, PGAM_P )
+!
+!IMPLICIT NONE
+!
+!! INPUT
+!INTEGER,INTENT(IN) :: KDATE, KTIME
+!
+!REAL,DIMENSION(:),INTENT(IN) :: PLAT, PLONG
+!! PHOTOSYNTHETIC PHOTON FLUX DENSITY: INSTANTANEOUS, DAILY
+!REAL,DIMENSION(:),INTENT(IN) :: PPFD, PPFD_D
+!! OUTPUT
+!REAL,DIMENSION(:),INTENT(OUT) :: PGAM_P ! GAMMA_P
+!
+!! LOCAL PARAMETERS
+!REAL, DIMENSION(SIZE(PLAT)) :: ZHOUR, ZSINBETA ! HOUR IS SOLAR HOUR
+!INTEGER, DIMENSION(SIZE(PLAT)) :: IDAY ! DAY IS DOY (JDATE)
+!
+!REAL :: ZPTOA, ZPHI
+!REAL :: ZAAA, ZBBB
+!REAL :: ZBETA ! SOLAR ZENITH ANGLE
+!INTEGER :: JJ
+!
+!!... BEGIN ESTIMATING GAMMA_P
+!
+!!... CONVERT DATE AND TIME FORMAT TO LOCAL TIME
+!! DAY IS JULIAN DAY
+!IDAY(:) = MOD(KDATE,1000)
+!
+!! CONVERT FROM XXXXXX FORMAT TO XX.XX (SOLAR HOUR)
+!! HOUR = 0 -> 23.XX
+!! SOLAR HOUR
+!ZHOUR(:) = KTIME/10000. + PLONG(:)/15.
+!
+!WHERE ( ZHOUR(:).LT.0. )
+! ZHOUR(:) = ZHOUR(:) + 24.0
+! IDAY(:) = IDAY(:) - 1.
+!ENDWHERE
+!
+!! GET SOLAR ELEVATION ANGLE
+!CALL SOLARANGLE(IDAY, ZHOUR, PLAT, ZSINBETA)
+!
+!DO JJ = 1,SIZE(ZSINBETA)
+!
+! IF ( ZSINBETA(JJ).LE.0. ) THEN
+!
+! PGAM_P(JJ) = 0.
+!
+! ELSE IF ( ZSINBETA(JJ).GT.0. ) THEN
+!
+! ZPTOA = 3000.0 + 99.0 *COS(2. * 3.14 * (IDAY(JJ)-10.)/365.)
+!
+! ZPHI = PPFD(JJ) / (ZSINBETA(JJ) * ZPTOA)
+!
+! ZBBB = 1. + 0.0005 * (PPFD_D(JJ)-400. )
+! ZAAA = ( 2.46 * ZBBB * ZPHI ) - ( 0.9 * ZPHI**2 )
+!
+! PGAM_P(JJ) = ZSINBETA(JJ) * ZAAA
+!
+! ZBETA = ASIN(ZSINBETA(JJ)) * XRPI180 ! DEGREE
+!
+! ! SCREENING THE UNFORCED ERRORS
+! ! IF SOLAR ELEVATION ANGLE IS LESS THAN 1 THEN
+! ! GAMMA_P CAN NOT BE GREATER THAN 0.1.
+! IF ( ZBETA.LT.1.0 .AND. PGAM_P(JJ).GT.0.1 ) THEN
+! PGAM_P(JJ) = 0.0
+! ENDIF
+!
+! ELSE
+!
+! WRITE(*,*) "ERROR: SOLAR ANGLE IS INVALID - FATAL ERROR GAMMA_P, STOP"
+! STOP
+!
+! ENDIF
+! ! END LOOP FOR NROWS
+!ENDDO ! END LOOP FOR NCOLS
+!
+!END SUBROUTINE GAMMA_P
+!!-----------------------------------------------------------------------
+!
+!
+!!-----------------------------------------------------------------------
+!!.....3) CALCULATE GAM_T (GAMMA_T) FOR ISOPRENE
+!!-----------------------------------------------------------------------
+!! EOPT*CT2*EXP(CT1*X)
+!! GAMMA_T = ------------------------
+!! [CT2-CT1*(1-EXP(CT2*X))]
+!! WHERE X = [ (1/TOPT)-(1/THR) ] / 0.00831
+!! EOPT = 1.75*EXP(0.08(TDAILY-297)
+!! CT1 = 80
+!! CT2 = 200
+!! THR = HOURLY AVERAGE AIR TEMPERATURE (K)
+!! TDAILY = DAILY AVERAGE AIR TEMPERATURE (K)
+!! TOPT = 313 + 0.6(TDAILY-297)
+!!
+!! NOTE: AAA = EOPT*CT2*EXP(CT1*X)
+!! BBB = [CT2-CT1*(1-EXP(CT2*X))]
+!! GAMMA_T = AAA/BBB
+!!
+!! SUBROUTINE GAMMA_TLD RETURNS THE GAMMA_T VALUE FOR ISOPRENE
+!!-----------------------------------------------------------------------
+!SUBROUTINE GAMMA_TLD( PTEMP, PTEMP_D, PGAM_T, HSPC_NAME )
+!
+!IMPLICIT NONE
+!
+!! INPUT
+!REAL,DIMENSION(:),INTENT(IN) :: PTEMP, PTEMP_D ! DAILY, HOURLY SURFACE TEMPERATURE
+!! OUTPUT
+!REAL,DIMENSION(:),INTENT(OUT) :: PGAM_T ! GAMMA_T
+!CHARACTER(LEN=16),INTENT(IN) :: HSPC_NAME
+!!
+!! LOCAL PARAMETERS
+!REAL :: ZEOPT, ZTOPT, ZX, ZAAA, ZBBB
+!INTEGER :: ISPCNUM, JJ
+!
+!ISPCNUM = INDEX1(HSPC_NAME, CMGN_SPC)
+!
+!DO JJ = 1,SIZE(PTEMP)
+!
+! ZEOPT = XCLEO(ISPCNUM) * EXP(0.08*(PTEMP_D(JJ)-297.))
+! ZTOPT = 313.0 + ( 0.6*(PTEMP_D(JJ)-297.) )
+! ZX = ( (1/ZTOPT)-(1/PTEMP(JJ)) ) / 0.00831
+!
+! ZAAA = ZEOPT * XCT2 * EXP(XCTM1(ISPCNUM)*ZX)
+! ZBBB = ( XCT2- XCTM1(ISPCNUM)*( 1.-EXP(XCT2*ZX) ) )
+! PGAM_T(JJ) = ZAAA/ZBBB
+!
+!ENDDO
+!
+!END SUBROUTINE GAMMA_TLD
+!!-----------------------------------------------------------------------
+!
+!
+!!-----------------------------------------------------------------------
+!!.....4) CALCULATE GAM_T (GAMMA_T) FOR NON-ISOPRENE
+!!-----------------------------------------------------------------------
+!!
+!! GAMMA_T = EXP[TDP_FCT*(T-TS)]
+!! WHERE TDP_FCT = TEMPERATURE DEPENDENT PARAMETER ('BETA')
+!! TS = STANDARD TEMPERATURE (NORMALLY 303K, 30C)
+!!
+!! SUBROUTINE GAMMA_TLI RETURNS THE GAMMA_T VALUE FOR NON-ISOPRENE
+!!-----------------------------------------------------------------------
+!SUBROUTINE GAMMA_TLI(HSPCNAM, PTEMP, PGAM_T)
+!
+!IMPLICIT NONE
+!
+!CHARACTER(LEN=16), INTENT(IN) :: HSPCNAM
+!REAL,DIMENSION(:), INTENT(IN):: PTEMP
+!REAL, DIMENSION(:), INTENT(OUT) :: PGAM_T
+!!
+!INTEGER :: ISPCNUM ! SPECIES NUMBER
+!
+!!--END OF DECLARATIONS--
+!
+!ISPCNUM = INDEX1(HSPCNAM, CMGN_SPC)
+!!
+!PGAM_T = EXP( XTDF_PRM(ISPCNUM) * (PTEMP-XTS) )
+!
+!END SUBROUTINE GAMMA_TLI
+!!-----------------------------------------------------------------------
+!
+!!=======================================================================
+!!-----------------------------------------------------------------------
+!!.....7) CALCULATE GAM_CO2(GAMMA_CO2)
+!!-----------------------------------------------------------------------
+!!
+!! GAMMA_CO2 = 1.0 (NON-DIMENSION)
+!! WHEN CO2 =400PPM
+!!
+!! SUBROUTINE GAM_CO2 RETURNS THE GAMMA_CO2 VALUES
+!! XUEMEI WANG-2009-06-22
+!!-----------------------------------------------------------------------
+!SUBROUTINE GAMMA_CO2(PCO2, PGAM_CO2)
+!
+!IMPLICIT NONE
+!
+!REAL, DIMENSION(:), INTENT(IN) :: PCO2
+!REAL, DIMENSION(:), INTENT(OUT) :: PGAM_CO2
+!
+!REAL :: ZCI
+!INTEGER :: JJ
+!
+!DO JJ = 1,SIZE(PCO2)
+!
+! IF ( PCO2(JJ).EQ.400. ) THEN
+! PGAM_CO2(JJ) = 1.0
+! ELSE
+! ZCI = 0.7* PCO2(JJ)
+! PGAM_CO2(JJ) = XISMAX - ((XISMAX*ZCI**XH) /(XCSTAR**XH+ZCI**XH))
+! ENDIF
+!
+!ENDDO
+!
+!END SUBROUTINE GAMMA_CO2
+!
+!!=======================================================================
+!!=======================================================================
+!!-----------------------------------------------------------------------
+!!.....8) CALCULATE GAMMA_LAIBIDIR(GAM_LAIBIDIR,LAI)
+!!-----------------------------------------------------------------------
+!!FROM ALEX GUENTHER 2010-01-26
+!!IF LAI < 2 THEN
+!!GAMMALAIBIDIR= 0.5 * LAI
+!!ELSEIF LAI <= 6 THEN
+!!GAMMALAIBIDIR= 1 - 0.0625 * (LAI - 2)
+!!ELSE
+!!GAMMALAIBIDIR= 0.75
+!!END IF
+!!
+!! SUBROUTINE GAMMA_LAIBIDIR RETURNS THE GAM_LAIBIDIR VALUES
+!! XUEMEI WANG-2010-01-28
+!!
+!!-----------------------------------------------------------------------
+!SUBROUTINE GAMMA_LAIBIDIR(PLAI, PGAM_LAIBIDIR)
+!
+!IMPLICIT NONE
+!
+!REAL,DIMENSION(:),INTENT(IN) :: PLAI
+!REAL,DIMENSION(:),INTENT(OUT) :: PGAM_LAIBIDIR
+!
+!INTEGER :: JJ
+!!
+!DO JJ = 1,SIZE(PLAI)
+!
+! IF ( PLAI(JJ)<2. ) THEN
+! PGAM_LAIBIDIR(JJ) = 0.5 * PLAI(JJ)
+! ELSEIF ( PLAI(JJ).GE.2. .AND. PLAI(JJ).LE.6. ) THEN
+! PGAM_LAIBIDIR(JJ) = 1. - 0.0625 * ( PLAI(JJ)-2. )
+! ELSE
+! PGAM_LAIBIDIR(JJ) = 0.75
+! ENDIF
+!
+!ENDDO
+!
+!END SUBROUTINE GAMMA_LAIBIDIR
+!!=======================================================================
+!
+END MODULE MODE_GAMMA_ETC
diff --git a/src/ICCARE_BASE/mode_megan.F90 b/src/ICCARE_BASE/mode_megan.F90
new file mode 100644
index 0000000000000000000000000000000000000000..584fda604460f5e9520796307a6719c89100c482
--- /dev/null
+++ b/src/ICCARE_BASE/mode_megan.F90
@@ -0,0 +1,1235 @@
+MODULE MODE_MEGAN
+!
+USE MODD_MEGAN
+!
+USE MODI_SOLARANGLE
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+IMPLICIT NONE
+!
+!XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
+!
+! INPUT AND OUTPUT FILES MUST BE SELECTED BEFORE STARTING THE PROGRAM
+!
+!XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
+!!
+! INPUT VARIBLES
+!
+! DAY JULIAN DAY
+! LAT LATITUDE
+! HOUR HOUR OF THE DAY
+! TC TEMPERATURE [C]
+! PPFD INCOMING PHOTOSYNTHETIC ACTIVE RADIATION [UMOL/M2/S1]
+! WIND WIND SPEED [M S-1]
+! HUMIDITY RELATIVE HUMIDITY [%]
+! CANTYPYE DEFINES SET OF CANOPY CHARACTERISTICS
+! LAI LEAF AREA INDEX [M2 PER M2 GROUND AREA]
+! DI ???
+! PRES PRESSURE [PA]
+!
+! USED VARIABLES:
+!
+! PPFDFRAC FRACTION OF TOTAL SOLAR RADIATION THAT IS PPFD
+! SOLAR SOLAR RADIATION [W/M2]
+! MAXSOLAR MAXIMUM OF SOLAR RADIATION
+! BETA SIN OF SOLAR ANGLE ABOVE HORIZON
+! SINBETA SOLAR ANGLE ABOVE HORIZON
+! TAIRK0 ABOVE CANOPY AIR TEMPERATURE [K]
+! TAIRK ARRAY OF CANOPY AIR TEMPERATURE [K]
+! WS0 ABOVE CANOPY WIND SPEED [M/S]
+! WS ARRAY OF CANOPY WIND SPEED [M/S]
+! HUMIDAIRPA0 ABOVE CANOPY AMBIENT HUMIDITY [PA]
+! HUMIDAIRPA ARRAY OF CANOPY AMBIENT HUMIDITY IN [PA]
+! STOMATADI INDEX FOR WATER STATUS OF LEAVES. USED TO MODIFY STOMATAL CONDUCTANCE
+! TRANSMIS TRANSMISSION OF PPFD THAT IS DIFFUSE
+! DIFFFRAC FRACTION OF PPFD THAT IS DIFFUSE
+! PPFDFRAC FRACTION OF SOLAR RAD THAT IS PPFD
+! TRATE STABILITY OF BOUNDARY ???
+! SH SENSIBLE HEAT FLUX ???
+! VPGAUSWT ARRAY OF GAUSSIAN WEIGHTING FACTORS
+! VPGAUSDIS ARRAY OF GAUSSIAN WEIGHTING FACTORS
+! VPSLWWT ARRAY OF GAUSSIAN WEIGHTING FACTORS
+! SUNFRAC ARRAY OF THE FRACTION OF SUN LEAVES. I = 1 IS THE TOP CANOPY LAYER, 2 IS THE NEXT LAYER, ETC.
+! SUNPPFD ARRAY OF INCOMING (NOT ABSORBED) PPFD ON A SUN LEAF [UMOL/M2/S]
+! SHADEPPFD ARRAY OF INCOMING (NOT ABSORBED) PPFD ON A SHADE LEAF [UMOL/M2/S]
+! SUNQV ARRAY OF VISIBLE RADIATION (IN AND OUT) FLUXES ON SUN LEAVES
+! SHADEQV ARRAY OF ABSORBED VISIBLE RADIATION (IN AND OUT) FLUXES ON SHADE LEAVES
+! SUNQN ARRAY OF ABSORBED NEAR IR RADIATION (IN AND OUT) FLUXES ON SUN LEAVES
+! SHADEQN ARRAY OF ABSORBED NEAR IR RADIATION (IN AND OUT) FLUXES ON SHADE LEAVES
+! SUNLEAFTK ARRAY OF LEAF TEMPERATURE FOR SUN LEAVES [K]
+! SUNLEAFSH ARRAY OF SENSIBLE HEAT FLUX FOR SUN LEAVES [W/M2]
+! SUNLEAFLH ARRAY OF LATENT HEAT FLUX FOR SUN LEAVES [W/M2]
+! SUNLEAFIR ARRAY OF INFRARED FLUX FOR SUN LEAVES [W/M2]
+! SHADELEAFTK ARRAY OF LEAF TEMPERATURE FOR SHADE LEAVES [K]
+! SHADELEAFSH ARRAY OF SENSIBLE HEAT FLUX FOR SHADE LEAVES [W/M2]
+! SHADELEAFLH ARRAY OF LATENT HEAT FLUX FOR SHADE LEAVES [W/M2]
+! SHADELEAFIR ARRAY OF INFRARED FLUX FOR SHADE LEAVES [W/M2]
+! QBABSV, QBABSN ABSORBED DIRECT BEAM LIGHT FOR VISIBLE AND NEAR INFRA RED
+! QDABSV, QDABSN ARRAY OF ABSORBED DIFFUSE LIGHT FOR VISIBLE AND NEAR INFRA RED
+! QSABSV, QSABSN ARRAY OF ABSORBED SCATTERED LIGHT FOR VISIBLE AND NEAR INFRA RED
+! QBEAMV, QBEAMN ABOVE CANOPY BEAM (DIRECT) LIGHT FOR VISIBLE AND NEAR INFRA RED
+! QDIFFV, QDIFFN ABOVE CANOPY DIFFUSE LIGHT FOR VISIBLE AND NEAR INFRA RED
+! EA1PLAYER ARRAY OF EMISSION ACTIVITY OF LIGHT PER LAYER
+! EA1TLAYER ARRAY OF EMISSION ACTIVITY OF TEMPERATURE PER LAYER
+! EA1LAYER ARRAY OF COMPANIED EMISSION ACTIVITY
+! EA1PCANOPY TOTAL EMISSION ACTIVITY OF LIGHT
+! EATILAYER ARRAY OF EMISSION ACTIVITY OF TEMPERATURE INDENDENT PER LAYER
+! EA1TCANOPY TOTAL EMISSION ACTIVITY OF TEMPERATURE DEPEDENT FACTOR
+! PEA1CANOPY TOTAL COMPANIED EMISSION ACTIVITY
+! PEATICANOPY TOTAL EMISSION ACTIVITY OF TEMPERATURE INDEPEDENT FACTOR
+! CALCBETA FUNCTION: CALCULATION OF SOLAR ZENITH ANGLE
+! WATERVAPPRES FUNCTION: CONVERT WATER MIXING RATIO (KG/KG) TO WATER VAPOR PRESSURE
+! STABILITY FUNCTION: TEMPERATURE LAPSE RATE
+! EA1T99 FUNCTION: TEMPERATURE DEPENDENCE ACTIVITY FACTOR FOR EMISSION TYPE 1
+! EA1P99 FUNCTION: LIGHT DEPENDENCE ACTIVITY FACTOR FOR EMISSION
+! EALTI FUNCTION: TEMPERATURE INDEPENDENCE ACTIVITY FACTOR FOR EMISSION
+! DISTOMATA FUNCTION:
+! CALCECCENTRICITY FUNCTION:
+!
+!XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
+!
+CONTAINS
+!
+SUBROUTINE GAMME_CE(KDATE, KTIME, PCANOPYCHAR, KCANTYPE, HSPCNAME, &
+ PPFD24, PPFD240, PT24, PT240, PDI, &
+ PPFD0, PLAT, PLONG, PTC, PWIND, PHUMIDITY, &
+ PLAI, PRES, PEA1CANOPY, PEATICANOPY) !!
+!
+IMPLICIT NONE
+! INPUT
+INTEGER,INTENT(IN) :: KDATE, KTIME, KCANTYPE
+REAL,DIMENSION(:,:),INTENT(IN) :: PCANOPYCHAR
+CHARACTER(LEN=16), INTENT(IN) :: HSPCNAME
+!
+REAL, DIMENSION(:), INTENT(IN) :: PT24, PT240, PPFD24, PPFD240
+REAL, INTENT(IN) :: PDI
+!
+REAL, DIMENSION(:), INTENT(IN) :: PPFD0
+REAL, DIMENSION(:), INTENT(IN) :: PLONG, PLAT
+REAL, DIMENSION(:), INTENT(IN) :: PTC, PRES, PWIND, PHUMIDITY, PLAI
+! ARRAY OF CANOPY CHARACTERISTICS FOR KRTYP OF CANOPY TYPE
+! OUTPUT
+REAL, DIMENSION(:), INTENT(OUT) :: PEA1CANOPY, PEATICANOPY
+!
+! LOCAL VARIABLES
+REAL, DIMENSION(NLAYERS) :: ZVPGAUSWT, ZVPGAUSDIS2, ZVPGAUSDIS
+!
+REAL, DIMENSION(SIZE(PLONG),NLAYERS) :: ZEA1LAYER, ZEATILAYER, ZVPSLWWT
+REAL, DIMENSION(SIZE(PLONG),NLAYERS) :: ZSUNFRAC, ZSUNQV, ZSHADEQV, ZSUNQN, ZSHADEQN, &
+ ZSUNPPFD, ZSHADEPPFD, ZSUNLEAFTK, ZSHADELEAFTK, &
+ ZSUNLEAFSH, ZSHADELEAFSH, Z_PPFD, Z_ALPHAP
+!
+REAL, DIMENSION(SIZE(PLONG)) :: ZHOUR, ZSINBETA, ZSOLAR, &
+ ZMAXSOLAR, ZQDIFFV, ZQBEAMV, ZQDIFFN, ZQBEAMN, &
+ ZHUMIDAIRPA0, ZTRATE
+!
+REAL :: ZSTOMATADI
+INTEGER, DIMENSION(SIZE(PLONG)) :: IDAY
+INTEGER :: JI, JJ
+!
+!---------------------------HEADER OVER--------------------------------
+!
+IDAY(:) = MOD(KDATE,1000)
+! CONVERT FROM XXXXXX FORMAT TO XX.XX (SOLAR HOUR)
+! HOUR = 0 -> 23.XX
+! SOLAR HOUR
+ZHOUR(:) = KTIME/10000. + PLONG(:)/15.
+!
+WHERE ( ZHOUR(:).LT.0. )
+ ZHOUR(:) = ZHOUR(:) + 24.
+ IDAY (:) = IDAY (:) - 1
+ELSEWHERE ( ZHOUR.GT.24. )
+ ZHOUR(:) = ZHOUR(:) - 24.
+ IDAY (:) = IDAY (:) + 1
+END WHERE
+!
+CALL SOLARANGLE(IDAY, ZHOUR, PLAT, ZSINBETA)
+
+!
+ZSOLAR (:) = PPFD0(:)/2.25
+ZMAXSOLAR(:) = ZSINBETA(:) * XSOLARCONSTANT * CALCECCENTRICITY(IDAY(:))
+CALL SOLARFRACTIONS(ZSOLAR, ZMAXSOLAR, ZQDIFFV, ZQBEAMV, ZQDIFFN, ZQBEAMN)
+!
+CALL GAUSSIANINTEGRATION(ZVPGAUSWT, ZVPGAUSDIS, ZVPGAUSDIS2)
+!
+CALL CANOPYRAD(KCANTYPE, PCANOPYCHAR, ZVPGAUSDIS, &
+ PLAI, ZSINBETA, ZQBEAMV, ZQDIFFV, ZQBEAMN, ZQDIFFN, &
+ ZSUNFRAC, ZSUNQV, ZSHADEQV, ZSUNQN, ZSHADEQN, &
+ ZSUNPPFD, ZSHADEPPFD)
+!
+ZTRATE (:) = STABILITY(PCANOPYCHAR, KCANTYPE, ZSOLAR)
+!
+ZSTOMATADI = DISTOMATA(PDI)
+!
+ZHUMIDAIRPA0(:) = WATERVAPPRES(XWATERAIRRATIO, PHUMIDITY, PRES)
+!
+CALL CANOPYEB(KCANTYPE, PCANOPYCHAR, ZVPGAUSDIS, ZSTOMATADI, &
+ PTC, PWIND, ZTRATE, ZHUMIDAIRPA0, &
+ ZSUNQV, ZSHADEQV, ZSUNQN, ZSHADEQN, ZSUNPPFD, ZSHADEPPFD, &
+ ZSUNLEAFTK, ZSHADELEAFTK, ZSUNLEAFSH, ZSHADELEAFSH)
+
+!ZEA1TCANOPY(:) = 0.
+!ZEA1PCANOPY(:) = 0.
+PEA1CANOPY (:) = 0.
+PEATICANOPY(:) = 0.
+
+DO JI = 1,SIZE(ZEA1LAYER,2)
+
+
+ !ZEA1TLAYER(:,JI) = EA1T99(ZSUNLEAFTK (:,JI), PT24, PT240, HSPCNAME) * ZSUNFRAC(:,JI) + &
+ ! EA1T99(ZSHADELEAFTK(:,JI), PT24, PT240, HSPCNAME) *(1.-ZSUNFRAC(:,JI))
+
+! PSTD = 200 FOR SUN LEAVES
+! PSTD = 50 FOR SHADE LEAVES
+ !ZEA1PLAYER(:,JI) = EA1P99(ZSUNPPFD(:,JI), PPFD24*0.5, PPFD240*0.5, XPSTD_SUN) * ZSUNFRAC(:,JI) + &
+ ! EA1P99(ZSHADEPPFD(:,JI), PPFD24*0.16, PPFD240*0.16, XPSTD_SHADE) * (1.-ZSUNFRAC(:,JI))
+
+ ZEA1LAYER(:,JI) = EA1T99(HSPCNAME , PT24 , PT240 , ZSUNLEAFTK (:,JI)) * &
+ EA1P99(XPSTD_SUN , PPFD24*0.5 , PPFD240*0.5 , ZSUNPPFD (:,JI)) * ZSUNFRAC(:,JI) + &
+ EA1T99(HSPCNAME , PT24 , PT240 , ZSHADELEAFTK(:,JI)) * &
+ EA1P99(XPSTD_SHADE, PPFD24*0.16, PPFD240*0.16, ZSHADEPPFD (:,JI) ) * (1.-ZSUNFRAC(:,JI))
+
+ ZEATILAYER(:,JI) = EALTI99(HSPCNAME, ZSUNLEAFTK (:,JI)) * ZSUNFRAC(:,JI) + &
+ EALTI99(HSPCNAME, ZSHADELEAFTK(:,JI)) * (1-ZSUNFRAC(:,JI))
+
+ Z_PPFD(:,JI) = ZSUNPPFD(:,JI) * ZSUNFRAC(:,JI) + ZSHADEPPFD(:,JI) * (1.-ZSUNFRAC(:,JI))
+
+ Z_ALPHAP(:,JI) = EA1P99(XPSTD_SUN , PPFD24*0.5 , PPFD240*0.5 , ZSUNPPFD (:,JI)) * ZSUNFRAC(:,JI) + &
+ EA1P99(XPSTD_SHADE, PPFD24*0.16, PPFD240*0.16, ZSHADEPPFD (:,JI) ) * (1.-ZSUNFRAC(:,JI)) !!
+ ! IF (KCANTYPE == 15) THEN
+ ! PRINT*, JI, ZSUNPPFD(:,JI)
+ !ENDIF
+
+ENDDO
+
+CALL WEIGHTSLW(ZVPGAUSDIS, PLAI, ZVPSLWWT)
+!
+DO JJ = 1,SIZE(PEA1CANOPY)
+! ZEA1PCANOPY(JJ) = SUM(ZEA1PLAYER(JJ,:) * ZVPSLWWT(JJ,:) * ZVPGAUSWT(:) )
+! ZEA1TCANOPY(JJ) = SUM(ZEA1TLAYER(JJ,:) * ZVPSLWWT(JJ,:) * ZVPGAUSWT(:) )
+ PEA1CANOPY (JJ) = SUM(ZEA1LAYER (JJ,:) * ZVPSLWWT(JJ,:) * ZVPGAUSWT(:) )
+ PEATICANOPY(JJ) = SUM(ZEATILAYER(JJ,:) * ZVPSLWWT(JJ,:) * ZVPGAUSWT(:) )
+! THIS QUANTITY IS APPARENTLY NOT PASSED OUT OF THE SUBROUTINE
+! ZSH(JJ) = SUM( ( ZSUNLEAFSH (JJ,:) * ZSUNFRAC(:,JJ) + &
+! ZSHADELEAFSH(JJ,:) * (1 - ZSUNFRAC(:,JJ))) * PLAI(:) * ZVPGAUSWT(:) )
+ENDDO
+
+
+PEA1CANOPY(:) = PEA1CANOPY(:) * XCCE * PLAI(:)
+
+
+END SUBROUTINE GAMME_CE
+
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+!
+! SUBROUTINE GAUSSIANINTEGRATION
+!
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+
+SUBROUTINE GAUSSIANINTEGRATION(PWEIGHTGAUSS, PDISTGAUSS, PDISTGAUSS2)
+!
+IMPLICIT NONE
+!
+REAL,DIMENSION(:),INTENT(OUT) :: PWEIGHTGAUSS, PDISTGAUSS, PDISTGAUSS2
+!
+! LOCAL VARIABLES
+INTEGER :: JI
+!--------------------------------------------------------------------
+!
+IF ( NLAYERS.EQ.1 ) THEN
+ PWEIGHTGAUSS(1) = 1
+ PDISTGAUSS (1) = 0.5
+ PDISTGAUSS2 (1) = 1
+ELSEIF ( NLAYERS.EQ.3 ) THEN
+ PWEIGHTGAUSS(1) = 0.277778
+ PWEIGHTGAUSS(2) = 0.444444
+ PWEIGHTGAUSS(3) = 0.277778
+ PDISTGAUSS(1) = 0.112702
+ PDISTGAUSS(2) = 0.5
+ PDISTGAUSS(3) = 0.887298
+ PDISTGAUSS2(1) = 0.277778
+ PDISTGAUSS2(2) = 0.722222
+ PDISTGAUSS2(3) = 1
+ELSEIF ( NLAYERS.EQ.5 ) THEN
+ PWEIGHTGAUSS(1) = 0.1184635
+ PWEIGHTGAUSS(2) = 0.2393144
+ PWEIGHTGAUSS(3) = 0.284444444
+ PWEIGHTGAUSS(4) = 0.2393144
+ PWEIGHTGAUSS(5) = 0.1184635
+ PDISTGAUSS(1) = 0.0469101
+ PDISTGAUSS(2) = 0.2307534
+ PDISTGAUSS(3) = 0.5
+ PDISTGAUSS(4) = 0.7692465
+ PDISTGAUSS(5) = 0.9530899
+ PDISTGAUSS2(1) = 0.1184635
+ PDISTGAUSS2(2) = 0.3577778
+ PDISTGAUSS2(3) = 0.6422222
+ PDISTGAUSS2(4) = 0.881536
+ PDISTGAUSS2(5) = 1.0
+ELSE
+ DO JI = 1,NLAYERS
+ PWEIGHTGAUSS(JI) = 1. / NLAYERS
+ PDISTGAUSS (JI) = (JI - 0.5) / NLAYERS
+ PDISTGAUSS2 (JI) = JI / NLAYERS
+ ENDDO
+ENDIF
+
+END SUBROUTINE GAUSSIANINTEGRATION
+
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+!
+! SUBROUTINE WEIGHTSLW
+!
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+
+SUBROUTINE WEIGHTSLW(PDISTGAUSS, PLAI, PSLW)
+
+IMPLICIT NONE
+
+REAL, DIMENSION(:), INTENT(IN) :: PLAI
+REAL, DIMENSION(:), INTENT(IN) :: PDISTGAUSS
+
+REAL, DIMENSION(:,:), INTENT(OUT) :: PSLW
+
+! LOCAL VARIABLES
+INTEGER :: JI
+!--------------------------------------------------
+
+DO JI = 1,NLAYERS
+ PSLW(:,JI) = 0.63 + 0.37 * EXP(-((PLAI(:) * PDISTGAUSS(JI)) - 1.))
+ENDDO
+
+END SUBROUTINE WEIGHTSLW
+
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+!
+! SUBROUTINE SOLARFRACTIONS
+! TRANSMISSION, FRACTION OF PPFD THAT IS DIFFUSE,
+! FRACTION OF SOLAR RAD THAT IS PPFD
+!
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+
+SUBROUTINE SOLARFRACTIONS(PSOLAR, PMAXSOLAR, PQDIFFV, PQBEAMV, PQDIFFN, PQBEAMN)
+!
+IMPLICIT NONE
+!
+! INTEGER,INTENT(IN) :: TIMEPERIOD
+REAL, DIMENSION(:), INTENT(IN) :: PSOLAR, PMAXSOLAR
+!
+REAL, DIMENSION(:), INTENT(OUT) :: PQDIFFV, PQBEAMV, PQDIFFN, PQBEAMN
+!
+! INTERNAL VARIABLES
+REAL :: ZFRACDIFF, ZPPFDFRAC, ZPPFDDIFFRAC, ZQV, ZQN
+REAL :: ZTRANSMIS
+INTEGER :: JJ
+!-----------------------------------------------------
+! IF (TIMEPERIOD .EQ. 1) THEN ! DAILY TRANSMISSION
+! TRANSMIN = 0.26
+! TRANSSLOPE= 1.655
+! ELSE ! HOURLY TRANSMISSION
+! TRANSMIN = 0.26
+! TRANSSLOPE = 1.655
+! ENDIF
+DO JJ = 1,SIZE(PSOLAR)
+
+ IF (PMAXSOLAR(JJ)<=0) THEN
+ ZTRANSMIS = 0.5
+ ELSEIF (PMAXSOLAR(JJ)<PSOLAR(JJ)) THEN
+ ZTRANSMIS = 1.0
+ ELSE
+ ZTRANSMIS = PSOLAR(JJ) / PMAXSOLAR(JJ)
+ ENDIF
+
+! ESTIMATE DIFFUSE FRACTION BASED ON DAILY TRANSMISSION (RODERICK 1999, GOUDRIANN AND VAN LAAR 1994- P.33)
+
+! IF (TRANSMIS > 0.81) THEN
+! FRACDIFF = 0.05
+! ELSEIF (TRANSMIS > TRANSMIN) THEN
+! FRACDIFF = 0.96-TRANSSLOPE * (TRANSMIS - TRANSMIN)
+! ELSE
+! FRACDIFF = 0.96
+! ENDIF
+
+! THE FRACTION OF TOTAL SOLAR RADIATION THAT IS PPFD (43% TO 55%)
+! G. AND L. 84
+! PPFDFRAC = 0.43 + FRACDIFF * 0.12
+
+!FRACDIFF IS BASED ON LIZASO 2005
+!MODIFIED BY XUEMEI 2010-01-26 ACCORDING TO ALEX'S DOCUMENT
+ ZFRACDIFF = 0.156 + 0.86/(1 + EXP(11.1*(ZTRANSMIS -0.53)))
+
+!PPFDFRAC IS BASED ON G.L. 84
+!MODIFIED BY XUEMEI 2010-01-26 ACCORDING TO ALEX'S DOCUMENT
+ ZPPFDFRAC = 0.55 -ZTRANSMIS*0.12
+
+!PPFDDIFFRAC IS BASED ON DATA IN JACOVIDES 2007
+!MODIFIED BY XUEMEI 2010-01-26 ACCORDING TO ALEX'S DOCUMENT
+ ZPPFDDIFFRAC = ZFRACDIFF * (1.06 + ZTRANSMIS*0.4)
+
+! CALCULTE QDIFFV,QBEAMV, QDIFFN, QBEAMN IN THE SUBROUTINE
+! MODIFIED BY XUEMEI 2010-01-26 ACCORDING TO ALEX'S DOCUMENT
+ IF (ZPPFDDIFFRAC > 1.0) ZPPFDDIFFRAC = 1.0
+
+ ZQV = ZPPFDFRAC * PSOLAR(JJ)
+ PQDIFFV(JJ) = ZQV * ZPPFDDIFFRAC
+ PQBEAMV(JJ) = ZQV - PQDIFFV(JJ)
+ ZQN = PSOLAR(JJ) - ZQV
+ PQDIFFN(JJ) = ZQN * ZFRACDIFF
+ PQBEAMN(JJ) = ZQN - PQDIFFN(JJ)
+
+ENDDO
+
+END SUBROUTINE SOLARFRACTIONS
+
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+!
+! SUBROUTINE CANOPYRAD
+!
+! CANOPY LIGHT ENVIRONMENT MODEL
+! CODE DEVELOPED BY ALEX GUENTHER, BASED ON SPITTERS ET AL. (1986),
+! GOUDRIAN AND LAAR (1994), LEUNING (1997)
+! INITIAL CODE 8-99, MODIFIED 7-2000 AND 12-2001
+!
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+SUBROUTINE CANOPYRAD(KCANTYPE, PCANOPYCHAR, PDISTGAUSS, &
+ PLAI, PSINBETA, PQBEAMV, PQDIFFV, PQBEAMN, PQDIFFN, &
+ PSUNFRAC, PSUNQV, PSHADEQV, PSUNQN, PSHADEQN, &
+ PSUNPPFD, PSHADEPPFD, &
+ PQDABSV, PQDABSN, PQSABSV, PQSABSN, PQBABSV, PQBABSN)
+
+IMPLICIT NONE
+
+! INPUT
+INTEGER, INTENT(IN) :: KCANTYPE
+REAL, DIMENSION(:,:), INTENT(IN) :: PCANOPYCHAR
+REAL, DIMENSION(:), INTENT(IN) :: PDISTGAUSS
+!
+REAL, DIMENSION(:), INTENT(IN) :: PLAI, PSINBETA, PQBEAMV, PQDIFFV, PQBEAMN, PQDIFFN
+! OUTPUT
+REAL, DIMENSION(:,:), INTENT(OUT) :: PSUNFRAC, PSUNQV, PSHADEQV, &
+ PSUNQN, PSHADEQN, PSHADEPPFD, PSUNPPFD
+REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PQDABSV, PQDABSN, PQSABSV, PQSABSN
+REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PQBABSV, PQBABSN
+
+! INTERNAL VARIABLES
+REAL, DIMENSION(SIZE(PQBEAMV)) :: ZKB, ZLAIDEPTH, ZQDABSVL, ZQSABSVL, ZQDABSNL, ZQSABSNL, &
+ ZREFLBV, ZREFLBN, ZKBPV, ZKBPN, ZKDPV, ZKDPN
+REAL, DIMENSION(SIZE(PQBEAMV)) :: ZQBABSV, ZQBABSN
+REAL :: ZSCATV, ZSCATN, ZREFLDV, ZREFLDN, ZKD, ZCLUSTER
+!
+INTEGER :: JI, JJ
+!
+!---------------------------------------------------------------------
+
+
+! SCATTERING COEFFICIENTS (SCATV,SCATN), DIFFUSE AND BEAM REFLECTION
+! COEFFICIENTS (REF..) FOR VISIBLE OR NEAR IR
+ZSCATV = PCANOPYCHAR(5,KCANTYPE)
+ZSCATN = PCANOPYCHAR(6,KCANTYPE)
+ZREFLDV = PCANOPYCHAR(7,KCANTYPE)
+ZREFLDN = PCANOPYCHAR(8,KCANTYPE)
+ZCLUSTER = PCANOPYCHAR(9,KCANTYPE)
+!
+! EXTINCTION COEFFICIENTS FOR BLACK LEAVES FOR BEAM (KB) OR DIFFUSE (KD)
+ZKB(:) = ZCLUSTER * 0.5 / MAX(0.00002,PSINBETA(:))
+! (0.5 ASSUMES A SPHERICAL LEAF ANGLE DISTRIBUTION (0.5 = COS (60 DEG))
+ZKD = 0.8 * ZCLUSTER
+! (0.8 ASSUMES A SPHERICAL LEAF ANGLE DISTRIBUTION)
+
+CALL CALCEXTCOEFF(ZSCATV,ZKD,PQBEAMV,ZKB,ZREFLBV,ZKBPV,ZKDPV,ZQBABSV)
+CALL CALCEXTCOEFF(ZSCATN,ZKD,PQBEAMN,ZKB,ZREFLBN,ZKBPN,ZKDPN,ZQBABSN)
+
+PSUNFRAC(:,:) = 0.
+DO JI = 1,NLAYERS
+
+! PLAI DEPTH AT THIS LAYER
+ ZLAIDEPTH(:) = PLAI(:) * PDISTGAUSS(JI)
+!FRACTION OF LEAVES THAT ARE SUNLIT
+ PSUNFRAC(:,JI) = EXP(-ZKB(:) * ZLAIDEPTH(:))
+
+
+ CALL CALCRADCOMPONENTS(ZSCATV, ZREFLDV, PQDIFFV, PQBEAMV, ZKDPV, ZKBPV, ZKB, &
+ ZREFLBV, ZLAIDEPTH, ZQDABSVL, ZQSABSVL)
+
+ CALL CALCRADCOMPONENTS(ZSCATN, ZREFLDN, PQDIFFN, PQBEAMN, ZKDPN, ZKBPN, ZKB, &
+ ZREFLBN, ZLAIDEPTH, ZQDABSNL, ZQSABSNL)
+
+
+ PSHADEPPFD(:,JI) = (ZQDABSVL(:) + ZQSABSVL(:)) * XCONVERTSHADEPPFD / (1. - ZSCATV)
+ PSUNPPFD (:,JI) = PSHADEPPFD(:,JI) + (ZQBABSV(:) * XCONVERTSUNPPFD / (1. - ZSCATV))
+ PSHADEQV (:,JI) = ZQDABSVL(:) + ZQSABSVL(:)
+ PSUNQV (:,JI) = PSHADEQV(:,JI) + ZQBABSV(:)
+ PSHADEQN (:,JI) = ZQDABSNL(:) + ZQSABSNL(:)
+ PSUNQN (:,JI) = PSHADEQN(:,JI) + ZQBABSN(:)
+ IF (PRESENT(PQDABSV)) PQDABSV (:,JI) = ZQDABSVL(:)
+ IF (PRESENT(PQSABSV)) PQSABSV (:,JI) = ZQSABSVL(:)
+ IF (PRESENT(PQDABSN)) PQDABSN (:,JI) = ZQDABSNL(:)
+ IF (PRESENT(PQSABSN)) PQSABSN (:,JI) = ZQSABSNL(:)
+!
+
+ENDDO
+
+
+DO JJ = 1,SIZE(PQBEAMV)
+
+ IF ( (PQBEAMV(JJ)+PQDIFFV(JJ))<=0.001 .OR. PSINBETA(JJ)<=0.00002 .OR. PLAI(JJ)<=0.001 ) THEN
+ ! NIGHT TIME
+ ZQBABSV(JJ) = 0.
+ ZQBABSN(JJ) = 0.
+
+ PSUNFRAC (JJ,:) = 0.2
+ PSUNQN (JJ,:) = 0.
+ PSHADEQN (JJ,:) = 0.
+ PSUNQV (JJ,:) = 0.
+ PSHADEQV (JJ,:) = 0.
+ PSUNPPFD (JJ,:) = 0.
+ PSHADEPPFD(JJ,:) = 0.
+ IF (PRESENT(PQDABSV)) PQDABSV(JJ,:) = 0.
+ IF (PRESENT(PQSABSV)) PQSABSV(JJ,:) = 0.
+ IF (PRESENT(PQDABSN)) PQDABSN(JJ,:) = 0.
+ IF (PRESENT(PQSABSN)) PQSABSN(JJ,:) = 0.
+
+ ENDIF
+
+END DO
+
+IF (PRESENT(PQBABSV)) PQBABSV(:) = ZQBABSV(:)
+IF (PRESENT(PQBABSN)) PQBABSN(:) = ZQBABSN(:)
+
+END SUBROUTINE CANOPYRAD
+
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+!
+! SUBROUTINE CALCEXTCOEFF
+!
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+
+SUBROUTINE CALCEXTCOEFF(PSCAT, PKD, PQBEAM, PKB, PREFLB, PKBP, PKDP, PQBEAMABSORB)
+!
+IMPLICIT NONE
+!
+REAL, INTENT(IN) :: PSCAT, PKD
+REAL, DIMENSION(:), INTENT(IN) :: PQBEAM, PKB
+REAL, DIMENSION(:), INTENT(OUT) :: PREFLB, PKBP, PKDP, PQBEAMABSORB
+
+! LOCAL VARIABLES
+REAL :: ZP
+INTEGER :: JJ
+!-------------------------------------------------------------------
+
+ZP = (1.-PSCAT)**0.5
+
+DO JJ = 1,SIZE(PKB)
+
+ PREFLB(JJ) = 1. - EXP((-2. * ((1.-ZP)/(1.+ZP)) * PKB(JJ)) / (1. + PKB(JJ)))
+
+ ! EXTINCTION COEFFICIENTS
+ PKBP(JJ) = PKB(JJ) * ZP
+ PKDP(JJ) = PKD * ZP
+ ! ABSORBED BEAM RADIATION
+ PQBEAMABSORB(JJ) = PKB(JJ) * PQBEAM(JJ) * (1 - PSCAT)
+
+ENDDO
+
+END SUBROUTINE CALCEXTCOEFF
+
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+!
+! SUBROUTINE CALCRADCOMPONENTS
+!
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+
+SUBROUTINE CALCRADCOMPONENTS(PSCAT, PREFLD, PQDIFF, PQBEAM, PKDP, PKBP, PKB, &
+ PREFLB, PLAIDEPTH, PQDABS, PQSABS)
+
+IMPLICIT NONE
+
+REAL, INTENT(IN) :: PSCAT, PREFLD
+REAL, DIMENSION(:), INTENT(IN) :: PQDIFF, PQBEAM, PKDP, PKBP, PKB, PREFLB, PLAIDEPTH
+REAL, DIMENSION(:), INTENT(OUT) :: PQDABS, PQSABS
+!-------------------------------------------------------------------
+
+PQDABS(:) = PQDIFF(:) * PKDP(:) * (1. - PREFLD) * EXP(-PKDP(:) * PLAIDEPTH(:))
+
+PQSABS(:) = PQBEAM(:) * ((PKBP(:) * (1. - PREFLB(:)) * EXP(-PKBP(:) * PLAIDEPTH(:))) &
+ - (PKB(:) * (1. - PSCAT) * EXP(-PKB (:) * PLAIDEPTH(:))))
+
+END SUBROUTINE CALCRADCOMPONENTS
+
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+!
+! SUBROUTINE CANOPYEB
+!
+! CANOPY ENERGY BALANCE MODEL FOR ESTIMATING LEAF TEMPERATURE
+! CODE DEVELOPED BY ALEX GUENTHER, BASED ON GOUDRIAN AND LAAR (1994),
+! LEUNING (1997)
+! INITIAL CODE 8-99, MODIFIED 7-2000 AND 12-2001
+!
+! NOTE: I DENOTES AN ARRAY CONTAINING A VERTICAL PROFILE THROUGH THE
+! CANOPY WITH 0
+! (ABOVE CANOPY CONDITIONS) PLUS 1 TO NUMBER OF CANOPY LAYERS
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+
+SUBROUTINE CANOPYEB(KCANTYPE, PCANOPYCHAR, PDISTGAUSS, PSTOMATADI, &
+ PTAIRK0, PWS0, PTRATE, PHUMIDAIRPA0, &
+ PSUNQV, PSHADEQV, PSUNQN, PSHADEQN, PSUNPPFD, PSHADEPPFD, &
+ PSUNLEAFTK, PSHADELEAFTK, PSUNLEAFSH, PSHADELEAFSH, &
+ PTAIRK, PHUMIDAIRPA, PWS, &
+ PSUNLEAFLH, PSUNLEAFIR, PSHADELEAFLH, PSHADELEAFIR)
+
+IMPLICIT NONE
+
+! INPUTS
+INTEGER, INTENT(IN) :: KCANTYPE
+REAL, DIMENSION(:,:), INTENT(IN) :: PCANOPYCHAR
+REAL, DIMENSION(:), INTENT(IN) :: PDISTGAUSS
+REAL, INTENT(IN) :: PSTOMATADI
+!
+REAL, DIMENSION(:), INTENT(IN) :: PTRATE, PTAIRK0, PWS0, PHUMIDAIRPA0
+REAL, DIMENSION(:,:), INTENT(IN) :: PSUNQV, PSHADEQV, &
+ PSUNQN, PSHADEQN, PSUNPPFD, PSHADEPPFD
+
+! OUTPUTS
+REAL, DIMENSION(:,:), INTENT(OUT) :: PSUNLEAFTK, PSHADELEAFTK, PSUNLEAFSH, PSHADELEAFSH
+!
+REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PTAIRK, PHUMIDAIRPA, PWS, &
+ PSUNLEAFLH, PSHADELEAFLH,&
+ PSUNLEAFIR, PSHADELEAFIR
+! LOCAL VARIABLES
+REAL :: ZLDEPTH, ZWSH
+REAL, DIMENSION(SIZE(PTRATE)) :: ZTAIRK, ZHUMIDAIRPA, ZWS, &
+ ZSUNLEAFLH, ZSHADELEAFLH, ZSUNLEAFIR, ZSHADELEAFIR
+!
+REAL, DIMENSION(SIZE(PTRATE)) :: ZDELTAH, ZIRIN, ZIROUT
+REAL :: ZCDEPTH, ZLWIDTH, ZLLENGTH, ZCHEIGHT, ZEPS, ZTRANSPIRETYPE
+INTEGER :: JI
+!
+!-----------------------------------------------------------------------
+
+ZCDEPTH = PCANOPYCHAR(1, KCANTYPE)
+!ZLWIDTH = PCANOPYCHAR(2, KCANTYPE)
+ZLLENGTH = PCANOPYCHAR(3, KCANTYPE)
+ZCHEIGHT = PCANOPYCHAR(4, KCANTYPE)
+ZEPS = PCANOPYCHAR(10,KCANTYPE)
+ZTRANSPIRETYPE = PCANOPYCHAR(11,KCANTYPE)
+
+WHERE ( PTAIRK0(:) >288. )
+! PA M-1 (PHUMIDITY PROFILE FOR T < 288)
+ ZDELTAH(:) = PCANOPYCHAR(14,KCANTYPE) / ZCHEIGHT
+ELSEWHERE ( PTAIRK0(:)>278. )
+ ZDELTAH(:) = ( PCANOPYCHAR(14,KCANTYPE) - ( (288.-PTAIRK0(:))/10.) * &
+ ( PCANOPYCHAR(14,KCANTYPE) - PCANOPYCHAR(15,KCANTYPE)) ) / ZCHEIGHT
+ELSEWHERE
+! PA M-1 (PHUMIDITY PROFILE FOR T <278)
+ ZDELTAH(:) = PCANOPYCHAR(15,KCANTYPE) / ZCHEIGHT
+END WHERE
+
+DO JI = 1,SIZE(PDISTGAUSS)
+
+ ZLDEPTH = ZCDEPTH * PDISTGAUSS(JI)
+ ZWSH = ( ZCHEIGHT - ZLDEPTH ) - ( PCANOPYCHAR(16,KCANTYPE) * ZCHEIGHT )
+
+ ZTAIRK (:) = PTAIRK0 (:) + (PTRATE (:) * ZLDEPTH) ! CHECK THIS
+ ZHUMIDAIRPA(:) = PHUMIDAIRPA0(:) + (ZDELTAH(:) * ZLDEPTH)
+ IF ( ZWSH.GT.1E-3 ) THEN
+ ZWS(:) = ( PWS0(:) * LOG(ZWSH) / LOG(ZCHEIGHT-PCANOPYCHAR(16,KCANTYPE)*ZCHEIGHT) )
+ ELSE
+ ZWS(:) = 0.05
+ END IF
+
+ ZIRIN(:) = UNEXPOSEDLEAFIRIN(ZEPS, ZTAIRK)
+
+ ZSUNLEAFIR(:) = 0.5 * EXPOSEDLEAFIRIN(PHUMIDAIRPA0,PTAIRK0) + 1.5*ZIRIN(:)
+
+! SUN
+ CALL LEAFEB(ZEPS, ZTRANSPIRETYPE, ZLLENGTH, PSTOMATADI, &
+ PSUNPPFD(:,JI), PSUNQV(:,JI)+PSUNQN(:,JI), &
+ ZSUNLEAFIR, ZTAIRK, ZHUMIDAIRPA, ZWS, &
+ PSUNLEAFTK(:,JI), PSUNLEAFSH(:,JI), ZSUNLEAFLH, &
+ ZIROUT )
+!
+ IF (PRESENT(PSUNLEAFIR)) PSUNLEAFIR(:,JI) = ZSUNLEAFIR(:) - ZIROUT(:)
+
+! SHADE
+ ZSHADELEAFIR(:) = 2. * ZIRIN(:)
+
+ CALL LEAFEB(ZEPS, ZTRANSPIRETYPE, ZLLENGTH, PSTOMATADI, &
+ PSHADEPPFD(:,JI), PSHADEQV(:,JI)+PSHADEQN(:,JI), &
+ ZSHADELEAFIR, ZTAIRK, ZHUMIDAIRPA, ZWS, &
+ PSHADELEAFTK(:,JI), PSHADELEAFSH(:,JI), ZSHADELEAFLH, &
+ ZIROUT )
+!
+ IF (PRESENT(PSHADELEAFIR)) PSHADELEAFIR(:,JI) = ZSHADELEAFIR(:) - ZIROUT(:)
+
+ IF (PRESENT(PTAIRK)) PTAIRK (:,JI) = ZTAIRK (:)
+ IF (PRESENT(PHUMIDAIRPA)) PHUMIDAIRPA (:,JI) = ZHUMIDAIRPA (:)
+ IF (PRESENT(PWS)) PWS (:,JI) = ZWS (:)
+ IF (PRESENT(PSUNLEAFLH)) PSUNLEAFLH (:,JI) = ZSUNLEAFLH (:)
+ IF (PRESENT(PSHADELEAFLH)) PSHADELEAFLH(:,JI) = ZSHADELEAFLH(:)
+
+ENDDO
+!
+END SUBROUTINE CANOPYEB
+
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+!
+! SUBROUTINE LEAFEB
+!
+! LEAF ENERGY BALANCE
+!
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+
+SUBROUTINE LEAFEB(PEPS, PTRANSPIRETYPE, PLLENGTH, PSTOMATADI, &
+ PPFD, PQ, PIRIN, PTAIRK, PHUMIDAIRPA, PWS, &
+ PTLEAF, PSH, PLH, PIROUT)
+
+IMPLICIT NONE
+
+REAL, INTENT(IN) :: PEPS, PTRANSPIRETYPE, PLLENGTH, PSTOMATADI
+REAL, DIMENSION(:), INTENT(IN) :: PPFD, PQ, PIRIN, PTAIRK, PHUMIDAIRPA, PWS
+REAL, DIMENSION(:), INTENT(OUT) :: PTLEAF, PSH, PLH, PIROUT
+
+! LOCAL VARIABLES
+REAL, DIMENSION(SIZE(PPFD)) :: ZHUMIDAIRKGM3, ZGHFORCED, ZSTOMRES, ZIROUTAIRT, ZLATHV, &
+ ZLHAIRT, ZTDELT, ZBALANCE, ZGH1, ZSH1, ZLH1, ZE1, ZIROUT1, ZGH, &
+ ZTAIRK, ZVAPDEFICIT
+INTEGER :: JI
+!----------------------------------------------------
+
+! AIR VAPOR DENSITY KG M-3
+ZHUMIDAIRKGM3(:) = CONVERTHUMIDITYPA2KGM3(PHUMIDAIRPA, PTAIRK)
+
+! LATENT HEAT OF VAPORIZATION (J KG-1)
+ZLATHV(:) = LHV(PTAIRK)
+!
+! HEAT CONVECTION COEFFICIENT (W M-2 K-1) FOR FORCED CONVECTION.
+! NOBEL PAGE 366
+ZGHFORCED(:) = 0.0259 / (0.004 * ((PLLENGTH / PWS(:))**0.5))
+!
+! STOMATAL RESISTENCE S M-1
+ZSTOMRES (:) = RESSC(PSTOMATADI, PPFD)
+!
+! LATENT HEAT FLUX
+ZVAPDEFICIT(:) = SVDTK(PTAIRK(:)) - ZHUMIDAIRKGM3(:)
+ZLHAIRT(:) = LEAFLE(PTRANSPIRETYPE, ZVAPDEFICIT, ZLATHV, ZGHFORCED, ZSTOMRES)
+!
+ZIROUTAIRT(:) = LEAFIROUT(PEPS, PTAIRK)
+ZE1(:) = (PQ(:) + PIRIN(:) - ZIROUTAIRT(:) - ZLHAIRT(:))
+WHERE ( ZE1(:).EQ.0. ) ZE1(:) = -1.
+!
+ZTDELT (:) = 1.
+ZBALANCE(:) = 10.
+DO JI = 1, 10
+ !
+ WHERE ( ABS(ZBALANCE(:))>2. )
+ !
+ ZTAIRK (:) = PTAIRK(:) + ZTDELT(:)
+ !
+ ! LATENT HEAT OF VAPORIZATION (J KG-1)
+ ZLATHV(:) = LHV(ZTAIRK)
+ ! BOUNDARY LAYER CONDUCTANCE
+ ZGH1 (:) = LEAFBLC(PLLENGTH, ZGHFORCED, ZTDELT)
+ !
+ ZVAPDEFICIT(:) = SVDTK(ZTAIRK(:)) - ZHUMIDAIRKGM3(:)
+ PLH (:) = LEAFLE(PTRANSPIRETYPE, ZVAPDEFICIT, ZLATHV, ZGH1, ZSTOMRES)
+ !
+ PIROUT (:) = LEAFIROUT(PEPS, PTAIRK+ZTDELT)
+ ZIROUT1(:) = PIROUT(:) - ZIROUTAIRT(:)
+ !
+ ! CONVECTIVE HEAT FLUX
+ ZSH1(:) = LEAFH(ZTDELT, ZGH1)
+ ZLH1(:) = PLH(:) - ZLHAIRT(:)
+ !
+ ZTDELT (:) = ZE1(:) / ((ZSH1(:) + ZLH1(:) + ZIROUT1(:)) / ZTDELT(:))
+ ZBALANCE(:) = PQ(:) + PIRIN(:) - PIROUT(:) - ZSH1(:) - PLH(:)
+ END WHERE
+ !
+ IF (ALL(ZBALANCE(:)<=2.)) EXIT
+ !
+ENDDO
+!
+ZTDELT(:) = MAX(-10.,MIN(ZTDELT(:),10.))
+!
+PTLEAF(:) = PTAIRK(:) + ZTDELT(:)
+!
+ZGH(:) = LEAFBLC(PLLENGTH, ZGHFORCED, ZTDELT)
+PSH(:) = LEAFH (ZTDELT, ZGH)
+!
+ZVAPDEFICIT(:) = SVDTK(PTLEAF(:)) - ZHUMIDAIRKGM3(:)
+PLH(:) = LEAFLE (PTRANSPIRETYPE, ZVAPDEFICIT, ZLATHV, ZGH, ZSTOMRES)
+PIROUT(:) = LEAFIROUT(PEPS, PTLEAF)
+!
+END SUBROUTINE LEAFEB
+
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+!
+! FUNCTION DISTOMATA
+!
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+
+FUNCTION DISTOMATA(PDI) RESULT(PDISTOMATA)
+
+IMPLICIT NONE
+
+REAL, INTENT(IN) :: PDI
+REAL :: PDISTOMATA
+INTEGER :: JJ
+! > -.5 INCIPIENT, MILD OR NO DROUGHT; < -4 EXTREME DROUGHT
+!--------------------------------------------------------------------
+
+IF ( PDI>XDIHIGH ) THEN
+ PDISTOMATA = 1. ! NO DROUGHT
+ELSEIF ( PDI>XDILOW ) THEN
+ ! INTERPOLATE
+ PDISTOMATA = 1. - (0.9 * ((PDI - XDIHIGH) / (XDILOW - XDIHIGH)))
+ELSE
+ PDISTOMATA = 0. ! MAXIMUM DROUGHT, MAXIMUM STOMATAL RESISTANCE
+ENDIF
+
+END FUNCTION DISTOMATA
+
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+!
+! FUNCTION CALCECCENTRICITY
+!
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+
+FUNCTION CALCECCENTRICITY(KDAY) RESULT(PCALCECCENTRICITY)
+
+IMPLICIT NONE
+
+INTEGER, DIMENSION(:), INTENT(IN) :: KDAY
+!
+REAL, DIMENSION(SIZE(KDAY)) :: PCALCECCENTRICITY
+!
+!--------------------------------------------------------------------
+
+PCALCECCENTRICITY(:) = 1. + 0.033 * COS(2*3.14*(KDAY(:)-10)/365)
+
+END FUNCTION CALCECCENTRICITY
+
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+!
+! FUNCTION UNEXPOSEDLEAFIRIN
+!
+! CALCULATE IR INTO LEAF THAT IS NOT EXPOSED TO THE SKY
+!
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+
+FUNCTION UNEXPOSEDLEAFIRIN(PEPS, PTK) RESULT(PUNEXPOSEDLEAFIRIN)
+
+IMPLICIT NONE
+
+REAL, INTENT(IN) :: PEPS
+REAL, DIMENSION(:), INTENT(IN) :: PTK
+REAL, DIMENSION(SIZE(PTK)) :: PUNEXPOSEDLEAFIRIN
+!--------------------------------------------------------------------
+
+PUNEXPOSEDLEAFIRIN(:) = PEPS * XSB * (PTK(:)**4.)
+
+END FUNCTION UNEXPOSEDLEAFIRIN
+
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+!
+! FUNCTION EXPOSEDLEAFIRIN
+!
+! CALCULATE IR INTO LEAF THAT IS EXPOSED TO THE SKY
+!
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+
+FUNCTION EXPOSEDLEAFIRIN(PHUMIDPA, PTK) RESULT(PEXPOSEDLEAFIRIN)
+
+IMPLICIT NONE
+
+REAL, DIMENSION(:), INTENT(IN) :: PTK, PHUMIDPA
+REAL, DIMENSION(SIZE(PTK)) :: PEXPOSEDLEAFIRIN
+REAL :: ZEMISSATM
+INTEGER :: JJ
+!--------------------------------------------------------------------
+
+! APPARENT ATMOSPHERIC EMISSIVITY FOR CLEAR SKIES:
+! FUNCTION OF WATER VAPOR PRESSURE (PA)
+! AND AMBIENT TEMPERATURE (K) BASED ON BRUTSAERT(1975)
+! REFERENCED IN LEUNING (1997)
+
+DO JJ = 1,SIZE(PTK)
+ ZEMISSATM = 0.642 * (PHUMIDPA(JJ) / PTK(JJ))**(1./7.)
+ PEXPOSEDLEAFIRIN(JJ) = ZEMISSATM * XSB * (PTK(JJ)**4.)
+ENDDO
+
+END FUNCTION EXPOSEDLEAFIRIN
+
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+!
+! FUNCTION WATERVAPPRES
+!
+! CONVERT WATER MIXING RATIO (KG/KG) TO WATER VAPOR PRESSURE
+! (PA OR KPA DEPENDING ON UNITS OF INPUT )
+! MIXING RATIO (KG/KG), TEMP (C), PRESSURE (KPA)
+!
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+
+FUNCTION WATERVAPPRES(PWATERAIRRATIO, PDENS, PRES) RESULT(PWATERVAPPRES)
+
+IMPLICIT NONE
+
+REAL, INTENT(IN) :: PWATERAIRRATIO
+REAL, DIMENSION(:), INTENT(IN) :: PDENS, PRES
+REAL, DIMENSION(SIZE(PDENS)) :: PWATERVAPPRES
+!--------------------------------------------------------------------
+
+PWATERVAPPRES(:) = (PDENS(:) / (PDENS(:) + PWATERAIRRATIO)) * PRES(:)
+
+END FUNCTION WATERVAPPRES
+
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+!
+! FUNCTION STABILITY
+!
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+
+FUNCTION STABILITY(PCANOPYCHAR, KCANTYPE, PSOLAR) RESULT(PSTABILITY)
+
+IMPLICIT NONE
+!
+REAL, DIMENSION(:,:), INTENT(IN) :: PCANOPYCHAR
+INTEGER, INTENT(IN) :: KCANTYPE
+REAL, DIMENSION(:), INTENT(IN) :: PSOLAR
+REAL, DIMENSION(SIZE(PSOLAR)) :: PSTABILITY
+REAL :: ZTRATEBOUNDARY
+INTEGER :: JJ
+!--------------------------------------------------------------------
+
+ZTRATEBOUNDARY = 500
+
+DO JJ = 1,SIZE(PSOLAR)
+ IF ( PSOLAR(JJ)>ZTRATEBOUNDARY ) THEN
+ ! DAYTIME TEMPERATURE LAPSE RATE
+ PSTABILITY(JJ) = PCANOPYCHAR(12,KCANTYPE)
+ ELSEIF ( PSOLAR(JJ)>0. ) THEN
+ PSTABILITY(JJ) = PCANOPYCHAR(12,KCANTYPE) - &
+ ( (ZTRATEBOUNDARY - PSOLAR(JJ)) / ZTRATEBOUNDARY ) * &
+ (PCANOPYCHAR(12,KCANTYPE) - PCANOPYCHAR(13,KCANTYPE))
+ ELSE
+ ! NIGHTIME TEMPERATURE LAPSE RATE
+ PSTABILITY = PCANOPYCHAR(13,KCANTYPE)
+ ENDIF
+ENDDO
+
+END FUNCTION STABILITY
+
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+!
+! FUNCTION CONVERTHUMIDITYPA2KGM3
+!
+! SATURATION VAPOR DENSITY (KG/M3)
+!
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+
+FUNCTION CONVERTHUMIDITYPA2KGM3(PA, PTK) RESULT(PCONVERTHUMIDITYPA2KGM3)
+
+IMPLICIT NONE
+
+REAL, DIMENSION(:), INTENT(IN) :: PA, PTK
+REAL, DIMENSION(SIZE(PA)) :: PCONVERTHUMIDITYPA2KGM3
+!--------------------------------------------------------------------
+
+PCONVERTHUMIDITYPA2KGM3(:) = 0.002165 * PA(:) / PTK(:)
+
+END FUNCTION CONVERTHUMIDITYPA2KGM3
+
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+!
+! FUNCTION RESSC
+!
+! LEAF STOMATAL COND. RESISTANCE S M-1
+!
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+
+FUNCTION RESSC(PSTOMATADI, PAR) RESULT(PRESSC)
+
+IMPLICIT NONE
+
+REAL, INTENT(IN) :: PSTOMATADI
+REAL, DIMENSION(:), INTENT(IN) :: PAR
+REAL, DIMENSION(SIZE(PAR)) :: PRESSC
+REAL, DIMENSION(SIZE(PAR)) :: ZSCADJ
+INTEGER :: JJ
+!--------------------------------------------------------------------
+
+ZSCADJ(:) = PSTOMATADI * &
+ ( (0.0027*1.066*PAR(:)) / ((1 + 0.0027*0.0027*PAR(:)**2.)**0.5) )
+!
+WHERE (ZSCADJ(:)<0.1)
+ PRESSC(:) = 2000.
+ELSE WHERE
+ PRESSC(:) = 200./ZSCADJ(:)
+END WHERE
+
+END FUNCTION RESSC
+
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+!
+! FUNCTION LEAFIROUT
+!
+! IR THERMAL RADIATION ENERGY OUTPUT BY LEAF
+!
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+
+FUNCTION LEAFIROUT(PEPS, PTLEAF) RESULT(PLEAFIROUT)
+
+IMPLICIT NONE
+
+REAL, INTENT(IN) :: PEPS
+REAL, DIMENSION(:), INTENT(IN) :: PTLEAF
+REAL, DIMENSION(SIZE(PTLEAF)) :: PLEAFIROUT
+!--------------------------------------------------------------------
+
+! PRINT*,'EPS, SB, TLEAF =', EPS, SB, TLEAF
+PLEAFIROUT(:) = PEPS * XSB * (2 * (PTLEAF(:)**4.))
+
+END FUNCTION LEAFIROUT
+
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+!
+! FUNCTION LHV
+!
+! LATENT HEAT OF VAPORIZATION(J KG-1) FROM STULL P641
+!
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+
+FUNCTION LHV(PTK) RESULT(PLHV)
+
+IMPLICIT NONE
+
+REAL, DIMENSION(:), INTENT(IN) :: PTK
+REAL, DIMENSION(SIZE(PTK)) :: PLHV
+!--------------------------------------------------------------------
+
+PLHV(:) = 2501000. - (2370. * (PTK(:) - 273.))
+
+END FUNCTION LHV
+
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+!
+! FUNCTION LEAFLE
+!
+! LATENT ENERGY TERM IN ENERGY BALANCE
+!
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+
+FUNCTION LEAFLE(PTRANSPIRETYPE, PVAPDEFICIT, PLATHV, PGH, PSTOMRES) RESULT(PLEAFLE)
+
+IMPLICIT NONE
+
+REAL, INTENT(IN) :: PTRANSPIRETYPE
+REAL, DIMENSION(:), INTENT(IN) :: PVAPDEFICIT, PLATHV, PGH, PSTOMRES
+REAL, DIMENSION(SIZE(PLATHV)) :: PLEAFLE
+REAL, DIMENSION(SIZE(PLATHV)) :: ZLEAFRES
+!INTEGER :: JJ
+!--------------------------------------------------------------------
+
+ZLEAFRES(:) = (1. / (1.075 * (PGH(:) / 1231.))) + PSTOMRES(:)
+
+! LATENT HEAT OF VAP (J KG-1) * VAP DEFICIT(KG M-3) /
+! LEAF RESISTENCE (S M-1)
+PLEAFLE(:) = PTRANSPIRETYPE * (1./ZLEAFRES(:)) * PLATHV(:) * PVAPDEFICIT(:)
+!
+PLEAFLE(:) = MAX(PLEAFLE(:),0.)
+!
+END FUNCTION LEAFLE
+
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+!
+! FUNCTION LEAFBLC
+!
+! BOUNDARY LAYER CONDUCTANCE
+!
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+
+FUNCTION LEAFBLC(PLLENGTH, PGHFORCED, PTDELTA) RESULT(PLEAFBLC)
+
+IMPLICIT NONE
+
+REAL, INTENT(IN) :: PLLENGTH
+REAL, DIMENSION(:), INTENT(IN) :: PGHFORCED, PTDELTA
+REAL, DIMENSION(SIZE(PTDELTA)) :: PLEAFBLC
+REAL, DIMENSION(SIZE(PTDELTA)) :: ZGHFREE
+REAL :: ZLLENGTH3
+INTEGER :: JJ
+!--------------------------------------------------------------------
+
+! THIS IS BASED ON LEUNING 1995 P.1198 EXCEPT USING MOLECULAR
+! CONDUCTIVITY (.00253 W M-1 K-1 STULL P 640) INSTEAD OF MOLECULAR
+! DIFFUSIVITY SO THAT YOU END UP WITH A HEAT CONVECTION COEFFICIENT
+! (W M-2 K-1) INSTEAD OF A CONDUCTANCE FOR FREE CONVECTION
+!
+ZLLENGTH3 = PLLENGTH**3
+!
+WHERE (PTDELTA(:)>=0.)
+ ZGHFREE (:) = 0.5 * 0.00253 * ((160000000. * PTDELTA(:) / (ZLLENGTH3))**0.25) / PLLENGTH
+ PLEAFBLC(:) = PGHFORCED(:) + ZGHFREE(:)
+ELSE WHERE
+ PLEAFBLC(:) = PGHFORCED(:)
+END WHERE
+!
+END FUNCTION LEAFBLC
+
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+!
+! FUNCTION LEAFH
+!
+! CONVECTIVE ENERGY TERM IN ENERGY BALANCE (W M-2 HEAT FLUX FROM
+! BOTH SIDES OF LEAF)
+!
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+
+FUNCTION LEAFH(PTDELTA, PGH) RESULT(PLEAFH)
+
+IMPLICIT NONE
+
+REAL, DIMENSION(:), INTENT(IN) :: PTDELTA, PGH
+REAL, DIMENSION(SIZE(PGH)) :: PLEAFH
+!--------------------------------------------------------------------
+
+! 2 SIDES X CONDUCTANCE X TEMPERATURE GRADIENT
+PLEAFH(:) = 2. * PGH(:) * PTDELTA(:)
+
+END FUNCTION LEAFH
+
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+!
+! FUNCTION SVDTK
+!
+! SATURATION VAPOR DENSITY (KG/M3)
+!
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+
+FUNCTION SVDTK(PTK) RESULT(PSVDTK)
+
+IMPLICIT NONE
+
+REAL, DIMENSION(:), INTENT(IN) :: PTK
+REAL, DIMENSION(SIZE(PTK)) :: PSVDTK
+REAL, DIMENSION(SIZE(PTK)) :: ZSVP
+INTEGER :: JJ
+!--------------------------------------------------------------------
+
+! SATURATION VAPOR PRESSURE (MILLIBARS)
+ZSVP (:) = 10.**((-2937.4 / PTK(:)) - (4.9283 * LOG10(PTK(:))) + 23.5518)
+PSVDTK(:) = 0.2165 * ZSVP(:) / PTK(:)
+
+END FUNCTION SVDTK
+
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+!
+! FUNCTION EA1T99
+!
+! TEMPERATURE DEPENDENCE ACTIVITY FACTOR FOR EMISSION TYPE 1
+! (E.G. ISOPRENE, MBO)
+!
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+
+FUNCTION EA1T99(HSPC_NAME, PT24, PT240, PT1) RESULT(PEA1T99)
+
+USE MODI_INDEX1
+
+IMPLICIT NONE
+
+CHARACTER(LEN=16),INTENT(IN) :: HSPC_NAME
+REAL, DIMENSION(:), INTENT(IN) :: PT1, PT24, PT240
+REAL, DIMENSION(SIZE(PT1)) :: PEA1T99
+REAL :: ZTOPT, ZX, ZEOPT
+INTEGER :: ISPCNUM
+INTEGER :: JJ
+!--------------------------------------------------------------------
+
+ISPCNUM = INDEX1(HSPC_NAME, CMGN_SPC)
+!
+DO JJ = 1,SIZE(PT1)
+ IF ( PT1(JJ)<260. ) THEN
+ PEA1T99(JJ) = 0.
+ ELSE
+ ! ENERGY OF ACTIVATION AND DEACTIVATION
+ ! TEMPERATURE AT WHICH MAXIMUM EMISSION OCCURS
+ ZTOPT = 312.5 + 0.6 * (PT240(JJ) - 297)
+ ZX = ((1 / ZTOPT) - (1 / PT1(JJ))) / 0.00831
+
+ ! MAXIMUM EMISSION (RELATIVE TO EMISSION AT 30 C)
+ ZEOPT = XCLEO(ISPCNUM) * EXP(0.05 * (PT24(JJ) - 297)) * EXP(0.05*(PT240(JJ)-297))
+
+ PEA1T99(JJ) = ZEOPT * XCTM2 * EXP(XCTM1(ISPCNUM)*ZX) / &
+ (XCTM2 - XCTM1(ISPCNUM) * (1.-EXP(XCTM2*ZX)))
+ ENDIF
+
+ENDDO
+
+END FUNCTION EA1T99
+
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+!
+! FUNCTION EA1PP
+!
+! PSTD = 200 FOR SUN LEAVES AND 50 FOR SHADE LEAVES
+!
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+
+FUNCTION EA1P99(PSTD, PPFD24, PPFD240, PPFD1) RESULT(PEA1P99)
+
+IMPLICIT NONE
+
+REAL, INTENT(IN) :: PSTD
+REAL, DIMENSION(:), INTENT(IN) :: PPFD1, PPFD24, PPFD240
+REAL, DIMENSION(SIZE(PPFD1)) :: PEA1P99
+REAL :: ZALPHA, ZC1
+INTEGER :: JJ
+!--------------------------------------------------------------------
+
+DO JJ = 1,SIZE(PPFD1)
+
+ IF ( PPFD240(JJ)<0.01 ) THEN
+ PEA1P99(JJ) = 0.
+ ELSE
+ ZALPHA = 0.004 - 0.0005 * LOG(PPFD240(JJ))
+ ZC1 = 0.0468 * EXP(0.0005 * (PPFD24(JJ) - PSTD)) * (PPFD240(JJ)**0.6)
+ PEA1P99(JJ) = (ZALPHA * ZC1 * PPFD1(JJ)) / ((1 + ZALPHA**2. * PPFD1(JJ)**2.)**0.5)
+ ENDIF
+
+ENDDO
+
+END FUNCTION EA1P99
+
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+!
+! FUNCTION EALTI99
+!
+! CALCULATE LIGHT INDEPENT ALGORITHMS
+! CODED BY XUEMEI WANG 05 NOV. 2007
+!-- GAMMA_TLI = EXP[BETA*(T-TS)]
+! WHERE BETA = TEMPERATURE DEPENDENT PARAMETER
+! TS = STANDARD TEMPERATURE (NORMALLY 303K, 30C)
+!
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+
+FUNCTION EALTI99(HSPCNAM, PTEMP) RESULT(PEALTI99)
+
+USE MODI_INDEX1
+
+IMPLICIT NONE
+
+CHARACTER(LEN=16), INTENT(IN) :: HSPCNAM
+REAL, DIMENSION(:), INTENT(IN) :: PTEMP
+REAL, DIMENSION(SIZE(PTEMP)) :: PEALTI99
+!
+INTEGER :: ISPCNUM ! SPECIES NUMBER
+!--------------------------------------------------------------------
+ISPCNUM = INDEX1(HSPCNAM, CMGN_SPC)
+PEALTI99(:) = EXP( XTDF_PRM(ISPCNUM)*(PTEMP(:)-XTS) )
+
+END FUNCTION EALTI99
+!
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+!
+END MODULE MODE_MEGAN
diff --git a/src/ICCARE_BASE/write_diag_pgd_isban.F90 b/src/ICCARE_BASE/write_diag_pgd_isban.F90
new file mode 100644
index 0000000000000000000000000000000000000000..a3d13829f6fd60d9b268cf496e91f032a3b883f1
--- /dev/null
+++ b/src/ICCARE_BASE/write_diag_pgd_isban.F90
@@ -0,0 +1,642 @@
+!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SFX_LIC for details. version 1.
+! #########
+ SUBROUTINE WRITE_DIAG_PGD_ISBA_n (DTCO, HSELECT, U, CHI, NCHI, OSURF_DIAG_ALBEDO, &
+ IO, S, K, NP, NPE, ISS, HPROGRAM)
+! #########################################
+!
+!!**** *WRITE_DIAG_PGD_ISBA_n* - writes the ISBA physiographic diagnostic fields
+!!
+!! PURPOSE
+!! -------
+!!
+!!** METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Masson *Meteo France*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 01/2004
+!! Modified 10/2004 by P. Le Moigne: add XZ0REL, XVEGTYPE_PATCH
+!! Modified 11/2005 by P. Le Moigne: limit length of VEGTYPE_PATCH field names
+!! Modified 11/2013 by B. Decharme : XPATCH now in writesurf_isban.F90
+!! Modified 10/2014 by P. Samuelsson: MEB variables
+!! Modified 06/2014 by B. Decharme : add XVEGTYPE
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_TYPE_DATE_SURF
+!
+USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
+USE MODD_SSO_n, ONLY : SSO_t
+USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
+USE MODD_CH_ISBA_n, ONLY : CH_ISBA_t, CH_ISBA_NP_t
+USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
+USE MODD_ISBA_n, ONLY : ISBA_S_t, ISBA_K_t, ISBA_NP_t, ISBA_NPE_t, ISBA_P_t, ISBA_PE_t
+!
+USE MODD_SURF_PAR, ONLY : XUNDEF, NUNDEF
+USE MODD_AGRI, ONLY : LAGRIP
+!
+!
+USE MODD_IO_SURF_FA, ONLY : LFANOCOMPACT, LPREP
+!
+USE MODI_INIT_IO_SURF_n
+USE MODI_WRITE_SURF
+USE MODI_END_IO_SURF_n
+USE MODI_WRITE_FIELD_1D_PATCH
+USE MODI_WRITE_TFIELD_1D_PATCH
+USE MODI_UNPACK_SAME_RANK
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of arguments
+! -------------------------
+!
+!
+TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
+ CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT
+TYPE(SURF_ATM_t), INTENT(INOUT) :: U
+TYPE(CH_ISBA_t), INTENT(INOUT) :: CHI
+TYPE(CH_ISBA_NP_t), INTENT(INOUT) :: NCHI
+LOGICAL, INTENT(IN) :: OSURF_DIAG_ALBEDO
+TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
+TYPE(ISBA_S_t), INTENT(INOUT) :: S
+TYPE(ISBA_K_t), INTENT(INOUT) :: K
+TYPE(ISBA_NP_t), INTENT(INOUT) :: NP
+TYPE(ISBA_NPE_t), INTENT(INOUT) :: NPE
+TYPE(SSO_t), INTENT(INOUT) :: ISS
+!
+ CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling
+!
+!* 0.2 Declarations of local variables
+! -------------------------------
+!
+TYPE(ISBA_P_t), POINTER :: PK
+TYPE(ISBA_PE_t), POINTER :: PEK
+!
+REAL, DIMENSION(U%NSIZE_NATURE,IO%NPATCH) :: ZWORK
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZWORK1
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZWORK2
+!
+REAL, DIMENSION(U%NSIZE_NATURE,SIZE(NP%AL(1)%XDG,2)) :: ZDG ! Work array
+REAL, DIMENSION(U%NSIZE_NATURE) :: ZDG2
+REAL, DIMENSION(U%NSIZE_NATURE) :: ZDTOT
+!
+INTEGER :: IRESP ! IRESP : return-code if a problem appears
+CHARACTER(LEN=LEN_HREC) :: YRECFM ! Name of the article to be read
+CHARACTER(LEN=100):: YCOMMENT ! Comment string
+CHARACTER(LEN=2) :: YLVLV, YPAS
+CHARACTER(LEN=4) :: YLVL
+ CHARACTER(LEN=2) :: YPAT
+!
+INTEGER :: JI, JL, JP, ILAYER, ILU, IMASK
+INTEGER :: ISIZE_LMEB_PATCH ! Number of patches where multi-energy balance should be applied
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!-------------------------------------------------------------------------------
+!
+! Initialisation for IO
+!
+IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_PGD_ISBA_N',0,ZHOOK_HANDLE)
+!
+ILU = U%NSIZE_NATURE
+!
+ISIZE_LMEB_PATCH=COUNT(IO%LMEB_PATCH(:))
+!
+CALL INIT_IO_SURF_n(DTCO, U, HPROGRAM,'NATURE','ISBA ','WRITE','ISBA_VEG_EVOLUTION.OUT.nc')
+!
+!-------------------------------------------------------------------------------
+!
+!* Leaf Area Index
+!
+IF (IO%CPHOTO=='NON' .OR. IO%CPHOTO=='AST') THEN
+ !
+ YRECFM='LAI'
+ YCOMMENT='leaf area index (-)'
+ !
+ DO JP = 1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NPE%AL(JP)%XLAI(:),ILU,S%XWORK_WR)
+ ENDDO
+ !
+ENDIF
+!
+!* Leaf Area Index previous
+!
+IF (IO%CPHOTO=='NON' .OR. IO%CPHOTO=='AST') THEN
+ !
+ YRECFM='LAIp'
+ YCOMMENT='leaf area index previous (-)'
+ !
+ DO JP = 1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NPE%AL(JP)%XLAIp(:),ILU,S%XWORK_WR)
+ ENDDO
+ !
+ENDIF
+
+!-------------------------------------------------------------------------------
+!
+!* Vegetation fraction
+!
+YRECFM='VEG'
+YCOMMENT='vegetation fraction (-)'
+!
+DO JP = 1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NPE%AL(JP)%XVEG(:),ILU,S%XWORK_WR)
+ENDDO
+!
+!* Surface roughness length (without snow)
+!
+YRECFM='Z0VEG'
+YCOMMENT='surface roughness length (without snow) (m)'
+!
+DO JP = 1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NPE%AL(JP)%XZ0(:),ILU,S%XWORK_WR)
+ENDDO
+!
+IF (ISIZE_LMEB_PATCH>0) THEN
+ !
+ YRECFM='GNDLITTER'
+ YCOMMENT='MEB: ground litter fraction (-)'
+ !
+DO JP = 1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NPE%AL(JP)%XGNDLITTER(:),ILU,S%XWORK_WR)
+ENDDO
+ !
+ YRECFM='Z0LITTER'
+ YCOMMENT='MEB: ground litter roughness length (without snow) (m)'
+ !
+DO JP = 1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NPE%AL(JP)%XZ0LITTER(:),ILU,S%XWORK_WR)
+ENDDO
+ !
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+!* Soil depth for each patch
+!
+DO JL=1,SIZE(NP%AL(1)%XDG,2)
+ IF (JL<10) THEN
+ WRITE(YRECFM,FMT='(A2,I1)') 'DG',JL
+ ELSE
+ WRITE(YRECFM,FMT='(A2,I2)') 'DG',JL
+ ENDIF
+ YCOMMENT='soil depth'//' (M)'
+DO JP = 1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NP%AL(JP)%XDG(:,JL),ILU,S%XWORK_WR)
+ENDDO
+END DO
+!
+!* Averaged Soil depth
+!
+IF(IO%NPATCH>1)THEN
+!
+ ZDG(:,:)=0.0
+ DO JP=1,IO%NPATCH
+ PK => NP%AL(JP)
+ DO JL=1,SIZE(PK%XDG,2)
+ DO JI=1, PK%NSIZE_P
+ IMASK = PK%NR_P(JI)
+ ZDG(IMASK,JL) = ZDG(IMASK,JL) + PK%XPATCH(JI)*PK%XDG(JI,JL)
+ ENDDO
+ ENDDO
+ ENDDO
+!
+ DO JL=1,SIZE(NP%AL(1)%XDG,2)
+ WRITE(YLVL,'(I4)')JL
+ YRECFM='DG'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
+ YRECFM=YRECFM(:LEN_TRIM(YRECFM))//'_ISBA'
+ YCOMMENT='averaged soil depth layer '//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))//' (m)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,ZDG(:,JL),IRESP,HCOMMENT=YCOMMENT)
+ END DO
+!
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+IF(IO%CISBA=='DIF')THEN
+ !
+ ALLOCATE(ZWORK2(ILU,IO%NPATCH))
+ !
+ ZDG2 (:)=0.0
+ ZDTOT(:)=0.0
+ ZWORK2(:,:)=XUNDEF
+ DO JP=1,IO%NPATCH
+ PK => NP%AL(JP)
+ DO JI=1,PK%NSIZE_P
+ IMASK = PK%NR_P(JI)
+ ZDG2(IMASK) = ZDG2(IMASK) + PK%XPATCH(JI) * PK%XDG2(JI)
+ JL = PK%NWG_LAYER(JI)
+ IF(JL/=NUNDEF)THEN
+ ZWORK2(JI,JP) = PK%XDG(JI,JL)
+ ZDTOT(IMASK) = ZDTOT(IMASK) + PK%XPATCH(JI) * PK%XDG(JI,JL)
+ ENDIF
+ ENDDO
+ ENDDO
+ !
+ !* Root depth
+ !
+ YRECFM='DROOT_DIF'
+ YCOMMENT='Root depth in ISBA-DIF'
+ DO JP = 1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NP%AL(JP)%XDROOT(:),ILU,S%XWORK_WR)
+ ENDDO
+ !
+ YRECFM='DG2_DIF'
+ YCOMMENT='DG2 depth in ISBA-DIF'
+ DO JP = 1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NP%AL(JP)%XDG2(:),ILU,S%XWORK_WR)
+ ENDDO
+ !
+ IF(IO%NPATCH>1)THEN
+ YRECFM='DG2_DIF_ISBA'
+ YCOMMENT='Averaged DG2 depth in ISBA-DIF'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,ZDG2(:),IRESP,HCOMMENT=YCOMMENT)
+ ENDIF
+ !
+ !* Runoff depth
+ !
+ YRECFM='RUNOFFD'
+ YCOMMENT='Runoff deph in ISBA-DIF'
+ DO JP = 1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NP%AL(JP)%XRUNOFFD(:),ILU,S%XWORK_WR)
+ ENDDO
+ !
+ !* Total soil depth for mositure
+ !
+ YRECFM='DTOT_DIF'
+ YCOMMENT='Total soil depth for moisture in ISBA-DIF'
+ DO JP = 1,IO%NPATCH
+ PK => NP%AL(JP)
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,ZWORK2(1:PK%NSIZE_P,JP),ILU,S%XWORK_WR)
+ ENDDO
+ DEALLOCATE(ZWORK2)
+ !
+ IF(IO%NPATCH>1)THEN
+ YRECFM='DTOTDF_ISBA'
+ YCOMMENT='Averaged Total soil depth for moisture in ISBA-DIF'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,ZDTOT(:),IRESP,HCOMMENT=YCOMMENT)
+ ENDIF
+ !
+ !* Root fraction for each patch
+ !
+ ALLOCATE(ZWORK1(ILU))
+ DO JL=1,SIZE(PK%XROOTFRAC,2)
+ DO JP = 1,IO%NPATCH
+ PK => NP%AL(JP)
+ IF (JL<10) THEN
+ WRITE(YRECFM,FMT='(A8,I1)') 'ROOTFRAC',JL
+ ELSE
+ WRITE(YRECFM,FMT='(A8,I2)') 'ROOTFRAC',JL
+ ENDIF
+ YCOMMENT='root fraction by layer (-)'
+ ZWORK1(:)=XUNDEF
+ DO JI=1,SIZE(PK%XDG,1)
+ IF(JL<=PK%NWG_LAYER(JI).AND.PK%NWG_LAYER(JI)/=NUNDEF) THEN
+ ZWORK1(JI) = PK%XROOTFRAC(JI,JL)
+ ENDIF
+ ENDDO
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,ZWORK1(1:PK%NSIZE_P),ILU,S%XWORK_WR)
+ ENDDO
+ END DO
+ DEALLOCATE(ZWORK1)
+ !
+ !* SOC fraction for each layer
+ !
+ IF(IO%LSOC)THEN
+ DO JL=1,SIZE(NP%AL(1)%XDG,2)
+ IF (JL<10) THEN
+ WRITE(YRECFM,FMT='(A7,I1)') 'FRACSOC',JL
+ ELSE
+ WRITE(YRECFM,FMT='(A7,I2)') 'FRACSOC',JL
+ ENDIF
+ YCOMMENT='SOC fraction by layer (-)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,S%XFRACSOC(:,JL),IRESP,HCOMMENT=YCOMMENT)
+ ENDDO
+ ENDIF
+!
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+DO JL=1,SIZE(NP%AL(1)%XDG,2)
+ IF (JL<10) THEN
+ WRITE(YRECFM,FMT='(A4,I1)') 'WSAT',JL
+ ELSE
+ WRITE(YRECFM,FMT='(A4,I2)') 'WSAT',JL
+ ENDIF
+ YCOMMENT='soil porosity by layer (m3/m3)'
+ CALL WRITE_SURF(HSELECT, &
+ HPROGRAM,YRECFM,K%XWSAT(:,JL),IRESP,HCOMMENT=YCOMMENT)
+ENDDO
+!
+DO JL=1,SIZE(NP%AL(1)%XDG,2)
+ IF (JL<10) THEN
+ WRITE(YRECFM,FMT='(A3,I1)') 'WFC',JL
+ ELSE
+ WRITE(YRECFM,FMT='(A3,I2)') 'WFC',JL
+ ENDIF
+ YCOMMENT='field capacity by layer (m3/m3)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,K%XWFC(:,JL),IRESP,HCOMMENT=YCOMMENT)
+ENDDO
+!
+DO JL=1,SIZE(NP%AL(1)%XDG,2)
+ IF (JL<10) THEN
+ WRITE(YRECFM,FMT='(A5,I1)') 'WWILT',JL
+ ELSE
+ WRITE(YRECFM,FMT='(A5,I2)') 'WWILT',JL
+ ENDIF
+ YCOMMENT='wilting point by layer (m3/m3)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,K%XWWILT(:,JL),IRESP,HCOMMENT=YCOMMENT)
+ENDDO
+!
+!-------------------------------------------------------------------------------
+! For Earth System Model
+IF(LFANOCOMPACT.AND..NOT.LPREP)THEN
+ CALL END_IO_SURF_n(HPROGRAM)
+ IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_PGD_ISBA_N',1,ZHOOK_HANDLE)
+ RETURN
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+YRECFM='Z0REL'
+YCOMMENT='orography roughness length (M)'
+!
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,ISS%XZ0REL(:),IRESP,HCOMMENT=YCOMMENT)
+!
+!-------------------------------------------------------------------------------
+!
+!* Runoff soil ice depth for each patch
+!
+IF(IO%CHORT=='SGH'.AND.IO%CISBA/='DIF')THEN
+ YRECFM='DICE'
+ YCOMMENT='soil ice depth for runoff (m)'
+ DO JP = 1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NP%AL(JP)%XD_ICE(:),ILU,S%XWORK_WR)
+ ENDDO
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+!* Fraction of each vegetation type in the grid cell
+!
+DO JL=1,SIZE(S%XVEGTYPE_PATCH,2)
+ WRITE(YPAS,'(I2)') JL
+ YLVLV=ADJUSTL(YPAS(:LEN_TRIM(YPAS)))
+ WRITE(YRECFM,FMT='(A9)') 'VEGTYPE'//YLVLV
+ YCOMMENT='fraction of each vegetation type in the grid cell'//' (-)'
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,S%XVEGTYPE(:,JL),IRESP,HCOMMENT=YCOMMENT)
+END DO
+!-------------------------------------------------------------------------------
+!
+!* Fraction of each vegetation type for each patch
+!
+IF(IO%NPATCH>1.AND.SIZE(S%XVEGTYPE_PATCH,2)/=SIZE(S%XVEGTYPE_PATCH,3))THEN
+!
+ DO JL=1,SIZE(S%XVEGTYPE_PATCH,2)
+ WRITE(YPAS,'(I2)') JL
+ YLVLV=ADJUSTL(YPAS(:LEN_TRIM(YPAS)))
+ WRITE(YRECFM,FMT='(A9)') 'VEGTY_'//YLVLV
+ YCOMMENT='fraction of each vegetation type in each patch'//' (-)'
+ DO JP = 1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NP%AL(JP)%XVEGTYPE_PATCH(:,JL),ILU,S%XWORK_WR)
+ ENDDO
+ END DO
+!
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+!* other surface parameters
+!
+YRECFM='RSMIN'
+YCOMMENT='minimum stomatal resistance (sm-1)'
+DO JP = 1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NPE%AL(JP)%XRSMIN(:),ILU,S%XWORK_WR)
+ENDDO
+!
+YRECFM='GAMMA'
+YCOMMENT='coefficient for RSMIN calculation (-)'
+DO JP = 1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NPE%AL(JP)%XGAMMA(:),ILU,S%XWORK_WR)
+ENDDO
+!
+YRECFM='CV'
+YCOMMENT='vegetation thermal inertia coefficient (-)'
+DO JP = 1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NPE%AL(JP)%XCV(:),ILU,S%XWORK_WR)
+ENDDO
+!
+YRECFM='RGL'
+YCOMMENT='maximum solar radiation usable in photosynthesis (-)'
+DO JP = 1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NPE%AL(JP)%XRGL(:),ILU,S%XWORK_WR)
+ENDDO
+!
+YRECFM='EMIS_ISBA'
+YCOMMENT='surface emissivity (-)'
+DO JP = 1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NPE%AL(JP)%XEMIS(:),ILU,S%XWORK_WR)
+ENDDO
+!
+YRECFM='WRMAX_CF'
+YCOMMENT='coefficient for maximum water interception (-)'
+DO JP = 1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NPE%AL(JP)%XWRMAX_CF(:),ILU,S%XWORK_WR)
+ENDDO
+!
+IF (ISIZE_LMEB_PATCH>0) THEN
+ !
+ YRECFM='H_VEG'
+ YCOMMENT='MEB: height of vegetation (m)'
+ DO JP = 1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NPE%AL(JP)%XH_VEG(:),ILU,S%XWORK_WR)
+ ENDDO
+ !
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+IF (OSURF_DIAG_ALBEDO) THEN
+!
+!* Soil albedos
+!
+!
+ YRECFM='ALBNIR_S'
+ YCOMMENT='soil near-infra-red albedo (-)'
+ DO JP=1,IO%NPATCH
+ CALL UNPACK_SAME_RANK(NP%AL(JP)%NR_P, NPE%AL(JP)%XALBNIR_SOIL, ZWORK(:,JP))
+ WHERE (ZWORK(:,JP)/=XUNDEF) ZWORK(:,1) = ZWORK(:,JP)
+ ENDDO
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,ZWORK(:,1),IRESP,HCOMMENT=YCOMMENT)
+!
+!-------------------------------------------------------------------------------
+!
+ YRECFM='ALBVIS_S'
+ YCOMMENT='soil visible albedo (-)'
+ DO JP=1,IO%NPATCH
+ CALL UNPACK_SAME_RANK(NP%AL(JP)%NR_P, NPE%AL(JP)%XALBVIS_SOIL, ZWORK(:,JP))
+ WHERE (ZWORK(:,JP)/=XUNDEF) ZWORK(:,1) = ZWORK(:,JP)
+ ENDDO
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,ZWORK(:,1),IRESP,HCOMMENT=YCOMMENT)
+!
+!-------------------------------------------------------------------------------
+!
+ YRECFM='ALBUV_S'
+ YCOMMENT='soil UV albedo (-)'
+ DO JP=1,IO%NPATCH
+ CALL UNPACK_SAME_RANK(NP%AL(JP)%NR_P, NPE%AL(JP)%XALBUV_SOIL, ZWORK(:,JP))
+ WHERE (ZWORK(:,JP)/=XUNDEF) ZWORK(:,1) = ZWORK(:,JP)
+ ENDDO
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,ZWORK(:,1),IRESP,HCOMMENT=YCOMMENT)
+!
+!-------------------------------------------------------------------------------
+!
+!* albedos
+!
+ YRECFM='ALBNIR'
+ YCOMMENT='total near-infra-red albedo (-)'
+ DO JP = 1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NPE%AL(JP)%XALBNIR(:),ILU,S%XWORK_WR)
+ ENDDO
+!
+!-------------------------------------------------------------------------------
+!
+ YRECFM='ALBVIS'
+ YCOMMENT='total visible albedo (-)'
+ DO JP = 1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NPE%AL(JP)%XALBVIS(:),ILU,S%XWORK_WR)
+ ENDDO
+!
+!-------------------------------------------------------------------------------
+!
+ YRECFM='ALBUV'
+ YCOMMENT='total UV albedo (-)'
+ DO JP = 1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NPE%AL(JP)%XALBUV(:),ILU,S%XWORK_WR)
+ ENDDO
+!
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* chemical soil resistances
+!
+IF (CHI%CCH_DRY_DEP=='WES89' .AND. CHI%SVI%NBEQ>0) THEN
+ YRECFM='SOILRC_SO2'
+ YCOMMENT='bare soil resistance for SO2 (?)'
+ DO JP = 1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NCHI%AL(JP)%XSOILRC_SO2(:),ILU,S%XWORK_WR)
+ ENDDO
+ !
+ YRECFM='SOILRC_O3'
+ YCOMMENT='bare soil resistance for O3 (?)'
+ DO JP = 1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NCHI%AL(JP)%XSOILRC_O3(:),ILU,S%XWORK_WR)
+ ENDDO
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+IF (LAGRIP .AND. (IO%CPHOTO=='NIT' .OR. IO%CPHOTO=='NCB') ) THEN
+!
+!* seeding and reaping
+!
+ YRECFM='TSEED'
+ YCOMMENT='date of seeding (-)'
+ !
+ DO JP = 1,IO%NPATCH
+ CALL WRITE_TFIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NPE%AL(JP)%TSEED(:),ILU,S%TDATE_WR)
+ ENDDO
+!
+ YRECFM='TREAP'
+ YCOMMENT='date of reaping (-)'
+!
+ DO JP = 1,IO%NPATCH
+ CALL WRITE_TFIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NPE%AL(JP)%TREAP(:),ILU,S%TDATE_WR)
+ ENDDO
+!
+!-------------------------------------------------------------------------------
+!
+!* irrigated fraction
+!
+ YRECFM='IRRIG'
+ YCOMMENT='flag for irrigation (irrigation if >0.) (-)'
+!
+ DO JP = 1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NPE%AL(JP)%XIRRIG(:),ILU,S%XWORK_WR)
+ ENDDO
+!
+!-------------------------------------------------------------------------------
+!
+!* water supply for irrigation
+!
+ YRECFM='WATSUP'
+ YCOMMENT='water supply during irrigation process (mm)'
+!
+ DO JP = 1,IO%NPATCH
+ CALL WRITE_FIELD_1D_PATCH(HSELECT,HPROGRAM,YRECFM,YCOMMENT,JP,&
+ NP%AL(JP)%NR_P,NPE%AL(JP)%XWATSUP(:),ILU,S%XWORK_WR)
+ ENDDO
+!
+ENDIF
+!
+!-------------------------------------------------------------------------------
+! End of IO
+!
+ CALL END_IO_SURF_n(HPROGRAM)
+IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_PGD_ISBA_N',1,ZHOOK_HANDLE)
+!
+!
+END SUBROUTINE WRITE_DIAG_PGD_ISBA_n