Gaelle 26/04/2018 : add MEGAN PACK-MNH-V5-4--0-11_MEGAN
authorGaelle DELAUTIER <gaelle.delautier@meteo.fr>
Thu, 26 Apr 2018 12:43:16 +0000 (14:43 +0200)
committerGaelle DELAUTIER <gaelle.delautier@meteo.fr>
Thu, 26 Apr 2018 12:43:16 +0000 (14:43 +0200)
48 files changed:
A-INSTALL
src/Makefile.MESONH.mk
src/SURFEX/averaged_albedo_emis_isba.F90
src/SURFEX/ch_dep_isba.F90
src/SURFEX/ch_init_dep_isban.F90
src/SURFEX/ch_init_emissionn.F90
src/SURFEX/compute_isba_parameters.F90
src/SURFEX/coupling_isba_canopyn.F90
src/SURFEX/coupling_isba_orographyn.F90
src/SURFEX/coupling_isba_svatn.F90
src/SURFEX/coupling_isban.F90
src/SURFEX/coupling_tsz0n.F90
src/SURFEX/dealloc_isban.F90
src/SURFEX/fapair.F90
src/SURFEX/garden.F90
src/SURFEX/greenroof.F90
src/SURFEX/init_isban.F90
src/SURFEX/init_naturen.F90
src/SURFEX/init_surf_atmn.F90
src/SURFEX/init_teb_garden_pgdn.F90
src/SURFEX/init_teb_greenroof_pgdn.F90
src/SURFEX/init_tebn.F90
src/SURFEX/isba.F90
src/SURFEX/isba_meb.F90
src/SURFEX/modd_ch_isban.F90
src/SURFEX/modd_ch_surfn.F90
src/SURFEX/modd_ch_tebn.F90
src/SURFEX/modd_surfexn.F90
src/SURFEX/modn_isban.F90
src/SURFEX/pgd_surf_atm.F90
src/SURFEX/radiative_transfert.F90
src/SURFEX/read_default_isban.F90
src/SURFEX/read_isba_confn.F90
src/SURFEX/read_nam_pgd_chemistry.F90
src/SURFEX/read_namelists_isban.F90
src/SURFEX/read_pgd_isban.F90
src/SURFEX/read_pgd_teb_gardenn.F90
src/SURFEX/read_pgd_teb_greenroofn.F90
src/SURFEX/surfex_alloc.F90
src/SURFEX/update_rad_isban.F90
src/SURFEX/write_isban.F90
src/SURFEX/write_pgd_surf_atmn.F90
src/SURFEX/writesurf_ch_emisn.F90
src/SURFEX/writesurf_isba_confn.F90
src/SURFEX/writesurf_isban.F90
src/SURFEX/zoom_pgd_isba.F90
src/SURFEX/zoom_pgd_nature.F90
src/configure

index 9c9ec44..35e1944 100644 (file)
--- a/A-INSTALL
+++ b/A-INSTALL
@@ -23,8 +23,9 @@
 #       IX) OPTIONAL COMPILATION
 #           a) MNH_FOREFIRE for forefire runs ( external package needed )
 #           b) MNH_RTTOV for optional radiative computation
-#           c) MNH_ECRAD for optional compilation of new ECRAD radiative library from ECMWF 
-#           d) cleaning previous compiled version
+#           c) MNH_ECRAD for optional compilation of new ECRAD radiative library from ECMWF
+#           d) MNH_MEGAN for optional compilation of MEGAN 
+#           e) cleaning previous compiled version
 #
 #
 ^L
@@ -1021,11 +1022,19 @@ etc ...
 # REM : the 'profile_mesonh...' file & the 'dir_obj...' directory will be suffixed with an ECRAD extension 
 #
 #  Usage :
-#   1) In namelist replace RAD='ECMW' be RAD='ECRAD
+#   1) In namelist replace RAD='ECMW' be RAD='ECRA' 
 #   2) Add link to 'ecrad-1.0.1/data' files 
 #      see 007_16janvier/008_run2 test case for example
+#
+# d) MNH_MEGAN for optional compilation of MEGAN code 
+# --------------------------------------
+#
+# Configure & Compilation
+export MNH_MEGAN=1
+./configure
 
-# d) cleaning previous compiled version
+etc ...
+# e) cleaning previous compiled version
 # --------------------------------------
 #
 # If you have already compiled exactly the same version of MesoNH on this computer ( same $XYZ value )
index 6c8d4af..90a0d53 100644 (file)
@@ -204,6 +204,18 @@ CPPFLAGS_MNH += -DMNH_RTTOV_11=MNH_RTTOV_11
 endif
 endif
 ##########################################################
+#           Source MEGAN                                 #
+##########################################################
+ifdef MNH_MEGAN
+DIR_MEGAN      +=  LIB/MEGAN 
+CPPFLAGS_MEGAN = -DMNH_MEGAN
+#
+DIR_MASTER  += $(DIR_MEGAN)
+CPPFLAGS    += $(CPPFLAGS_MEGAN)
+INC         += $(INC_MEGAN)
+CPPFLAGS_MNH += -DMNH_MEGAN=${MNH_MEGAN}
+endif
+##########################################################
 #           Source NEWLFI                                #
 ##########################################################
 DIR_NEWLFI      += LIB/NEWLFI/src
index 40a86b1..c71be81 100644 (file)
@@ -5,7 +5,8 @@
 !     #########
       SUBROUTINE AVERAGED_ALBEDO_EMIS_ISBA (IO, S, NK, NP, NPE, &
                                  PZENITH, PTG1, PSW_BANDS, PDIR_ALB, PSCA_ALB, &
-                                 PEMIS, PTSRAD, PTSURF, PDIR_SW, PSCA_SW        )
+                                 PEMIS, PTSRAD, PTSURF, PDIR_SW, PSCA_SW,      & 
+                                 PRN_SHADE, PRN_SUNLIT        )
 !     ###################################################
 !
 !!**** ** computes radiative fields used in ISBA
@@ -90,6 +91,8 @@ REAL, DIMENSION(:),     INTENT(OUT)  :: PTSURF      ! surface effective temperat
 REAL, DIMENSION(:,:),   INTENT(IN), OPTIONAL   :: PDIR_SW ! Downwelling direct SW radiation
 REAL, DIMENSION(:,:),   INTENT(IN), OPTIONAL   :: PSCA_SW ! Downwelling diffuse SW radiation
 !
+REAL, DIMENSION(:),   INTENT(INOUT), OPTIONAL :: PRN_SHADE
+REAL, DIMENSION(:),   INTENT(INOUT), OPTIONAL :: PRN_SUNLIT
 !
 !*    0.2    Declaration of local variables
 !            ------------------------------
@@ -179,13 +182,14 @@ DO JP = 1,IO%NPATCH
     !
     CALL UPDATE_RAD_ISBA_n(IO, S, NK%AL(JP), NP%AL(JP), NPE%AL(JP), JP, PZENITH, PSW_BANDS,   &
                            ZDIR_ALB_PATCH(:,:,JP), ZSCA_ALB_PATCH(:,:,JP), ZEMIS_PATCH(:,JP), &
-                           PDIR_SW, PSCA_SW    )
+                           PRN_SHADE, PRN_SUNLIT, PDIR_SW, PSCA_SW    )
   ELSE
     !
     ! For cases when MEB patch albedo is not requested no downweeling SW is needed
     !
-    CALL UPDATE_RAD_ISBA_n(IO, S, NK%AL(JP), NP%AL(JP), NPE%AL(JP), JP, PZENITH, PSW_BANDS, &
-                           ZDIR_ALB_PATCH(:,:,JP), ZSCA_ALB_PATCH(:,:,JP), ZEMIS_PATCH(:,JP))
+    CALL UPDATE_RAD_ISBA_n(IO, S, NK%AL(JP), NP%AL(JP), NPE%AL(JP), JP, PZENITH, PSW_BANDS,  &
+                           ZDIR_ALB_PATCH(:,:,JP), ZSCA_ALB_PATCH(:,:,JP), ZEMIS_PATCH(:,JP),&
+                           PRN_SHADE, PRN_SUNLIT)
     !
   ENDIF
   !
index a7e18a7..1ce16c8 100644 (file)
@@ -408,7 +408,9 @@ DO JSV = 1, KSIZE
     ENDIF
     !
     ! computes resistance due to soil and vegetation
-    ZNATRC(JI,JSV) = 1./ ( PEK%XVEG(JI)/ZNATRC(JI,JSV) + (1.-PEK%XVEG(JI))/ZBARERC(JI,JSV) ) 
+    IF ( PEK%XVEG(JI)>0. ) THEN
+      ZNATRC(JI,JSV) = 1./ ( PEK%XVEG(JI)/ZNATRC(JI,JSV) + (1.-PEK%XVEG(JI))/ZBARERC(JI,JSV) ) 
+    ENDIF
     ! 
   ENDDO
   !
index ede4fe7..7510983 100644 (file)
@@ -150,7 +150,7 @@ REAL(KIND=JPRB) :: ZHOOK_HANDLE
       !
       !*       3.    read surface resistance SURF_RES
       !
-      ALLOCATE(NCHI%AL(JP)%XDEP(KLU,CHI%SVI%NBEQ))
+      ALLOCATE(NCHI%AL(JP)%XDEP(NP%AL(JP)%NSIZE_P,CHI%SVI%NBEQ))
       !
     ENDDO
     !
index 0210bb9..041cfc9 100644 (file)
@@ -28,7 +28,7 @@
 !!      P.Tulet  01/01/04  introduction of rhodref for externalization
 !!      M.Leriche 04/2014  change length of CHARACTER for emission 6->12
 !!      M.Leriche & V. Masson 05/16 bug in write emis fields for nest
-!!      06/06/17    (V.Masson & M. Leriche) add emission time by species
+!!      J. Pianezze 04/17 wrong length of YCOMMENT (100 instead of 40)
 !-----------------------------------------------------------------------------
 !
 !*       0.    DECLARATIONS
@@ -131,7 +131,8 @@ ELSE
   WRITE(ILUOUT,*) 'CEMIS_NAME already allocated with SIZE :',SIZE(CHE%CEMIS_NAME)
 END IF
 
-IF (.NOT. ASSOCIATED(CHE%NEMIS_NBT))   ALLOCATE(CHE%NEMIS_NBT(CHE%NEMISPEC_NBR))
+IF (.NOT. ASSOCIATED(CHE%CEMIS_AREA))   ALLOCATE(CHE%CEMIS_AREA(CHE%NEMISPEC_NBR))
+IF (.NOT. ASSOCIATED(CHE%NEMIS_NBT))    ALLOCATE(CHE%NEMIS_NBT (CHE%NEMISPEC_NBR))
 IF (.NOT. ASSOCIATED(CHE%NEMIS_TIME))   ALLOCATE(CHE%NEMIS_TIME(CHE%NEMIS_NBR))
 CHE%NEMIS_TIME(:) = -1
 !
@@ -161,6 +162,8 @@ DO JSPEC = 1,CHE%NEMISPEC_NBR ! Loop on the number of species
     CALL ABOR1_SFX('CH_INIT_EMISSIONN: PROBLEM WHEN READING NAME OF EMITTED CHEMICAL SPECIES')
   END IF
 
+  WRITE(YRECFM,'("EMISAREA",I3.3)') JSPEC
+  CALL READ_SURF(HPROGRAM,YRECFM,YSURF,IRESP,YCOMMENT)
   WRITE(YRECFM,'("EMISNBT",I3.3)') JSPEC
   CALL READ_SURF(HPROGRAM,YRECFM,INBTS,IRESP,YCOMMENT)
   WRITE(ILUOUT,*) ' Emission ',JSPEC,' : ',TRIM(YSPEC_NAME),'(',INBTS,' instants )'
@@ -192,9 +195,10 @@ DO JSPEC = 1,CHE%NEMISPEC_NBR ! Loop on the number of species
 !
 CHE%NTIME_MAX = MAXVAL(CHE%NEMIS_TIME)
 !
-! INBTIMES and CEMIS_NAME 
+! INBTIMES, CEMIS_AREA and CEMIS_NAME 
 ! are updated for ALL species
   CHE%CEMIS_NAME(JSPEC) = YSPEC_NAME
+  CHE%CEMIS_AREA(JSPEC) = YSURF
 ! 
 !*      2.     Simple reading of emission fields
 
index 16e2a19..39fb20d 100644 (file)
@@ -5,11 +5,11 @@
 !#############################################################
 SUBROUTINE COMPUTE_ISBA_PARAMETERS (DTCO, OREAD_BUDGETC, UG, U, &
                                     IO, DTI, SB, S, IG, K, NK, NIG, NP, NPE,   &
-                                    NAG, NISS, ISS, NCHI, CHI, ID, GB, NGB,    &
-                                    NDST, SLT, BLOWSNW, SV, HPROGRAM,HINIT,OLAND_USE, &
-                                    KI,KSV,KSW,HSV,PCO2,PRHOA,                 &
+                                    NAG, NISS, ISS, NCHI, CHI, MGN, MSF,  ID,  &
+                                    GB, NGB, NDST, SLT,BLOWSNW, SV, HPROGRAM,HINIT,    &
+                                    OLAND_USE,KI,KSV,KSW,HSV,PCO2,PRHOA,       &
                                     PZENITH,PSW_BANDS,PDIR_ALB,PSCA_ALB,       &
-                                    PEMIS,PTSRAD,PTSURF, HTEST             )  
+                                    PEMIS,PTSRAD,PTSURF, PMEGAN_FIELDS, HTEST  )  
 !#############################################################
 !
 !!****  *COMPUTE_ISBA_PARAMETERS_n* - routine to initialize ISBA
@@ -59,6 +59,7 @@ SUBROUTINE COMPUTE_ISBA_PARAMETERS (DTCO, OREAD_BUDGETC, UG, U, &
 !!      P. Samuelsson  02/14 : MEB
 !!      B. Decharme    01/16 : Bug when vegetation veg, z0 and emis are imposed whith interactive vegetation
 !!      B. Decharme   10/2016  bug surface/groundwater coupling 
+!!      P. Tulet       06/2016 : call init_megan for coupling megan with surfex
 !!
 !-------------------------------------------------------------------------------
 !
@@ -85,6 +86,9 @@ USE MODD_SLT_n, ONLY : SLT_t
 USE MODD_SV_n, ONLY : SV_t
 USE MODD_BLOWSNW_n, ONLY : BLOWSNW_t
 !
+USE MODD_MEGAN_n, ONLY : MEGAN_t
+USE MODD_MEGAN_SURF_FIELDS_n, ONLY : MEGAN_SURF_FIELDS_t
+!
 USE MODD_SFX_OASIS,  ONLY : LCPL_LAND, LCPL_FLOOD, LCPL_GW, LCPL_CALVING
 !
 !
@@ -151,6 +155,8 @@ USE MODI_FIX_MEB_VEG
 USE MODI_AV_PGD
 USE MODI_SURF_PATCH
 !
+USE MODI_INIT_MEGAN_n
+!
 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
 USE PARKIND1  ,ONLY : JPRB
 !
@@ -179,6 +185,8 @@ TYPE(SSO_NP_t), INTENT(INOUT) :: NISS
 TYPE(SSO_t), INTENT(INOUT) :: ISS
 TYPE(CH_ISBA_NP_t), INTENT(INOUT) :: NCHI
 TYPE(CH_ISBA_t), INTENT(INOUT) :: CHI
+TYPE(MEGAN_t), INTENT(INOUT) :: MGN
+TYPE(MEGAN_SURF_FIELDS_t), INTENT(INOUT) :: MSF
 TYPE(ISBA_DIAG_t), INTENT(INOUT) :: ID
 TYPE(GR_BIOG_t), INTENT(INOUT) :: GB
 TYPE(GR_BIOG_NP_t), INTENT(INOUT) :: NGB
@@ -204,6 +212,7 @@ REAL,             DIMENSION(KI,KSW),INTENT(OUT) :: PSCA_ALB  ! diffuse albedo fo
 REAL,             DIMENSION(KI),  INTENT(OUT) :: PEMIS     ! emissivity
 REAL,             DIMENSION(KI),  INTENT(OUT) :: PTSRAD    ! radiative temperature
 REAL,             DIMENSION(KI),  INTENT(OUT) :: PTSURF    ! surface effective temperature         (K)
+REAL,             DIMENSION(KI,MSF%NMEGAN_NBR),INTENT(IN) :: PMEGAN_FIELDS
 !
  CHARACTER(LEN=2),                 INTENT(IN)  :: HTEST       ! must be equal to 'OK'
 !
@@ -1086,6 +1095,16 @@ PEMIS  = S%XEMIS_NAT
 PTSRAD = ZTSRAD_NAT
 PTSURF = ZTSURF_NAT
 !
+IF (CHI%LCH_BIO_FLUX .AND. TRIM(CHI%CPARAMBVOC) == 'MEGAN') THEN
+  IF (IO%CPHOTO/='NON') THEN
+    CALL INIT_MEGAN_n(IO, S, K, NP, MSF, MGN, &
+                      IG%XLAT, CHI%SVI%CSV(CHI%SVI%NSV_CHSBEG:CHI%SVI%NSV_CHSEND), &
+                      PMEGAN_FIELDS)
+  ELSE
+    CALL ABOR1_SFX("INIT_MEGAN: CPHOTO need to be 'AGS', 'LAI', 'AST', 'LST', 'NIT' options ")
+  END IF
+END IF
+!
 !-------------------------------------------------------------------------------
 !
 !*      15.     ISBA diagnostics initialization
index 737cee7..599efbf 100644 (file)
@@ -3,7 +3,7 @@
 !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_ISBA_CANOPY_n (DTCO, UG, U, USS, SB, NAG, CHI, NCHI, DTV, ID, NGB, GB, &
+SUBROUTINE COUPLING_ISBA_CANOPY_n (DTCO, UG, U, USS, SB, NAG, CHI, NCHI, MGN,MSF, DTV, ID, NGB, GB, &
                                    ISS, NISS, IG, NIG, IO, S, K, NK, NP, NPE, NDST, SLT,   &
                                    BLOWSNW, HPROGRAM, HCOUPLING, PTSTEP,                   &
                                    KYEAR, KMONTH, KDAY, PTIME, KI, KSV, KSW, PTSUN,        &
@@ -43,6 +43,8 @@ SUBROUTINE COUPLING_ISBA_CANOPY_n (DTCO, UG, U, USS, SB, NAG, CHI, NCHI, DTV, ID
 !
 USE MODD_AGRI_n, ONLY : AGRI_NP_t
 USE MODD_CH_ISBA_n, ONLY : CH_ISBA_t, CH_ISBA_NP_t
+USE MODD_MEGAN_n, ONLY : MEGAN_t
+USE MODD_MEGAN_SURF_FIELDS_n, ONLY : MEGAN_SURF_FIELDS_t
 USE MODD_DATA_ISBA_n, ONLY : DATA_ISBA_t
 USE MODD_SURFEX_n, ONLY : ISBA_DIAG_t
 USE MODD_GR_BIOG_n, ONLY : GR_BIOG_t, GR_BIOG_NP_t
@@ -93,6 +95,8 @@ IMPLICIT NONE
 TYPE(AGRI_NP_t), INTENT(INOUT) :: NAG
 TYPE(CH_ISBA_t), INTENT(INOUT) :: CHI
 TYPE(CH_ISBA_NP_t), INTENT(INOUT) :: NCHI
+TYPE(MEGAN_t), INTENT(INOUT) :: MGN
+TYPE(MEGAN_SURF_FIELDS_t), INTENT(INOUT) :: MSF
 TYPE(DATA_ISBA_t), INTENT(INOUT) :: DTV
 TYPE(ISBA_DIAG_t), INTENT(INOUT) :: ID
 TYPE(GR_BIOG_NP_t), INTENT(INOUT) :: NGB
@@ -424,7 +428,7 @@ END IF
 !*      2.     Call of ISBA
 !              ------------
 !
- CALL COUPLING_ISBA_n(DTCO, UG, U, USS, NAG, CHI, NCHI, DTV, ID, NGB, GB, ISS,NISS, IG, &
+ CALL COUPLING_ISBA_n(DTCO, UG, U, USS, NAG, CHI, NCHI, MGN,MSF, DTV, ID, NGB, GB, ISS,NISS, IG, &
                       NIG, IO, S, K, NK, NP, NPE, NDST, SLT, HPROGRAM, GCOUPLING,       &
                       PTSTEP, KYEAR, KMONTH, KDAY, PTIME, KI, KSV, KSW, PTSUN, PZENITH, &
                       PZENITH2, ZZREF, ZUREF, PZS, ZU, ZV, ZQA, ZTA, PRHOA, ZSV, PCO2,  &
index df3e016..267cd5e 100644 (file)
@@ -3,7 +3,7 @@
 !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_ISBA_OROGRAPHY_n (DTCO, UG, U, USS, SB, NAG, CHI, NCHI, DTV, ID, NGB, GB, &
+SUBROUTINE COUPLING_ISBA_OROGRAPHY_n (DTCO, UG, U, USS, SB, NAG, CHI, NCHI, MGN, MSF,DTV, ID, NGB, GB, &
                                       ISS, NISS, IG, NIG, IO, S, K, NK, NP, NPE, NDST, SLT,   &
                                       BLOWSNW,HPROGRAM, HCOUPLING, PTSTEP,                    &
                                       KYEAR, KMONTH, KDAY, PTIME, KI, KSV, KSW, PTSUN,        &
@@ -45,6 +45,8 @@ SUBROUTINE COUPLING_ISBA_OROGRAPHY_n (DTCO, UG, U, USS, SB, NAG, CHI, NCHI, DTV,
 !
 USE MODD_AGRI_n, ONLY : AGRI_NP_t
 USE MODD_CH_ISBA_n, ONLY : CH_ISBA_t, CH_ISBA_NP_t
+USE MODD_MEGAN_n, ONLY : MEGAN_t
+USE MODD_MEGAN_SURF_FIELDS_n, ONLY : MEGAN_SURF_FIELDS_t
 USE MODD_DATA_ISBA_n, ONLY : DATA_ISBA_t
 USE MODD_SURFEX_n, ONLY : ISBA_DIAG_t
 USE MODD_GR_BIOG_n, ONLY : GR_BIOG_t, GR_BIOG_NP_t
@@ -83,6 +85,8 @@ IMPLICIT NONE
 TYPE(AGRI_NP_t), INTENT(INOUT) :: NAG
 TYPE(CH_ISBA_t), INTENT(INOUT) :: CHI
 TYPE(CH_ISBA_NP_t), INTENT(INOUT) :: NCHI
+TYPE(MEGAN_t), INTENT(INOUT) :: MGN
+TYPE(MEGAN_SURF_FIELDS_t), INTENT(INOUT) :: MSF
 TYPE(DATA_ISBA_t), INTENT(INOUT) :: DTV
 TYPE(ISBA_DIAG_t), INTENT(INOUT) :: ID
 TYPE(GR_BIOG_NP_t), INTENT(INOUT) :: NGB
@@ -322,7 +326,7 @@ ENDIF
 !*      3.     Call of ISBA
 !              ------------
 !
- CALL COUPLING_ISBA_CANOPY_n(DTCO, UG, U, USS, SB, NAG, CHI, NCHI, DTV, ID, NGB, GB,   &
+ CALL COUPLING_ISBA_CANOPY_n(DTCO, UG, U, USS, SB, NAG, CHI, NCHI, MGN, MSF,DTV, ID, NGB, GB,   &
                              ISS, NISS, IG, NIG, IO, S, K, NK, NP, NPE, NDST, SLT,     &
                              BLOWSNW,HPROGRAM, HCOUPLING, PTSTEP,                      &
                              KYEAR, KMONTH, KDAY, PTIME, KI, KSV, KSW, PTSUN, PZENITH, &
index a01fe18..7e5dd2a 100644 (file)
@@ -232,7 +232,7 @@ ZWORK_Z0H= 0.0 ! work array for mean roughness length for heat
 !
 DO JT=1,IT
 !
-  CALL COUPLING_ISBA_OROGRAPHY_n(DTCO, UG, U, USS, IM%SB, IM%NAG, IM%CHI, IM%NCHI, IM%DTV,     &
+  CALL COUPLING_ISBA_OROGRAPHY_n(DTCO, UG, U, USS, IM%SB, IM%NAG, IM%CHI, IM%NCHI, IM%MGN, IM%MSF, IM%DTV,     &
                                  IM%ID, IM%NGB, IM%GB, IM%ISS, IM%NISS, IM%G, IM%NG, IM%O,     &
                                  IM%S, IM%K, IM%NK, IM%NP, IM%NPE, NDST, SLT, BLOWSNW,         &
                                  HPROGRAM, HCOUPLING, ZTSTEP, KYEAR, KMONTH, KDAY, PTIME, KI,  &
index 7f4ede4..1e87ac0 100644 (file)
@@ -3,8 +3,8 @@
 !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_ISBA_n (DTCO, UG, U, USS, NAG, CHI, NCHI, DTI, ID, NGB, GB,         &
-                            ISS, NISS, IG, NIG, IO, S, K, NK, NP, NPE, NDST, SLT,       &
+SUBROUTINE COUPLING_ISBA_n (DTCO, UG, U, USS, NAG, CHI, NCHI, MGN, MSF,  DTI, ID, NGB,  &
+                            GB, ISS, NISS, IG, NIG, IO, S, K, NK, NP, NPE, NDST, SLT,   &
                             HPROGRAM, HCOUPLING, PTSTEP,  KYEAR, KMONTH, KDAY, PTIME,   &
                             KI, KSV, KSW, PTSUN, PZENITH, PZENITH2, PZREF, PUREF, PZS,  &
                             PU, PV, PQA, PTA, PRHOA, PSV, PCO2, HSV, PRAIN, PSNOW, PLW, &
@@ -68,6 +68,7 @@ SUBROUTINE COUPLING_ISBA_n (DTCO, UG, U, USS, NAG, CHI, NCHI, DTI, ID, NGB, GB,
 !!      P Samuelsson 10/2014 : MEB
 !!      P. LeMoigne  12/2014 EBA scheme update
 !!      R. Seferian  05/2015 : Add coupling fiels to vegetation_evol call
+!!      P. Tulet     06/2016 : call coupling_megan add RN leaves for MEGAN
 !!-------------------------------------------------------------------
 !
 USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
@@ -76,6 +77,8 @@ USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
 !
 USE MODD_AGRI_n, ONLY : AGRI_NP_t
 USE MODD_CH_ISBA_n, ONLY : CH_ISBA_t, CH_ISBA_NP_t
+USE MODD_MEGAN_n, ONLY : MEGAN_t
+USE MODD_MEGAN_SURF_FIELDS_n, ONLY : MEGAN_SURF_FIELDS_t
 USE MODD_DATA_ISBA_n, ONLY : DATA_ISBA_t
 USE MODD_SURFEX_n, ONLY : ISBA_DIAG_t
 USE MODD_GR_BIOG_n, ONLY : GR_BIOG_t, GR_BIOG_NP_t
@@ -151,6 +154,8 @@ USE MODI_ISBA_BUDGET_INIT
 USE MODI_ISBA_BUDGET
 USE MODI_UNPACK_DIAG_PATCH_n
 !
+USE MODI_COUPLING_MEGAN_n
+!
 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
 USE PARKIND1  ,ONLY : JPRB
 !
@@ -166,6 +171,8 @@ TYPE(SSO_t), INTENT(INOUT) :: USS
 TYPE(AGRI_NP_t), INTENT(INOUT) :: NAG
 TYPE(CH_ISBA_t), INTENT(INOUT) :: CHI
 TYPE(CH_ISBA_NP_t), INTENT(INOUT) :: NCHI
+TYPE(MEGAN_t), INTENT(INOUT) :: MGN
+TYPE(MEGAN_SURF_FIELDS_t), INTENT(INOUT) :: MSF
 TYPE(DATA_ISBA_t), INTENT(INOUT) :: DTI
 TYPE(ISBA_DIAG_t), INTENT(INOUT) :: ID
 TYPE(GR_BIOG_NP_t), INTENT(INOUT) :: NGB
@@ -302,6 +309,9 @@ REAL, DIMENSION(KI, IO%NPATCH) :: ZCPL_ICEFLUX
 !
 REAL, DIMENSION(KI, IO%NPATCH) :: ZSW_FORBIO
 !
+REAL, DIMENSION(KI) :: ZRNSHADE
+REAL, DIMENSION(KI) :: ZRNSUNLIT
+!
 REAL                       :: ZCONVERTFACM0_SLT, ZCONVERTFACM0_DST
 REAL                       :: ZCONVERTFACM3_SLT, ZCONVERTFACM3_DST
 REAL                       :: ZCONVERTFACM6_SLT, ZCONVERTFACM6_DST
@@ -364,6 +374,9 @@ ZCPL_ICEFLUX(:,:) = 0.0
 !
 ZSW_FORBIO(:,:)   =  XUNDEF
 !
+ZRNSHADE(:)       = 0.0
+ZRNSUNLIT(:)      = 0.0
+!
 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 ! Forcing Modifications:
 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
@@ -571,7 +584,7 @@ ENDIF
 DO JP = 1,IO%NPATCH
   CALL UPDATE_RAD_ISBA_n(IO, S, NK%AL(JP), NP%AL(JP), NPE%AL(JP), JP, PZENITH2, PSW_BANDS, &
                          ZDIR_ALB_TILE(:,:,JP), ZSCA_ALB_TILE(:,:,JP),                     &
-                         ZEMIS_TILE(:,JP), PDIR_SW, PSCA_SW  )
+                         ZEMIS_TILE(:,JP), ZRNSHADE, ZRNSUNLIT, PDIR_SW, PSCA_SW  )
 ENDDO
 !
  CALL AVERAGE_RAD(S%XPATCH, ZDIR_ALB_TILE, ZSCA_ALB_TILE, ZEMIS_TILE, &
@@ -610,7 +623,8 @@ PTRAD = S%XTSRAD_NAT
 ! --------------------------------------------------------------------------------------
 !
 IF (CHI%SVI%NBEQ>0 .AND. CHI%LCH_BIO_FLUX) THEN
- CALL CH_BVOCEM_n(CHI%SVI, NGB, GB, IO, S, NP, NPE, ZSW_FORBIO, PRHOA, PSFTS)
+  IF (TRIM(CHI%CPARAMBVOC)=='SOLMON') &
+    CALL CH_BVOCEM_n(CHI%SVI, NGB, GB, IO, S, NP, NPE, ZSW_FORBIO, PRHOA, PSFTS)
 ENDIF
 !
 !SOILNOX
@@ -713,6 +727,10 @@ REAL, DIMENSION(PK%NSIZE_P) :: ZP_Z0FLOOD  !Floodplain
 REAL, DIMENSION(PK%NSIZE_P) :: ZP_FFGNOS   !Floodplain fraction over the ground without snow
 REAL, DIMENSION(PK%NSIZE_P) :: ZP_FFVNOS   !Floodplain fraction over vegetation without snow
 !
+REAL, DIMENSION(SIZE(MGN%XPFT,1),PK%NSIZE_P) :: ZP_PFT
+REAL, DIMENSION(SIZE(MGN%XEF,1),PK%NSIZE_P) :: ZP_EF
+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)
 !
 !*  Aggregated coeffs for evaporative flux calculations
@@ -741,6 +759,9 @@ REAL, DIMENSION(PK%NSIZE_P) :: ZP_WGI_INI
 REAL, DIMENSION(PK%NSIZE_P) :: ZP_WR_INI
 REAL, DIMENSION(PK%NSIZE_P) :: ZP_SWE_INI
 !
+REAL, DIMENSION(PK%NSIZE_P) :: ZP_RNSHADE
+REAL, DIMENSION(PK%NSIZE_P) :: ZP_RNSUNLIT
+!
 ! miscellaneous
 !
 REAL, DIMENSION(PK%NSIZE_P)               :: ZP_DEEP_FLUX ! Flux at the bottom of the soil
@@ -790,6 +811,15 @@ IF (IO%NPATCH==1) THEN
    ZP_EXNA(:)       = ZEXNA       (:)
    ZP_EXNS(:)       = ZEXNS       (:)
    ZP_ALFA(:)       = ZALFA       (:)
+
+   IF ((TRIM(CHI%CPARAMBVOC) == 'MEGAN') .AND. CHI%LCH_BIO_FLUX) THEN
+      ZP_PFT(:,:)  = MGN%XPFT  (:,:)
+      ZP_EF(:,:)   = MGN%XEF   (:,:)
+      IP_SLTYP(:)  = MGN%NSLTYP  (:)
+   END IF   
+   ZP_RNSHADE(:)    = ZRNSHADE    (:)
+   ZP_RNSUNLIT(:)   = ZRNSUNLIT   (:)
+
 ELSE
 !cdir nodep
 !cdir unroll=8
@@ -843,6 +873,20 @@ ELSE
     ENDDO
   ENDDO
 !
+  IF ((TRIM(CHI%CPARAMBVOC) == 'MEGAN') .AND. CHI%LCH_BIO_FLUX) THEN  
+    DO JJ=1,PK%NSIZE_P
+      JI=PK%NR_P(JJ)
+      ZP_PFT(:,JJ) = MGN%XPFT  (:,JI)
+      ZP_EF(:,JJ)  = MGN%XEF   (:,JI)
+      IP_SLTYP(JJ) = MGN%NSLTYP  (JI)
+    ENDDO
+  END IF
+  DO JJ=1,PK%NSIZE_P
+    JI=PK%NR_P(JJ)
+    ZP_RNSHADE(JJ)  = ZRNSHADE (JI)
+    ZP_RNSUNLIT(JJ) = ZRNSUNLIT(JI)
+  ENDDO
+  
 ENDIF
 !
 !--------------------------------------------------------------------------------------
@@ -962,7 +1006,7 @@ ZIRRIG_GR(:)= 0.
            ZP_ALBVIS_TSOIL, ZPALPHAN, ZZ0G_WITHOUT_SNOW, ZZ0_MEBV, ZZ0H_MEBV, ZZ0EFF_MEBV,    &
            ZZ0_MEBN, ZZ0H_MEBN, ZZ0EFF_MEBN, ZP_TDEEP_A, ZP_CO2, ZP_FFGNOS, ZP_FFVNOS,        &
            ZP_EMIS, ZP_USTAR, ZP_AC_AGG, ZP_HU_AGG, ZP_RESP_BIOMASS_INST, ZP_DEEP_FLUX,       &
-           ZIRRIG_GR, ZP_BLOWSNW_FLUX, ZP_BLOWSNW_CONC    )
+           ZIRRIG_GR, ZP_RNSHADE, ZP_RNSUNLIT, ZP_BLOWSNW_FLUX, ZP_BLOWSNW_CONC          )
 !
 ZP_TRAD = DK%XTSRAD
 DK%XLE  = PEK%XLE
@@ -1062,23 +1106,28 @@ END IF
 ! Chemical dry deposition :
 ! --------------------------------------------------------------------------------------
 IF (CHI%SVI%NBEQ>0) THEN
+  ZP_SFTS(:,CHI%SVI%NSV_CHSBEG:CHI%SVI%NSV_CHSEND) = 0.
+  ZP_SFTS(:,CHI%SVI%NSV_AERBEG:CHI%SVI%NSV_AEREND) = 0.        
   IF( CHI%CCH_DRY_DEP == "WES89") THEN
 
     IBEG = CHI%SVI%NSV_CHSBEG
     IEND = CHI%SVI%NSV_CHSEND 
     ISIZE = IEND - IBEG + 1 
 
-    CALL CH_DEP_ISBA(KK, PK, PEK, DK, DMK, CHIK, &
-                     ZP_USTAR, ZP_TA, ZP_PA, ZP_TRAD(:), ISIZE )  
+    IF (ANY(PEK%XLAI(:)/=XUNDEF) ) THEN    
+      CALL CH_DEP_ISBA(KK, PK, PEK, DK, DMK, CHIK, &
+                       ZP_USTAR, ZP_TA, ZP_PA, ZP_TRAD(:), ISIZE )  
  
-    ZP_SFTS(:,IBEG:IEND) = - ZP_SV(:,IBEG:IEND) * CHIK%XDEP(:,1:CHI%SVI%NBEQ)  
+      ZP_SFTS(:,IBEG:IEND) = - ZP_SV(:,IBEG:IEND) * CHIK%XDEP(:,1:CHI%SVI%NBEQ)  
 
-    IF (CHI%SVI%NAEREQ > 0 ) THEN
+      IF (CHI%SVI%NAEREQ > 0 ) THEN
        
-      IBEG = CHI%SVI%NSV_AERBEG
-      IEND = CHI%SVI%NSV_AEREND
-      CALL CH_AER_DEP(ZP_SV(:,IBEG:IEND), ZP_SFTS(:,IBEG:IEND), ZP_USTAR, PEK%XRESA, ZP_TA, ZP_RHOA)     
-    END IF
+        IBEG = CHI%SVI%NSV_AERBEG
+        IEND = CHI%SVI%NSV_AEREND
+        CALL CH_AER_DEP(ZP_SV(:,IBEG:IEND), ZP_SFTS(:,IBEG:IEND), ZP_USTAR, PEK%XRESA, ZP_TA, ZP_RHOA)     
+      END IF
+    ENDIF
+    
   ELSE
 
     IBEG = CHI%SVI%NSV_AERBEG
@@ -1090,6 +1139,20 @@ IF (CHI%SVI%NBEQ>0) THEN
 ENDIF
 !
 ! --------------------------------------------------------------------------------------
+! Chemical natural flux (BVOC, NOx) from MEGAN:
+! --------------------------------------------------------------------------------------
+IF (CHI%SVI%NBEQ>0 .AND. CHI%LCH_BIO_FLUX) THEN
+ IF ((TRIM(CHI%CPARAMBVOC) == 'MEGAN').AND.(ANY(PEK%XLAI(:)/=XUNDEF))) THEN
+
+ CALL COUPLING_MEGAN_n(MGN, CHI, GK, PEK, &
+                       KYEAR, KMONTH, KDAY, PTIME, IO%LTR_ML, &
+                       IP_SLTYP, ZP_PFT, ZP_EF, &
+                       ZP_TA, GBK%XIACAN, ZP_TRAD, ZP_RNSUNLIT, ZP_RNSHADE, &
+                       ZP_WIND, ZP_PA, ZP_QA, ZP_SFTS)
+
+ END IF
+ENDIF
+! --------------------------------------------------------------------------------------
 ! Dust deposition and emission:
 ! --------------------------------------------------------------------------------------
 !
index 712403d..e4f99ff 100644 (file)
@@ -207,7 +207,7 @@ ENDDO
 !*      3.     Call to surface scheme
 !              ----------------------
 !
- CALL COUPLING_ISBA_OROGRAPHY_n(DTCO, UG, U, USS, IM%SB, IM%NAG, IM%CHI, IM%NCHI, IM%DTV, IM%ID, &
+ CALL COUPLING_ISBA_OROGRAPHY_n(DTCO, UG, U, USS, IM%SB, IM%NAG, IM%CHI, IM%NCHI, IM%MGN, IM%MSF,IM%DTV, IM%ID, &
                                 IM%NGB, IM%GB, IM%ISS, IM%NISS, IM%G, IM%NG, IM%O, IM%S, IM%K, IM%NK, &
                                 IM%NP, IM%NPE, NDST, SLT,BLOWSNW, HPROGRAM, 'E', 0.001, KYEAR,   &
                                 KMONTH, KDAY, PTIME,  KI, KSV, KSW, PTSUN, PZENITH,       &
index 7eba618..bd04922 100644 (file)
@@ -40,6 +40,11 @@ USE MODD_DIAG_n, ONLY : DIAG_INIT, DIAG_NP_INIT, DIAG_OPTIONS_INIT
 USE MODD_DIAG_EVAP_ISBA_n, ONLY : DIAG_EVAP_ISBA_INIT, DIAG_EVAP_ISBA_NP_INIT
 USE MODD_DIAG_MISC_ISBA_n, ONLY : DIAG_MISC_ISBA_INIT, DIAG_MISC_ISBA_NP_INIT
 !
+#ifdef MNH_MEGAN
+USE MODD_MEGAN_n, ONLY : MEGAN_INIT
+USE MODD_MEGAN_SURF_FIELDS_n, ONLY : MEGAN_SURF_FIELDS_INIT
+#endif
+
 USE MODD_AGRI_n, ONLY : AGRI_NP_INIT
 USE MODD_SFX_GRID_n, ONLY : GRID_INIT, GRID_NP_INIT
 USE MODD_CANOPY_n, ONLY : CANOPY_INIT
@@ -97,6 +102,11 @@ CALL ISBA_NP_INIT(IM%NP,0)
 CALL ISBA_NPE_INIT(IM%NPE,0)  
 CALL AGRI_NP_INIT(IM%NAG,0)
 !
+#ifdef MNH_MEGAN
+CALL MEGAN_INIT(IM%MGN)
+CALL MEGAN_SURF_FIELDS_INIT(IM%MSF)
+#endif
+!
 !-------------------------------------------------------------------------------------
 IF (LHOOK) CALL DR_HOOK('DEALLOC_ISBA_N',1,ZHOOK_HANDLE)
 !-------------------------------------------------------------------------------------
index fe1404e..03f8af7 100644 (file)
@@ -4,8 +4,8 @@
 !SFX_LIC for details. version 1.
 !     ######
 SUBROUTINE FAPAIR(PABC, PFD_SKY, PIA, PLAI, PXMUS, PSSA_SUP, PSSA_INF, &
-           PB_SUP, PB_INF, PALB_VEG, PALB_SOIL, OSHADE,            &
-           PFAPR, PFAPR_BS, PLAI_EFF, PIACAN,                      &
+           PB_SUP, PB_INF, PALB_VEG, PALB_SOIL, OSHADE,                &
+           PFAPR, PFAPR_BS, PRN_SHADE, PRN_SUNLIT, PLAI_EFF, PIACAN,   &
            PIACAN_SHADE, PIACAN_SUNLIT, PFRAC_SUN                  )
 !   #########################################################################
 !
@@ -46,6 +46,7 @@ SUBROUTINE FAPAIR(PABC, PFD_SKY, PIA, PLAI, PXMUS, PSSA_SUP, PSSA_INF, &
 !!      Commented by C. Delire 07/13
 !!      C. Delire   08/13 : moved calculation of diffuse fraction from here to radiative_transfert.F90
 !!      A. Boone    02/17 : corrected computation of PFAPR_BS
+!!      P. Tulet 06/2016 : add RN leaves computation (shade and sunlit) for MEGAN
 !!
 !!-------------------------------------------------------------------------------
 USE MODD_SURF_PAR,       ONLY : XUNDEF
@@ -78,6 +79,9 @@ LOGICAL, DIMENSION(:), INTENT(IN) :: OSHADE   ! OSHADE = if 1 shading activated
 !
 REAL, DIMENSION(:), INTENT(OUT) :: PFAPR
 REAL, DIMENSION(:), INTENT(OUT) :: PFAPR_BS
+!
+REAL, DIMENSION(:), INTENT(INOUT) :: PRN_SHADE, PRN_SUNLIT
+!
 REAL, DIMENSION(:), OPTIONAL,   INTENT(OUT) :: PLAI_EFF
 !
 REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT) :: PIACAN ! PAR in the canopy at different gauss level
@@ -95,7 +99,7 @@ REAL, DIMENSION(SIZE(PLAI))   :: ZB_DR_SUP, ZB_DR_INF, ZOMEGA_DR_SUP, ZOMEGA_DR_
 REAL, DIMENSION(SIZE(PLAI))   :: ZTR, ZFD_VEG, ZFD_SUP, ZLAI_EFF0, ZLAI_EFF
 !                                ZTR = transmittance
 !                                ZFD_VEG, ZFD_SUP = fraction of radiation diffused by the considered medium (vegetation)     
-!REAL, DIMENSION(SIZE(PLAI))  :: ZXIA_SUNLIT, ZXIA_SHADE, ZLAI_SUNLIT, ZLAI_SHADE
+REAL, DIMENSION(SIZE(PLAI))  :: ZXIA_SUNLIT, ZXIA_SHADE, ZLAI_SUNLIT, ZLAI_SHADE
 !                                ZXIA_SUNLIT = absorbed PAR of sunlit leaves
 !                                ZXIA_SHADE = absorbed PAR of shaded leaves
 !                                ZLAI_SUNLIT = LAI of sunlit leaves
@@ -123,10 +127,10 @@ ZXIA_SUP(:) = 0.
 ZFD_VEG(:)  = 0.
 ZFD_SUP(:)  = 0.
 !
-!ZXIA_SUNLIT(:) = 0.
-!ZXIA_SHADE(:)  = 0.
-!ZLAI_SUNLIT(:) = 0.
-!ZLAI_SHADE(:)  = 0.
+ZXIA_SUNLIT(:) = 0.
+ZXIA_SHADE(:)  = 0.
+ZLAI_SUNLIT(:) = 0.
+ZLAI_SHADE(:)  = 0.
 !
 ZLAI_EFF(:) = 0.
 !
@@ -137,8 +141,8 @@ ZFRAC_SUN(:,:)     = 0.
 !
 PFAPR(:)    = 0.
 PFAPR_BS(:) = 0.
-!PRN_SHADE(:) = 0.
-!PRN_SUNLIT(:) = 0.
+PRN_SHADE(:) = 0.
+PRN_SUNLIT(:) = 0.
 !
 !
 IF (PABC(SIZE(PABC)).GT.0.8) ZFD_VEG(:) = MIN(PFD_SKY(:),1.)   
@@ -221,18 +225,18 @@ DO JINT = SIZE(PABC),1,-1
       !not sunlit leaves
       ZIACAN_SHADE(I,JINT)  = MAX(0.,ZFD_SUP(I)/(ZWEIGHT*MAX(0.0001,PLAI(I)))*ZIACAN(I,JINT))
       !
-      !ZXIA_SUNLIT(I) = ZXIA_SUNLIT(I) + ZWEIGHT*ZTR(I)      *ZIACAN_SUNLIT(I,JINT)
-      !ZLAI_SUNLIT(I) = ZLAI_SUNLIT(I) + ZWEIGHT*ZTR(I)*ZCOEF*PLAI(I)
+      ZXIA_SUNLIT(I) = ZXIA_SUNLIT(I) + ZWEIGHT*ZTR(I)      *ZIACAN_SUNLIT(I,JINT)
+      ZLAI_SUNLIT(I) = ZLAI_SUNLIT(I) + ZWEIGHT*ZTR(I)*ZCOEF*PLAI(I)
       !
-      !ZXIA_SHADE(I)  = ZXIA_SHADE(I)  + ZWEIGHT*(1-ZTR(I))           *ZIACAN_SHADE(I,JINT)
-      !ZLAI_SHADE(I)  = ZLAI_SHADE(I)  + ZWEIGHT*(1-ZTR(I))*ZFD_SUP(I)*PLAI(I)
+      ZXIA_SHADE(I)  = ZXIA_SHADE(I)  + ZWEIGHT*(1-ZTR(I))           *ZIACAN_SHADE(I,JINT)
+      ZLAI_SHADE(I)  = ZLAI_SHADE(I)  + ZWEIGHT*(1-ZTR(I))*ZFD_SUP(I)*PLAI(I)
       !
       ZFRAC_SUN(I,JINT) = ZTR(I)  !fraction of sunlit leaves
       !      
     ELSE
       !
       ZIACAN_SUNLIT(I,JINT) = MAX(0.,ZIACAN(I,JINT)/(ZWEIGHT*MAX(0.0001,PLAI(I))))
-      !ZLAI_SUNLIT(I) = ZLAI_SUNLIT(I) + ZWEIGHT*PLAI(I)
+      ZLAI_SUNLIT(I) = ZLAI_SUNLIT(I) + ZWEIGHT*PLAI(I)
       !
     ENDIF
     !
@@ -248,8 +252,8 @@ WHERE (PIA(:).NE.0.)
   PFAPR_BS(:)= ZTR(:)*(1.-PALB_SOIL(:)*(1. - PALB_VEG(:)*(1.-ZTR(:))))
 END WHERE
 !
-!WHERE (ZLAI_SHADE(:) .NE.0.) ZRN_SHADE(:)  = ZXIA_SHADE(:) / ZLAI_SHADE(:)
-!WHERE (ZLAI_SUNLIT(:).NE.0.) ZRN_SUNLIT(:) = ZXIA_SUNLIT(:)/ ZLAI_SUNLIT(:)
+WHERE (ZLAI_SHADE(:) .NE.0.) PRN_SHADE(:)  = ZXIA_SHADE(:) / ZLAI_SHADE(:)
+WHERE (ZLAI_SUNLIT(:).NE.0.) PRN_SUNLIT(:) = ZXIA_SUNLIT(:)/ ZLAI_SUNLIT(:)
 !
 IF (PRESENT(PLAI_EFF))      PLAI_EFF      = ZLAI_EFF
 IF (PRESENT(PIACAN))        PIACAN        = ZIACAN
index 2f2408c..42b9055 100644 (file)
@@ -47,6 +47,7 @@
 !     B. decharme 04/2013 : variables for surf/atm coupling
 !                           dummy for water table / surface coupling
 !!    P. Samuelsson  10/2014  Introduced dummy variables in call to ISBA for MEB
+!!    P. Tulet    06/2016 add RN leaves to call ISBA (MEGAN coupling)
 !-------------------------------------------------------------------------------
 !
 !*       0.     DECLARATIONS
@@ -184,6 +185,8 @@ REAL, DIMENSION(SIZE(PPS)) :: ZEMISF
 !  variables for deep soil temperature
 REAL, DIMENSION(SIZE(PPS)) :: ZTDEEP_A
 !
+REAL, DIMENSION(SIZE(PPS)) :: ZRNSHADE, ZRNSUNLIT ! RN leaves
+!
 ! Dummy variables for MEB:
 REAL, DIMENSION(SIZE(PPS)) :: ZP_MEB_SCA_SW, ZPALPHAN, ZZ0G_WITHOUT_SNOW, &
                               ZZ0_MEBV, ZZ0H_MEBV, ZZ0EFF_MEBV, ZZ0_MEBN, &
@@ -252,7 +255,8 @@ ALLOCATE(GB%XIACAN(SIZE(PPS),SIZE(S%XABC)))
            PALBNIR_TVEG, PALBVIS_TVEG, PALBNIR_TSOIL, PALBVIS_TSOIL, ZPALPHAN,    &
            ZZ0G_WITHOUT_SNOW, ZZ0_MEBV, ZZ0H_MEBV, ZZ0EFF_MEBV, ZZ0_MEBN,         &
            ZZ0H_MEBN, ZZ0EFF_MEBN, ZTDEEP_A, PCO2, K%XFFG(:), K%XFFV(:),          &
-           ZEMISF, ZUSTAR, PAC_AGG, PHU_AGG, ZRESP_BIOMASS_INST, ZDEEP_FLUX, PIRRIG )     
+           ZEMISF, ZUSTAR, PAC_AGG, PHU_AGG, ZRESP_BIOMASS_INST, ZDEEP_FLUX, PIRRIG, &
+           ZRNSHADE, ZRNSUNLIT )     
 !
 IF (PEK%TSNOW%SCHEME=='3-L' .OR. PEK%TSNOW%SCHEME=='CRO') PEK%TSNOW%TS(:)= DMK%XSNOWTEMP(:,1)
 !
index f4defd3..d073a12 100644 (file)
@@ -50,6 +50,7 @@
 !                           calculation of vegetation CO2 flux
 !                           dummy for water table / surface coupling
 !!    P. Samuelsson  10/2014  Introduced dummy variables in call to ISBA for MEB
+!     P. Tulet    06/2016 add RN leaves to call ISBA (MEGAN coupling)
 !-------------------------------------------------------------------------------
 !
 !*       0.     DECLARATIONS
@@ -187,6 +188,8 @@ REAL, DIMENSION(SIZE(PPS)) :: ZEMISF
 !  variables for deep soil temperature
 REAL, DIMENSION(SIZE(PPS)) :: ZTDEEP_A
 !
+REAL, DIMENSION(SIZE(PPS)) :: ZRNSHADE, ZRNSUNLIT ! RN leaves
+!
 ! Dummy variables for MEB:
 REAL, DIMENSION(SIZE(PPS)) :: ZP_MEB_SCA_SW, ZPALPHAN, ZZ0G_WITHOUT_SNOW, &
                               ZZ0_MEBV, ZZ0H_MEBV, ZZ0EFF_MEBV, ZZ0_MEBN, &
@@ -269,7 +272,8 @@ ALLOCATE(GB%XIACAN(SIZE(PPS),SIZE(S%XABC)))
            PALBNIR_TVEG, PALBVIS_TVEG, PALBNIR_TSOIL, PALBVIS_TSOIL, ZPALPHAN,    &
            ZZ0G_WITHOUT_SNOW, ZZ0_MEBV, ZZ0H_MEBV, ZZ0EFF_MEBV, ZZ0_MEBN,         &
            ZZ0H_MEBN, ZZ0EFF_MEBN, ZTDEEP_A, PCO2, K%XFFG(:), K%XFFV(:),          &
-           ZEMISF, ZUSTAR, PAC_AGG, PHU_AGG, ZRESP_BIOMASS_INST, PDEEP_FLUX, PIRRIG )
+           ZEMISF, ZUSTAR, PAC_AGG, PHU_AGG, ZRESP_BIOMASS_INST, PDEEP_FLUX, PIRRIG, &
+           ZRNSHADE, ZRNSUNLIT )
 !
 IF (PEK%TSNOW%SCHEME=='3-L' .OR. PEK%TSNOW%SCHEME=='CRO') PEK%TSNOW%TS(:) = DMK%XSNOWTEMP(:,1)
 !
index cac8c7a..a668024 100644 (file)
@@ -8,8 +8,8 @@ SUBROUTINE INIT_ISBA_n (DTCO, OREAD_BUDGETC, UG, U, USS, GCP, IM, DTZ,&
                         OLAND_USE,                                    &
                         KI, KSV, KSW, HSV, PCO2, PRHOA, PZENITH,      &
                         PAZIM, PSW_BANDS, PDIR_ALB, PSCA_ALB, PEMIS,  &
-                        PTSRAD, PTSURF, KYEAR, KMONTH, KDAY, PTIME,   &
-                        TPDATE_END, HATMFILE, HATMFILETYPE, HTEST      )
+                        PTSRAD, PTSURF, PMEGAN_FIELDS, KYEAR, KMONTH, &
+                        KDAY, PTIME, TPDATE_END, HATMFILE, HATMFILETYPE, HTEST )
 !#############################################################
 !
 !!****  *INIT_ISBA_n* - routine to initialize ISBA
@@ -55,6 +55,8 @@ SUBROUTINE INIT_ISBA_n (DTCO, OREAD_BUDGETC, UG, U, USS, GCP, IM, DTZ,&
 !!      B. Decharme  04/2013 new coupling variables
 !!      P. Samuelsson  10/14 : MEB
 !!      P. Wautelet    16/02/2018: bug correction: allocate some work arrays to 0,1,1 instead of 0,0,1 (crash with XLF)
+!!      V.VIonnet       2017 : Blow snow
+!!      P.Tulet        06/16 : add MEGAN coupling  
 !!
 !-------------------------------------------------------------------------------
 !
@@ -165,6 +167,7 @@ REAL,             DIMENSION(KI),  INTENT(IN)  :: PRHOA     ! air density
 REAL,             DIMENSION(KI),  INTENT(IN)  :: PZENITH   ! solar zenithal angle
 REAL,             DIMENSION(KI),  INTENT(IN)  :: PAZIM     ! solar azimuthal angle (rad from N, clock)
 REAL,             DIMENSION(KSW), INTENT(IN)  :: PSW_BANDS ! middle wavelength of each band
+REAL,             DIMENSION(KI,IM%MSF%NMEGAN_NBR),INTENT(IN) :: PMEGAN_FIELDS
 REAL,             DIMENSION(KI,KSW),INTENT(OUT) :: PDIR_ALB  ! direct albedo for each band
 REAL,             DIMENSION(KI,KSW),INTENT(OUT) :: PSCA_ALB  ! diffuse albedo for each band
 REAL,             DIMENSION(KI),  INTENT(OUT) :: PEMIS     ! emissivity
@@ -246,9 +249,9 @@ ENDIF
 !
 !        0.2. Defaults from file header
 !    
- CALL READ_DEFAULT_ISBA_n(IM%CHI, IM%ID%DE, IM%ID%O, IM%ID%DM, IM%O, HPROGRAM)
+ CALL READ_DEFAULT_ISBA_n(IM%CHI, IM%MGN, IM%ID%DE, IM%ID%O, IM%ID%DM, IM%O, HPROGRAM)
 !
- CALL READ_ISBA_CONF_n(IM%CHI, IM%ID%DE, IM%ID%O, IM%ID%DM, IM%O, HPROGRAM)
+ CALL READ_ISBA_CONF_n(IM%CHI, IM%MGN, IM%ID%DE, IM%ID%O, IM%ID%DM, IM%O, HPROGRAM)
 !
 CALL INIT_IO_SURF_n(DTCO, U, HPROGRAM,'FULL  ','ISBA  ','READ ')
  CALL READ_SURF(HPROGRAM,'VERSION',IVERSION,IRESP)
@@ -471,11 +474,11 @@ END IF
 CALL COMPUTE_ISBA_PARAMETERS(DTCO, OREAD_BUDGETC, UG, U,                    &
                              IM%O, IM%DTV, IM%SB, IM%S, IM%G, IM%K, IM%NK,  &
                              IM%NG, IM%NP, IM%NPE, IM%NAG, IM%NISS, IM%ISS, &
-                             IM%NCHI, IM%CHI, IM%ID, IM%GB, IM%NGB,         &
-                             NDST, SLT,BLOWSNW, SV,HPROGRAM,HINIT,OLAND_USE,&
-                             KI,KSV,KSW, HSV,ZCO2,PRHOA,                &
+                             IM%NCHI, IM%CHI, IM%MGN, IM%MSF, IM%ID, IM%GB, &
+                             IM%NGB, NDST, SLT,BLOWSNW, SV, HPROGRAM,HINIT,         &
+                             OLAND_USE,KI,KSV,KSW, HSV,ZCO2,PRHOA,          &
                              PZENITH,PSW_BANDS,PDIR_ALB,PSCA_ALB,       &
-                             PEMIS,PTSRAD,PTSURF,HTEST                  )
+                             PEMIS,PTSRAD,PTSURF,PMEGAN_FIELDS, HTEST    )
 !
 IF ( IM%O%CSNOWMETAMO/="B92" ) THEN
   CALL READ_FZ06('drdt_bst_fit_60.nc')
index 372e883..bfa2c10 100644 (file)
@@ -8,6 +8,7 @@
                                 HPROGRAM,HINIT,OLAND_USE, KI,KSV,KSW,     &
                                 HSV,PCO2,PRHOA,PZENITH,PAZIM,PSW_BANDS,   &
                                 PDIR_ALB,PSCA_ALB,PEMIS,PTSRAD,PTSURF,    &
+                                PMEGAN_FIELDS,                            &
                                 KYEAR, KMONTH,KDAY, PTIME, TPDATE_END,    &
                                 HATMFILE,HATMFILETYPE,HTEST              )  
 !     #############################################################
@@ -42,6 +43,8 @@
 !!       V.Masson   15/03/99 new PGD treatment with COVER types
 !        F.Solmon  06/00   adaptation for patch approach
 !!      B. Decharme  04/2013 new coupling variables
+!!       V.Vionnet 2017 blow snow
+!!       P.Tulet     06/16  add MEGAN coupling
 !-------------------------------------------------------------------------------
 !
 !*       0.    DECLARATIONS
@@ -106,6 +109,7 @@ REAL,             DIMENSION(KI),  INTENT(IN)  :: PRHOA     ! air density
 REAL,             DIMENSION(KI),  INTENT(IN)  :: PZENITH   ! solar zenithal angle
 REAL,             DIMENSION(KI),  INTENT(IN)  :: PAZIM     ! solar azimuthal angle (rad from N, clock)
 REAL,             DIMENSION(KSW), INTENT(IN)  :: PSW_BANDS ! middle wavelength of each band
+REAL,             DIMENSION(KI,IM%MSF%NMEGAN_NBR),INTENT(IN) :: PMEGAN_FIELDS
 REAL,             DIMENSION(KI,KSW),INTENT(OUT) :: PDIR_ALB  ! direct albedo for each band
 REAL,             DIMENSION(KI,KSW),INTENT(OUT) :: PSCA_ALB  ! diffuse albedo for each band
 REAL,             DIMENSION(KI),  INTENT(OUT) :: PEMIS     ! emissivity
@@ -149,6 +153,7 @@ ELSE IF (U%CNATURE=='ISBA  ' .OR. U%CNATURE=='TSZ0') THEN
                    HPROGRAM, HINIT, OLAND_USE, KI, KSV, KSW, HSV, &
                    PCO2, PRHOA, PZENITH, PAZIM, PSW_BANDS,        &
                    PDIR_ALB, PSCA_ALB, PEMIS, PTSRAD, PTSURF,     &
+                   PMEGAN_FIELDS,                                 &
                    KYEAR, KMONTH, KDAY, PTIME, TPDATE_END,        &
                    HATMFILE, HATMFILETYPE, 'OK'     )  
 END IF
index 809e785..e88078e 100644 (file)
@@ -54,6 +54,7 @@ SUBROUTINE INIT_SURF_ATM_n (YSC, HPROGRAM,HINIT, OLAND_USE,             &
 !!     (J.Durand)      2014   add activation of chemical deposition if LCH_EMIS=F
 !!      R. Séférian 03/2014   Adding decoupling between CO2 seen by photosynthesis and radiative CO2
 !!      M.Leriche & V. Masson 05/16 bug in write emis fields for nest
+!!     (P.Tulet & M.Leriche)    06/2016   add MEGAN coupling
 !-------------------------------------------------------------------------------
 !
 !*       0.    DECLARATIONS
@@ -111,8 +112,6 @@ USE MODI_INIT_CHEMICAL_n
 USE MODI_CH_INIT_DEPCONST
 USE MODI_CH_INIT_EMISSION_n
 USE MODI_CH_INIT_SNAP_n
-USE MODI_OPEN_NAMELIST
-USE MODI_CLOSE_NAMELIST
 USE MODI_ABOR1_SFX
 USE MODI_ALLOC_DIAG_SURF_ATM_n
 USE MODI_GET_1D_MASK
@@ -131,6 +130,7 @@ USE MODI_GET_LUOUT
 USE MODI_SET_SURFEX_FILEIN
 !
 USE MODI_INIT_CPL_GCM_n
+USE MODI_READ_MEGAN_n
 !
 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
 USE PARKIND1  ,ONLY : JPRB
@@ -185,7 +185,6 @@ INTEGER           :: ISWB     ! number of shortwave bands
 INTEGER           :: JTILE    ! loop counter on tiles
 INTEGER           :: IRESP    ! error return code
 INTEGER           :: ILUOUT   ! unit of output listing file
-INTEGER           :: ICH      ! unit of input chemical file
 INTEGER           :: IVERSION, IBUGFIX       ! surface version
 !
 INTEGER, DIMENSION(:), ALLOCATABLE :: ISIZE_OMP
@@ -212,6 +211,8 @@ REAL, DIMENSION(:),     ALLOCATABLE :: ZP_EMIS     ! emissivity
 REAL, DIMENSION(:),     ALLOCATABLE :: ZP_TSRAD    ! radiative temperature
 REAL, DIMENSION(:),     ALLOCATABLE :: ZP_TSURF    ! surface effective temperature
 !
+REAL, DIMENSION(:,:),   ALLOCATABLE :: ZP_MEGAN_FIELDS
+!
 REAL, DIMENSION(:), ALLOCATABLE :: ZZ0VEG
 REAL :: XTIME0
 !
@@ -400,7 +401,7 @@ ENDIF
 !
  CALL READ_SURF(HPROGRAM,'CH_EMIS',YSC%CHU%LCH_EMIS,IRESP)
 !
-IF (YSC%CHU%LCH_EMIS) THEN
+IF (YSC%CHU%LCH_EMIS .AND. YSC%CHU%LCH_SURF_EMIS) THEN
   !
   IF ( IVERSION<7 .OR. IVERSION==7 .AND. IBUGFIX<3 ) THEN
     YSC%CHU%CCH_EMIS='AGGR'
@@ -449,6 +450,14 @@ DEALLOCATE(ZZ0VEG)
 !
  CALL READ_DUMMY_n(YSC%DUU,YSC%U%NSIZE_FULL, HPROGRAM)
 !
+!*       2.8 MEGAN fields
+!
+ CALL READ_SURF (HPROGRAM,'CH_BIOEMIS',YSC%CHU%LCH_BIOEMIS,IRESP)
+!
+IF (YSC%CHU%LCH_BIOEMIS) THEN
+  CALL READ_MEGAN_n(YSC%IM%MSF, YSC%U, HPROGRAM)
+ENDIF
+!
 !         End of IO
 !
  CALL END_IO_SURF_n(HPROGRAM)
@@ -601,7 +610,7 @@ IF (YSC%U%NDIM_NATURE>0) &
                      HPROGRAM,HINIT,OLAND_USE,YSC%U%NSIZE_NATURE,       &
                      KSV,KSW, HSV,ZP_CO2,ZP_RHOA,                       &
                      ZP_ZENITH,ZP_AZIM,PSW_BANDS,ZP_DIR_ALB,ZP_SCA_ALB, &
-                     ZP_EMIS,ZP_TSRAD,ZP_TSURF,                         &
+                     ZP_EMIS,ZP_TSRAD,ZP_TSURF,ZP_MEGAN_FIELDS,         &
                      KYEAR,KMONTH,KDAY,PTIME,TPDATE_END,                &
                      HATMFILE,HATMFILETYPE,'OK'      )
 !
@@ -674,6 +683,7 @@ ALLOCATE(ZP_RHOA         (KSIZE))
 ALLOCATE(ZP_ZENITH       (KSIZE))
 ALLOCATE(ZP_AZIM         (KSIZE))
 !
+ALLOCATE(ZP_MEGAN_FIELDS (KSIZE,YSC%IM%MSF%NMEGAN_NBR))
 !
 ! output arguments:
 !
@@ -693,27 +703,30 @@ IF (KSIZE>0) THEN
   ZP_EMIS    = XUNDEF
   ZP_TSRAD   = XUNDEF
   ZP_TSURF   = XUNDEF
+  ZP_MEGAN_FIELDS = 0.
 END IF
 !
 DO JJ=1,KSIZE
-IF (SIZE(PCO2)>0) &
-     ZP_CO2   (JJ)     = PCO2        (KMASK(JJ))  
-IF (SIZE(PRHOA)>0) &
-     ZP_RHOA  (JJ)     = PRHOA       (KMASK(JJ))  
-IF (SIZE(PZENITH)>0) THEN
+  IF (SIZE(PCO2)>0) &
+    ZP_CO2   (JJ)     = PCO2        (KMASK(JJ))  
+  IF (SIZE(PRHOA)>0) &
+    ZP_RHOA  (JJ)     = PRHOA       (KMASK(JJ))  
+  IF (SIZE(PZENITH)>0) THEN
     IF (LZENITH) THEN
-       ZP_ZENITH(JJ)     = PZENITH     (KMASK(JJ)) 
+      ZP_ZENITH(JJ)     = PZENITH     (KMASK(JJ)) 
     ELSE
-       ZP_ZENITH(JJ)     = ZZENITH     (KMASK(JJ)) 
+      ZP_ZENITH(JJ)     = ZZENITH     (KMASK(JJ)) 
     ENDIF
-ENDIF
-IF (SIZE(PAZIM  )>0) THEN
+  ENDIF
+  IF (SIZE(PAZIM  )>0) THEN
     IF (LZENITH) THEN
-       ZP_AZIM  (JJ)     = PAZIM       (KMASK(JJ)) 
+      ZP_AZIM  (JJ)     = PAZIM       (KMASK(JJ)) 
     ELSE
-       ZP_AZIM  (JJ)     = ZAZIM       (KMASK(JJ)) 
+      ZP_AZIM  (JJ)     = ZAZIM       (KMASK(JJ)) 
     ENDIF
-ENDIF
+  ENDIF
+  IF (SIZE(YSC%IM%MSF%XMEGAN_FIELDS,1)>0 .AND. YSC%IM%MSF%NMEGAN_NBR>0 ) &
+    ZP_MEGAN_FIELDS  (JJ,:)  = YSC%IM%MSF%XMEGAN_FIELDS(KMASK(JJ),:)  
 ENDDO
 IF (LHOOK) CALL DR_HOOK('PACK_SURF_INIT_ARG',1,ZHOOK_HANDLE)
 !
@@ -752,6 +765,7 @@ DEALLOCATE(ZP_SCA_ALB)
 DEALLOCATE(ZP_EMIS   )
 DEALLOCATE(ZP_TSRAD  )
 DEALLOCATE(ZP_TSURF  )
+DEALLOCATE(ZP_MEGAN_FIELDS  )
 IF (LHOOK) CALL DR_HOOK('UNPACK_SURF_INIT_ARG',1,ZHOOK_HANDLE)
 !
 END SUBROUTINE UNPACK_SURF_INIT_ARG
index b3c01cc..b8d9969 100644 (file)
@@ -3,7 +3,8 @@
 !SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt  
 !SFX_LIC for details. version 1.
 !#############################################################
-SUBROUTINE INIT_TEB_GARDEN_PGD_n (DTCO, U, OCH_BIO_FLUX, G, PGARDEN, TOP, IO, S, K, P, PEK, DTV, GB,  &
+SUBROUTINE INIT_TEB_GARDEN_PGD_n (DTCO, U, OCH_BIO_FLUX, HPARAMBVOC, G, PGARDEN, &
+                                  TOP, IO, S, K, P, PEK, DTV, GB,  &
                                   HPROGRAM, HINIT, OPATCH1, KI, KVERSION, KBUGFIX, PCO2, PRHOA)
 !#############################################################
 !
@@ -36,6 +37,7 @@ SUBROUTINE INIT_TEB_GARDEN_PGD_n (DTCO, U, OCH_BIO_FLUX, G, PGARDEN, TOP, IO, S,
 !!      Original    09/2009
 !!  11/2013 (B. Decharme) No exp profile with DIF
 !!      P. Wautelet    16/02/2018: bug correction: allocate some work arrays to 0,1,1 instead of 0,0,1 (crash with XLF)
+!!      2018 (J.Piannezze) : add MEGAN
 !-------------------------------------------------------------------------------
 !
 !*       0.    DECLARATIONS
@@ -89,6 +91,7 @@ IMPLICIT NONE
 TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
 TYPE(SURF_ATM_t), INTENT(INOUT) :: U
 LOGICAL, INTENT(IN) :: OCH_BIO_FLUX
+CHARACTER(LEN=*), INTENT(IN) :: HPARAMBVOC
 TYPE(GRID_t), INTENT(INOUT) :: G
 REAL, DIMENSION(:), INTENT(IN) :: PGARDEN
 TYPE(TEB_OPTIONS_t), INTENT(INOUT) :: TOP
@@ -177,7 +180,7 @@ END IF
 !
 IF (OPATCH1) THEN
   !
-  CALL READ_PGD_TEB_GARDEN_n(OCH_BIO_FLUX, DTCO, DTV, GB, U, &
+  CALL READ_PGD_TEB_GARDEN_n(OCH_BIO_FLUX, HPARAMBVOC, DTCO, DTV, GB, U, &
                              IO, K, G%NDIM, TOP, HPROGRAM,KVERSION,KBUGFIX)
   !
   ALLOCATE(S%XVEGTYPE(KI,NVEGTYPE))
index 22156cf..d87a7c1 100644 (file)
@@ -1,9 +1,10 @@
-!SFX_LIC Copyright 2009-2018 CNRS, Meteo-France and Universite Paul Sabatier
+!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 INIT_TEB_GREENROOF_PGD_n (DTCO, U, OCH_BIO_FLUX, G, PGREENROOF, TOP, IO, S, K, P, PEK, DTV, GB, &
+SUBROUTINE INIT_TEB_GREENROOF_PGD_n (DTCO, U, OCH_BIO_FLUX, HPARAMBVOC, G, PGREENROOF, TOP, &
+                                     IO, S, K, P, PEK, DTV, GB, &
                                      HPROGRAM, HINIT, OPATCH1, KI, KVERSION, PCO2, PRHOA)
 !#############################################################
 !
@@ -87,6 +88,7 @@ IMPLICIT NONE
 TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
 TYPE(SURF_ATM_t), INTENT(INOUT) :: U
 LOGICAL, INTENT(IN) :: OCH_BIO_FLUX
+CHARACTER(LEN=*), INTENT(IN) :: HPARAMBVOC
 TYPE(GRID_t), INTENT(INOUT) :: G
 REAL, DIMENSION(:), INTENT(IN) :: PGREENROOF
 TYPE(TEB_OPTIONS_t), INTENT(INOUT) :: TOP
@@ -188,7 +190,7 @@ END IF
 !
 IF (OPATCH1) THEN
 
-  CALL READ_PGD_TEB_GREENROOF_n(OCH_BIO_FLUX, DTCO, DTV, GB, U, &
+  CALL READ_PGD_TEB_GREENROOF_n(OCH_BIO_FLUX, HPARAMBVOC, DTCO, DTV, GB, U, &
                                 IO, S, K, G%NDIM, HPROGRAM,KVERSION)
   !
   ALLOCATE(S%XVEGTYPE(KI,NVEGTYPE))
index 7f35cc0..96a64f9 100644 (file)
@@ -457,12 +457,12 @@ DO JP=1,TOP%NTEB_PATCH
     CALL SET_SURFEX_FILEIN(HPROGRAM,'PGD ') ! change input file name to pgd name
     CALL INIT_IO_SURF_n(DTCO, U, HPROGRAM,'TOWN  ','TEB   ','READ ')     
     IF (JP==1) CALL INIT_TEB_VEG_OPTIONS_n(CHT, TD%MTO%LSURF_DIAG_ALBEDO, TOP%LGREENROOF, GDM%O, GRM%O, HPROGRAM)
-    CALL INIT_TEB_GARDEN_PGD_n(DTCO, U, CHT%LCH_BIO_FLUX, TG, NT%AL(JP)%XGARDEN, TOP, &
+    CALL INIT_TEB_GARDEN_PGD_n(DTCO, U, CHT%LCH_BIO_FLUX, CHT%CPARAMBVOC,TG, NT%AL(JP)%XGARDEN, TOP, &
                                GDM%O, GDM%S, GDM%K, GDM%P, GDM%NPE%AL(JP), GDM%DTV, GDM%GB, &
                                HPROGRAM,HINIT,(JP==1),KI,IVERSION,IBUGFIX,PCO2,PRHOA)
     ! Case of urban green roofs
     IF (TOP%LGREENROOF) THEN
-      CALL INIT_TEB_GREENROOF_PGD_n(DTCO, U, CHT%LCH_BIO_FLUX, TG, NT%AL(JP)%XGREENROOF, TOP, &
+      CALL INIT_TEB_GREENROOF_PGD_n(DTCO, U, CHT%LCH_BIO_FLUX, CHT%CPARAMBVOC,TG, NT%AL(JP)%XGREENROOF, TOP, &
                                     GRM%O, GRM%S, GRM%K, GRM%P, GRM%NPE%AL(JP), GRM%DTV, GRM%GB, &
                                     HPROGRAM,HINIT,(JP==1),KI,IVERSION,PCO2,PRHOA)
     ENDIF
index 6705b54..9e77a63 100644 (file)
@@ -13,7 +13,7 @@
                       PZ0EFF_MEBV, PZ0_MEBN, PZ0H_MEBN, PZ0EFF_MEBN, PTDEEP_A,   &
                       PCSP, PFFG_NOSNOW, PFFV_NOSNOW, PEMIST, PUSTAR, PAC_AGG,   &
                       PHU_AGG, PRESP_BIOMASS_INST, PDEEP_FLUX, PIRRIG_GR,        &
-                      PBLOWSNW_FLUX, PBLOWSNW_CONC   )      
+                      PRN_SHADE, PRN_SUNLIT,PBLOWSNW_FLUX, PBLOWSNW_CONC         )
 !     ##########################################################################
 !
 !
 !!      (P. LeMoigne) 12/2014 EBA scheme update
 !!      (A. Boone)    02/2015 Consider spectral band dependence of snow for IO%LTR_ML radiation option
 !!      B. Decharme    01/16 : Bug with flood budget
+!!       V.Vionnet 2017 blow snow
+!!      (P. Tulet)    06/2016 add RN leaves for MEGAN coupling
 !-------------------------------------------------------------------------------
 !
 !*       0.     DECLARATIONS
@@ -302,6 +304,7 @@ REAL, DIMENSION(:,:),OPTIONAL, INTENT(INOUT) :: PBLOWSNW_FLUX! Blowing snow part
 REAL, DIMENSION(:,:),OPTIONAL, INTENT(IN)    :: PBLOWSNW_CONC ! Blowing snow particles concentration:
 !                                           1: Number (#/m3) 2: Mass (kg/m3)
 !
+REAL, DIMENSION(:), INTENT(INOUT) :: PRN_SHADE, PRN_SUNLIT ! RN leaves 
 !
 !*      0.2    declarations of local variables
 !
@@ -493,7 +496,7 @@ IF(OMEB)THEN
                  PHU_AGG, PAC_AGG, ZDELHEATV_SFC, ZDELHEATG_SFC, ZDELHEATG, &
                  ZDELHEATN, ZDELHEATN_SFC, ZGSFCSNOW, PTDEEP_A, PDEEP_FLUX, &
                  ZRI3L, ZSNOW_THRUFAL, ZSNOW_THRUFAL_SOIL, ZEVAPCOR, ZSUBVCOR, &
-                 ZLITCOR, ZSNOWSFCH, ZQS3L,PBLOWSNW_FLUX,PBLOWSNW_CONC    )
+                 ZLITCOR, ZSNOWSFCH, ZQS3L,PBLOWSNW_FLUX,PBLOWSNW_CONC, PRN_SHADE, PRN_SUNLIT   )
 
 ELSE
 !
@@ -508,7 +511,7 @@ ELSE
                              PEK%XLAI, PZENITH, PABC, PEK%XFAPARC, PEK%XFAPIRC,    &
                              PEK%XMUS, PEK%XLAI_EFFC, GSHADE, PIACAN, ZIACAN_SUNLIT,&
                              ZIACAN_SHADE, ZFRAC_SUN, DMK%XFAPAR, DMK%XFAPIR,     &
-                             DMK%XFAPAR_BS, DMK%XFAPIR_BS  )
+                             DMK%XFAPAR_BS, DMK%XFAPIR_BS, PRN_SHADE, PRN_SUNLIT  )
    ENDIF
 !
 ! - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
@@ -531,7 +534,7 @@ ELSE
                     PPET_B_COEF, PPEQ_B_COEF, ZSNOW_THRUFAL_SOIL, ZGRNDFLUX, ZFLSN_COR,    &
                     ZGSFCSNOW, ZEVAPCOR, ZLES3L, ZLEL3L, ZEVAP3L, ZSNOWSFCH, ZDELHEATN,   &
                     ZDELHEATN_SFC, ZRI3L, PZENITH, ZDELHEATG, ZDELHEATG_SFC, ZQS3L,       &
-                    PBLOWSNW_FLUX,PBLOWSNW_CONC     )  
+                    PBLOWSNW_FLUX,PBLOWSNW_CONC     )   
 !  - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
 !
 !*      8.0    Plant stress, stomatal resistance and, possibly, CO2 assimilation
index 78a0fb3..7f77220 100644 (file)
@@ -17,7 +17,8 @@
                           PHU_AGG, PAC_AGG, PDELHEATV_SFC, PDELHEATG_SFC, PDELHEATG,&
                           PDELHEATN, PDELHEATN_SFC, PRESTOREN, PTDEEP_A, PDEEP_FLUX,&
                           PRISNOW, PSNOW_THRUFAL, PSNOW_THRUFAL_SOIL, PEVAPCOR,     &
-                          PSUBVCOR, PLITCOR, PSNOWSFCH, PQSNOW, PBLOWSNW_FLUX, PBLOWSNW_CONC )
+                          PSUBVCOR, PLITCOR, PSNOWSFCH, PQSNOW,                     &
+                          PBLOWSNW_FLUX, PBLOWSNW_CONC,PRN_SHADE, PRN_SUNLIT)
 !     ##########################################################################
 !
 !                             
@@ -246,6 +247,8 @@ REAL, DIMENSION(:),   INTENT(OUT)   :: PSNOWSFCH     ! snow surface layer pseudo
 !                                                    !  changes in grid thickness            (W/m2)
 REAL, DIMENSION(:),   INTENT(OUT)   :: PQSNOW        ! snow surface specific humidity (kg/kg)
 !
+REAL, DIMENSION(:),   INTENT(INOUT) :: PRN_SHADE, PRN_SUNLIT
+!
 ! diagnostic variables for Carbon assimilation:
 !
 REAL, DIMENSION(:,:), INTENT(OUT)   :: PRESP_BIOMASS_INST ! instantaneous biomass respiration (kgCO2/kgair m/s)
@@ -565,7 +568,7 @@ END WHERE
                           PSW_RAD, ZLAI, PZENITH, PABC, PEK%XFAPARC, PEK%XFAPIRC,    &
                           PEK%XMUS, PEK%XLAI_EFFC, OSHADE, ZIACAN,  ZIACAN_SUNLIT,   &
                           ZIACAN_SHADE, ZFRAC_SUN, DMK%XFAPAR, DMK%XFAPIR,           &
-                          DMK%XFAPAR_BS, DMK%XFAPIR_BS )    
+                          DMK%XFAPAR_BS, DMK%XFAPIR_BS, PRN_SHADE, PRN_SUNLIT )    
 
 ! Compute all-wavelength effective ground (soil+snow) surface,
 ! soil and veg albedos, respectively:
index 5d9eb5d..6f97ac6 100644 (file)
@@ -25,6 +25,7 @@
 !!    MODIFICATIONS
 !!    -------------
 !!  16/07/03 (P. Tulet)  restructured for externalization
+!!  06/2016 (P. Tulet) add CPARAMBVOC to choice between MEGAN and Solmon
 !------------------------------------------------------------------------------
 !
 !*       0.   DECLARATIONS
@@ -41,6 +42,7 @@ TYPE CH_ISBA_t
 !
   CHARACTER(LEN=28)  :: CCHEM_SURF_FILE  ! name of general (chemical) purpose ASCII input file
   CHARACTER(LEN=6)                :: CCH_DRY_DEP            !  deposition scheme
+  CHARACTER(LEN=6)                :: CPARAMBVOC             !  BVOC flux scheme 
   REAL, DIMENSION(:,:), POINTER :: XDEP                   ! final dry deposition  
                                                             ! velocity  for nature
   REAL, DIMENSION(:),   POINTER :: XSOILRC_SO2            ! for SO2
@@ -49,12 +51,13 @@ TYPE CH_ISBA_t
                                                             ! biogenic fluxes
   LOGICAL                         :: LCH_NO_FLUX            ! flag for the calculation of
                                                             ! biogenic NO fluxes
+  LOGICAL                         :: LSOILNOX               ! flag for the MEGAN SOILNOX parameterization                                                            
   TYPE(SV_t) :: SVI
 
   CHARACTER(LEN=6), DIMENSION(:), POINTER :: CCH_NAMES      ! NAME OF CHEMICAL SPECIES
                                                             ! (FOR DIAG ONLY)
   CHARACTER(LEN=6), DIMENSION(:), POINTER :: CAER_NAMES     ! NAME OF CHEMICAL SPECIES
-  CHARACTER(LEN=6), DIMENSION(:), POINTER :: CSNWNAMES      ! NAME OF CHEMICAL SPECIES  
+  CHARACTER(LEN=6), DIMENSION(:), POINTER :: CSNWNAMES      ! NAME OF CHEMICAL SPECIES 
   CHARACTER(LEN=6), DIMENSION(:), POINTER :: CDSTNAMES      ! NAME OF CHEMICAL SPECIES
   CHARACTER(LEN=6), DIMENSION(:), POINTER :: CSLTNAMES      ! NAME OF CHEMICAL SPECIES                                                            
 !
@@ -82,8 +85,10 @@ NULLIFY(YCH_ISBA%CSLTNAMES)
 NULLIFY(YCH_ISBA%CSNWNAMES)
 YCH_ISBA%CCHEM_SURF_FILE=' '
 YCH_ISBA%CCH_DRY_DEP=' '
+YCH_ISBA%CPARAMBVOC=' '
 YCH_ISBA%LCH_BIO_FLUX=.FALSE.
 YCH_ISBA%LCH_NO_FLUX=.FALSE.
+YCH_ISBA%LSOILNOX=.FALSE.
 CALL SV_INIT(YCH_ISBA%SVI)
 IF (LHOOK) CALL DR_HOOK("MODD_CH_ISBA_N:CH_ISBA_INIT",1,ZHOOK_HANDLE)
 END SUBROUTINE CH_ISBA_INIT
index 3064958..66f8d7d 100644 (file)
@@ -26,6 +26,7 @@
 !!    -------------
 !!  16/07/03 (P. Tulet)  restructured for externalization
 !!   10/2011 (S. Queguiner) Add CCH_EMIS
+!!   06/2017 (M. Leriche) add CCH_BIOEMIS and LCH_BIOEMIS for MEGAN coupling activation
 !------------------------------------------------------------------------------
 !
 !*       0.   DECLARATIONS
@@ -45,6 +46,9 @@ TYPE CH_SURF_t
                                                        !    for each specie and hour
                                                        ! 'SNAP' : from SNAP data using
                                                        !    potential emission & temporal profiles
+  CHARACTER(LEN=4)              :: CCH_BIOEMIS         ! Option for MEGAN coupling activation
+                                                       ! 'NONE' : no coupling with MEGAN
+                                                       ! 'MEGA' : activate MEGAN coupling                                               
   CHARACTER(LEN=6), DIMENSION(:), POINTER :: CCH_NAMES ! NAME OF CHEMICAL
   CHARACTER(LEN=6), DIMENSION(:), POINTER :: CAER_NAMES ! NAME OF AEROSOL SPECIES
                                                        ! SPECIES (FOR DIAG ONLY)
@@ -57,18 +61,15 @@ TYPE CH_SURF_t
                                                        ! are used
   LOGICAL  :: LCH_EMIS                                 ! T : chemical emissions
                                                        ! are present in the file
+  LOGICAL  :: LCH_BIOEMIS                              ! T : megan emissions
+                                                       ! are present in the file
 !
 END TYPE CH_SURF_t
 
 
 
 CONTAINS
-
 !
-
-
-
-
 SUBROUTINE CH_SURF_INIT(YCH_SURF)
 TYPE(CH_SURF_t), INTENT(INOUT) :: YCH_SURF
 REAL(KIND=JPRB) :: ZHOOK_HANDLE
@@ -77,9 +78,11 @@ IF (LHOOK) CALL DR_HOOK("MODD_CH_SURF_N:CH_SURF_INIT",0,ZHOOK_HANDLE)
   NULLIFY(YCH_SURF%CAER_NAMES)
   NULLIFY(YCH_SURF%XCONVERSION)
 YCH_SURF%CCH_EMIS=' '
+YCH_SURF%CCH_BIOEMIS=' '
 YCH_SURF%CCHEM_SURF_FILE=' '
 YCH_SURF%LCH_SURF_EMIS=.FALSE.
 YCH_SURF%LCH_EMIS=.FALSE.
+YCH_SURF%LCH_BIOEMIS=.FALSE.
 IF (LHOOK) CALL DR_HOOK("MODD_CH_SURF_N:CH_SURF_INIT",1,ZHOOK_HANDLE)
 END SUBROUTINE CH_SURF_INIT
 
index aa6171f..511d142 100644 (file)
@@ -49,6 +49,7 @@ TYPE CH_TEB_t
                                                             ! biogenic fluxes
   LOGICAL                         :: LCH_NO_FLUX            ! flag for the calculation of
                                                             ! biogenic NO fluxes
+  CHARACTER(LEN=6)                :: CPARAMBVOC             !  BVOC flux scheme                                                            
   TYPE(SV_t) :: SVT
   
   CHARACTER(LEN=6), DIMENSION(:), POINTER :: CCH_NAMES      ! NAME OF CHEMICAL SPECIES
@@ -82,6 +83,7 @@ NULLIFY(YCH_TEB%CDSTNAMES)
 NULLIFY(YCH_TEB%CSLTNAMES)
 YCH_TEB%CCHEM_SURF_FILE=' '
 YCH_TEB%CCH_DRY_DEP=' '
+YCH_TEB%CPARAMBVOC=' '
 YCH_TEB%LCH_BIO_FLUX=.FALSE.
 YCH_TEB%LCH_NO_FLUX=.FALSE.
 CALL SV_INIT(YCH_TEB%SVT)
index e76ee83..98c8726 100644 (file)
@@ -59,6 +59,8 @@ USE MODD_BEM_n, ONLY : BEM_NP_t
 USE MODD_DIAG_MISC_TEB_n, ONLY : DIAG_MISC_TEB_NP_t
 USE MODD_TEB_n, ONLY : TEB_NP_t
 !
+USE MODD_MEGAN_n, ONLY : MEGAN_t
+USE MODD_MEGAN_SURF_FIELDS_n, ONLY : MEGAN_SURF_FIELDS_t
 !
 !---------------------------------------------------------------------------
 !
@@ -159,6 +161,9 @@ TYPE(ISBA_NP_t) :: NP
 TYPE(ISBA_NPE_t) :: NPE
 TYPE(AGRI_NP_t) :: NAG
 !
+TYPE(MEGAN_t) :: MGN
+TYPE(MEGAN_SURF_FIELDS_t) :: MSF
+!
 END TYPE ISBA_MODEL_t
 !
 !---------------------------------------
index e5fa333..7d7e564 100644 (file)
@@ -30,6 +30,7 @@ MODULE MODN_ISBA_n
 !!      Original    01/2004                    
 !!      Modified    08/2009 by B. Decharme : LSURF_BUDGETC for all tiles
 !!      Modified by A.L. Gibelin, 04/2009: add carbon spinup
+!!      P. Tulet & M. Leriche 06/2017 : coupling megan online
 !!
 !-------------------------------------------------------------------------------
 !
@@ -87,7 +88,12 @@ LOGICAL  :: L2M_MIN_ZS
 LOGICAL  :: LCOEF
 LOGICAL  :: LSURF_VARS
 LOGICAL  :: LCH_BIO_FLUX
+LOGICAL  :: LSOILNOX
 LOGICAL  :: LCH_NO_FLUX
+REAL     :: XDROUGHT 
+REAL     :: XDAILYPAR
+REAL     :: XDAILYTEMP
+REAL     :: XMODPREC
 LOGICAL  :: LGLACIER
 LOGICAL  :: LVEGUPD
 LOGICAL  :: LNITRO_DILU
@@ -100,7 +106,7 @@ LOGICAL  :: LSNOWDRIFT_SUBLIM
 LOGICAL  :: LSNOW_ABS_ZENITH
  CHARACTER(3) :: CSNOWMETAMO
  CHARACTER(3) :: CSNOWRAD
- CHARACTER(LEN=6)  :: CCH_DRY_DEP
+ CHARACTER(LEN=6)  :: CCH_DRY_DEP, CPARAMBVOC
  CHARACTER(LEN=28) :: CCHEM_SURF_FILE
 !
 NAMELIST/NAM_ISBAn/CC1DRY,CSCOND,CSOILFRZ,CDIFSFCOND,CSNOWRES,CCPSURF, &
@@ -112,7 +118,8 @@ NAMELIST/NAM_DIAG_ISBAn/LPGD,LSURF_EVAP_BUDGET,LSURF_MISC_BUDGET,LSURF_DIAG_ALBE
 NAMELIST/NAM_DIAG_SURFn/N2M,L2M_MIN_ZS,LSURF_BUDGET,LRAD_BUDGET, &
                         LSURF_BUDGETC,LRESET_BUDGETC,LCOEF,LSURF_VARS
 NAMELIST/NAM_CH_CONTROLn/CCHEM_SURF_FILE
-NAMELIST/NAM_CH_ISBAn/LCH_BIO_FLUX,CCH_DRY_DEP,LCH_NO_FLUX
+NAMELIST/NAM_CH_ISBAn/LCH_BIO_FLUX,CCH_DRY_DEP,LCH_NO_FLUX, CPARAMBVOC, LSOILNOX, XDROUGHT,&
+                      XMODPREC, XDAILYPAR, XDAILYTEMP
 NAMELIST/NAM_SPINUP_CARBn/LSPINUPCARBS,LSPINUPCARBW,XSPINMAXS,XSPINMAXW,NNBYEARSPINS,&
         NNBYEARSPINW, XCO2_START, XCO2_END
 NAMELIST/NAM_ISBA_SNOWn/LSNOWDRIFT,LSNOWDRIFT_SUBLIM, LSNOW_ABS_ZENITH, CSNOWMETAMO, CSNOWRAD
@@ -375,37 +382,53 @@ SUBROUTINE UPDATE_NAM_CH_CONTROLn (CHI)
 IF (LHOOK) CALL DR_HOOK('MODN_ISBA_N:UPDATE_NAM_CH_CONTROLN',1,ZHOOK_HANDLE)
 END SUBROUTINE UPDATE_NAM_CH_CONTROLn
 
-SUBROUTINE INIT_NAM_CH_ISBAn (CHI)
+SUBROUTINE INIT_NAM_CH_ISBAn (CHI, MGN)
 !
   USE MODD_CH_ISBA_n, ONLY : CH_ISBA_t
+  USE MODD_MEGAN_n, ONLY : MEGAN_t  
 !
   IMPLICIT NONE
 
 !
   TYPE(CH_ISBA_t), INTENT(INOUT) :: CHI
+  TYPE(MEGAN_t), INTENT(INOUT) :: MGN
   REAL(KIND=JPRB) :: ZHOOK_HANDLE
 
   IF (LHOOK) CALL DR_HOOK('MODN_ISBA_N:INIT_NAM_CH_ISBAN',0,ZHOOK_HANDLE)
   LCH_BIO_FLUX = CHI%LCH_BIO_FLUX
   LCH_NO_FLUX = CHI%LCH_NO_FLUX
   CCH_DRY_DEP = CHI%CCH_DRY_DEP
+  CPARAMBVOC = CHI%CPARAMBVOC
+  LSOILNOX = CHI%LSOILNOX
+  XDROUGHT = MGN%XDROUGHT
+  XMODPREC = MGN%XMODPREC
+  XDAILYPAR = MGN%XDAILYPAR
+  XDAILYTEMP = MGN%XDAILYTEMP  
 IF (LHOOK) CALL DR_HOOK('MODN_ISBA_N:INIT_NAM_CH_ISBAN',1,ZHOOK_HANDLE)
 END SUBROUTINE INIT_NAM_CH_ISBAn
 
-SUBROUTINE UPDATE_NAM_CH_ISBAn (CHI)
+SUBROUTINE UPDATE_NAM_CH_ISBAn (CHI, MGN)
 !
   USE MODD_CH_ISBA_n, ONLY : CH_ISBA_t
+  USE MODD_MEGAN_n, ONLY : MEGAN_t
 !
   IMPLICIT NONE
 
 !
   TYPE(CH_ISBA_t), INTENT(INOUT) :: CHI
+  TYPE(MEGAN_t), INTENT(INOUT) :: MGN
   REAL(KIND=JPRB) :: ZHOOK_HANDLE
 
   IF (LHOOK) CALL DR_HOOK('MODN_ISBA_N:UPDATE_NAM_CH_ISBAN',0,ZHOOK_HANDLE)
   CHI%LCH_BIO_FLUX = LCH_BIO_FLUX
   CHI%LCH_NO_FLUX = LCH_NO_FLUX
   CHI%CCH_DRY_DEP = CCH_DRY_DEP
+  CHI%CPARAMBVOC = CPARAMBVOC
+  CHI%LSOILNOX = LSOILNOX
+  MGN%XDROUGHT = XDROUGHT
+  MGN%XMODPREC = XMODPREC
+  MGN%XDAILYPAR = XDAILYPAR
+  MGN%XDAILYTEMP = XDAILYTEMP
 IF (LHOOK) CALL DR_HOOK('MODN_ISBA_N:UPDATE_NAM_CH_ISBAN',1,ZHOOK_HANDLE)
 END SUBROUTINE UPDATE_NAM_CH_ISBAn
 
index 263f45b..412f22a 100644 (file)
@@ -36,6 +36,7 @@
 !!      A. Lemonsu      05/2009         Ajout de la clef LGARDEN pour TEB
 !!      J. Escobar      11/2013         Add USE MODI_READ_NAM_PGD_CHEMISTRY
 !!      B. Decharme     02/2014         Add LRM_RIVER
+!!      M. Leriche      06/2017         Add MEGAN coupling
 !----------------------------------------------------------------------------
 !
 !*    0.     DECLARATION
@@ -74,6 +75,7 @@ USE MODI_PGD_CHEMISTRY
 USE MODI_PGD_CHEMISTRY_SNAP
 USE MODI_WRITE_COVER_TEX_END
 USE MODI_INIT_READ_DATA_COVER
+USE MODI_PGD_MEGAN
 !
 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
 USE PARKIND1  ,ONLY : JPRB
@@ -221,7 +223,7 @@ IF (YSC%U%NDIM_SEA>0) CALL PGD_SEA(YSC%DTCO, YSC%SM%DTS, YSC%SM%G, YSC%SM%S, &
 !*   10.      Chemical Emission fields
 !             ------------------------
 !
- CALL READ_NAM_PGD_CHEMISTRY(HPROGRAM,YSC%CHU%CCH_EMIS)
+ CALL READ_NAM_PGD_CHEMISTRY(HPROGRAM,YSC%CHU%CCH_EMIS,YSC%CHU%CCH_BIOEMIS)
 IF (YSC%CHU%CCH_EMIS=='SNAP') THEN
   CALL PGD_CHEMISTRY_SNAP(YSC%CHN, YSC%DTCO, YSC%UG, YSC%U, YSC%USS, &
                           HPROGRAM,YSC%CHU%LCH_EMIS)
@@ -229,6 +231,10 @@ ELSE IF (YSC%CHU%CCH_EMIS=='AGGR') THEN
   CALL PGD_CHEMISTRY(YSC%CHE, YSC%DTCO, YSC%UG, YSC%U, YSC%USS, &
                      HPROGRAM,YSC%CHU%LCH_EMIS)
 ENDIF
+IF (YSC%CHU%CCH_BIOEMIS=='MEGA') THEN
+  CALL PGD_MEGAN(YSC%DTCO, YSC%UG, YSC%U, YSC%USS, YSC%IM%MSF, &
+                 HPROGRAM,YSC%CHU%LCH_BIOEMIS)
+ENDIF
 !_______________________________________________________________________________
 !
 !*   11.     Writing in cover latex file
index 045bac0..5a00a31 100644 (file)
@@ -8,7 +8,8 @@ SUBROUTINE RADIATIVE_TRANSFERT(OAGRI_TO_GRASS, PVEGTYPE,          &
             PSW_RAD, PLAI, PZENITH, PABC,                         &
             PFAPARC, PFAPIRC, PMUS, PLAI_EFFC, OSHADE, PIACAN,    &             
             PIACAN_SUNLIT, PIACAN_SHADE, PFRAC_SUN,               &          
-            PFAPAR, PFAPIR, PFAPAR_BS, PFAPIR_BS                  ) 
+            PFAPAR, PFAPIR, PFAPAR_BS, PFAPIR_BS, PRN_SHADE,      &
+            PRN_SUNLIT                  ) 
 !   #########################################################################
 !
 !!****  *RADIATIVE_TRANSFERT*  
@@ -54,6 +55,7 @@ SUBROUTINE RADIATIVE_TRANSFERT(OAGRI_TO_GRASS, PVEGTYPE,          &
 !!     Original    04/11 
 !!     C. Delire   08/13 : moved calculation of diffuse fraction from fapair to here
 !!     Commented by C. Delire 07/13
+!!      P. Tulet       06/16 : add RN leaves (shade and sunlit) for MEGAN
 !!
 !-------------------------------------------------------------------------------
 !!
@@ -116,6 +118,8 @@ REAL, DIMENSION(:,:), INTENT(OUT) :: PFRAC_SUN   ! fraction of sunlit leaves
 !
 REAL, DIMENSION(:),   INTENT(OUT) :: PFAPAR, PFAPIR, PFAPAR_BS, PFAPIR_BS
 !
+REAL, DIMENSION(:),   INTENT(INOUT) :: PRN_SHADE, PRN_SUNLIT
+!
 !*      0.2    declarations of local variables
 !
 !
@@ -186,12 +190,13 @@ END DO
 ZIA(:)     = PSW_RAD(:)*(1.-XPARCF)
  CALL FAPAIR(PABC, ZFD_SKY, ZIA, ZLAI, ZXMUS, XSSA_SUP_PIR, XSSA_INF_PIR,  &
          ZB_SUP, ZB_INF, PALBNIR_VEG, PALBNIR_SOIL, OSHADE,      &
-         PFAPIR, PFAPIR_BS                                       )
+         PFAPIR, PFAPIR_BS, PRN_SHADE, PRN_SUNLIT                )
 !
 ZIA(:)     = PSW_RAD(:)*XPARCF
- CALL FAPAIR(PABC, ZFD_SKY, ZIA, ZLAI, ZXMUS, XSSA_SUP, XSSA_INF,          &
+ CALL FAPAIR(PABC, ZFD_SKY, ZIA, ZLAI, ZXMUS, XSSA_SUP, XSSA_INF,&
          ZB_SUP, ZB_INF, PALBVIS_VEG, PALBVIS_SOIL, OSHADE,      &
-         PFAPAR, PFAPAR_BS, PLAI_EFF=ZLAI_EFF, PIACAN=PIACAN,    &
+         PFAPAR, PFAPAR_BS, PRN_SHADE, PRN_SUNLIT, &
+         PLAI_EFF=ZLAI_EFF, PIACAN=PIACAN,    &
          PIACAN_SHADE=PIACAN_SHADE, PIACAN_SUNLIT=PIACAN_SUNLIT, &
          PFRAC_SUN=PFRAC_SUN                                     )
 !
index 6691723..9a52897 100644 (file)
@@ -3,7 +3,7 @@
 !SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt  
 !SFX_LIC for details. version 1.
 !     #########
-      SUBROUTINE READ_DEFAULT_ISBA_n (CHI, DE, DGO, DMI, IO, HPROGRAM)
+      SUBROUTINE READ_DEFAULT_ISBA_n (CHI, MGN, DE, DGO, DMI, IO, HPROGRAM)
 !     #######################################################
 !
 !!****  *READ_ISBA_CONF* - routine to read the configuration for ISBA
 !*       0.    DECLARATIONS
 !              ------------
 !
-!
-!
-!
-!
 USE MODD_CH_ISBA_n, ONLY : CH_ISBA_t
+USE MODD_MEGAN_n, ONLY : MEGAN_t
 USE MODD_DIAG_EVAP_ISBA_n, ONLY : DIAG_EVAP_ISBA_t
 USE MODD_DIAG_n, ONLY : DIAG_OPTIONS_t
 USE MODD_DIAG_MISC_ISBA_n, ONLY : DIAG_MISC_ISBA_t
@@ -67,20 +64,18 @@ IMPLICIT NONE
 !*       0.1   Declarations of arguments
 !              -------------------------
 !
-!
 TYPE(CH_ISBA_t), INTENT(INOUT) :: CHI
+TYPE(MEGAN_t), INTENT(INOUT) :: MGN
 TYPE(DIAG_EVAP_ISBA_t), INTENT(INOUT) :: DE
 TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DGO
 TYPE(DIAG_MISC_ISBA_t), INTENT(INOUT) :: DMI
 TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
 !
  CHARACTER(LEN=6),  INTENT(IN)  :: HPROGRAM ! program calling ISBA
-
 !
 !*       0.2   Declarations of local variables
 !              -------------------------------
 !
-!
 LOGICAL           :: GFOUND         ! Return code when searching namelist
 INTEGER           :: ILUOUT         ! output listing logical unit
 INTEGER           :: ILUDES         ! .des file logical unit
@@ -105,7 +100,7 @@ IF (IMI.NE.-1 .AND. LNAM_READ) THEN
  CALL INIT_NAM_DIAG_SURFn(DGO)
  CALL INIT_NAM_DIAG_ISBAn(DE, DGO, DMI)
  CALL INIT_NAM_CH_CONTROLn(CHI)
- CALL INIT_NAM_CH_ISBAn(CHI)
+ CALL INIT_NAM_CH_ISBAn(CHI, MGN)
  CALL INIT_NAM_SPINUP_CARB_ISBAn(IO)
  CALL INIT_NAM_ISBA_SNOWn(IO)
 ENDIF
@@ -142,7 +137,7 @@ IF (IMI.NE.-1) THEN
  CALL UPDATE_NAM_DIAG_SURFn(DGO)
  CALL UPDATE_NAM_DIAG_ISBAn(DE, DGO, DMI)
  CALL UPDATE_NAM_CH_CONTROLn(CHI)
- CALL UPDATE_NAM_CH_ISBAn(CHI)
+ CALL UPDATE_NAM_CH_ISBAn(CHI, MGN)
  CALL UPDATE_NAM_SPINUP_CARB_ISBAn(IO)
  CALL UPDATE_NAM_ISBA_SNOWn(IO) 
 ENDIF
index 75665b6..d273ddc 100644 (file)
@@ -3,7 +3,7 @@
 !SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt  
 !SFX_LIC for details. version 1.
 !     #########
-      SUBROUTINE READ_ISBA_CONF_n (CHI, DE, DGO, DMI, IO, HPROGRAM)
+      SUBROUTINE READ_ISBA_CONF_n (CHI, MGN, DE, DGO, DMI, IO, HPROGRAM)
 !     #######################################################
 !
 !!****  *READ_ISBA_CONF* - routine to read the configuration for ISBA
 !*       0.    DECLARATIONS
 !              ------------
 !
-!
-!
-!
-!
 USE MODD_CH_ISBA_n, ONLY : CH_ISBA_t
+USE MODD_MEGAN_n, ONLY : MEGAN_t
 USE MODD_DIAG_EVAP_ISBA_n, ONLY : DIAG_EVAP_ISBA_t
 USE MODD_DIAG_n, ONLY : DIAG_OPTIONS_t
 USE MODD_DIAG_MISC_ISBA_n, ONLY : DIAG_MISC_ISBA_t
@@ -77,20 +74,18 @@ IMPLICIT NONE
 !*       0.1   Declarations of arguments
 !              -------------------------
 !
-!
 TYPE(CH_ISBA_t), INTENT(INOUT) :: CHI
+TYPE(MEGAN_t), INTENT(INOUT) :: MGN
 TYPE(DIAG_EVAP_ISBA_t), INTENT(INOUT) :: DE
 TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DGO
 TYPE(DIAG_MISC_ISBA_t), INTENT(INOUT) :: DMI
 TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
 !
  CHARACTER(LEN=6),  INTENT(IN)  :: HPROGRAM ! program calling ISBA
-
 !
 !*       0.2   Declarations of local variables
 !              -------------------------------
 !
-!
 LOGICAL           :: GFOUND         ! Return code when searching namelist
 INTEGER           :: ILUOUT         ! logical unit of output file
 INTEGER           :: INAM           ! logical unit of namelist file
@@ -112,7 +107,7 @@ IF (IMI.NE.-1 .AND. LNAM_READ) THEN
  CALL INIT_NAM_DIAG_ISBAn(DE, DGO, DMI)
  CALL INIT_NAM_DIAG_SURFn(DGO)
  CALL INIT_NAM_CH_CONTROLn(CHI)
- CALL INIT_NAM_CH_ISBAn(CHI)
+ CALL INIT_NAM_CH_ISBAn(CHI, MGN)
  CALL INIT_NAM_SPINUP_CARB_ISBAn(IO)
  CALL INIT_NAM_ISBA_SNOWn(IO) 
 ENDIF
@@ -175,7 +170,7 @@ IF (IMI.NE.-1) THEN
  CALL UPDATE_NAM_DIAG_ISBAn(DE, DGO, DMI)
  CALL UPDATE_NAM_DIAG_SURFn(DGO)
  CALL UPDATE_NAM_CH_CONTROLn(CHI)
- CALL UPDATE_NAM_CH_ISBAn(CHI)
+ CALL UPDATE_NAM_CH_ISBAn(CHI, MGN)
  CALL UPDATE_NAM_SPINUP_CARB_ISBAn(IO)
  CALL UPDATE_NAM_ISBA_SNOWn(IO) 
 ENDIF
index fd04cd8..30abbf3 100644 (file)
@@ -3,7 +3,7 @@
 !SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt  
 !SFX_LIC for details. version 1.
 !     #########
-      SUBROUTINE READ_NAM_PGD_CHEMISTRY(HPROGRAM, HCH_EMIS )  
+      SUBROUTINE READ_NAM_PGD_CHEMISTRY(HPROGRAM, HCH_EMIS, HCH_BIOEMIS )  
 !     ##############################################################
 !
 !!**** *READ_NAM_PGD_CHEMISTRY* reads namelist for CHEMISTRY
@@ -33,6 +33,7 @@
 !!    ------------
 !!
 !!    Original    09/2011
+!!    M. Leriche 06/17 add coupling MEGAN
 !----------------------------------------------------------------------------
 !
 !*    0.     DECLARATION
@@ -55,9 +56,9 @@ IMPLICIT NONE
 !*    0.1    Declaration of arguments
 !            ------------------------
 !                                   
- CHARACTER(LEN=6),    INTENT(IN)    :: HPROGRAM      ! Type of program
- CHARACTER(LEN=4),    INTENT(OUT)   :: HCH_EMIS      ! Option for emissions computations
-!                                  
+CHARACTER(LEN=6),    INTENT(IN)    :: HPROGRAM      ! Type of program
+CHARACTER(LEN=4),    INTENT(OUT)   :: HCH_EMIS      ! Option for emissions computations
+CHARACTER(LEN=4),    INTENT(OUT)   :: HCH_BIOEMIS   ! Option for activating MEGAN coupling      
 !
 !*    0.2    Declaration of local variables
 !            ------------------------------
@@ -69,10 +70,11 @@ LOGICAL                           :: GFOUND    ! flag when namelist is present
 !*    0.3    Declaration of namelists
 !            ------------------------
 !
- CHARACTER(LEN=4)         :: CCH_EMIS
+CHARACTER(LEN=4)         :: CCH_EMIS
+CHARACTER(LEN=4)         :: CCH_BIOEMIS 
 REAL(KIND=JPRB) :: ZHOOK_HANDLE
 !
-NAMELIST/NAM_CH_EMISSIONS/ CCH_EMIS
+NAMELIST/NAM_CH_EMISSIONS/ CCH_EMIS, CCH_BIOEMIS
 !
 !-------------------------------------------------------------------------------
 !
@@ -81,6 +83,7 @@ NAMELIST/NAM_CH_EMISSIONS/ CCH_EMIS
 !
 IF (LHOOK) CALL DR_HOOK('READ_NAM_PGD_CHEMISTRY',0,ZHOOK_HANDLE)
 CCH_EMIS        = 'NONE'
+CCH_BIOEMIS     = 'NONE'
 !
  CALL GET_LUOUT(HPROGRAM,ILUOUT)
 !
@@ -89,18 +92,20 @@ CCH_EMIS        = 'NONE'
 !*    2.      Reading of namelist
 !             -------------------
 !
- CALL OPEN_NAMELIST(HPROGRAM,ILUNAM)
+CALL OPEN_NAMELIST(HPROGRAM,ILUNAM)
 !
- CALL POSNAM(ILUNAM,'NAM_CH_EMISSIONS',GFOUND,ILUOUT)
+CALL POSNAM(ILUNAM,'NAM_CH_EMISSIONS',GFOUND,ILUOUT)
 IF (GFOUND) READ(UNIT=ILUNAM,NML=NAM_CH_EMISSIONS)
 !
- CALL TEST_NAM_VAR_SURF(ILUOUT,'CCH_EMIS',CCH_EMIS,'NONE','AGGR','SNAP')
+CALL TEST_NAM_VAR_SURF(ILUOUT,'CCH_EMIS',CCH_EMIS,'NONE','AGGR','SNAP')
+CALL TEST_NAM_VAR_SURF(ILUOUT,'CCH_BIOEMIS',CCH_BIOEMIS,'NONE','MEGA')
 !
- CALL CLOSE_NAMELIST(HPROGRAM,ILUNAM)
+CALL CLOSE_NAMELIST(HPROGRAM,ILUNAM)
 !
 !-------------------------------------------------------------------------------
 !
-HCH_EMIS   = CCH_EMIS
+HCH_EMIS = CCH_EMIS
+HCH_BIOEMIS = CCH_BIOEMIS
 !
 IF (LHOOK) CALL DR_HOOK('READ_NAM_PGD_CHEMISTRY',1,ZHOOK_HANDLE)
 !
index 36e9693..e00f17f 100644 (file)
@@ -75,9 +75,9 @@ IF (LHOOK) CALL DR_HOOK('READ_NAMELISTS_ISBA_N',0,ZHOOK_HANDLE)
  CALL DEFAULT_CROCUS(LSNOWDRIFT,LSNOWDRIFT_SUBLIM,LSNOW_ABS_ZENITH,&
                      CSNOWMETAMO,CSNOWRAD)
 !
- CALL READ_DEFAULT_ISBA_n(IM%CHI, IM%ID%DE, IM%ID%O, IM%ID%DM, IM%O, HPROGRAM)
+ CALL READ_DEFAULT_ISBA_n(IM%CHI, IM%MGN, IM%ID%DE, IM%ID%O, IM%ID%DM, IM%O, HPROGRAM)
 !
- CALL READ_ISBA_CONF_n(IM%CHI, IM%ID%DE, IM%ID%O, IM%ID%DM, IM%O, HPROGRAM)
+ CALL READ_ISBA_CONF_n(IM%CHI, IM%MGN, IM%ID%DE, IM%ID%O, IM%ID%DM, IM%O, HPROGRAM)
 !
 !
 SODELX(:)      = XUNDEF
index 532c0c7..a79c305 100644 (file)
@@ -41,7 +41,9 @@
 !!                   11/2013  : same for groundwater distribution
 !!                   11/2014  : Read XSOILGRID as a series of real 
 !!      P. Samuelsson 10/2014 : MEB
-!!    10/2016 B. Decharme : bug surface/groundwater coupling   
+!!    10/2016 B. Decharme : bug surface/groundwater coupling  
+!!      M. Leriche   06/2017 add SOLMON option for biogenic emissions
+!!                           warning this option do not work anymore -> to be debug
 !-------------------------------------------------------------------------------
 !
 !*       0.    DECLARATIONS
@@ -539,32 +541,39 @@ ENDIF
 !* biogenic chemical emissions
 !
 IF (CHI%LCH_BIO_FLUX) THEN
-  ALLOCATE(ZWORK(U%NSIZE_FULL,1))
-  !
-  CALL END_IO_SURF_n(HPROGRAM)
-CALL INIT_IO_SURF_n(DTCO, U, HPROGRAM,'FULL  ','SURF  ','READ ')
-  !
-  CALL GET_LUOUT(HPROGRAM,ILUOUT)
-  ALLOCATE(IMASK(IG%NDIM))
-  ILU=0
-  CALL GET_SURF_MASK_n(DTCO, U, 'NATURE',IG%NDIM,IMASK,ILU,ILUOUT)
-  ALLOCATE(GB%XISOPOT(IG%NDIM))
-  ALLOCATE(GB%XMONOPOT(IG%NDIM))
-  !
-  ZWORK(:,:) = 0.  
-  YRECFM='E_ISOPOT'
-  CALL READ_SURF(HPROGRAM,YRECFM,ZWORK,IRESP)
-  CALL PACK_SAME_RANK(IMASK,ZWORK(:,1),GB%XISOPOT(:))
-  !
-  ZWORK(:,:) = 0.  
-  YRECFM='E_MONOPOT'
-  CALL READ_SURF(HPROGRAM,YRECFM,ZWORK,IRESP)
-  CALL PACK_SAME_RANK(IMASK,ZWORK(:,1),GB%XMONOPOT(:))
-  !
-  CALL END_IO_SURF_n(HPROGRAM)
-CALL INIT_IO_SURF_n(DTCO, U, HPROGRAM,'NATURE','ISBA  ','READ ')
-  !
-  DEALLOCATE(ZWORK)
+
+  IF (CHI%CPARAMBVOC=="SOLMON") THEN
+    !
+    ALLOCATE(ZWORK(U%NSIZE_FULL,1))
+    !
+    CALL END_IO_SURF_n(HPROGRAM)
+    CALL INIT_IO_SURF_n(DTCO, U, HPROGRAM,'FULL  ','SURF  ','READ ')
+    !
+    CALL GET_LUOUT(HPROGRAM,ILUOUT)
+    ALLOCATE(IMASK(IG%NDIM))
+    ILU=0
+    CALL GET_SURF_MASK_n(DTCO, U, 'NATURE',IG%NDIM,IMASK,ILU,ILUOUT)
+    ALLOCATE(GB%XISOPOT(IG%NDIM))
+    ALLOCATE(GB%XMONOPOT(IG%NDIM))
+    !
+    ZWORK(:,:) = 0.  
+    YRECFM='E_ISOPOT'
+    CALL READ_SURF(HPROGRAM,YRECFM,ZWORK,IRESP)
+    CALL PACK_SAME_RANK(IMASK,ZWORK(:,1),GB%XISOPOT(:))
+    !
+    ZWORK(:,:) = 0.  
+    YRECFM='E_MONOPOT'
+    CALL READ_SURF(HPROGRAM,YRECFM,ZWORK,IRESP)
+    CALL PACK_SAME_RANK(IMASK,ZWORK(:,1),GB%XMONOPOT(:))
+    !
+    CALL END_IO_SURF_n(HPROGRAM)
+    CALL INIT_IO_SURF_n(DTCO, U, HPROGRAM,'NATURE','ISBA  ','READ ')
+    !
+    DEALLOCATE(ZWORK)
+  ELSE
+    ALLOCATE(GB%XISOPOT (0))
+    ALLOCATE(GB%XMONOPOT(0))
+  END IF
 ELSE
   ALLOCATE(GB%XISOPOT (0))
   ALLOCATE(GB%XMONOPOT(0))
index 9fe56f1..b8de0ed 100644 (file)
@@ -3,7 +3,7 @@
 !SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt  
 !SFX_LIC for details. version 1.
 !     #########
-      SUBROUTINE READ_PGD_TEB_GARDEN_n (OCH_BIO_FLUX, DTCO, DTV, GB, U, &
+      SUBROUTINE READ_PGD_TEB_GARDEN_n (OCH_BIO_FLUX, HPARAMBVOC, DTCO, DTV, GB, U, &
                                         IO, K, KDIM, TOP, HPROGRAM,KVERSION,KBUGFIX)
 !     #########################################
 !
@@ -69,6 +69,7 @@ IMPLICIT NONE
 !              -------------------------
 !
 LOGICAL, INTENT(IN) :: OCH_BIO_FLUX
+CHARACTER(LEN=*), INTENT(IN) :: HPARAMBVOC
 !
 TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
 TYPE(DATA_ISBA_t), INTENT(INOUT) :: DTV
@@ -141,7 +142,7 @@ ENDIF
 !
 !* biogenic chemical emissions
 !
-IF (OCH_BIO_FLUX) THEN
+IF (OCH_BIO_FLUX.AND.HPARAMBVOC=="SOLMON") THEN
   ALLOCATE(GB%XISOPOT(KDIM))
   YRECFM='E_ISOPOT'
   CALL READ_SURF(HPROGRAM,YRECFM,GB%XISOPOT,IRESP)
index 9aaba36..9d3b742 100644 (file)
@@ -3,8 +3,9 @@
 !SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt  
 !SFX_LIC for details. version 1.
 !     #########
-      SUBROUTINE READ_PGD_TEB_GREENROOF_n (OCH_BIO_FLUX, DTCO, DTV, GB, U, &
-                                           IO, S, K, KDIM, HPROGRAM,KVERSION)
+      SUBROUTINE READ_PGD_TEB_GREENROOF_n (OCH_BIO_FLUX, HPARAMBVOC, &
+                                           DTCO, DTV, GB, U, IO, S, K, &
+                                           KDIM, HPROGRAM,KVERSION)
 !     #########################################
 !
 !!****  *READ_PGD_TEB_GREENROOF_n* - routine to initialise ISBA physiographic variables 
 !!
 !!    MODIFICATIONS
 !!    -------------
-!!      Original    07/2011 
+!!      Original    07/2011
+!!      P. Tulet    06/2016 : add XEF for MEGAN coupling
+!!      M. Leriche     2017 : BVOC emission do not work with greenroof
+!!                              -> to be debug
 !-------------------------------------------------------------------------------
 !
 !*       0.    DECLARATIONS
@@ -69,6 +73,7 @@ IMPLICIT NONE
 !
 !
 LOGICAL, INTENT(IN) :: OCH_BIO_FLUX
+CHARACTER(LEN=*), INTENT(IN) :: HPARAMBVOC
 TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
 TYPE(DATA_ISBA_t), INTENT(INOUT) :: DTV
 TYPE(GR_BIOG_t), INTENT(INOUT) :: GB
@@ -121,7 +126,7 @@ ENDIF
 !-------------------------------------------------------------------------------
 !* biogenic chemical emissions
 !
-IF (OCH_BIO_FLUX) THEN
+IF (OCH_BIO_FLUX.AND.HPARAMBVOC=="SOLMON") THEN
   ALLOCATE(GB%XISOPOT(KDIM))
   YRECFM='E_ISOPOT'
   CALL READ_SURF(HPROGRAM,YRECFM,GB%XISOPOT,IRESP)
index fe75ab8..41b4953 100644 (file)
@@ -66,6 +66,9 @@ USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_INIT
 USE MODD_ISBA_n, ONLY : ISBA_S_INIT, ISBA_K_INIT, ISBA_P_INIT, &
                         ISBA_NK_INIT, ISBA_NP_INIT, ISBA_NPE_INIT
 !
+USE MODD_MEGAN_n, ONLY : MEGAN_INIT
+USE MODD_MEGAN_SURF_FIELDS_n, ONLY : MEGAN_SURF_FIELDS_INIT
+!
 USE MODD_CH_SEAFLUX_n, ONLY : CH_SEAFLUX_INIT
 USE MODD_DATA_SEAFLUX_n, ONLY : DATA_SEAFLUX_INIT
 USE MODD_SEAFLUX_n, ONLY : SEAFLUX_INIT
@@ -150,6 +153,8 @@ IF (LHOOK) CALL DR_HOOK("SURFEX_ALLOC",0,ZHOOK_HANDLE)
   CALL ISBA_NPE_INIT(YDSURFEX%IM%NPE,NVEGTYPE_ECOSG)  
   CALL AGRI_NP_INIT(YDSURFEX%IM%NAG,NVEGTYPE_ECOSG)
   !
+  CALL MEGAN_INIT(YDSURFEX%IM%MGN)
+  CALL MEGAN_SURF_FIELDS_INIT(YDSURFEX%IM%MSF)  
   !
   CALL DIAG_NP_INIT(YDSURFEX%GDM%VD%ND,NTEB_PATCH_MAX)  
   CALL DIAG_EVAP_ISBA_NP_INIT(YDSURFEX%GDM%VD%NDE,NTEB_PATCH_MAX)
index 28b02d0..0ac2c48 100644 (file)
@@ -5,7 +5,7 @@
 !     #########
 SUBROUTINE UPDATE_RAD_ISBA_n (IO, S, KK, PK, PEK, KPATCH, PZENITH, PSW_BANDS, &
                               PDIR_ALB_WITH_SNOW,PSCA_ALB_WITH_SNOW, PEMIST,  &
-                              PDIR_SW, PSCA_SW     )
+                              PRN_SHADE, PRN_SUNLIT, PDIR_SW, PSCA_SW     )
 !     ####################################################################
 !
 !!****  *UPDATE_RAD_ISBA_n * - Calculate snow/flood fraction, dir/dif albedo
@@ -82,6 +82,9 @@ REAL, DIMENSION(:,:), INTENT(OUT)  :: PDIR_ALB_WITH_SNOW ! Total direct albedo a
 REAL, DIMENSION(:,:), INTENT(OUT)  :: PSCA_ALB_WITH_SNOW ! Total diffuse albedo at t+1
 REAL, DIMENSION(:),   INTENT(OUT)  :: PEMIST             ! Total emissivity at t+1
 !
+REAL, DIMENSION(:),   INTENT(INOUT), OPTIONAL :: PRN_SHADE
+REAL, DIMENSION(:),   INTENT(INOUT), OPTIONAL :: PRN_SUNLIT
+!
 REAL, DIMENSION(:,:),   INTENT(IN), OPTIONAL   :: PDIR_SW   ! direct  solar radiation (on horizontal surf.)
 REAL, DIMENSION(:,:),   INTENT(IN), OPTIONAL   :: PSCA_SW   ! diffuse solar radiation (on horizontal surf.)
 !
@@ -226,7 +229,7 @@ IF(IO%LMEB_PATCH(KPATCH))THEN
               ZGLOBAL_SW, ZLAIN, ZZENITH, S%XABC,                                &
               PEK%XFAPARC, PEK%XFAPIRC, PEK%XMUS, PEK%XLAI_EFFC, GSHADE, ZIACAN, &              
               ZIACAN_SUNLIT, ZIACAN_SHADE, ZFRAC_SUN,                            &
-              ZFAPAR, ZFAPIR, ZFAPAR_BS, ZFAPIR_BS                               )    
+              ZFAPAR, ZFAPIR, ZFAPAR_BS, ZFAPIR_BS, PRN_SHADE, PRN_SUNLIT        )    
 
       ! Total effective surface (canopy, ground/flooded zone, snow) all-wavelength
       ! albedo: diagnosed from shortwave energy budget closure.
index 0c816be..706414e 100644 (file)
@@ -87,15 +87,15 @@ IF (LHOOK) CALL DR_HOOK('WRITE_ISBA_N',0,ZHOOK_HANDLE)
 !*       1.     Selection of surface scheme
 !               ---------------------------
 !        
- CALL WRITESURF_ISBA_CONF_n(IM%CHI, IM%ID%DE, IM%ID%O, IM%ID%DM, IM%O, HPROGRAM)
+ CALL WRITESURF_ISBA_CONF_n(IM%CHI, IM%MGN, IM%ID%DE, IM%ID%O, IM%ID%DM, IM%O, HPROGRAM)
 !
  CALL INIT_IO_SURF_n(DTCO, U, HPROGRAM,'NATURE','ISBA  ','WRITE','ISBA_PROGNOSTIC.OUT.nc')
 !
- CALL WRITESURF_ISBA_n(HSELECT, OSNOWDIMNC, IM%CHI, NDST, IM%O, IM%S, IM%NP, IM%NPE, &
+ CALL WRITESURF_ISBA_n(HSELECT, OSNOWDIMNC, IM%CHI, IM%MGN, NDST, IM%O, IM%S, IM%NP, IM%NPE, &
                        U%NSIZE_NATURE, HPROGRAM,OLAND_USE)
 !
 IF ((.NOT.LNOWRITE_CANOPY).OR.SIZE(HSELECT)>0) THEN
-  CALL WRITESURF_SBL_n(HSELECT, IM%O%LCANOPY, IM%SB, HPROGRAM, HWRITE, "NATURE",SV=IM%CHI%SVI)
+  CALL WRITESURF_SBL_n(HSELECT, IM%O%LCANOPY, IM%SB, HPROGRAM, HWRITE, "NATURE")
 ENDIF
 !
  CALL END_IO_SURF_n(HPROGRAM)
index 552eaaf..116cdfc 100644 (file)
@@ -33,6 +33,7 @@
 !!    MODIFICATIONS
 !!    -------------
 !!      Original    05/2011 according to previous write_surf_atmn.f90
+!!      P.Tulet & M. Leriche 06/2017 add coupling MEGAN
 !-------------------------------------------------------------------------------
 !
 !*       0.    DECLARATIONS
@@ -62,6 +63,8 @@ USE MODI_WRITESURF_SSO_n
 USE MODI_WRITESURF_DUMMY_n
 USE MODI_WRITESURF_SNAP_n
 USE MODI_WRITESURF_CH_EMIS_n
+USE MODI_WRITESURF_MEGAN_n
+!
 USE MODI_WRITE_GRID
 !
 USE MODI_WRITE_ECOCLIMAP2_DATA
@@ -140,15 +143,20 @@ ENDIF
  CALL WRITESURF_DUMMY_n(YSC%DUO%CSELECT, YSC%DUU, HPROGRAM)
 !
 YCOMMENT='CH_EMIS'
- CALL WRITE_SURF( YSC%DUO%CSELECT,  &
-                 HPROGRAM,'CH_EMIS',YSC%CHU%LCH_EMIS,IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(YSC%DUO%CSELECT,HPROGRAM,'CH_EMIS',YSC%CHU%LCH_EMIS,IRESP,HCOMMENT=YCOMMENT)
 !
 IF (YSC%CHU%LCH_EMIS) THEN
   YCOMMENT='CH_EMIS_OPT'
-  CALL WRITE_SURF( YSC%DUO%CSELECT,  &
-                 HPROGRAM,'CH_EMIS_OPT',YSC%CHU%CCH_EMIS,IRESP,HCOMMENT=YCOMMENT)
+  CALL WRITE_SURF(YSC%DUO%CSELECT,HPROGRAM,'CH_EMIS_OPT',YSC%CHU%CCH_EMIS,IRESP,HCOMMENT=YCOMMENT)
 END IF
 !
+! MEGAN coupling
+YCOMMENT='CH_BIOEMIS'
+CALL WRITE_SURF(YSC%DUO%CSELECT, HPROGRAM,'CH_BIOEMIS',YSC%CHU%LCH_BIOEMIS,IRESP,HCOMMENT=YCOMMENT)
+IF (YSC%CHU%LCH_BIOEMIS) THEN
+  CALL WRITESURF_MEGAN_n(YSC%DUO%CSELECT, YSC%IM%MSF, HPROGRAM)
+ENDIF
+!
 IF (YSC%CHU%LCH_EMIS) THEN
   IF (YSC%CHU%CCH_EMIS=='AGGR') THEN
     CALL WRITESURF_CH_EMIS_n(YSC%DUO%CSELECT, YSC%CHE, HPROGRAM)
index 3215564..06023f9 100644 (file)
@@ -19,8 +19,6 @@
 !!    -------------
 !!      Original    03/2004
 !!      M.Moge    01/2016  using WRITE_SURF_FIELD2D/3D for 2D/3D surfex fields writes
-!!      V.Masson & M. Leriche 06/06/17 do not count emitted species in nest case
-!!                                     do not write CEMIS_AREA no longer used
 !-------------------------------------------------------------------------------
 !
 !*       0.    DECLARATIONS
@@ -129,8 +127,7 @@ END IF
 !
 YRECFM='EMISPEC_NBR '
 YCOMMENT='Number of emitted chemical species.'
- CALL WRITE_SURF(HSELECT, &
-                 HPROGRAM,YRECFM,IEMISPEC_NBR,IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT, HPROGRAM,YRECFM,IEMISPEC_NBR,IRESP,HCOMMENT=YCOMMENT)
 !
 IF (IEMISPEC_NBR > 0) THEN
   !
@@ -191,27 +188,27 @@ ZWORK2D(:,:) = CHE%XEMIS_FIELDS(:,IINDEX(:))
 ! Write NAME of species JSPEC with AREA and number of emission times 
 ! stored in the commentary
 WRITE(YRECFM,'("EMISNAME",I3.3)') JSPEC
-YCOMMENT = "Emission species name" 
- CALL WRITE_SURF(HSELECT, &
-                 HPROGRAM,YRECFM,YEMISPEC_NAMES(JSPEC),IRESP,HCOMMENT=YCOMMENT)
-! !
+WRITE(YCOMMENT,'(A3,", emission times number:",I5)') CHE%CEMIS_AREA(IINDEX(1)),KSIZE
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,YEMISPEC_NAMES(JSPEC),IRESP,HCOMMENT=YCOMMENT)
+! 
+WRITE(YRECFM,'("EMISAREA",I3.3)') JSPEC
+YCOMMENT = "Emission area" 
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,CHE%CEMIS_AREA(IINDEX(1)),IRESP,HCOMMENT=YCOMMENT)
+!
 WRITE(YRECFM,'("EMISNBT",I3.3)') JSPEC
 YCOMMENT = "Emission times number" 
- CALL WRITE_SURF(HSELECT, &
-                 HPROGRAM,YRECFM,KSIZE,IRESP,HCOMMENT=YCOMMENT)
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,KSIZE,IRESP,HCOMMENT=YCOMMENT)
 
 ! Write emission times (ITIME) for species JSPEC
 WRITE(YRECFM,'("EMISTIMES",I3.3)') JSPEC  
 YCOMMENT = "Emission times in second"
- CALL WRITE_SURF(HSELECT, &
-                 HPROGRAM,YRECFM,ITIME(:),IRESP,HCOMMENT=YCOMMENT,HDIR='-',HNAM_DIM="Temporal_emiss  ")
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,ITIME(:),IRESP,HCOMMENT=YCOMMENT,HDIR='-',HNAM_DIM="Temporal_emiss  ")
 !
 ! Finally write emission data for species JSPEC
 YRECFM = "E_"//TRIM(YEMISPEC_NAMES(JSPEC))
 YCOMMENT = "Emission data (x,y,t),"//TRIM(CHE%CEMIS_COMMENT(IINDEX(1)))
 YCOMMENTUNIT='-'
- CALL WRITE_SURF_FIELD2D(HSELECT, &
-                  HPROGRAM,ZWORK2D(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT,HNAM_DIM="Temporal_emiss  ")
+ CALL WRITE_SURF_FIELD2D(HSELECT,HPROGRAM,ZWORK2D(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT,HNAM_DIM="Temporal_emiss  ")
 !
 IF (LHOOK) CALL DR_HOOK('WRITESURF_CH_EMIS_N:WRITE_EMIS_SPEC',1,ZHOOK_HANDLE)
 !
index 82dc03e..8c824d0 100644 (file)
@@ -3,7 +3,7 @@
 !SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt  
 !SFX_LIC for details. version 1.
 !     #########
-      SUBROUTINE WRITESURF_ISBA_CONF_n (CHI, DE, DGO, DMI, IO, HPROGRAM)
+      SUBROUTINE WRITESURF_ISBA_CONF_n (CHI, MGN, DE, DGO, DMI, IO, HPROGRAM)
 !     ######################################################
 !
 !!****  *WRITESURF_ISBA_CONF* - routine to read the configuration for ISBA
@@ -38,6 +38,7 @@
 !              ------------
 !
 USE MODD_CH_ISBA_n, ONLY : CH_ISBA_t
+USE MODD_MEGAN_n, ONLY : MEGAN_t
 USE MODD_DIAG_EVAP_ISBA_n, ONLY : DIAG_EVAP_ISBA_t
 USE MODD_DIAG_n, ONLY : DIAG_OPTIONS_t
 USE MODD_DIAG_MISC_ISBA_n, ONLY : DIAG_MISC_ISBA_t
@@ -60,8 +61,8 @@ IMPLICIT NONE
 !*       0.1   Declarations of arguments
 !              -------------------------
 !
-!
 TYPE(CH_ISBA_t), INTENT(INOUT) :: CHI
+TYPE(MEGAN_t), INTENT(INOUT) :: MGN
 TYPE(DIAG_EVAP_ISBA_t), INTENT(INOUT) :: DE
 TYPE(DIAG_OPTIONS_t), INTENT(INOUT) :: DGO
 TYPE(DIAG_MISC_ISBA_t), INTENT(INOUT) :: DMI
@@ -90,7 +91,7 @@ IF (ILUDES==0) RETURN
  CALL INIT_NAM_ISBA_AGSn(IO)
  CALL INIT_NAM_SGH_ISBAn(IO)
  CALL INIT_NAM_DIAG_ISBAn(DE, DGO, DMI)
- CALL INIT_NAM_CH_ISBAn(CHI)
+ CALL INIT_NAM_CH_ISBAn(CHI, MGN)
  CALL INIT_NAM_SPINUP_CARB_ISBAn(IO)
  CALL INIT_NAM_ISBA_SNOWn(IO)
 !
index 06f28d8..d991d94 100644 (file)
@@ -3,7 +3,7 @@
 !SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt  
 !SFX_LIC for details. version 1.
 !     #########
-      SUBROUTINE WRITESURF_ISBA_n (HSELECT, OSNOWDIMNC, CHI, NDST, &
+      SUBROUTINE WRITESURF_ISBA_n (HSELECT, OSNOWDIMNC, CHI, MGN, NDST, &
                                    IO, S, NP, NPE, KI, HPROGRAM, OLAND_USE)
 !     #####################################
 !
@@ -46,6 +46,8 @@
 !!      B. Decharme  09/2012 : write some key for prep_read_external
 !!      B. Decharme  04/2013 : Only 2 temperature layer in ISBA-FR
 !!      P. Samuelsson 10/2014: MEB
+!!      P. Tulet  06/2016 : add XEF et XPFT for MEGAN coupling
+!!      M. Leriche 06/2017: comment write XEF & XPFT bug
 !!
 !-------------------------------------------------------------------------------
 !
@@ -62,6 +64,7 @@ USE MODD_DST_n, ONLY : DST_NP_t
 !
 USE MODD_ISBA_OPTIONS_n, ONLY : ISBA_OPTIONS_t
 USE MODD_ISBA_n, ONLY : ISBA_NP_t, ISBA_NPE_t, ISBA_S_t
+USE MODD_MEGAN_n, ONLY : MEGAN_t
 !
 USE MODD_SURF_PAR, ONLY : NUNDEF
 !
@@ -88,6 +91,7 @@ IMPLICIT NONE
 LOGICAL, INTENT(IN) :: OSNOWDIMNC  
 !
 TYPE(CH_ISBA_t), INTENT(INOUT) :: CHI
+TYPE(MEGAN_t), INTENT(INOUT) :: MGN
 TYPE(DST_NP_t), INTENT(INOUT) :: NDST
 !
 TYPE(ISBA_OPTIONS_t), INTENT(INOUT) :: IO
index 3356197..06acaf2 100644 (file)
@@ -3,7 +3,7 @@
 !SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt  
 !SFX_LIC for details. version 1.
 !     ###########################################################
-      SUBROUTINE ZOOM_PGD_ISBA (CHI, DTCO, DTV, IG, IO, S, K, ISS, UG, U, USS, GCP, &
+      SUBROUTINE ZOOM_PGD_ISBA (CHI, MSF, DTCO, DTV, IG, IO, S, K, ISS, UG, U, USS, GCP, &
                                 HPROGRAM,HINIFILE,HINIFILETYPE,HFILE,HFILETYPE,OECOCLIMAP)
 !     ###########################################################
 
@@ -53,6 +53,7 @@ USE MODD_ISBA_n, ONLY : ISBA_S_t, ISBA_K_t
 USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
 USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
 USE MODD_SSO_n, ONLY : SSO_t
+USE MODD_MEGAN_SURF_FIELDS_n, ONLY : MEGAN_SURF_FIELDS_t
 !
 USE MODD_SURF_PAR, ONLY : XUNDEF
 USE MODD_DATA_COVER_PAR, ONLY : JPCOVER
@@ -84,6 +85,7 @@ IMPLICIT NONE
 !
 !
 TYPE(CH_ISBA_t), INTENT(INOUT) :: CHI
+TYPE(MEGAN_SURF_FIELDS_t), INTENT(INOUT) :: MSF
 TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
 TYPE(DATA_ISBA_t), INTENT(INOUT) :: DTV
 TYPE(GRID_t), INTENT(INOUT) :: IG
@@ -214,6 +216,8 @@ ENDIF
 !------------------------------------------------------------------------------
 IO%LECOCLIMAP = OECOCLIMAP
 !
+MSF%NMEGAN_NBR = 0
+!
 !-------------------------------------------------------------------------------
 !
 !*    7.      Number of points and packing of general fields
index 979c372..aece2f9 100644 (file)
@@ -87,7 +87,7 @@ ELSE IF (U%CNATURE=='FLUX  ') THEN
   IF (LHOOK) CALL DR_HOOK('ZOOM_PGD_NATURE',1,ZHOOK_HANDLE)
   RETURN
 ELSE IF (U%CNATURE=='ISBA  ' .OR. U%CNATURE=='TSZ0') THEN
-  CALL ZOOM_PGD_ISBA(IM%CHI, DTCO, IM%DTV, IM%G, IM%O, IM%S, IM%K, IM%ISS, UG, U, USS, GCP, &
+  CALL ZOOM_PGD_ISBA(IM%CHI, IM%MSF, DTCO, IM%DTV, IM%G, IM%O, IM%S, IM%K, IM%ISS, UG, U, USS, GCP, &
                      HPROGRAM,HINIFILE,HINIFILETYPE,HFILE,HFILETYPE,OECOCLIMAP)
 END IF
 IF (LHOOK) CALL DR_HOOK('ZOOM_PGD_NATURE',1,ZHOOK_HANDLE)
index 89bcf6c..68a1fa0 100755 (executable)
@@ -448,6 +448,12 @@ if [ "x${VER_OASIS}" == "xOASISAUTO" ] ; then
 ( cd $LOCAL/src/LIB ; [ ! -d oasis3-${VERSION_OASIS} ] && tar xvfz oasis3-${VERSION_OASIS}.tar.gz ; [ ! -d toy_${VERSION_TOY} ] && tar xvfz toy_${VERSION_TOY}.tar.gz )
 fi
 #
+#  Install MEGAN if MNH_MEGAN=1
+#
+if [ "x${MNH_MEGAN}" == "x1" ] ; then
+( cd $LOCAL/src/LIB ; [ ! -d MEGAN ] && tar xvfz megan.tar.gz )
+fi
+#
 #  Install GRIBAPI
 #
 cd $LOCAL/src/LIB ; [ ! -d grib_api-${VERSION_GRIBAPI} ] && [ -f grib_api-${VERSION_GRIBAPI}.tar.gz ] && gunzip -c grib_api-${VERSION_GRIBAPI}.tar.gz |tar -xvf -