From ee1e990a4ec7ff8a1babeff685bf3590f91a19e5 Mon Sep 17 00:00:00 2001
From: Gaelle Tanguy <gaelle.tanguy@meteo.fr>
Date: Mon, 18 Jan 2016 09:18:35 +0000
Subject: [PATCH] Gaelle 18/01/2016: modif for PREPLL from M.Moge
---
src/MNH/fill_sonfieldn.f90 | 470 ++--
src/MNH/fill_zsmtn.f90 | 299 +-
src/MNH/open_nestpgd_files.f90 | 665 ++---
src/SURFEX/build_emisstabn.F90 | 411 ++-
src/SURFEX/ch_emission_fluxn.F90 | 875 +++---
src/SURFEX/ch_init_snapn.F90 | 341 ++-
src/SURFEX/mode_read_extern.F90 | 1320 +++++----
src/SURFEX/prep_isba_extern.F90 | 371 ++-
src/SURFEX/prep_teb_extern.F90 | 733 ++---
src/SURFEX/prep_teb_garden_extern.F90 | 480 ++--
src/SURFEX/prep_teb_greenroof_extern.F90 | 478 ++--
src/SURFEX/read_gr_snow.F90 | 743 +++--
src/SURFEX/read_isban.F90 | 879 +++---
src/SURFEX/read_pgd_isba_parn.F90 | 1358 +++++-----
src/SURFEX/read_surf_field2d.F90 | 132 +
src/SURFEX/read_surf_field3d.F90 | 148 +
src/SURFEX/read_surf_isba_parn.F90 | 184 +-
src/SURFEX/regular_grid_spawn.F90 | 1224 ++++-----
src/SURFEX/write_diag_misc_isban.F90 | 1114 ++++----
src/SURFEX/write_diag_pgd_isban.F90 | 855 +++---
src/SURFEX/write_diag_seb_isban.F90 | 3147 +++++++++++-----------
src/SURFEX/write_surf_field2d.F90 | 134 +
src/SURFEX/write_surf_field3d.F90 | 146 +
src/SURFEX/writesurf_ch_emisn.F90 | 362 +--
src/SURFEX/writesurf_gr_snow.F90 | 581 ++--
src/SURFEX/writesurf_isban.F90 | 945 +++----
src/SURFEX/writesurf_pgd_isba_parn.F90 | 1020 +++----
src/SURFEX/writesurf_pgd_isban.F90 | 715 +++--
src/SURFEX/writesurf_snapn.F90 | 166 +-
29 files changed, 10211 insertions(+), 10085 deletions(-)
create mode 100644 src/SURFEX/read_surf_field2d.F90
create mode 100644 src/SURFEX/read_surf_field3d.F90
create mode 100644 src/SURFEX/write_surf_field2d.F90
create mode 100644 src/SURFEX/write_surf_field3d.F90
diff --git a/src/MNH/fill_sonfieldn.f90 b/src/MNH/fill_sonfieldn.f90
index aba16ef34..c4163bda2 100644
--- a/src/MNH/fill_sonfieldn.f90
+++ b/src/MNH/fill_sonfieldn.f90
@@ -1,242 +1,228 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$
-!-----------------------------------------------------------------
-! ##########################
- MODULE MODI_FILL_SONFIELD_n
-! ##########################
-!
-INTERFACE
-!
- SUBROUTINE FILL_SONFIELD_n(KMI,YFIELD,PNESTFIELD,KLSON)
-!
-INTEGER , INTENT(IN) :: KMI ! son model number
-CHARACTER(LEN=6), INTENT(IN) :: YFIELD ! name of the field to nest
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNESTFIELD
-INTEGER, INTENT(IN) :: KLSON ! rank of son model in PNESTFIELD
-!
-END SUBROUTINE FILL_SONFIELD_n
-END INTERFACE
-!
-END MODULE MODI_FILL_SONFIELD_n
-!
-!
-!
-! ##################################################
- SUBROUTINE FILL_SONFIELD_n(KMI,YFIELD,PNESTFIELD,KLSON)
-! ##################################################
-!
-!!**** *FILL_SONFIELD_n* - fill the working array for nesting of pgd files
-!! with son model index= _n
-!!
-!! PURPOSE
-!! -------
-!
-!!** METHOD
-!! ------
-!!
-!! EXTERNAL
-!! --------
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!! Book2 of the documentation
-!!
-!!
-!! AUTHOR
-!! ------
-!! V. Masson * Meteo France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 27/09/96
-!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-!
-USE MODD_GRID_n
-USE MODD_NESTING
-USE MODD_PARAMETERS
-USE MODE_SPLITTING_ll, ONLY : SPLIT2
-USE MODD_VAR_ll, ONLY : NPROC, IP, YSPLITTING, NMNH_COMM_WORLD
-USE MODD_STRUCTURE_ll, ONLY : ZONE_ll
-!
-USE MODE_MODELN_HANDLER
-!
-!USE MODE_TOOLS_ll, ONLY : GET_OR_ll
-!USE MODE_LS_ll
-!USE MODD_LSFIELD_n, ONLY : SET_LSFIELD_1WAY_ll
-USE MODE_ll
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-!
-INTEGER , INTENT(IN) :: KMI ! son model number
-CHARACTER(LEN=6), INTENT(IN) :: YFIELD ! name of the field to nest
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNESTFIELD
-INTEGER, INTENT(IN) :: KLSON ! rank of son model in PNESTFIELD
-!
-!
-!* 0.2 declarations of local variables
-!
-INTEGER :: IIB1,IIE1,IJB1,IJE1 ! limits of physical domain of KDAD model
-INTEGER :: JI1,JJ1 ! loop counters in domain of KDAD model
-!
-INTEGER :: JI2INF, JI2SUP ! limits of a grid mesh of domain of KDAD model
-INTEGER :: JJ2INF,JJ2SUP ! relatively to son domain
-INTEGER :: IMI ! current model index
-INTEGER :: JLAYER ! loop counter
-INTEGER :: IINFO_ll
-INTEGER :: IXSIZE, IYSIZE ! sizes of global son domain in father grid
-TYPE(ZONE_ll), DIMENSION(:), ALLOCATABLE :: TZSPLITTING
-INTEGER :: IXOR, IYOR ! origin of local subdomain
-INTEGER :: IXOR_C, IYOR_C, IXEND_C, IYEND_C ! origin and end of local physical son subdomain in father grid
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZSUM
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZSUM_C
-INTEGER :: IDIMX_C, IDIMY_C ! size of extended local son subdomain in father grid obtained with GET_CHILD_DIM_ll
-!-------------------------------------------------------------------------------
-!
-!* 1. initializations
-! ---------------
-!
-IMI = GET_CURRENT_MODEL_INDEX()
-CALL GET_OR_ll( YSPLITTING, IXOR, IYOR )
-CALL GOTO_MODEL(KMI)
-CALL GO_TOMODEL_ll(KMI, IINFO_ll)
-!
-IF (KLSON/=1) THEN
- ! get sizes of global son domain in father grid
- IXSIZE = NXEND_ALL(KMI) - NXOR_ALL (KMI) + 1 - 2*JPHEXT ! - 1
- IYSIZE = NYEND_ALL(KMI) - NYOR_ALL (KMI) + 1 - 2*JPHEXT ! - 1
- ! get splitting of current model KMI in father grid
- ALLOCATE(TZSPLITTING(NPROC))
- CALL SPLIT2 ( IXSIZE, IYSIZE, 1, NPROC, TZSPLITTING, YSPLITTING )
-! IIB1 = NXOR_ALL(KMI) + TZSPLITTING(IP)%NXOR - JPHEXT - IXOR + 1
-! IIE1 = NXOR_ALL(KMI) + TZSPLITTING(IP)%NXEND - JPHEXT - IXOR + 1
-! IJB1 = NYOR_ALL(KMI) + TZSPLITTING(IP)%NYOR - JPHEXT - IYOR + 1
-! IJE1 = NYOR_ALL(KMI) + TZSPLITTING(IP)%NYEND - JPHEXT - IYOR + 1
- IIB1 = JPHEXT + 1
- IIE1 = TZSPLITTING(IP)%NXEND - TZSPLITTING(IP)%NXOR + JPHEXT + 1
- IJB1 = JPHEXT + 1
- IJE1 = TZSPLITTING(IP)%NYEND - TZSPLITTING(IP)%NYOR + JPHEXT + 1
-! IIB1 = NXOR_ALL(KMI) + TZSPLITTING(IP)%NXOR - JPHEXT
-! IIE1 = NXOR_ALL(KMI) + TZSPLITTING(IP)%NXEND - JPHEXT
-! IJB1 = NYOR_ALL(KMI) + TZSPLITTING(IP)%NYOR - JPHEXT
-! IJE1 = NYOR_ALL(KMI) + TZSPLITTING(IP)%NYEND - JPHEXT
-ENDIF
-!
-!* correct only if JPHEXT = 1
-!
-!JUAN A REVOIR TODO_JPHEXT !!!
-! <<<<<<< fill_sonfieldn.f90
-!IIB1 = NXOR_ALL (KMI)+1
-!IIE1 = NXEND_ALL(KMI)-1
-!IJB1 = NYOR_ALL (KMI)+1
-!IJE1 = NYEND_ALL(KMI)-1
-! =======
-!IIB1 = NXOR_ALL (KMI)+JPHEXT
-!IIE1 = NXEND_ALL(KMI)-JPHEXT
-!IJB1 = NYOR_ALL (KMI)+JPHEXT
-!IJE1 = NYEND_ALL(KMI)-JPHEXT
-! >>>>>>> 1.2.4.1.18.2.2.1
-!
-DO JLAYER=1,SIZE(PNESTFIELD,4)
- PNESTFIELD(:,:,KLSON,JLAYER) = XUNDEF
-END DO
-!
-!-------------------------------------------------------------------------------
-IF (KLSON==1) THEN
-!
-!* 2. case KLSON=1 : father itself
-! ----------------------------
-!
- SELECT CASE(YFIELD)
- CASE ('ZS ')
- PNESTFIELD(:,:,KLSON,1) = XZS(:,:)
- CASE ('ZSMT ') ! smooth topography for SLEVE coordinate
- PNESTFIELD(:,:,KLSON,1) = XZSMT(:,:)
- CASE DEFAULT
- CALL GOTO_MODEL(IMI)
- CALL GO_TOMODEL_ll(IMI, IINFO_ll)
- END SELECT
-!
-!-------------------------------------------------------------------------------
-ELSE
-!
-!* 3. case KLSON>1 : one son
-! ----------------------
-!
-! ALLOCATE( ZSUM(SIZE(PNESTFIELD,1), SIZE(PNESTFIELD,2)) )
- ALLOCATE( ZSUM(SIZE(XZS,1), SIZE(XZS,2)) )
- !
- CALL GOTO_MODEL( NDAD(KMI) )
- CALL GO_TOMODEL_ll( NDAD(KMI), IINFO_ll )
- CALL GET_CHILD_DIM_ll(KMI, IDIMX_C, IDIMY_C, IINFO_ll)
- CALL GOTO_MODEL( KMI )
- CALL GO_TOMODEL_ll( KMI, IINFO_ll )
- ALLOCATE( ZSUM_C(IDIMX_C, IDIMY_C) )
- !
- DO JI1 = IIB1,IIE1
- DO JJ1 = IJB1,IJE1
- JI2INF= (JI1-IIB1) *NDXRATIO_ALL(KMI)+1+JPHEXT
- JI2SUP= (JI1-IIB1+1)*NDXRATIO_ALL(KMI) +JPHEXT
- JJ2INF= (JJ1-IJB1) *NDYRATIO_ALL(KMI)+1+JPHEXT
- JJ2SUP= (JJ1-IJB1+1)*NDYRATIO_ALL(KMI) +JPHEXT
-
- SELECT CASE(YFIELD)
- CASE ('ZS ')
-! ZSUM(JI1,JJ1) = SUM ( XZS(JI2INF:JI2SUP,JJ2INF:JJ2SUP ) )&
-! / ( NDXRATIO_ALL(KMI)*NDYRATIO_ALL(KMI) )
-! ZSUM(JI2INF:JI2SUP,JJ2INF:JJ2SUP) = SUM ( XZS(JI2INF:JI2SUP,JJ2INF:JJ2SUP ) )&
-! / ( NDXRATIO_ALL(KMI)*NDYRATIO_ALL(KMI) )
- ZSUM_C(1+JPHEXT+(JI1-IIB1+1),1+JPHEXT+(JJ1-IJB1+1)) = SUM ( XZS(JI2INF:JI2SUP,JJ2INF:JJ2SUP ) )&
- / ( NDXRATIO_ALL(KMI)*NDYRATIO_ALL(KMI) )
-! PNESTFIELD(JI1,JJ1,KLSON,1) = SUM ( XZS(JI2INF:JI2SUP,JJ2INF:JJ2SUP ) )&
-! / ( NDXRATIO_ALL(KMI)*NDYRATIO_ALL(KMI) )
- CASE ('ZSMT ') ! smooth topography for SLEVE coordinate
-! ZSUM(JI1,JJ1) = SUM ( XZSMT(JI2INF:JI2SUP,JJ2INF:JJ2SUP ) )&
-! / ( NDXRATIO_ALL(KMI)*NDYRATIO_ALL(KMI) )
-! ZSUM(JI2INF,JJ2INF) = SUM ( XZSMT(JI2INF:JI2SUP,JJ2INF:JJ2SUP ) )&
-! / ( NDXRATIO_ALL(KMI)*NDYRATIO_ALL(KMI) )
- ZSUM_C(1+JPHEXT+(JI1-IIB1+1),1+JPHEXT+(JJ1-IJB1+1)) = SUM ( XZSMT(JI2INF:JI2SUP,JJ2INF:JJ2SUP ) )&
- / ( NDXRATIO_ALL(KMI)*NDYRATIO_ALL(KMI) )
-! PNESTFIELD(JI1,JJ1,KLSON,1) = SUM ( XZSMT(JI2INF:JI2SUP,JJ2INF:JJ2SUP ) )&
-! / ( NDXRATIO_ALL(KMI)*NDYRATIO_ALL(KMI) )
- CASE DEFAULT
- CALL GOTO_MODEL(IMI)
- CALL GO_TOMODEL_ll(IMI, IINFO_ll)
- RETURN
- END SELECT
-
- END DO
- END DO
- !switch to father model to set the LSFIELD and do the communications with LS_FEEDBACK_ll
-! CALL GOTO_MODEL( NDAD(KMI) )
-! CALL GO_TOMODEL_ll( NDAD(KMI), IINFO_ll )
-! CALL SET_LSFIELD_1WAY_ll(PNESTFIELD(:,:,KLSON,1), ZSUM, KMI)
-CALL GET_FEEDBACK_COORD_ll(IXOR_C,IYOR_C,IXEND_C,IYEND_C,IINFO_ll) ! physical domain's origin and end
- CALL SET_LSFIELD_2WAY_ll(PNESTFIELD(IXOR_C:IXEND_C,IYOR_C:IYEND_C,KLSON,1), ZSUM_C)
-! CALL SET_LSFIELD_2WAY_ll(PNESTFIELD(:,:,KLSON,1), ZSUM)
-! CALL GOTO_MODEL( KMI )
-! CALL GO_TOMODEL_ll( KMI, IINFO_ll )
- CALL LS_FEEDBACK_ll(IINFO_ll)
- CALL UNSET_LSFIELD_1WAY_ll()
-!
-!-------------------------------------------------------------------------------
-END IF
-!
-CALL GOTO_MODEL(IMI)
-CALL GO_TOMODEL_ll(IMI, IINFO_ll)
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE FILL_SONFIELD_n
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!--------------- special set of characters for RCS information
+!-----------------------------------------------------------------
+! $Source$ $Revision$
+!-----------------------------------------------------------------
+! ##########################
+ MODULE MODI_FILL_SONFIELD_n
+! ##########################
+!
+INTERFACE
+!
+ SUBROUTINE FILL_SONFIELD_n(KMI,YFIELD,PNESTFIELD,KLSON)
+!
+INTEGER , INTENT(IN) :: KMI ! son model number
+CHARACTER(LEN=6), INTENT(IN) :: YFIELD ! name of the field to nest
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNESTFIELD
+INTEGER, INTENT(IN) :: KLSON ! rank of son model in PNESTFIELD
+!
+END SUBROUTINE FILL_SONFIELD_n
+END INTERFACE
+!
+END MODULE MODI_FILL_SONFIELD_n
+!
+!
+!
+! ##################################################
+ SUBROUTINE FILL_SONFIELD_n(KMI,YFIELD,PNESTFIELD,KLSON)
+! ##################################################
+!
+!!**** *FILL_SONFIELD_n* - fill the working array for nesting of pgd files
+!! with son model index= _n
+!!
+!! PURPOSE
+!! -------
+!
+!!** METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of the documentation
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Masson * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 27/09/96
+!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+!! M.Moge 01/2016 bug fix for parallel execution
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+USE MODD_GRID_n
+USE MODD_NESTING
+USE MODD_PARAMETERS
+USE MODE_SPLITTING_ll, ONLY : SPLIT2, DEF_SPLITTING2
+USE MODD_VAR_ll, ONLY : NPROC, IP, YSPLITTING, NMNH_COMM_WORLD
+USE MODD_STRUCTURE_ll, ONLY : ZONE_ll
+!
+USE MODE_MODELN_HANDLER
+!
+!USE MODE_TOOLS_ll, ONLY : GET_OR_ll
+!USE MODE_LS_ll
+!USE MODD_LSFIELD_n, ONLY : SET_LSFIELD_1WAY_ll
+USE MODE_ll
+!
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+INTEGER , INTENT(IN) :: KMI ! son model number
+CHARACTER(LEN=6), INTENT(IN) :: YFIELD ! name of the field to nest
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PNESTFIELD
+INTEGER, INTENT(IN) :: KLSON ! rank of son model in PNESTFIELD
+!
+!
+!* 0.2 declarations of local variables
+!
+INTEGER :: IIB1,IIE1,IJB1,IJE1 ! limits of physical domain of KDAD model
+INTEGER :: JI1,JJ1 ! loop counters in domain of KDAD model
+!
+INTEGER :: JI2INF, JI2SUP ! limits of a grid mesh of domain of KDAD model
+INTEGER :: JJ2INF,JJ2SUP ! relatively to son domain
+INTEGER :: IMI ! current model index
+INTEGER :: JLAYER ! loop counter
+INTEGER :: IINFO_ll
+INTEGER :: IXSIZE, IYSIZE ! sizes of global son domain in father grid
+INTEGER :: IXSIZE_F, IYSIZE_F ! sizes of global father domain
+TYPE(ZONE_ll), DIMENSION(:), ALLOCATABLE :: TZSPLITTING
+INTEGER :: IXOR, IYOR ! origin of local subdomain
+INTEGER :: IXOR_C, IYOR_C, IXEND_C, IYEND_C ! origin and end of local physical son subdomain in father grid
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZSUM
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZSUM_C
+INTEGER :: IDIMX_C, IDIMY_C ! size of extended local son subdomain in father grid obtained with GET_CHILD_DIM_ll
+INTEGER :: IXDOMAINS, IYDOMAINS ! number of subdomains in X and Y directions
+LOGICAL :: GPREM ! needed for DEF_SPLITTING2, true if NPROC is a prime number
+!-------------------------------------------------------------------------------
+!
+!* 1. initializations
+! ---------------
+!
+IMI = GET_CURRENT_MODEL_INDEX()
+CALL GET_OR_ll( YSPLITTING, IXOR, IYOR )
+CALL GOTO_MODEL(KMI)
+CALL GO_TOMODEL_ll(KMI, IINFO_ll)
+!
+IF (KLSON/=1) THEN
+ ! get sizes of global son domain in father grid
+ IXSIZE = NXEND_ALL(KMI) - NXOR_ALL (KMI) + 1 - 2*JPHEXT ! - 1
+ IYSIZE = NYEND_ALL(KMI) - NYOR_ALL (KMI) + 1 - 2*JPHEXT ! - 1
+ ! get splitting of current model KMI in father grid
+ IXSIZE_F = NXEND_ALL(NDAD(KMI)) - NXOR_ALL (NDAD(KMI)) + 1 - 2*JPHEXT
+ IYSIZE_F = NYEND_ALL(NDAD(KMI)) - NYOR_ALL (NDAD(KMI)) + 1 - 2*JPHEXT
+ ALLOCATE(TZSPLITTING(NPROC))
+! we want the same domain partitioning for the child domain and for the father domain
+ CALL DEF_SPLITTING2(IXDOMAINS,IYDOMAINS,IXSIZE_F,IYSIZE_F,NPROC,GPREM)
+ CALL SPLIT2 ( IXSIZE, IYSIZE, 1, NPROC, TZSPLITTING, YSPLITTING, IXDOMAINS, IYDOMAINS )
+ IIB1 = JPHEXT + 1
+ IIE1 = TZSPLITTING(IP)%NXEND - TZSPLITTING(IP)%NXOR + JPHEXT + 1
+ IJB1 = JPHEXT + 1
+ IJE1 = TZSPLITTING(IP)%NYEND - TZSPLITTING(IP)%NYOR + JPHEXT + 1
+! IIB1 = NXOR_ALL(KMI) + TZSPLITTING(IP)%NXOR - JPHEXT
+! IIE1 = NXOR_ALL(KMI) + TZSPLITTING(IP)%NXEND - JPHEXT
+! IJB1 = NYOR_ALL(KMI) + TZSPLITTING(IP)%NYOR - JPHEXT
+! IJE1 = NYOR_ALL(KMI) + TZSPLITTING(IP)%NYEND - JPHEXT
+ENDIF
+!
+!* correct only if JPHEXT = 1
+!
+!JUAN A REVOIR TODO_JPHEXT !!!
+! <<<<<<< fill_sonfieldn.f90
+!IIB1 = NXOR_ALL (KMI)+1
+!IIE1 = NXEND_ALL(KMI)-1
+!IJB1 = NYOR_ALL (KMI)+1
+!IJE1 = NYEND_ALL(KMI)-1
+! =======
+!IIB1 = NXOR_ALL (KMI)+JPHEXT
+!IIE1 = NXEND_ALL(KMI)-JPHEXT
+!IJB1 = NYOR_ALL (KMI)+JPHEXT
+!IJE1 = NYEND_ALL(KMI)-JPHEXT
+! >>>>>>> 1.2.4.1.18.2.2.1
+!
+DO JLAYER=1,SIZE(PNESTFIELD,4)
+ PNESTFIELD(:,:,KLSON,JLAYER) = XUNDEF
+END DO
+!
+!-------------------------------------------------------------------------------
+IF (KLSON==1) THEN
+!
+!* 2. case KLSON=1 : father itself
+! ----------------------------
+!
+ SELECT CASE(YFIELD)
+ CASE ('ZS ')
+ PNESTFIELD(:,:,KLSON,1) = XZS(:,:)
+ CASE ('ZSMT ') ! smooth topography for SLEVE coordinate
+ PNESTFIELD(:,:,KLSON,1) = XZSMT(:,:)
+ CASE DEFAULT
+ CALL GOTO_MODEL(IMI)
+ CALL GO_TOMODEL_ll(IMI, IINFO_ll)
+ END SELECT
+!
+!-------------------------------------------------------------------------------
+ELSE
+!
+!* 3. case KLSON>1 : one son
+! ----------------------
+!
+! ALLOCATE( ZSUM(SIZE(PNESTFIELD,1), SIZE(PNESTFIELD,2)) )
+ ALLOCATE( ZSUM(SIZE(XZS,1), SIZE(XZS,2)) )
+ !
+ CALL GOTO_MODEL( NDAD(KMI) )
+ CALL GO_TOMODEL_ll( NDAD(KMI), IINFO_ll )
+ CALL GET_CHILD_DIM_ll(KMI, IDIMX_C, IDIMY_C, IINFO_ll)
+ CALL GOTO_MODEL( KMI )
+ CALL GO_TOMODEL_ll( KMI, IINFO_ll )
+ ALLOCATE( ZSUM_C(IDIMX_C, IDIMY_C) )
+ !
+ DO JI1 = IIB1,IIE1
+ DO JJ1 = IJB1,IJE1
+ JI2INF= (JI1-IIB1) *NDXRATIO_ALL(KMI)+1+JPHEXT
+ JI2SUP= (JI1-IIB1+1)*NDXRATIO_ALL(KMI) +JPHEXT
+ JJ2INF= (JJ1-IJB1) *NDYRATIO_ALL(KMI)+1+JPHEXT
+ JJ2SUP= (JJ1-IJB1+1)*NDYRATIO_ALL(KMI) +JPHEXT
+
+ SELECT CASE(YFIELD)
+ CASE ('ZS ')
+ ZSUM_C(1+JPHEXT+(JI1-IIB1+1),1+JPHEXT+(JJ1-IJB1+1)) = SUM ( XZS(JI2INF:JI2SUP,JJ2INF:JJ2SUP ) )&
+ / ( NDXRATIO_ALL(KMI)*NDYRATIO_ALL(KMI) )
+ CASE ('ZSMT ') ! smooth topography for SLEVE coordinate
+ ZSUM_C(1+JPHEXT+(JI1-IIB1+1),1+JPHEXT+(JJ1-IJB1+1)) = SUM ( XZSMT(JI2INF:JI2SUP,JJ2INF:JJ2SUP ) )&
+ / ( NDXRATIO_ALL(KMI)*NDYRATIO_ALL(KMI) )
+ CASE DEFAULT
+ CALL GOTO_MODEL(IMI)
+ CALL GO_TOMODEL_ll(IMI, IINFO_ll)
+ RETURN
+ END SELECT
+
+ END DO
+ END DO
+ !switch to father model to set the LSFIELD and do the communications with LS_FEEDBACK_ll
+CALL GET_FEEDBACK_COORD_ll(IXOR_C,IYOR_C,IXEND_C,IYEND_C,IINFO_ll) ! physical domain's origin and end
+ CALL SET_LSFIELD_2WAY_ll(PNESTFIELD(IXOR_C:IXEND_C,IYOR_C:IYEND_C,KLSON,1), ZSUM_C)
+ CALL LS_FEEDBACK_ll(IINFO_ll)
+ CALL UNSET_LSFIELD_1WAY_ll()
+!
+!-------------------------------------------------------------------------------
+END IF
+!
+CALL GOTO_MODEL(IMI)
+CALL GO_TOMODEL_ll(IMI, IINFO_ll)
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE FILL_SONFIELD_n
diff --git a/src/MNH/fill_zsmtn.f90 b/src/MNH/fill_zsmtn.f90
index fadde4e1b..5bb8ae9ea 100644
--- a/src/MNH/fill_zsmtn.f90
+++ b/src/MNH/fill_zsmtn.f90
@@ -1,147 +1,152 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$
-! masdev4_7 BUG1 2007/06/15 17:47:17
-!-----------------------------------------------------------------
-! ######################
- MODULE MODI_FILL_ZSMTn
-! ######################
-!
-INTERFACE
-!
- SUBROUTINE FILL_ZSMT_n(HFIELD,PFIELD,KSON)
-!
-CHARACTER(LEN=6), INTENT(IN) :: HFIELD ! name of the field to nest
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PFIELD
-INTEGER, INTENT(IN) :: KSON ! son model index
-!
-END SUBROUTINE FILL_ZSMT_n
-!
-END INTERFACE
-!
-END MODULE MODI_FILL_ZSMTn
-!
-!
-!
-! ##########################################
- SUBROUTINE FILL_ZSMT_n(HFIELD,PFIELD,KSON)
-! ##########################################
-!
-!!**** *FILL_ZSMT_n* - fill the working array for nesting of pgd files
-!! with KSON model index
-!!
-!! PURPOSE
-!! -------
-!
-!!** METHOD
-!! ------
-!!
-!! EXTERNAL
-!! --------
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!! Book2 of the documentation
-!!
-!!
-!! AUTHOR
-!! ------
-!! V. Masson * Meteo France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 12/01/05
-!! Modification 20/05/06 Remove Clark and Farley interpolation
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-!
-USE MODD_GRID_n, ONLY : XZSMT
-USE MODD_LUNIT_n, ONLY : CLUOUT
-USE MODD_LBC_n, ONLY : CLBCX,CLBCY
-USE MODD_NESTING
-USE MODD_PARAMETERS
-!
-USE MODI_INI_BIKHARDT_n
-USE MODI_SPAWN_ZS
-USE MODE_MODELN_HANDLER
-!
-USE MODE_SPLITTING_ll, ONLY : SPLIT2
-USE MODD_VAR_ll, ONLY : NPROC, IP, YSPLITTING, NMNH_COMM_WORLD
-USE MODD_STRUCTURE_ll, ONLY : ZONE_ll
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-!
-CHARACTER(LEN=6), INTENT(IN) :: HFIELD ! name of the field to fill
-REAL, DIMENSION(:,:), INTENT(INOUT) :: PFIELD
-INTEGER, INTENT(IN) :: KSON ! son model index
-!
-!* 0.2 declarations of local variables
-!-------------------------------------------------------------------------------
-INTEGER :: IMI ! current model index (DAD index)
-!
-! Dummy pointers needed to correct an ifort Bug
-CHARACTER(LEN=4), DIMENSION(:), POINTER :: DPTR_CLBCX,DPTR_CLBCY
-REAL, DIMENSION(:,:), POINTER :: DPTR_XZSMT
-INTEGER :: IINFO_ll
-INTEGER :: IXSIZE, IYSIZE ! sizes of global son domain in father grid
-TYPE(ZONE_ll), DIMENSION(:), ALLOCATABLE :: TZSPLITTING
-INTEGER :: IXOR,IXEND,IYOR,IYEND ! limits of extended domain of KSON model in its father's grid
-INTEGER :: IDIMX, IDIMY ! dimensions of extended son subdomain in father's grid + one point in each direction
-!
-!* 1. initializations
-! ---------------
-!
-IMI = GET_CURRENT_MODEL_INDEX()
-CALL GOTO_MODEL(KSON)
-CALL GO_TOMODEL_ll(KSON, IINFO_ll)
-!
-! get sizes of global son domain in father grid
-IXSIZE = NXEND_ALL(KSON) - NXOR_ALL (KSON) + 1 - 2*JPHEXT
-IYSIZE = NYEND_ALL(KSON) - NYOR_ALL (KSON) + 1 - 2*JPHEXT
-! get splitting of current model KMI in father grid
-ALLOCATE(TZSPLITTING(NPROC))
-CALL SPLIT2 ( IXSIZE, IYSIZE, 1, NPROC, TZSPLITTING, YSPLITTING )
-! get coords of extended domain of KSON in its father's grid
-IXOR = NXOR_ALL(KSON) + TZSPLITTING(IP)%NXOR -1 - JPHEXT
-IXEND = NXOR_ALL(KSON) + TZSPLITTING(IP)%NXEND -1 + JPHEXT
-IYOR = NYOR_ALL(KSON) + TZSPLITTING(IP)%NYOR -1 - JPHEXT
-IYEND = NYOR_ALL(KSON) + TZSPLITTING(IP)%NYEND -1 + JPHEXT
-!
-!IDIMX = IXEND - IXOR - 1
-!IDIMY = IYEND - IYOR - 1
-IDIMX = IXEND - IXOR + 1 +2*1 ! + 2*JPHEXT
-IDIMY = IYEND - IYOR + 1 +2*1 ! + 2*JPHEXT
-!
-CALL INI_BIKHARDT_n(NDXRATIO_ALL(KSON),NDYRATIO_ALL(KSON),KSON)
-!
-!-------------------------------------------------------------------------------
-!
-!* 2. interpolation of dad field
-! --------------------------
-!
-DPTR_CLBCX=>CLBCX
-DPTR_CLBCY=>CLBCY
-DPTR_XZSMT=>XZSMT
-!CALL SPAWN_ZS(IXOR,IXEND,IYOR,IYEND, &
-! NDXRATIO_ALL(KSON),NDYRATIO_ALL(KSON),DPTR_CLBCX,DPTR_CLBCY, &
-! CLUOUT,PFIELD,DPTR_XZSMT,HFIELD )
-CALL SPAWN_ZS(NXOR_ALL(KSON),NXEND_ALL(KSON),NYOR_ALL(KSON),NYEND_ALL(KSON), &
- NDXRATIO_ALL(KSON),NDYRATIO_ALL(KSON),IDIMX,IDIMY,DPTR_CLBCX,DPTR_CLBCY, &
- CLUOUT,PFIELD,DPTR_XZSMT,HFIELD )
-!-------------------------------------------------------------------------------
-!
-CALL GOTO_MODEL(IMI)
-CALL GO_TOMODEL_ll(IMI, IINFO_ll)
-!
-END SUBROUTINE FILL_ZSMT_n
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!--------------- special set of characters for RCS information
+!-----------------------------------------------------------------
+! $Source$ $Revision$
+! masdev4_7 BUG1 2007/06/15 17:47:17
+!-----------------------------------------------------------------
+! ######################
+ MODULE MODI_FILL_ZSMTn
+! ######################
+!
+INTERFACE
+!
+ SUBROUTINE FILL_ZSMT_n(HFIELD,PFIELD,KSON)
+!
+CHARACTER(LEN=6), INTENT(IN) :: HFIELD ! name of the field to nest
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PFIELD
+INTEGER, INTENT(IN) :: KSON ! son model index
+!
+END SUBROUTINE FILL_ZSMT_n
+!
+END INTERFACE
+!
+END MODULE MODI_FILL_ZSMTn
+!
+!
+!
+! ##########################################
+ SUBROUTINE FILL_ZSMT_n(HFIELD,PFIELD,KSON)
+! ##########################################
+!
+!!**** *FILL_ZSMT_n* - fill the working array for nesting of pgd files
+!! with KSON model index
+!!
+!! PURPOSE
+!! -------
+!
+!!** METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!! Book2 of the documentation
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Masson * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 12/01/05
+!! Modification 20/05/06 Remove Clark and Farley interpolation
+!! M.Moge 01/2016 bug fix for parallel execution
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+USE MODD_GRID_n, ONLY : XZSMT
+USE MODD_LUNIT_n, ONLY : CLUOUT
+USE MODD_LBC_n, ONLY : CLBCX,CLBCY
+USE MODD_NESTING
+USE MODD_PARAMETERS
+!
+USE MODI_INI_BIKHARDT_n
+USE MODI_SPAWN_ZS
+USE MODE_MODELN_HANDLER
+!
+USE MODE_SPLITTING_ll, ONLY : SPLIT2, DEF_SPLITTING2
+USE MODD_VAR_ll, ONLY : NPROC, IP, YSPLITTING, NMNH_COMM_WORLD
+USE MODD_STRUCTURE_ll, ONLY : ZONE_ll
+!
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+CHARACTER(LEN=6), INTENT(IN) :: HFIELD ! name of the field to fill
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PFIELD
+INTEGER, INTENT(IN) :: KSON ! son model index
+!
+!* 0.2 declarations of local variables
+!-------------------------------------------------------------------------------
+INTEGER :: IMI ! current model index (DAD index)
+!
+! Dummy pointers needed to correct an ifort Bug
+CHARACTER(LEN=4), DIMENSION(:), POINTER :: DPTR_CLBCX,DPTR_CLBCY
+REAL, DIMENSION(:,:), POINTER :: DPTR_XZSMT
+INTEGER :: IINFO_ll
+INTEGER :: IXSIZE, IYSIZE ! sizes of global son domain in father grid
+INTEGER :: IXSIZE_F, IYSIZE_F ! sizes of global father domain
+TYPE(ZONE_ll), DIMENSION(:), ALLOCATABLE :: TZSPLITTING
+INTEGER :: IXOR,IXEND,IYOR,IYEND ! limits of extended domain of KSON model in its father's grid
+INTEGER :: IDIMX, IDIMY ! dimensions of extended son subdomain in father's grid + one point in each direction
+INTEGER :: IXDOMAINS, IYDOMAINS ! number of subdomains in X and Y directions
+LOGICAL :: GPREM ! needed for DEF_SPLITTING2, true if NPROC is a prime number
+!
+!* 1. initializations
+! ---------------
+!
+IMI = GET_CURRENT_MODEL_INDEX()
+CALL GOTO_MODEL(KSON)
+CALL GO_TOMODEL_ll(KSON, IINFO_ll)
+!
+! get sizes of global son domain in father grid
+IXSIZE = NXEND_ALL(KSON) - NXOR_ALL (KSON) + 1 - 2*JPHEXT
+IYSIZE = NYEND_ALL(KSON) - NYOR_ALL (KSON) + 1 - 2*JPHEXT
+! get splitting of current model KMI in father grid
+IXSIZE_F = NXEND_ALL(NDAD(KSON)) - NXOR_ALL (NDAD(KSON)) + 1 - 2*JPHEXT
+IYSIZE_F = NYEND_ALL(NDAD(KSON)) - NYOR_ALL (NDAD(KSON)) + 1 - 2*JPHEXT
+ALLOCATE(TZSPLITTING(NPROC))
+! we want the same domain partitioning for the child domain and for the father domain
+CALL DEF_SPLITTING2(IXDOMAINS,IYDOMAINS,IXSIZE_F,IYSIZE_F,NPROC,GPREM)
+CALL SPLIT2 ( IXSIZE, IYSIZE, 1, NPROC, TZSPLITTING, YSPLITTING, IXDOMAINS, IYDOMAINS )
+! get coords of extended domain of KSON in its father's grid
+IXOR = NXOR_ALL(KSON) + TZSPLITTING(IP)%NXOR -1 - JPHEXT
+IXEND = NXOR_ALL(KSON) + TZSPLITTING(IP)%NXEND -1 + JPHEXT
+IYOR = NYOR_ALL(KSON) + TZSPLITTING(IP)%NYOR -1 - JPHEXT
+IYEND = NYOR_ALL(KSON) + TZSPLITTING(IP)%NYEND -1 + JPHEXT
+!
+!IDIMX = IXEND - IXOR - 1
+!IDIMY = IYEND - IYOR - 1
+IDIMX = IXEND - IXOR + 1 +2*1 ! + 2*JPHEXT
+IDIMY = IYEND - IYOR + 1 +2*1 ! + 2*JPHEXT
+!
+CALL INI_BIKHARDT_n(NDXRATIO_ALL(KSON),NDYRATIO_ALL(KSON),KSON)
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. interpolation of dad field
+! --------------------------
+!
+DPTR_CLBCX=>CLBCX
+DPTR_CLBCY=>CLBCY
+DPTR_XZSMT=>XZSMT
+CALL SPAWN_ZS(NXOR_ALL(KSON),NXEND_ALL(KSON),NYOR_ALL(KSON),NYEND_ALL(KSON), &
+ NDXRATIO_ALL(KSON),NDYRATIO_ALL(KSON),IDIMX,IDIMY,DPTR_CLBCX,DPTR_CLBCY, &
+ CLUOUT,PFIELD,DPTR_XZSMT,HFIELD )
+!-------------------------------------------------------------------------------
+!
+CALL GOTO_MODEL(IMI)
+CALL GO_TOMODEL_ll(IMI, IINFO_ll)
+!
+END SUBROUTINE FILL_ZSMT_n
diff --git a/src/MNH/open_nestpgd_files.f90 b/src/MNH/open_nestpgd_files.f90
index f369febac..70cf5af88 100644
--- a/src/MNH/open_nestpgd_files.f90
+++ b/src/MNH/open_nestpgd_files.f90
@@ -1,332 +1,333 @@
-!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
-!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
-!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!MNH_LIC for details. version 1.
-!-----------------------------------------------------------------
-!--------------- special set of characters for RCS information
-!-----------------------------------------------------------------
-! $Source$ $Revision$
-!-----------------------------------------------------------------
-!#############################
-MODULE MODI_OPEN_NESTPGD_FILES
-!#############################
-!
-INTERFACE
- SUBROUTINE OPEN_NESTPGD_FILES(HPGD,HNESTPGD)
-!
-CHARACTER(LEN=28), DIMENSION(:), INTENT(OUT) :: HPGD ! name of the input pgd files
-CHARACTER(LEN=28), DIMENSION(:), INTENT(OUT) :: HNESTPGD ! name of the output pgd files
-END SUBROUTINE OPEN_NESTPGD_FILES
-END INTERFACE
-END MODULE MODI_OPEN_NESTPGD_FILES
-! ############################################
- SUBROUTINE OPEN_NESTPGD_FILES(HPGD,HNESTPGD)
-! ############################################
-!
-!!**** *OPEN_NESTPGD_FILES* - openning of the files used in PREP_NEST_PGD
-!!
-!!
-!! PURPOSE
-!! -------
-!!
-!!** METHOD
-!! ------
-!!
-!! CAUTION:
-!! This routine supposes the name of the namelist file is 'PRE_NEST_PGD1.nam'.
-!!
-!! EXTERNAL
-!! --------
-!!
-!! Routine FMOPEN
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! Module MODD_LUNIT : contains logical unit names for all models
-!! CLUOUT0 : name of output-listing
-!!
-!! REFERENCE
-!! ---------
-!!
-!! Book 2
-!!
-!! AUTHOR
-!! ------
-!!
-!! V.Masson Meteo-France
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 26/09/96
-!! 30/07/97 (Masson) group MODI_OPEN_LUOUTn
-!! 15/10/01 (I.Mallet) allow namelists in different orders
-!! 07/06/2010 (J.escobar from Ivan Ristic) bug PGI
-!! 30/12/2012 (S.Bielli) Add NAM_NCOUT for netcdf output
-!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
-!! 11/2015 (M.Moge) disable the creation of files on multiple
-!! Z-levels when using parallel IO for PREP_PGD
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_LUNIT
-USE MODD_CONF
-USE MODD_NESTING
-USE MODD_PARAMETERS
-!
-USE MODI_OPEN_LUOUTn
-!
-USE MODE_IO_ll
-USE MODE_FM
-USE MODE_POS
-!
-USE MODE_MODELN_HANDLER
-!
-#ifdef MNH_NCWRIT
-USE MODN_NCOUT
-#endif
-USE MODN_CONFIO
-!
-USE MODD_PARAMETERS, ONLY : JPHEXT
-USE MODD_CONF, ONLY : NHALO_CONF_MNH => NHALO
-!
-USE MODN_CONFZ
-!
-IMPLICIT NONE
-!
-!* 0.1 Declaration of arguments
-! ------------------------
-!
-CHARACTER(LEN=28), DIMENSION(:), INTENT(OUT) :: HPGD ! name of the input pgd files
-CHARACTER(LEN=28), DIMENSION(:), INTENT(OUT) :: HNESTPGD ! name of the output pgd files
-!
-!* 0.2 Declaration of local variables
-! ------------------------------
-!
-INTEGER :: IRESP ! return-code if problems eraised
-INTEGER :: ILUOUT0 ! logical unit for listing file
-INTEGER :: ININAR ! number of articles initially present in a FM file
-LOGICAL :: GFOUND ! Return code when searching namelist
-!
-CHARACTER(LEN=28) :: HPRE_NEST_PGD ! name of namelist file
-INTEGER :: IPRE_NEST_PGD ! logical unit of namelist file
-!
-CHARACTER(LEN=28) :: YPGD ! name of the pgd file for each model
-CHARACTER(LEN=28) :: YLUOUT ! name of output listing file for each model
-CHARACTER(LEN=2) :: YNEST ! to define the output pgd file names
-CHARACTER(LEN=28) :: YPGD1, YPGD2, YPGD3, YPGD4, &
- YPGD5, YPGD6, YPGD7, YPGD8
-! ! name of all pgd files
-! ! in the namelist
-INTEGER :: IDAD ! father of one model
-INTEGER :: JPGD ! loop counter
-LOGICAL :: GADD !
-CHARACTER(LEN=21), DIMENSION(JPMODELMAX) :: YSHORTPGD
-INTEGER :: NHALO_MNH
-!
-INTEGER :: ILUNAM,ILUOUT ! Logical unit number for the EXSPA file
-!
-!* 0.3 Declaration of namelists
-! ------------------------
-!
-NAMELIST/NAM_PGD1/ YPGD1
-NAMELIST/NAM_PGD2/ YPGD2, IDAD
-NAMELIST/NAM_PGD3/ YPGD3, IDAD
-NAMELIST/NAM_PGD4/ YPGD4, IDAD
-NAMELIST/NAM_PGD5/ YPGD5, IDAD
-NAMELIST/NAM_PGD6/ YPGD6, IDAD
-NAMELIST/NAM_PGD7/ YPGD7, IDAD
-NAMELIST/NAM_PGD8/ YPGD8, IDAD
-NAMELIST/NAM_NEST_PGD/ YNEST
-NAMELIST/NAM_CONF_NEST/JPHEXT, NHALO_MNH
-!-------------------------------------------------------------------------------
-!
-!* 1. SET DEFAULT NAMES
-! -----------------
-!
-DO JPGD=1,JPMODELMAX
- HPGD (JPGD)=' '
- HNESTPGD(JPGD)=' '
-END DO
-!
-HPRE_NEST_PGD='PRE_NEST_PGD1.nam'
-CLUOUT0='OUTPUT_LISTING0'
-!
-!-------------------------------------------------------------------------------
-!
-!* 2. OPENNING OF CLUOUT0
-! -------------------
-!
-CALL OPEN_ll(UNIT=ILUOUT0,FILE=CLUOUT0,IOSTAT=IRESP,FORM='FORMATTED',ACTION='WRITE', &
- MODE=GLOBAL)
-!
-!-------------------------------------------------------------------------------
-!
-!* 3. OPENNING OF PRE_NEST_PGD1.nam
-! -----------------------------
-!
-CALL OPEN_ll(UNIT=IPRE_NEST_PGD,FILE=HPRE_NEST_PGD,IOSTAT=IRESP,FORM='FORMATTED',ACTION='READ', &
- MODE=GLOBAL)
-!reading of NAM_CONFZ
-CALL FMLOOK_ll(HPRE_NEST_PGD,HPRE_NEST_PGD,ILUOUT,IRESP)
-CALL POSNAM(IPRE_NEST_PGD,'NAM_CONFZ',GFOUND)
-IF (GFOUND) READ(UNIT=IPRE_NEST_PGD,NML=NAM_CONFZ)
-!
-!JUAN
-CALL POSNAM(IPRE_NEST_PGD,'NAM_CONF_NEST',GFOUND)
-IF (GFOUND) THEN
- NHALO_MNH = NHALO_CONF_MNH
- READ(UNIT=IPRE_NEST_PGD,NML=NAM_CONF_NEST)
- NHALO_CONF_MNH = NHALO_MNH
-END IF
-!JUAN
-!
-!-------------------------------------------------------------------------------
-!
-!* 4. READING OF THE OTHER FILE NAMES
-! -------------------------------
-!
-YPGD1=' '
-YPGD2=' '
-YPGD3=' '
-YPGD4=' '
-YPGD5=' '
-YPGD6=' '
-YPGD7=' '
-YPGD8=' '
-NDAD(:)=0
-GADD=.TRUE.
-!
-DO JPGD=1,JPMODELMAX
- IDAD=0
- IF (JPGD==1) THEN
- CALL POSNAM(IPRE_NEST_PGD,'NAM_PGD1',GFOUND)
- IF (GFOUND) READ(UNIT=IPRE_NEST_PGD,NML=NAM_PGD1)
- END IF
- IF (JPGD==2) THEN
- CALL POSNAM(IPRE_NEST_PGD,'NAM_PGD2',GFOUND)
- IF (GFOUND) READ(UNIT=IPRE_NEST_PGD,NML=NAM_PGD2)
- END IF
- IF (JPGD==3) THEN
- CALL POSNAM(IPRE_NEST_PGD,'NAM_PGD3',GFOUND)
- IF (GFOUND) READ(UNIT=IPRE_NEST_PGD,NML=NAM_PGD3)
- END IF
- IF (JPGD==4) THEN
- CALL POSNAM(IPRE_NEST_PGD,'NAM_PGD4',GFOUND)
- IF (GFOUND) READ(UNIT=IPRE_NEST_PGD,NML=NAM_PGD4)
- END IF
- IF (JPGD==5) THEN
- CALL POSNAM(IPRE_NEST_PGD,'NAM_PGD5',GFOUND)
- IF (GFOUND) READ(UNIT=IPRE_NEST_PGD,NML=NAM_PGD5)
- END IF
- IF (JPGD==6) THEN
- CALL POSNAM(IPRE_NEST_PGD,'NAM_PGD6',GFOUND)
- IF (GFOUND) READ(UNIT=IPRE_NEST_PGD,NML=NAM_PGD6)
- END IF
- IF (JPGD==7) THEN
- CALL POSNAM(IPRE_NEST_PGD,'NAM_PGD7',GFOUND)
- IF (GFOUND) READ(UNIT=IPRE_NEST_PGD,NML=NAM_PGD7)
- END IF
- IF (JPGD==8) THEN
- CALL POSNAM(IPRE_NEST_PGD,'NAM_PGD8',GFOUND)
- IF (GFOUND) READ(UNIT=IPRE_NEST_PGD,NML=NAM_PGD8)
- END IF
- !
- IF (JPGD==1) YPGD=YPGD1
- IF (JPGD==2) YPGD=YPGD2
- IF (JPGD==3) YPGD=YPGD3
- IF (JPGD==4) YPGD=YPGD4
- IF (JPGD==5) YPGD=YPGD5
- IF (JPGD==6) YPGD=YPGD6
- IF (JPGD==7) YPGD=YPGD7
- IF (JPGD==8) YPGD=YPGD8
- !
- IF (LEN_TRIM(YPGD) == 0) THEN
- IF (JPGD==1) THEN
- WRITE(ILUOUT0,*) 'No pgd file was present for model 1 in namelist NAM_PGD1'
-!callabortstop
- CALL CLOSE_ll(CLUOUT0,IOSTAT=IRESP)
- CALL ABORT
- STOP
- ELSE
- GADD=.FALSE.
- CYCLE
- END IF
- END IF
- !
- IF ( (IDAD<1 .OR. IDAD>JPMODELMAX) .AND. (JPGD>1) ) THEN
- WRITE(ILUOUT0,*) 'No father indicated for model ',JPGD,' in namelist NAM_PGD',JPGD
-!callabortstop
- CALL CLOSE_ll(CLUOUT0,IOSTAT=IRESP)
- CALL ABORT
- STOP
- END IF
- !
- IF (GADD) THEN
- NMODEL=JPGD
- !
- IF (IDAD>=JPGD) THEN
- WRITE(ILUOUT0,*) 'pgd files are not correctly ordered:'
- WRITE(ILUOUT0,*) ' in namelist NAM_PGD',JPGD,' was found IDAD= ', IDAD
-!callabortstop
- CALL CLOSE_ll(CLUOUT0,IOSTAT=IRESP)
- CALL ABORT
- STOP
- END IF
- !
- NDAD(JPGD)=IDAD
- HPGD(JPGD)=YPGD
- END IF
-END DO
-!
-!-------------------------------------------------------------------------------
-!
-!* 5. NAMES OF OUTPUT PGD FILES
-! -------------------------
-!
-CALL POSNAM(IPRE_NEST_PGD,'NAM_NEST_PGD',GFOUND,ILUOUT0)
-IF (GFOUND) READ(UNIT=IPRE_NEST_PGD,NML=NAM_NEST_PGD)
-HNESTPGD(:) = ' '
-!
-YSHORTPGD(:)=HPGD(:)
-DO JPGD=1,NMODEL
- HNESTPGD(JPGD) = ADJUSTR( YSHORTPGD(JPGD))//'.nest'//ADJUSTL(YNEST)
- HNESTPGD(JPGD) = ADJUSTL(HNESTPGD(JPGD))
-END DO
-#ifdef MNH_NCWRIT
-CALL POSNAM(IPRE_NEST_PGD,'NAM_NCOUT',GFOUND,ILUOUT0)
-IF (GFOUND) READ(UNIT=IPRE_NEST_PGD,NML=NAM_NCOUT)
-#endif
-!
-CALL POSNAM(IPRE_NEST_PGD,'NAM_CONFIO',GFOUND,ILUOUT0)
-IF (GFOUND) READ(UNIT=IPRE_NEST_PGD,NML=NAM_CONFIO)
-CALL SET_CONFIO_ll(LCDF4, LLFIOUT, LLFIREAD)
-!
-!-------------------------------------------------------------------------------
-CALL CLOSE_ll(HPRE_NEST_PGD)
-!-------------------------------------------------------------------------------
-!
-!* 6. OPENING OF INPUT AND OUTPUT PGD FILES
-! -------------------------------------
-!
-DO JPGD=1,NMODEL
- CALL FMOPEN_ll(HPGD(JPGD),'READ',CLUOUT0,0,2,NVERB,ININAR,IRESP,OPARALLELIO=.FALSE.)
- CALL FMOPEN_ll(HNESTPGD(JPGD),'WRITE',CLUOUT0,0,1,NVERB,ININAR,IRESP,OPARALLELIO=.FALSE.)
-END DO
-!
-!-------------------------------------------------------------------------------
-!
-!* 7. OPENING OF OUPUT LISTING FILES FOR ALL MODELS
-! ----------------------------------------------
-!
-DO JPGD=1,NMODEL
- CALL GOTO_MODEL(JPGD)
- WRITE(YLUOUT,'("OUTPUT_LISTING",I0)') JPGD
- CALL OPEN_LUOUT_n(YLUOUT)
-END DO
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE OPEN_NESTPGD_FILES
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!--------------- special set of characters for RCS information
+!-----------------------------------------------------------------
+! $Source$ $Revision$
+!-----------------------------------------------------------------
+!#############################
+MODULE MODI_OPEN_NESTPGD_FILES
+!#############################
+!
+INTERFACE
+ SUBROUTINE OPEN_NESTPGD_FILES(HPGD,HNESTPGD)
+!
+CHARACTER(LEN=28), DIMENSION(:), INTENT(OUT) :: HPGD ! name of the input pgd files
+CHARACTER(LEN=28), DIMENSION(:), INTENT(OUT) :: HNESTPGD ! name of the output pgd files
+END SUBROUTINE OPEN_NESTPGD_FILES
+END INTERFACE
+END MODULE MODI_OPEN_NESTPGD_FILES
+! ############################################
+ SUBROUTINE OPEN_NESTPGD_FILES(HPGD,HNESTPGD)
+! ############################################
+!
+!!**** *OPEN_NESTPGD_FILES* - openning of the files used in PREP_NEST_PGD
+!!
+!!
+!! PURPOSE
+!! -------
+!!
+!!** METHOD
+!! ------
+!!
+!! CAUTION:
+!! This routine supposes the name of the namelist file is 'PRE_NEST_PGD1.nam'.
+!!
+!! EXTERNAL
+!! --------
+!!
+!! Routine FMOPEN
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! Module MODD_LUNIT : contains logical unit names for all models
+!! CLUOUT0 : name of output-listing
+!!
+!! REFERENCE
+!! ---------
+!!
+!! Book 2
+!!
+!! AUTHOR
+!! ------
+!!
+!! V.Masson Meteo-France
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 26/09/96
+!! 30/07/97 (Masson) group MODI_OPEN_LUOUTn
+!! 15/10/01 (I.Mallet) allow namelists in different orders
+!! 07/06/2010 (J.escobar from Ivan Ristic) bug PGI
+!! 30/12/2012 (S.Bielli) Add NAM_NCOUT for netcdf output
+!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
+!! 11/2015 (M.Moge) disable the creation of files on multiple
+!! Z-levels when using parallel IO for PREP_PGD
+!! 01/2016 (M.Moge) Bug fix : open the output file using Z-parallel IO
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_LUNIT
+USE MODD_CONF
+USE MODD_NESTING
+USE MODD_PARAMETERS
+!
+USE MODI_OPEN_LUOUTn
+!
+USE MODE_IO_ll
+USE MODE_FM
+USE MODE_POS
+!
+USE MODE_MODELN_HANDLER
+!
+#ifdef MNH_NCWRIT
+USE MODN_NCOUT
+#endif
+USE MODN_CONFIO
+!
+USE MODD_PARAMETERS, ONLY : JPHEXT
+USE MODD_CONF, ONLY : NHALO_CONF_MNH => NHALO
+!
+USE MODN_CONFZ
+!
+IMPLICIT NONE
+!
+!* 0.1 Declaration of arguments
+! ------------------------
+!
+CHARACTER(LEN=28), DIMENSION(:), INTENT(OUT) :: HPGD ! name of the input pgd files
+CHARACTER(LEN=28), DIMENSION(:), INTENT(OUT) :: HNESTPGD ! name of the output pgd files
+!
+!* 0.2 Declaration of local variables
+! ------------------------------
+!
+INTEGER :: IRESP ! return-code if problems eraised
+INTEGER :: ILUOUT0 ! logical unit for listing file
+INTEGER :: ININAR ! number of articles initially present in a FM file
+LOGICAL :: GFOUND ! Return code when searching namelist
+!
+CHARACTER(LEN=28) :: HPRE_NEST_PGD ! name of namelist file
+INTEGER :: IPRE_NEST_PGD ! logical unit of namelist file
+!
+CHARACTER(LEN=28) :: YPGD ! name of the pgd file for each model
+CHARACTER(LEN=28) :: YLUOUT ! name of output listing file for each model
+CHARACTER(LEN=2) :: YNEST ! to define the output pgd file names
+CHARACTER(LEN=28) :: YPGD1, YPGD2, YPGD3, YPGD4, &
+ YPGD5, YPGD6, YPGD7, YPGD8
+! ! name of all pgd files
+! ! in the namelist
+INTEGER :: IDAD ! father of one model
+INTEGER :: JPGD ! loop counter
+LOGICAL :: GADD !
+CHARACTER(LEN=21), DIMENSION(JPMODELMAX) :: YSHORTPGD
+INTEGER :: NHALO_MNH
+!
+INTEGER :: ILUNAM,ILUOUT ! Logical unit number for the EXSPA file
+!
+!* 0.3 Declaration of namelists
+! ------------------------
+!
+NAMELIST/NAM_PGD1/ YPGD1
+NAMELIST/NAM_PGD2/ YPGD2, IDAD
+NAMELIST/NAM_PGD3/ YPGD3, IDAD
+NAMELIST/NAM_PGD4/ YPGD4, IDAD
+NAMELIST/NAM_PGD5/ YPGD5, IDAD
+NAMELIST/NAM_PGD6/ YPGD6, IDAD
+NAMELIST/NAM_PGD7/ YPGD7, IDAD
+NAMELIST/NAM_PGD8/ YPGD8, IDAD
+NAMELIST/NAM_NEST_PGD/ YNEST
+NAMELIST/NAM_CONF_NEST/JPHEXT, NHALO_MNH
+!-------------------------------------------------------------------------------
+!
+!* 1. SET DEFAULT NAMES
+! -----------------
+!
+DO JPGD=1,JPMODELMAX
+ HPGD (JPGD)=' '
+ HNESTPGD(JPGD)=' '
+END DO
+!
+HPRE_NEST_PGD='PRE_NEST_PGD1.nam'
+CLUOUT0='OUTPUT_LISTING0'
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. OPENNING OF CLUOUT0
+! -------------------
+!
+CALL OPEN_ll(UNIT=ILUOUT0,FILE=CLUOUT0,IOSTAT=IRESP,FORM='FORMATTED',ACTION='WRITE', &
+ MODE=GLOBAL)
+!
+!-------------------------------------------------------------------------------
+!
+!* 3. OPENNING OF PRE_NEST_PGD1.nam
+! -----------------------------
+!
+CALL OPEN_ll(UNIT=IPRE_NEST_PGD,FILE=HPRE_NEST_PGD,IOSTAT=IRESP,FORM='FORMATTED',ACTION='READ', &
+ MODE=GLOBAL)
+!reading of NAM_CONFZ
+CALL FMLOOK_ll(HPRE_NEST_PGD,HPRE_NEST_PGD,ILUOUT,IRESP)
+CALL POSNAM(IPRE_NEST_PGD,'NAM_CONFZ',GFOUND)
+IF (GFOUND) READ(UNIT=IPRE_NEST_PGD,NML=NAM_CONFZ)
+!
+!JUAN
+CALL POSNAM(IPRE_NEST_PGD,'NAM_CONF_NEST',GFOUND)
+IF (GFOUND) THEN
+ NHALO_MNH = NHALO_CONF_MNH
+ READ(UNIT=IPRE_NEST_PGD,NML=NAM_CONF_NEST)
+ NHALO_CONF_MNH = NHALO_MNH
+END IF
+!JUAN
+!
+!-------------------------------------------------------------------------------
+!
+!* 4. READING OF THE OTHER FILE NAMES
+! -------------------------------
+!
+YPGD1=' '
+YPGD2=' '
+YPGD3=' '
+YPGD4=' '
+YPGD5=' '
+YPGD6=' '
+YPGD7=' '
+YPGD8=' '
+NDAD(:)=0
+GADD=.TRUE.
+!
+DO JPGD=1,JPMODELMAX
+ IDAD=0
+ IF (JPGD==1) THEN
+ CALL POSNAM(IPRE_NEST_PGD,'NAM_PGD1',GFOUND)
+ IF (GFOUND) READ(UNIT=IPRE_NEST_PGD,NML=NAM_PGD1)
+ END IF
+ IF (JPGD==2) THEN
+ CALL POSNAM(IPRE_NEST_PGD,'NAM_PGD2',GFOUND)
+ IF (GFOUND) READ(UNIT=IPRE_NEST_PGD,NML=NAM_PGD2)
+ END IF
+ IF (JPGD==3) THEN
+ CALL POSNAM(IPRE_NEST_PGD,'NAM_PGD3',GFOUND)
+ IF (GFOUND) READ(UNIT=IPRE_NEST_PGD,NML=NAM_PGD3)
+ END IF
+ IF (JPGD==4) THEN
+ CALL POSNAM(IPRE_NEST_PGD,'NAM_PGD4',GFOUND)
+ IF (GFOUND) READ(UNIT=IPRE_NEST_PGD,NML=NAM_PGD4)
+ END IF
+ IF (JPGD==5) THEN
+ CALL POSNAM(IPRE_NEST_PGD,'NAM_PGD5',GFOUND)
+ IF (GFOUND) READ(UNIT=IPRE_NEST_PGD,NML=NAM_PGD5)
+ END IF
+ IF (JPGD==6) THEN
+ CALL POSNAM(IPRE_NEST_PGD,'NAM_PGD6',GFOUND)
+ IF (GFOUND) READ(UNIT=IPRE_NEST_PGD,NML=NAM_PGD6)
+ END IF
+ IF (JPGD==7) THEN
+ CALL POSNAM(IPRE_NEST_PGD,'NAM_PGD7',GFOUND)
+ IF (GFOUND) READ(UNIT=IPRE_NEST_PGD,NML=NAM_PGD7)
+ END IF
+ IF (JPGD==8) THEN
+ CALL POSNAM(IPRE_NEST_PGD,'NAM_PGD8',GFOUND)
+ IF (GFOUND) READ(UNIT=IPRE_NEST_PGD,NML=NAM_PGD8)
+ END IF
+ !
+ IF (JPGD==1) YPGD=YPGD1
+ IF (JPGD==2) YPGD=YPGD2
+ IF (JPGD==3) YPGD=YPGD3
+ IF (JPGD==4) YPGD=YPGD4
+ IF (JPGD==5) YPGD=YPGD5
+ IF (JPGD==6) YPGD=YPGD6
+ IF (JPGD==7) YPGD=YPGD7
+ IF (JPGD==8) YPGD=YPGD8
+ !
+ IF (LEN_TRIM(YPGD) == 0) THEN
+ IF (JPGD==1) THEN
+ WRITE(ILUOUT0,*) 'No pgd file was present for model 1 in namelist NAM_PGD1'
+!callabortstop
+ CALL CLOSE_ll(CLUOUT0,IOSTAT=IRESP)
+ CALL ABORT
+ STOP
+ ELSE
+ GADD=.FALSE.
+ CYCLE
+ END IF
+ END IF
+ !
+ IF ( (IDAD<1 .OR. IDAD>JPMODELMAX) .AND. (JPGD>1) ) THEN
+ WRITE(ILUOUT0,*) 'No father indicated for model ',JPGD,' in namelist NAM_PGD',JPGD
+!callabortstop
+ CALL CLOSE_ll(CLUOUT0,IOSTAT=IRESP)
+ CALL ABORT
+ STOP
+ END IF
+ !
+ IF (GADD) THEN
+ NMODEL=JPGD
+ !
+ IF (IDAD>=JPGD) THEN
+ WRITE(ILUOUT0,*) 'pgd files are not correctly ordered:'
+ WRITE(ILUOUT0,*) ' in namelist NAM_PGD',JPGD,' was found IDAD= ', IDAD
+!callabortstop
+ CALL CLOSE_ll(CLUOUT0,IOSTAT=IRESP)
+ CALL ABORT
+ STOP
+ END IF
+ !
+ NDAD(JPGD)=IDAD
+ HPGD(JPGD)=YPGD
+ END IF
+END DO
+!
+!-------------------------------------------------------------------------------
+!
+!* 5. NAMES OF OUTPUT PGD FILES
+! -------------------------
+!
+CALL POSNAM(IPRE_NEST_PGD,'NAM_NEST_PGD',GFOUND,ILUOUT0)
+IF (GFOUND) READ(UNIT=IPRE_NEST_PGD,NML=NAM_NEST_PGD)
+HNESTPGD(:) = ' '
+!
+YSHORTPGD(:)=HPGD(:)
+DO JPGD=1,NMODEL
+ HNESTPGD(JPGD) = ADJUSTR( YSHORTPGD(JPGD))//'.nest'//ADJUSTL(YNEST)
+ HNESTPGD(JPGD) = ADJUSTL(HNESTPGD(JPGD))
+END DO
+#ifdef MNH_NCWRIT
+CALL POSNAM(IPRE_NEST_PGD,'NAM_NCOUT',GFOUND,ILUOUT0)
+IF (GFOUND) READ(UNIT=IPRE_NEST_PGD,NML=NAM_NCOUT)
+#endif
+!
+CALL POSNAM(IPRE_NEST_PGD,'NAM_CONFIO',GFOUND,ILUOUT0)
+IF (GFOUND) READ(UNIT=IPRE_NEST_PGD,NML=NAM_CONFIO)
+CALL SET_CONFIO_ll(LCDF4, LLFIOUT, LLFIREAD)
+!
+!-------------------------------------------------------------------------------
+CALL CLOSE_ll(HPRE_NEST_PGD)
+!-------------------------------------------------------------------------------
+!
+!* 6. OPENING OF INPUT AND OUTPUT PGD FILES
+! -------------------------------------
+!
+DO JPGD=1,NMODEL
+ CALL FMOPEN_ll(HPGD(JPGD),'READ',CLUOUT0,0,2,NVERB,ININAR,IRESP,OPARALLELIO=.FALSE.)
+ CALL FMOPEN_ll(HNESTPGD(JPGD),'WRITE',CLUOUT0,0,1,NVERB,ININAR,IRESP)
+END DO
+!
+!-------------------------------------------------------------------------------
+!
+!* 7. OPENING OF OUPUT LISTING FILES FOR ALL MODELS
+! ----------------------------------------------
+!
+DO JPGD=1,NMODEL
+ CALL GOTO_MODEL(JPGD)
+ WRITE(YLUOUT,'("OUTPUT_LISTING",I0)') JPGD
+ CALL OPEN_LUOUT_n(YLUOUT)
+END DO
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE OPEN_NESTPGD_FILES
diff --git a/src/SURFEX/build_emisstabn.F90 b/src/SURFEX/build_emisstabn.F90
index 3d009724e..02cb7a679 100644
--- a/src/SURFEX/build_emisstabn.F90
+++ b/src/SURFEX/build_emisstabn.F90
@@ -1,207 +1,204 @@
-!SURFEX_LIC Copyright 1994-2014 Meteo-France
-!SURFEX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SURFEX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SURFEX_LIC for details. version 1.
-! #########
- SUBROUTINE BUILD_EMISSTAB_n(HPROGRAM,KCH,HEMIS_GR_NAME, KNBTIMES,&
- KEMIS_GR_TIME,KOFFNDX,TPEMISS,KSIZE,KLUOUT, KVERB,PRHODREF)
-!! #####################################################################
-!!
-!!*** *BUILD_EMISSTAB*
-!!
-!! PURPOSE
-!! -------
-!!
-!!** METHOD
-!! ------
-!!
-!! AUTHOR
-!! ------
-!! D. Gazen
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 01/02/00
-!! C. Mari 30/10/00 call of MODD_TYPE_EFUTIL and MODD_CST
-!! D.Gazen 01/12/03 change emissions handling for surf. externalization!!
-!! P.Tulet 01/01/04 change conversion for externalization (flux unit is
-!! molec./m2/s)
-!! M.Leriche 04/14 apply conversion factor if lead = f
-!!
-!! EXTERNAL
-!! --------
-USE MODI_CH_OPEN_INPUTB
-USE MODI_READ_SURF
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-USE MODD_TYPE_EFUTIL, ONLY : EMISSVAR_T
-USE MODD_CSTS, ONLY : NDAYSEC, XMD, XAVOGADRO
-USE MODD_CH_SURF_n, ONLY : XCONVERSION
-!------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! -----------------
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-USE MODI_ABOR1_SFX
-!
-IMPLICIT NONE
-!
-!* 0.1 declaration of arguments
-!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! Program name
-INTEGER, INTENT(IN) :: KCH
- CHARACTER(LEN=*),DIMENSION(:), INTENT(IN) :: HEMIS_GR_NAME ! Offline species name
-INTEGER, DIMENSION(:), INTENT(IN) :: KNBTIMES ! nb of emis times array
-INTEGER, DIMENSION(:), INTENT(IN) :: KEMIS_GR_TIME
-INTEGER, DIMENSION(:), INTENT(IN) :: KOFFNDX ! index of offline species
-TYPE(EMISSVAR_T),DIMENSION(:), INTENT(OUT):: TPEMISS ! emission struct array to fill
-INTEGER, INTENT(IN) :: KSIZE ! size X*Y (1D) of physical domain
-INTEGER, INTENT(IN) :: KLUOUT ! output listing channel
-INTEGER, INTENT(IN) :: KVERB ! verbose level
-REAL, DIMENSION(:), INTENT(IN) :: PRHODREF ! dry density for ref. state
-!
-!
-!* 0.2 declaration of local variables
-!
- CHARACTER(LEN=3):: YUNIT ! unit of the flux
-INTEGER :: INBTS ! Number of emis times for a species
-INTEGER :: IRESP ! I/O return value
-INTEGER :: IIND1, IIND2
-INTEGER :: JSPEC ! loop index
-INTEGER :: ITIME ! loop index
-INTEGER :: IWS_DEFAULT ! Default Memory window size for emission reading
- CHARACTER (LEN=16):: YRECFM ! LFI article name
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-
-!
-!------------------------------------------------------------------------------
-!
-!* EXECUTABLE STATEMENTS
-! ---------------------
-!
-
-IF (LHOOK) CALL DR_HOOK('BUILD_EMISSTAB_N',0,ZHOOK_HANDLE)
-IF (KVERB >= 5) THEN
- WRITE(KLUOUT,*) '******** SUBROUTINE (CHIMIE): BUILD_EMISSTAB_n ********'
-END IF
-!
-!* 1. READ DATA
-! --------------
-!
- CALL CH_OPEN_INPUTB("EMISUNIT", KCH, KLUOUT)
-!
-! read unit identifier
-READ(KCH,'(A3)') YUNIT
-!
-!
-!* 2. MAP DATA ONTO PROGNOSTIC VARIABLES
-! ---------------------------------------
-!
-ALLOCATE (XCONVERSION(SIZE(PRHODREF,1)))
-! determine the conversion factor
- XCONVERSION(:) = 1.
-SELECT CASE (YUNIT)
-CASE ('MIX') ! flux given ppp*m/s, conversion to molec/m2/s
-! where 1 molecule/cm2/s = (224.14/6.022136E23) ppp*m/s
- XCONVERSION(:) = XAVOGADRO * PRHODREF(:) / XMD
-CASE ('CON') ! flux given in molecules/cm2/s, conversion to molec/m2/s
- XCONVERSION(:) = 1E4
-CASE ('MOL') ! flux given in microMol/m2/day, conversion to molec/m2/s
-! where 1 microMol/m2/day = (22.414/86.400)*1E-12 ppp*m/s
- !XCONVERSION(:) = (22.414/86.400)*1E-12 * XAVOGADRO * PRHODREF(:) / XMD
- XCONVERSION(:) = 1E-6 * XAVOGADRO / 86400.
-
-CASE DEFAULT
- CALL ABOR1_SFX('CH_BUILDEMISSN: UNKNOWN CONVERSION FACTOR')
-END SELECT
-!
-! Read Window size default value >= 2
-IWS_DEFAULT = 5 ! Should be set by namelist
-IF (IWS_DEFAULT < 2) IWS_DEFAULT = 2
-!
-IIND1 = 0
-IIND2 = 0
-DO JSPEC=1,SIZE(TPEMISS) ! loop on offline emission species
-!
- INBTS = KNBTIMES(JSPEC)
-!
-! Fill %CNAME
- TPEMISS(JSPEC)%CNAME = HEMIS_GR_NAME(KOFFNDX(JSPEC))
-! Allocate and Fill %NETIMES
- ALLOCATE(TPEMISS(JSPEC)%NETIMES(INBTS))
- IIND1 = IIND2+1
- IIND2 = IIND2+INBTS
- TPEMISS(JSPEC)%NETIMES(:) = KEMIS_GR_TIME(IIND1:IIND2)
-!
-! Update %NWS, %NDX, %NTX, %LREAD, %XEMISDATA
- IF (INBTS <= IWS_DEFAULT) THEN
-! Number of times smaller than read window size allowed
-! Read emis data once and for all
- TPEMISS(JSPEC)%NWS = INBTS
- TPEMISS(JSPEC)%NDX = 1
- TPEMISS(JSPEC)%NTX = 1
- TPEMISS(JSPEC)%LREAD = .FALSE. ! to prevent future reading
- ALLOCATE(TPEMISS(JSPEC)%XEMISDATA(KSIZE,INBTS))
-! Read file for emission data
- YRECFM='E_'//TRIM(TPEMISS(JSPEC)%CNAME)
- CALL READ_SURF(HPROGRAM,YRECFM,TPEMISS(JSPEC)%XEMISDATA(:,:),IRESP)
-!
-! Correction : Replace 999. with 0. value in the Emission FLUX
-! and apply conversion
- WHERE(TPEMISS(JSPEC)%XEMISDATA(:,:) == 999.)
- TPEMISS(JSPEC)%XEMISDATA(:,:) = 0.
- END WHERE
- WHERE(TPEMISS(JSPEC)%XEMISDATA(:,:) == 1.E20)
- TPEMISS(JSPEC)%XEMISDATA(:,:) = 0.
- END WHERE
- DO ITIME=1,INBTS
- ! XCONVERSION IS APPLIED IN CH_EMISSION_FLUXN ONLY FOR LREAD = T
- TPEMISS(JSPEC)%XEMISDATA(:,ITIME) = TPEMISS(JSPEC)%XEMISDATA(:,ITIME) * XCONVERSION(:)
- !TPEMISS(JSPEC)%XEMISDATA(:,ITIME) = TPEMISS(JSPEC)%XEMISDATA(:,ITIME)
- END DO
- ELSE
-! Read window size is smaller than number of emission times
- TPEMISS(JSPEC)%NWS = IWS_DEFAULT
- TPEMISS(JSPEC)%NDX = IWS_DEFAULT
- TPEMISS(JSPEC)%NTX = 0
- TPEMISS(JSPEC)%LREAD = .TRUE.
- ALLOCATE(TPEMISS(JSPEC)%XEMISDATA(KSIZE,IWS_DEFAULT))
- END IF
-
- IF (INBTS == 1) THEN
- TPEMISS(JSPEC)%XFWORK=>TPEMISS(JSPEC)%XEMISDATA(:,1)
- ELSE
- ALLOCATE(TPEMISS(JSPEC)%XFWORK(KSIZE))
- END IF
-! Compute index for periodic case
- TPEMISS(JSPEC)%NPX = MAXVAL(MINLOC(TPEMISS(JSPEC)%NETIMES(:)+&
- (1+(TPEMISS(JSPEC)%NETIMES(INBTS)-&
- TPEMISS(JSPEC)%NETIMES(:))/NDAYSEC)*NDAYSEC))
-!
-! Some di###ay
- IF (KVERB >= 6) THEN
- WRITE(KLUOUT,*) '====== Species ',TRIM(TPEMISS(JSPEC)%CNAME), ' ======'
- WRITE(KLUOUT,*) ' Emission Times :' ,TPEMISS(JSPEC)%NETIMES
- WRITE(KLUOUT,*) ' Current time index :' ,TPEMISS(JSPEC)%NTX
- WRITE(KLUOUT,*) ' Current data index :' ,TPEMISS(JSPEC)%NDX
- WRITE(KLUOUT,*) ' Periodic index = ',TPEMISS(JSPEC)%NPX,&
- ' at time :',TPEMISS(JSPEC)%NETIMES(TPEMISS(JSPEC)%NPX)
- WRITE(KLUOUT,*) ' Read window size :', TPEMISS(JSPEC)%NWS
- IF (TPEMISS(JSPEC)%LREAD) THEN
- WRITE(KLUOUT,*) ' -> Data must be read during simulation.'
- ELSE
- WRITE(KLUOUT,*) ' -> Data already in memory.'
- END IF
- END IF
-END DO
-
-IF (KVERB >= 5) THEN
- WRITE(KLUOUT,*) '******** END SUBROUTINE (CHIMIE) : BUILD_EMISSTAB_n ********'
-END IF
-IF (LHOOK) CALL DR_HOOK('BUILD_EMISSTAB_N',1,ZHOOK_HANDLE)
-
-END SUBROUTINE BUILD_EMISSTAB_n
+! #########
+ SUBROUTINE BUILD_EMISSTAB_n(HPROGRAM,KCH,HEMIS_GR_NAME, KNBTIMES,&
+ KEMIS_GR_TIME,KOFFNDX,TPEMISS,KSIZE,KLUOUT, KVERB,PRHODREF)
+!! #####################################################################
+!!
+!!*** *BUILD_EMISSTAB*
+!!
+!! PURPOSE
+!! -------
+!!
+!!** METHOD
+!! ------
+!!
+!! AUTHOR
+!! ------
+!! D. Gazen
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 01/02/00
+!! C. Mari 30/10/00 call of MODD_TYPE_EFUTIL and MODD_CST
+!! D.Gazen 01/12/03 change emissions handling for surf. externalization!!
+!! P.Tulet 01/01/04 change conversion for externalization (flux unit is
+!! molec./m2/s)
+!! M.Leriche 04/14 apply conversion factor if lead = f
+!! M.Moge 01/2016 using READ_SURF_FIELD2D for 2D surfex fields reads
+!!
+!! EXTERNAL
+!! --------
+USE MODI_CH_OPEN_INPUTB
+USE MODI_READ_SURF_FIELD2D
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+USE MODD_TYPE_EFUTIL, ONLY : EMISSVAR_T
+USE MODD_CSTS, ONLY : NDAYSEC, XMD, XAVOGADRO
+USE MODD_CH_SURF_n, ONLY : XCONVERSION
+!------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! -----------------
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+USE MODI_ABOR1_SFX
+!
+IMPLICIT NONE
+!
+!* 0.1 declaration of arguments
+!
+ CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! Program name
+INTEGER, INTENT(IN) :: KCH
+ CHARACTER(LEN=*),DIMENSION(:), INTENT(IN) :: HEMIS_GR_NAME ! Offline species name
+INTEGER, DIMENSION(:), INTENT(IN) :: KNBTIMES ! nb of emis times array
+INTEGER, DIMENSION(:), INTENT(IN) :: KEMIS_GR_TIME
+INTEGER, DIMENSION(:), INTENT(IN) :: KOFFNDX ! index of offline species
+TYPE(EMISSVAR_T),DIMENSION(:), INTENT(OUT):: TPEMISS ! emission struct array to fill
+INTEGER, INTENT(IN) :: KSIZE ! size X*Y (1D) of physical domain
+INTEGER, INTENT(IN) :: KLUOUT ! output listing channel
+INTEGER, INTENT(IN) :: KVERB ! verbose level
+REAL, DIMENSION(:), INTENT(IN) :: PRHODREF ! dry density for ref. state
+!
+!
+!* 0.2 declaration of local variables
+!
+ CHARACTER(LEN=3):: YUNIT ! unit of the flux
+INTEGER :: INBTS ! Number of emis times for a species
+INTEGER :: IRESP ! I/O return value
+INTEGER :: IIND1, IIND2
+INTEGER :: JSPEC ! loop index
+INTEGER :: ITIME ! loop index
+INTEGER :: IWS_DEFAULT ! Default Memory window size for emission reading
+ CHARACTER (LEN=16):: YRECFM ! LFI article name
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+!
+!------------------------------------------------------------------------------
+!
+!* EXECUTABLE STATEMENTS
+! ---------------------
+!
+
+IF (LHOOK) CALL DR_HOOK('BUILD_EMISSTAB_N',0,ZHOOK_HANDLE)
+IF (KVERB >= 5) THEN
+ WRITE(KLUOUT,*) '******** SUBROUTINE (CHIMIE): BUILD_EMISSTAB_n ********'
+END IF
+!
+!* 1. READ DATA
+! --------------
+!
+ CALL CH_OPEN_INPUTB("EMISUNIT", KCH, KLUOUT)
+!
+! read unit identifier
+READ(KCH,'(A3)') YUNIT
+!
+!
+!* 2. MAP DATA ONTO PROGNOSTIC VARIABLES
+! ---------------------------------------
+!
+ALLOCATE (XCONVERSION(SIZE(PRHODREF,1)))
+! determine the conversion factor
+ XCONVERSION(:) = 1.
+SELECT CASE (YUNIT)
+CASE ('MIX') ! flux given ppp*m/s, conversion to molec/m2/s
+! where 1 molecule/cm2/s = (224.14/6.022136E23) ppp*m/s
+ XCONVERSION(:) = XAVOGADRO * PRHODREF(:) / XMD
+CASE ('CON') ! flux given in molecules/cm2/s, conversion to molec/m2/s
+ XCONVERSION(:) = 1E4
+CASE ('MOL') ! flux given in microMol/m2/day, conversion to molec/m2/s
+! where 1 microMol/m2/day = (22.414/86.400)*1E-12 ppp*m/s
+ !XCONVERSION(:) = (22.414/86.400)*1E-12 * XAVOGADRO * PRHODREF(:) / XMD
+ XCONVERSION(:) = 1E-6 * XAVOGADRO / 86400.
+
+CASE DEFAULT
+ CALL ABOR1_SFX('CH_BUILDEMISSN: UNKNOWN CONVERSION FACTOR')
+END SELECT
+!
+! Read Window size default value >= 2
+IWS_DEFAULT = 5 ! Should be set by namelist
+IF (IWS_DEFAULT < 2) IWS_DEFAULT = 2
+!
+IIND1 = 0
+IIND2 = 0
+DO JSPEC=1,SIZE(TPEMISS) ! loop on offline emission species
+!
+ INBTS = KNBTIMES(JSPEC)
+!
+! Fill %CNAME
+ TPEMISS(JSPEC)%CNAME = HEMIS_GR_NAME(KOFFNDX(JSPEC))
+! Allocate and Fill %NETIMES
+ ALLOCATE(TPEMISS(JSPEC)%NETIMES(INBTS))
+ IIND1 = IIND2+1
+ IIND2 = IIND2+INBTS
+ TPEMISS(JSPEC)%NETIMES(:) = KEMIS_GR_TIME(IIND1:IIND2)
+!
+! Update %NWS, %NDX, %NTX, %LREAD, %XEMISDATA
+ IF (INBTS <= IWS_DEFAULT) THEN
+! Number of times smaller than read window size allowed
+! Read emis data once and for all
+ TPEMISS(JSPEC)%NWS = INBTS
+ TPEMISS(JSPEC)%NDX = 1
+ TPEMISS(JSPEC)%NTX = 1
+ TPEMISS(JSPEC)%LREAD = .FALSE. ! to prevent future reading
+ ALLOCATE(TPEMISS(JSPEC)%XEMISDATA(KSIZE,INBTS))
+! Read file for emission data
+ YRECFM='E_'//TRIM(TPEMISS(JSPEC)%CNAME)
+ CALL READ_SURF_FIELD2D(HPROGRAM,TPEMISS(JSPEC)%XEMISDATA(:,:),YRECFM)
+!
+! Correction : Replace 999. with 0. value in the Emission FLUX
+! and apply conversion
+ WHERE(TPEMISS(JSPEC)%XEMISDATA(:,:) == 999.)
+ TPEMISS(JSPEC)%XEMISDATA(:,:) = 0.
+ END WHERE
+ WHERE(TPEMISS(JSPEC)%XEMISDATA(:,:) == 1.E20)
+ TPEMISS(JSPEC)%XEMISDATA(:,:) = 0.
+ END WHERE
+ DO ITIME=1,INBTS
+ ! XCONVERSION IS APPLIED IN CH_EMISSION_FLUXN ONLY FOR LREAD = T
+ TPEMISS(JSPEC)%XEMISDATA(:,ITIME) = TPEMISS(JSPEC)%XEMISDATA(:,ITIME) * XCONVERSION(:)
+ !TPEMISS(JSPEC)%XEMISDATA(:,ITIME) = TPEMISS(JSPEC)%XEMISDATA(:,ITIME)
+ END DO
+ ELSE
+! Read window size is smaller than number of emission times
+ TPEMISS(JSPEC)%NWS = IWS_DEFAULT
+ TPEMISS(JSPEC)%NDX = IWS_DEFAULT
+ TPEMISS(JSPEC)%NTX = 0
+ TPEMISS(JSPEC)%LREAD = .TRUE.
+ ALLOCATE(TPEMISS(JSPEC)%XEMISDATA(KSIZE,IWS_DEFAULT))
+ END IF
+
+ IF (INBTS == 1) THEN
+ TPEMISS(JSPEC)%XFWORK=>TPEMISS(JSPEC)%XEMISDATA(:,1)
+ ELSE
+ ALLOCATE(TPEMISS(JSPEC)%XFWORK(KSIZE))
+ END IF
+! Compute index for periodic case
+ TPEMISS(JSPEC)%NPX = MAXVAL(MINLOC(TPEMISS(JSPEC)%NETIMES(:)+&
+ (1+(TPEMISS(JSPEC)%NETIMES(INBTS)-&
+ TPEMISS(JSPEC)%NETIMES(:))/NDAYSEC)*NDAYSEC))
+!
+! Some di###ay
+ IF (KVERB >= 6) THEN
+ WRITE(KLUOUT,*) '====== Species ',TRIM(TPEMISS(JSPEC)%CNAME), ' ======'
+ WRITE(KLUOUT,*) ' Emission Times :' ,TPEMISS(JSPEC)%NETIMES
+ WRITE(KLUOUT,*) ' Current time index :' ,TPEMISS(JSPEC)%NTX
+ WRITE(KLUOUT,*) ' Current data index :' ,TPEMISS(JSPEC)%NDX
+ WRITE(KLUOUT,*) ' Periodic index = ',TPEMISS(JSPEC)%NPX,&
+ ' at time :',TPEMISS(JSPEC)%NETIMES(TPEMISS(JSPEC)%NPX)
+ WRITE(KLUOUT,*) ' Read window size :', TPEMISS(JSPEC)%NWS
+ IF (TPEMISS(JSPEC)%LREAD) THEN
+ WRITE(KLUOUT,*) ' -> Data must be read during simulation.'
+ ELSE
+ WRITE(KLUOUT,*) ' -> Data already in memory.'
+ END IF
+ END IF
+END DO
+
+IF (KVERB >= 5) THEN
+ WRITE(KLUOUT,*) '******** END SUBROUTINE (CHIMIE) : BUILD_EMISSTAB_n ********'
+END IF
+IF (LHOOK) CALL DR_HOOK('BUILD_EMISSTAB_N',1,ZHOOK_HANDLE)
+
+END SUBROUTINE BUILD_EMISSTAB_n
diff --git a/src/SURFEX/ch_emission_fluxn.F90 b/src/SURFEX/ch_emission_fluxn.F90
index 7bb844b53..93b35766f 100644
--- a/src/SURFEX/ch_emission_fluxn.F90
+++ b/src/SURFEX/ch_emission_fluxn.F90
@@ -1,439 +1,436 @@
-!SURFEX_LIC Copyright 1994-2014 Meteo-France
-!SURFEX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SURFEX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SURFEX_LIC for details. version 1.
-! #########
- SUBROUTINE CH_EMISSION_FLUX_n(HPROGRAM,PSIMTIME,PSFSV, PRHOA, PTSTEP, KNBTS_MAX)
-! ######################################################################
-!!
-!!*** *CH_EMISSION_FLUX_n* -
-!!
-!! PURPOSE
-!! -------
-!! Return a time-dependent emission flux based on tabulated values
-!!
-!!** METHOD
-!! ------
-!!
-!! AUTHOR
-!! ------
-!! D. Gazen
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 08/02/00
-!! C. Mari 30/10/00 call to MODD_TYPE_EFUTIL and MODD_CST
-!! D.Gazen 01/12/03 change emissions handling for surf. externalization
-!! P.Tulet 01/01/04 change emission conversion factor
-!! P.Tulet 01/01/05 add dust, orilam
-!! M.Leriche 2015 suppress ZDEPOT
-!!
-!! EXTERNAL
-!! --------
-!!
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-USE MODD_SV_n, ONLY: CSV,NSV_CHSBEG,NSV_CHSEND, NSV_AERBEG, NSV_AEREND
-USE MODD_TYPE_EFUTIL, ONLY: EMISSVAR_T, PRONOSVAR_T
-USE MODD_CSTS, ONLY: NDAYSEC
-USE MODD_CH_EMIS_FIELD_n, ONLY: TSEMISS, TSPRONOSLIST, XTIME_SIMUL
-USE MODD_CH_SURF_n, ONLY: XCONVERSION
-!
-USE MODI_READ_SURF
-USE MODI_INIT_IO_SURF_n
-USE MODI_END_IO_SURF_n
-USE MODI_GET_LUOUT
-!UPG*AERO1
-USE MODD_CHS_AEROSOL, ONLY: LCH_AERO_FLUX
-USE MODI_CH_AER_EMISSION
-!UPG*AERO1
-!!
-!------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! -----------------
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-USE MODI_ABOR1_SFX
-!
-IMPLICIT NONE
-!
-!* 0.1 declaration of arguments
-!
-CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
-REAL, INTENT(IN) :: PSIMTIME ! time of simulation in sec UTC
- ! (counting from midnight of
- ! the current day)
-REAL,DIMENSION(:,:), INTENT(INOUT) :: PSFSV ! emission flux in ppp*m/s
-REAL, DIMENSION(:), INTENT(IN) :: PRHOA ! air density (kg/m3)
-REAL, INTENT(IN) :: PTSTEP ! atmospheric time-step (s)
-INTEGER, INTENT(IN) :: KNBTS_MAX !max size of TEMISS%NETIMES
-
-!
-!* 0.2 declaration of local variables
-!
-INTEGER :: IVERB ! verbosity level
-INTEGER :: KSIZE1D ! 1D size = X*Y physical domain
-INTEGER :: JI ! loop control
-REAL :: ZALPHA ! interpolation weight
-!
-INTEGER :: INBTS ! Number of emission times for a species
-INTEGER :: ITIM1,ITIM2 ! first/last time for interpolation
-INTEGER :: INDX1,INDX2 ! first/next index for data interpolation
-INTEGER :: ISIMTIME, ITPERIOD
-CHARACTER (LEN=16) :: YRECFM ! LFI article name
-TYPE(PRONOSVAR_T),POINTER :: CURPRONOS !Current pronostic variable
-!
-!* 0.3 declaration of saved local variables
-!
-CHARACTER(LEN=6), DIMENSION(:), POINTER :: CNAMES
-REAL,DIMENSION(SIZE(PSFSV,1),KNBTS_MAX) :: ZWORK ! temporary array for reading data
-REAL,DIMENSION(SIZE(PSFSV,1),SIZE(PSFSV,2)) :: ZEMIS ! interpolated in time emission flux
-REAL,DIMENSION(SIZE(PSFSV,1)) :: ZFCO ! CO flux
-INTEGER :: INEQ ! number of chemical var
- !(=NEQ (chimie gaz) + NSV_AER (chimie aerosol)
-INTEGER :: IWS ! window size
-INTEGER :: IRESP ! return code for I/O
-INTEGER :: ILUOUT ! Outputlisting unit
-LOGICAL :: LIOINIT ! True if I/O init done
-INTEGER :: JW
-INTEGER :: ITIME
-LOGICAL :: GCO = .FALSE. ! switch if CO emission are available
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-!------------------------------------------------------------------------------
-!
-!* EXECUTABLE STATEMENTS
-! ---------------------
-!
-IF (LHOOK) CALL DR_HOOK('CH_EMISSION_FLUX_N',0,ZHOOK_HANDLE)
-CALL GET_LUOUT(HPROGRAM,ILUOUT)
-LIOINIT = .FALSE.
-IVERB = 5
-KSIZE1D = SIZE(PSFSV,1)
-INEQ = SIZE(PSFSV,2)
-!
-!------------------------------------------------------------------------------
-!
-!* 3. INTERPOLATE SURFACE FLUXES IN TIME IF NEEDED
-! ------------------------------------------------
-!
-IF (XTIME_SIMUL == 0.) THEN
- XTIME_SIMUL = PSIMTIME
-ELSE
- XTIME_SIMUL = XTIME_SIMUL + PTSTEP
-END IF
-
-IF (IVERB >= 5) WRITE(ILUOUT,*) '******** CH_EMISSION_FLUX ********'
-DO JI=1,SIZE(TSEMISS)
-! Simulation time (counting from midnight) is saved
- ISIMTIME = XTIME_SIMUL
-!
- INBTS = SIZE(TSEMISS(JI)%NETIMES) !
- IWS = TSEMISS(JI)%NWS ! Window Size for I/O
- INDX1 = TSEMISS(JI)%NDX ! Current data index
-!
- IF (INBTS == 1) THEN
-! Time Constant Flux
-! XFWORK already points on data (see build_emisstabn.F90)
- IF (IVERB >= 6) THEN
- WRITE(ILUOUT,*) 'NO interpolation for ',TRIM(TSEMISS(JI)%CNAME)
- IF (IVERB >= 10 ) WRITE(ILUOUT,*) TSEMISS(JI)%XFWORK
- END IF
- ELSE
- IF (IVERB >= 6) THEN
- WRITE(ILUOUT,*) 'Interpolation (T =',ISIMTIME,') : ',TSEMISS(JI)%CNAME
- END IF
- IF (ISIMTIME < TSEMISS(JI)%NETIMES(1)) THEN
-! Tsim < T(1)=Tmin should not happen but who knows ?
- TSEMISS(JI)%NTX = 1
- ELSE
-! Check for periodicity when ISIMTIME is beyond last emission time
-! and probably correct ISIMTIME
- IF (ISIMTIME > TSEMISS(JI)%NETIMES(INBTS)) THEN
-! Tsim > T(INBTS)=Tmax
- ITPERIOD = (1+(TSEMISS(JI)%NETIMES(INBTS)-&
- TSEMISS(JI)%NETIMES(TSEMISS(JI)%NPX))/NDAYSEC)*NDAYSEC
- ISIMTIME = MODULO(ISIMTIME-TSEMISS(JI)%NETIMES(TSEMISS(JI)%NPX),ITPERIOD)+&
- TSEMISS(JI)%NETIMES(TSEMISS(JI)%NPX)
- IF (IVERB >= 6) THEN
- WRITE(ILUOUT,*) ' ITPERIOD = ', ITPERIOD
- WRITE(ILUOUT,*) ' ISIMTIME modifie = ', ISIMTIME
- END IF
- IF (TSEMISS(JI)%NTX == INBTS .AND. ISIMTIME<TSEMISS(JI)%NETIMES(INBTS)) THEN
-! Update time index NTX
- TSEMISS(JI)%NTX = TSEMISS(JI)%NPX
-! Increment data index NDX : NDX correction will occur later
-! to assure 1 <= NDX <= IWS
- INDX1 = INDX1 + 1
- END IF
- END IF
-!
-! search NTX such that : ETIMES(NTX) < ISIMTIME <= ETIMES(NTX+1)
-! and make NDX follow NTX : NDX correction will occur later
-! to assure 1 <= NDX <= IWS
- DO WHILE (TSEMISS(JI)%NTX < INBTS)
- IF (ISIMTIME >= TSEMISS(JI)%NETIMES(TSEMISS(JI)%NTX+1)) THEN
- TSEMISS(JI)%NTX = TSEMISS(JI)%NTX + 1
- INDX1 = INDX1 + 1
- INDX2 = INDX1 + 1
- ELSE
- EXIT
- END IF
- END DO
- END IF
-!
-! Check availability of data within memory Window (XEMISDATA(:,1:IWS))
- IF (INDX1 >= IWS) THEN
-!
-! Data index reached the memory window limits
-!
- IF (TSEMISS(JI)%LREAD) THEN
-!
-! File must be read to update XEMISDATA array for this species
-!
- IF (.NOT. LIOINIT) THEN
-! Must be done once before reading
- CALL INIT_IO_SURF_n(HPROGRAM,'FULL ','SURF ','READ ')
- IF (IVERB >= 6) WRITE(ILUOUT,*) 'INIT des I/O DONE.'
- LIOINIT=.TRUE.
- END IF
- YRECFM='E_'//TRIM(TSEMISS(JI)%CNAME)
- IF (IVERB >= 6)&
- WRITE (ILUOUT,*) 'READ emission :',TRIM(YRECFM),&
- ', SIZE(ZWORK)=',SIZE(ZWORK,1),INBTS
- CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,1:INBTS),IRESP)
-!
-! Correction : Replace 999. with 0. value in the Emission FLUX
- WHERE(ZWORK(:,1:INBTS) == 999.)
- ZWORK(:,1:INBTS) = 0.
- END WHERE
- WHERE(ZWORK(:,1:INBTS) == 1.E20)
- ZWORK(:,1:INBTS) = 0.
- END WHERE
- DO ITIME=1,INBTS
- ZWORK(:,ITIME) = ZWORK(:,ITIME)*XCONVERSION(:)
- END DO
-!
-!
- IF ((TSEMISS(JI)%NTX+IWS-1) > INBTS) THEN
-!
-! ===== Periodic CASE =====
-!
- IF (IVERB >= 6)&
- WRITE (ILUOUT,*) 'Periodic CASE : NPX =',TSEMISS(JI)%NPX
- IF (IWS < (INBTS-TSEMISS(JI)%NPX+1)) THEN
-! Window size is smaller then number of periodical times
-!
-! example : IWS=5, NPX=2, INBTS=11, NTX=9
-! NTX NPX
-! | |
-! time index : ...9 10 11 # 2 3 4...11 #
-! old data index :[1 2 3 4 5]
-! new data index : [1 2 3 4 5]
-! |
-! NDX
-!
- TSEMISS(JI)%XEMISDATA(:,1:INBTS-TSEMISS(JI)%NTX+1) = &
- ZWORK(:,TSEMISS(JI)%NTX:INBTS)
-!
- IF (IVERB >= 6) THEN
- WRITE(ILUOUT,*) 'Window SIZE smaller than INBTS !'
- WRITE(ILUOUT,*) 'Window index, Time index'
- DO JW=1,INBTS-TSEMISS(JI)%NTX+1
- WRITE(ILUOUT,*) JW,TSEMISS(JI)%NTX+JW-1
- END DO
- END IF
-!
- TSEMISS(JI)%XEMISDATA(:,INBTS-TSEMISS(JI)%NTX+2:IWS) = &
- ZWORK(:,TSEMISS(JI)%NPX:TSEMISS(JI)%NPX+IWS-INBTS+TSEMISS(JI)%NTX-2)
-!
- IF (IVERB >= 6) THEN
- DO JW=INBTS-TSEMISS(JI)%NTX+2,IWS
- WRITE(ILUOUT,*) JW,TSEMISS(JI)%NPX+JW-(INBTS-TSEMISS(JI)%NTX+2)
- END DO
- END IF
- INDX1 = 1
- INDX2 = 2
- ELSE
-! Window size may get smaller AND it will be the last reading
-!
-! example : IWS=6, NPX=7, INBTS=11, NTX=9
-!
-! NTX NPX NTX
-! | | |
-! time index: ...9 10 11 # 7 8 9 10 11 #
-! old data index: ...6]
-! new data index: [1 2 3 4 5]
-! |
-! NDX=NTX-NPX+1
-!
- IWS = INBTS-TSEMISS(JI)%NPX+1
- TSEMISS(JI)%NWS = IWS
- TSEMISS(JI)%XEMISDATA(:,1:IWS) = ZWORK(:,TSEMISS(JI)%NPX:INBTS)
- IF (IVERB >= 6) THEN
- WRITE(ILUOUT,*) 'Window SIZE equal or greater than INBTS !'
- WRITE(ILUOUT,*) 'Window index, Time index'
- DO JW=1,IWS
- WRITE(ILUOUT,*) JW,TSEMISS(JI)%NPX+JW-1
- END DO
- END IF
- INDX1 = TSEMISS(JI)%NTX-TSEMISS(JI)%NPX+1
- INDX2 = MOD((INDX1+1),IWS)
- TSEMISS(JI)%LREAD = .FALSE. ! no more reading
- END IF
- ELSE
-!
-! ===== NON periodic (normal) CASE =====
-!
-! example : with IWS=5, the window moves forward
-! NTX
-! |
-! time index : 1 2 3 4 5 6 7 8 9 10 11 ... INBTS #
-! old data index :[1 2 3 4 5]
-! new data index : [1 2 3 4 5]
-! |
-! NDX
-!
- TSEMISS(JI)%XEMISDATA(:,1:IWS) = ZWORK(:,TSEMISS(JI)%NTX:TSEMISS(JI)%NTX+IWS-1)
- IF (IVERB >= 6) THEN
- WRITE(ILUOUT,*) 'Window index, Time index'
- DO JW=1,IWS
- WRITE(ILUOUT,*) JW,TSEMISS(JI)%NTX+JW-1
- END DO
- END IF
- INDX1 = 1
- INDX2 = 2
- END IF
- ELSE
-! Data is already in memory because window size is sufficient
-! to hold INBTS emission times => simply update NDX according to NTX
-!
- IF (IWS==INBTS) THEN
-!
-! 'Window size' = 'Nb emis times' at INIT (ch_init_emission)
-! so NDX must be set equal to NTX (the window does not move)
-! example :
-! NPX NTX
-! | |
-! time index : 1 2 3 ... INBTS
-! data index : [1 2 3 ... INBTS]
-! |
-! NDX
-
- INDX1 = TSEMISS(JI)%NTX
- INDX2 = INDX1+1
- IF (INDX2 > IWS) INDX2=TSEMISS(JI)%NPX
- ELSE
-!
-! Windows size changed during periodic case
-! NDX must be equal to NTX - NPX + 1
-! (the window does not move)
-! example :
-! NTX
-! |
-! time index : NPX NPX+1 NPX+2 ... INBTS
-! data index : [1 2 3 ... IWS]
-! |
-! NDX
- INDX1 = TSEMISS(JI)%NTX-TSEMISS(JI)%NPX+1
- INDX2 = MOD((INDX1+1),IWS)
- END IF
- END IF
- ELSE ! (INDX1 < IWS)
- INDX2 = INDX1+1
- END IF
-!
-! Don't forget to update NDX with new value INDX1
- TSEMISS(JI)%NDX = INDX1
-!
-! Compute both times for interpolation
- IF (TSEMISS(JI)%NTX < INBTS) THEN
- ITIM1 = TSEMISS(JI)%NETIMES(TSEMISS(JI)%NTX)
- ITIM2 = TSEMISS(JI)%NETIMES(TSEMISS(JI)%NTX+1)
- ELSE
- ITIM1 = TSEMISS(JI)%NETIMES(INBTS)
- ITIM2 = TSEMISS(JI)%NETIMES(TSEMISS(JI)%NPX)+ITPERIOD
- END IF
-!
-! Interpolate variables in time -> update XFWORK
-!
-!
-! time : ITIM1...Tsim...ITIM2
-! | |
-! data index : INDX1 INDX2
-!
-!
- ZALPHA = (REAL(ISIMTIME) - ITIM1) / (ITIM2-ITIM1)
- TSEMISS(JI)%XFWORK(:) = ZALPHA*TSEMISS(JI)%XEMISDATA(:,INDX2) +&
- (1.-ZALPHA)*TSEMISS(JI)%XEMISDATA(:,INDX1)
- IF (IVERB >= 6) THEN
- WRITE(ILUOUT,*) ' Current time INDEX : ',TSEMISS(JI)%NTX
- WRITE(ILUOUT,*) ' TIME : ',ISIMTIME, ' (',ITIM1,',',ITIM2,')'
- WRITE(ILUOUT,*) ' Window size : ',TSEMISS(JI)%NWS
- WRITE(ILUOUT,*) ' Current data INDEX : ',INDX1,INDX2
- IF (IVERB >= 10) WRITE(ILUOUT,*) ' FLUX : ',TSEMISS(JI)%XFWORK
- END IF
- END IF
-END DO
-!
-! Agregation : flux computation
-!
-ZEMIS(:,:) = 0.
-!
-! Point on head of Pronostic variable list
-! to cover the entire list.
-IF (NSV_AEREND > 0) THEN
-CNAMES=>CSV(NSV_CHSBEG:NSV_AEREND)
-ELSE
-CNAMES=>CSV(NSV_CHSBEG:NSV_CHSEND)
-END IF
-CURPRONOS=>TSPRONOSLIST
-DO WHILE(ASSOCIATED(CURPRONOS))
- IF (CURPRONOS%NAMINDEX > INEQ) THEN
- WRITE(ILUOUT,*) 'FATAL ERROR in CH_EMISSION_FLUXN : SIZE(ZEMIS,2) =',&
- INEQ,', INDEX bugge =',CURPRONOS%NAMINDEX
- CALL ABOR1_SFX('CH_EMISSION_FLUXN: FATAL ERROR')
- END IF
-
- ZEMIS(:,CURPRONOS%NAMINDEX) = 0.
-!
-! Loop on the number of agreg. coeff.
- DO JI=1,CURPRONOS%NBCOEFF
-! Compute agregated flux
- ZEMIS(:,CURPRONOS%NAMINDEX) = ZEMIS(:,CURPRONOS%NAMINDEX)+&
- CURPRONOS%XCOEFF(JI)*TSEMISS(CURPRONOS%NEFINDEX(JI))%XFWORK(:)
- END DO
-
- IF (IVERB >= 6) THEN
- WRITE(ILUOUT,*) 'Agregation for ',CNAMES(CURPRONOS%NAMINDEX)
- IF (IVERB >= 10) WRITE(ILUOUT,*) 'ZEMIS = ',ZEMIS(:,CURPRONOS%NAMINDEX)
- END IF
- IF ((CNAMES(CURPRONOS%NAMINDEX) == "CO") .AND. ANY(ZEMIS(:,CURPRONOS%NAMINDEX).GT.0.)) THEN
- ZFCO(:) = ZEMIS(:,CURPRONOS%NAMINDEX)
- GCO = .TRUE.
- END IF
-
- CURPRONOS=>CURPRONOS%NEXT
-!
-END DO
-!
-IF ((LCH_AERO_FLUX).AND.(NSV_AERBEG > 0)) THEN
- IF (GCO) THEN
- CALL CH_AER_EMISSION(ZEMIS, PRHOA, CSV, NSV_CHSBEG, PFCO=ZFCO)
- ELSE
- CALL CH_AER_EMISSION(ZEMIS, PRHOA, CSV, NSV_CHSBEG)
- ENDIF
-END IF
-!
-PSFSV(:,:) = PSFSV(:,:) + ZEMIS(:,:)
-!
-IF (LIOINIT) CALL END_IO_SURF_n(HPROGRAM)
-!
-IF (IVERB >= 6) WRITE(ILUOUT,*) '******** END CH_EMISSION_FLUX ********'
-IF (LHOOK) CALL DR_HOOK('CH_EMISSION_FLUX_N',1,ZHOOK_HANDLE)
-!
-END SUBROUTINE CH_EMISSION_FLUX_n
+! #########
+ SUBROUTINE CH_EMISSION_FLUX_n(HPROGRAM,PSIMTIME,PSFSV, PRHOA, PTSTEP, KNBTS_MAX)
+! ######################################################################
+!!
+!!*** *CH_EMISSION_FLUX_n* -
+!!
+!! PURPOSE
+!! -------
+!! Return a time-dependent emission flux based on tabulated values
+!!
+!!** METHOD
+!! ------
+!!
+!! AUTHOR
+!! ------
+!! D. Gazen
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 08/02/00
+!! C. Mari 30/10/00 call to MODD_TYPE_EFUTIL and MODD_CST
+!! D.Gazen 01/12/03 change emissions handling for surf. externalization
+!! P.Tulet 01/01/04 change emission conversion factor
+!! P.Tulet 01/01/05 add dust, orilam
+!! M.Leriche 2015 suppress ZDEPOT
+!! M.Moge 01/2016 using READ_SURF_FIELD2D for 2D surfex fields reads
+!!
+!! EXTERNAL
+!! --------
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+USE MODD_SV_n, ONLY: CSV,NSV_CHSBEG,NSV_CHSEND, NSV_AERBEG, NSV_AEREND
+USE MODD_TYPE_EFUTIL, ONLY: EMISSVAR_T, PRONOSVAR_T
+USE MODD_CSTS, ONLY: NDAYSEC
+USE MODD_CH_EMIS_FIELD_n, ONLY: TSEMISS, TSPRONOSLIST, XTIME_SIMUL
+USE MODD_CH_SURF_n, ONLY: XCONVERSION
+!
+USE MODI_READ_SURF_FIELD2D
+USE MODI_INIT_IO_SURF_n
+USE MODI_END_IO_SURF_n
+USE MODI_GET_LUOUT
+!UPG*AERO1
+USE MODD_CHS_AEROSOL, ONLY: LCH_AERO_FLUX
+USE MODI_CH_AER_EMISSION
+!UPG*AERO1
+!!
+!------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! -----------------
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+USE MODI_ABOR1_SFX
+!
+IMPLICIT NONE
+!
+!* 0.1 declaration of arguments
+!
+CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
+REAL, INTENT(IN) :: PSIMTIME ! time of simulation in sec UTC
+ ! (counting from midnight of
+ ! the current day)
+REAL,DIMENSION(:,:), INTENT(INOUT) :: PSFSV ! emission flux in ppp*m/s
+REAL, DIMENSION(:), INTENT(IN) :: PRHOA ! air density (kg/m3)
+REAL, INTENT(IN) :: PTSTEP ! atmospheric time-step (s)
+INTEGER, INTENT(IN) :: KNBTS_MAX !max size of TEMISS%NETIMES
+
+!
+!* 0.2 declaration of local variables
+!
+INTEGER :: IVERB ! verbosity level
+INTEGER :: KSIZE1D ! 1D size = X*Y physical domain
+INTEGER :: JI ! loop control
+REAL :: ZALPHA ! interpolation weight
+!
+INTEGER :: INBTS ! Number of emission times for a species
+INTEGER :: ITIM1,ITIM2 ! first/last time for interpolation
+INTEGER :: INDX1,INDX2 ! first/next index for data interpolation
+INTEGER :: ISIMTIME, ITPERIOD
+CHARACTER (LEN=16) :: YRECFM ! LFI article name
+TYPE(PRONOSVAR_T),POINTER :: CURPRONOS !Current pronostic variable
+!
+!* 0.3 declaration of saved local variables
+!
+CHARACTER(LEN=6), DIMENSION(:), POINTER :: CNAMES
+REAL,DIMENSION(SIZE(PSFSV,1),KNBTS_MAX) :: ZWORK ! temporary array for reading data
+REAL,DIMENSION(SIZE(PSFSV,1),SIZE(PSFSV,2)) :: ZEMIS ! interpolated in time emission flux
+REAL,DIMENSION(SIZE(PSFSV,1)) :: ZFCO ! CO flux
+INTEGER :: INEQ ! number of chemical var
+ !(=NEQ (chimie gaz) + NSV_AER (chimie aerosol)
+INTEGER :: IWS ! window size
+INTEGER :: IRESP ! return code for I/O
+INTEGER :: ILUOUT ! Outputlisting unit
+LOGICAL :: LIOINIT ! True if I/O init done
+INTEGER :: JW
+INTEGER :: ITIME
+LOGICAL :: GCO = .FALSE. ! switch if CO emission are available
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+!------------------------------------------------------------------------------
+!
+!* EXECUTABLE STATEMENTS
+! ---------------------
+!
+IF (LHOOK) CALL DR_HOOK('CH_EMISSION_FLUX_N',0,ZHOOK_HANDLE)
+CALL GET_LUOUT(HPROGRAM,ILUOUT)
+LIOINIT = .FALSE.
+IVERB = 5
+KSIZE1D = SIZE(PSFSV,1)
+INEQ = SIZE(PSFSV,2)
+!
+!------------------------------------------------------------------------------
+!
+!* 3. INTERPOLATE SURFACE FLUXES IN TIME IF NEEDED
+! ------------------------------------------------
+!
+IF (XTIME_SIMUL == 0.) THEN
+ XTIME_SIMUL = PSIMTIME
+ELSE
+ XTIME_SIMUL = XTIME_SIMUL + PTSTEP
+END IF
+
+IF (IVERB >= 5) WRITE(ILUOUT,*) '******** CH_EMISSION_FLUX ********'
+DO JI=1,SIZE(TSEMISS)
+! Simulation time (counting from midnight) is saved
+ ISIMTIME = XTIME_SIMUL
+!
+ INBTS = SIZE(TSEMISS(JI)%NETIMES) !
+ IWS = TSEMISS(JI)%NWS ! Window Size for I/O
+ INDX1 = TSEMISS(JI)%NDX ! Current data index
+!
+ IF (INBTS == 1) THEN
+! Time Constant Flux
+! XFWORK already points on data (see build_emisstabn.F90)
+ IF (IVERB >= 6) THEN
+ WRITE(ILUOUT,*) 'NO interpolation for ',TRIM(TSEMISS(JI)%CNAME)
+ IF (IVERB >= 10 ) WRITE(ILUOUT,*) TSEMISS(JI)%XFWORK
+ END IF
+ ELSE
+ IF (IVERB >= 6) THEN
+ WRITE(ILUOUT,*) 'Interpolation (T =',ISIMTIME,') : ',TSEMISS(JI)%CNAME
+ END IF
+ IF (ISIMTIME < TSEMISS(JI)%NETIMES(1)) THEN
+! Tsim < T(1)=Tmin should not happen but who knows ?
+ TSEMISS(JI)%NTX = 1
+ ELSE
+! Check for periodicity when ISIMTIME is beyond last emission time
+! and probably correct ISIMTIME
+ IF (ISIMTIME > TSEMISS(JI)%NETIMES(INBTS)) THEN
+! Tsim > T(INBTS)=Tmax
+ ITPERIOD = (1+(TSEMISS(JI)%NETIMES(INBTS)-&
+ TSEMISS(JI)%NETIMES(TSEMISS(JI)%NPX))/NDAYSEC)*NDAYSEC
+ ISIMTIME = MODULO(ISIMTIME-TSEMISS(JI)%NETIMES(TSEMISS(JI)%NPX),ITPERIOD)+&
+ TSEMISS(JI)%NETIMES(TSEMISS(JI)%NPX)
+ IF (IVERB >= 6) THEN
+ WRITE(ILUOUT,*) ' ITPERIOD = ', ITPERIOD
+ WRITE(ILUOUT,*) ' ISIMTIME modifie = ', ISIMTIME
+ END IF
+ IF (TSEMISS(JI)%NTX == INBTS .AND. ISIMTIME<TSEMISS(JI)%NETIMES(INBTS)) THEN
+! Update time index NTX
+ TSEMISS(JI)%NTX = TSEMISS(JI)%NPX
+! Increment data index NDX : NDX correction will occur later
+! to assure 1 <= NDX <= IWS
+ INDX1 = INDX1 + 1
+ END IF
+ END IF
+!
+! search NTX such that : ETIMES(NTX) < ISIMTIME <= ETIMES(NTX+1)
+! and make NDX follow NTX : NDX correction will occur later
+! to assure 1 <= NDX <= IWS
+ DO WHILE (TSEMISS(JI)%NTX < INBTS)
+ IF (ISIMTIME >= TSEMISS(JI)%NETIMES(TSEMISS(JI)%NTX+1)) THEN
+ TSEMISS(JI)%NTX = TSEMISS(JI)%NTX + 1
+ INDX1 = INDX1 + 1
+ INDX2 = INDX1 + 1
+ ELSE
+ EXIT
+ END IF
+ END DO
+ END IF
+!
+! Check availability of data within memory Window (XEMISDATA(:,1:IWS))
+ IF (INDX1 >= IWS) THEN
+!
+! Data index reached the memory window limits
+!
+ IF (TSEMISS(JI)%LREAD) THEN
+!
+! File must be read to update XEMISDATA array for this species
+!
+ IF (.NOT. LIOINIT) THEN
+! Must be done once before reading
+ CALL INIT_IO_SURF_n(HPROGRAM,'FULL ','SURF ','READ ')
+ IF (IVERB >= 6) WRITE(ILUOUT,*) 'INIT des I/O DONE.'
+ LIOINIT=.TRUE.
+ END IF
+ YRECFM='E_'//TRIM(TSEMISS(JI)%CNAME)
+ IF (IVERB >= 6)&
+ WRITE (ILUOUT,*) 'READ emission :',TRIM(YRECFM),&
+ ', SIZE(ZWORK)=',SIZE(ZWORK,1),INBTS
+ CALL READ_SURF_FIELD2D(HPROGRAM,ZWORK(:,1:INBTS),YRECFM)
+!
+! Correction : Replace 999. with 0. value in the Emission FLUX
+ WHERE(ZWORK(:,1:INBTS) == 999.)
+ ZWORK(:,1:INBTS) = 0.
+ END WHERE
+ WHERE(ZWORK(:,1:INBTS) == 1.E20)
+ ZWORK(:,1:INBTS) = 0.
+ END WHERE
+ DO ITIME=1,INBTS
+ ZWORK(:,ITIME) = ZWORK(:,ITIME)*XCONVERSION(:)
+ END DO
+!
+!
+ IF ((TSEMISS(JI)%NTX+IWS-1) > INBTS) THEN
+!
+! ===== Periodic CASE =====
+!
+ IF (IVERB >= 6)&
+ WRITE (ILUOUT,*) 'Periodic CASE : NPX =',TSEMISS(JI)%NPX
+ IF (IWS < (INBTS-TSEMISS(JI)%NPX+1)) THEN
+! Window size is smaller then number of periodical times
+!
+! example : IWS=5, NPX=2, INBTS=11, NTX=9
+! NTX NPX
+! | |
+! time index : ...9 10 11 # 2 3 4...11 #
+! old data index :[1 2 3 4 5]
+! new data index : [1 2 3 4 5]
+! |
+! NDX
+!
+ TSEMISS(JI)%XEMISDATA(:,1:INBTS-TSEMISS(JI)%NTX+1) = &
+ ZWORK(:,TSEMISS(JI)%NTX:INBTS)
+!
+ IF (IVERB >= 6) THEN
+ WRITE(ILUOUT,*) 'Window SIZE smaller than INBTS !'
+ WRITE(ILUOUT,*) 'Window index, Time index'
+ DO JW=1,INBTS-TSEMISS(JI)%NTX+1
+ WRITE(ILUOUT,*) JW,TSEMISS(JI)%NTX+JW-1
+ END DO
+ END IF
+!
+ TSEMISS(JI)%XEMISDATA(:,INBTS-TSEMISS(JI)%NTX+2:IWS) = &
+ ZWORK(:,TSEMISS(JI)%NPX:TSEMISS(JI)%NPX+IWS-INBTS+TSEMISS(JI)%NTX-2)
+!
+ IF (IVERB >= 6) THEN
+ DO JW=INBTS-TSEMISS(JI)%NTX+2,IWS
+ WRITE(ILUOUT,*) JW,TSEMISS(JI)%NPX+JW-(INBTS-TSEMISS(JI)%NTX+2)
+ END DO
+ END IF
+ INDX1 = 1
+ INDX2 = 2
+ ELSE
+! Window size may get smaller AND it will be the last reading
+!
+! example : IWS=6, NPX=7, INBTS=11, NTX=9
+!
+! NTX NPX NTX
+! | | |
+! time index: ...9 10 11 # 7 8 9 10 11 #
+! old data index: ...6]
+! new data index: [1 2 3 4 5]
+! |
+! NDX=NTX-NPX+1
+!
+ IWS = INBTS-TSEMISS(JI)%NPX+1
+ TSEMISS(JI)%NWS = IWS
+ TSEMISS(JI)%XEMISDATA(:,1:IWS) = ZWORK(:,TSEMISS(JI)%NPX:INBTS)
+ IF (IVERB >= 6) THEN
+ WRITE(ILUOUT,*) 'Window SIZE equal or greater than INBTS !'
+ WRITE(ILUOUT,*) 'Window index, Time index'
+ DO JW=1,IWS
+ WRITE(ILUOUT,*) JW,TSEMISS(JI)%NPX+JW-1
+ END DO
+ END IF
+ INDX1 = TSEMISS(JI)%NTX-TSEMISS(JI)%NPX+1
+ INDX2 = MOD((INDX1+1),IWS)
+ TSEMISS(JI)%LREAD = .FALSE. ! no more reading
+ END IF
+ ELSE
+!
+! ===== NON periodic (normal) CASE =====
+!
+! example : with IWS=5, the window moves forward
+! NTX
+! |
+! time index : 1 2 3 4 5 6 7 8 9 10 11 ... INBTS #
+! old data index :[1 2 3 4 5]
+! new data index : [1 2 3 4 5]
+! |
+! NDX
+!
+ TSEMISS(JI)%XEMISDATA(:,1:IWS) = ZWORK(:,TSEMISS(JI)%NTX:TSEMISS(JI)%NTX+IWS-1)
+ IF (IVERB >= 6) THEN
+ WRITE(ILUOUT,*) 'Window index, Time index'
+ DO JW=1,IWS
+ WRITE(ILUOUT,*) JW,TSEMISS(JI)%NTX+JW-1
+ END DO
+ END IF
+ INDX1 = 1
+ INDX2 = 2
+ END IF
+ ELSE
+! Data is already in memory because window size is sufficient
+! to hold INBTS emission times => simply update NDX according to NTX
+!
+ IF (IWS==INBTS) THEN
+!
+! 'Window size' = 'Nb emis times' at INIT (ch_init_emission)
+! so NDX must be set equal to NTX (the window does not move)
+! example :
+! NPX NTX
+! | |
+! time index : 1 2 3 ... INBTS
+! data index : [1 2 3 ... INBTS]
+! |
+! NDX
+
+ INDX1 = TSEMISS(JI)%NTX
+ INDX2 = INDX1+1
+ IF (INDX2 > IWS) INDX2=TSEMISS(JI)%NPX
+ ELSE
+!
+! Windows size changed during periodic case
+! NDX must be equal to NTX - NPX + 1
+! (the window does not move)
+! example :
+! NTX
+! |
+! time index : NPX NPX+1 NPX+2 ... INBTS
+! data index : [1 2 3 ... IWS]
+! |
+! NDX
+ INDX1 = TSEMISS(JI)%NTX-TSEMISS(JI)%NPX+1
+ INDX2 = MOD((INDX1+1),IWS)
+ END IF
+ END IF
+ ELSE ! (INDX1 < IWS)
+ INDX2 = INDX1+1
+ END IF
+!
+! Don't forget to update NDX with new value INDX1
+ TSEMISS(JI)%NDX = INDX1
+!
+! Compute both times for interpolation
+ IF (TSEMISS(JI)%NTX < INBTS) THEN
+ ITIM1 = TSEMISS(JI)%NETIMES(TSEMISS(JI)%NTX)
+ ITIM2 = TSEMISS(JI)%NETIMES(TSEMISS(JI)%NTX+1)
+ ELSE
+ ITIM1 = TSEMISS(JI)%NETIMES(INBTS)
+ ITIM2 = TSEMISS(JI)%NETIMES(TSEMISS(JI)%NPX)+ITPERIOD
+ END IF
+!
+! Interpolate variables in time -> update XFWORK
+!
+!
+! time : ITIM1...Tsim...ITIM2
+! | |
+! data index : INDX1 INDX2
+!
+!
+ ZALPHA = (REAL(ISIMTIME) - ITIM1) / (ITIM2-ITIM1)
+ TSEMISS(JI)%XFWORK(:) = ZALPHA*TSEMISS(JI)%XEMISDATA(:,INDX2) +&
+ (1.-ZALPHA)*TSEMISS(JI)%XEMISDATA(:,INDX1)
+ IF (IVERB >= 6) THEN
+ WRITE(ILUOUT,*) ' Current time INDEX : ',TSEMISS(JI)%NTX
+ WRITE(ILUOUT,*) ' TIME : ',ISIMTIME, ' (',ITIM1,',',ITIM2,')'
+ WRITE(ILUOUT,*) ' Window size : ',TSEMISS(JI)%NWS
+ WRITE(ILUOUT,*) ' Current data INDEX : ',INDX1,INDX2
+ IF (IVERB >= 10) WRITE(ILUOUT,*) ' FLUX : ',TSEMISS(JI)%XFWORK
+ END IF
+ END IF
+END DO
+!
+! Agregation : flux computation
+!
+ZEMIS(:,:) = 0.
+!
+! Point on head of Pronostic variable list
+! to cover the entire list.
+IF (NSV_AEREND > 0) THEN
+CNAMES=>CSV(NSV_CHSBEG:NSV_AEREND)
+ELSE
+CNAMES=>CSV(NSV_CHSBEG:NSV_CHSEND)
+END IF
+CURPRONOS=>TSPRONOSLIST
+DO WHILE(ASSOCIATED(CURPRONOS))
+ IF (CURPRONOS%NAMINDEX > INEQ) THEN
+ WRITE(ILUOUT,*) 'FATAL ERROR in CH_EMISSION_FLUXN : SIZE(ZEMIS,2) =',&
+ INEQ,', INDEX bugge =',CURPRONOS%NAMINDEX
+ CALL ABOR1_SFX('CH_EMISSION_FLUXN: FATAL ERROR')
+ END IF
+
+ ZEMIS(:,CURPRONOS%NAMINDEX) = 0.
+!
+! Loop on the number of agreg. coeff.
+ DO JI=1,CURPRONOS%NBCOEFF
+! Compute agregated flux
+ ZEMIS(:,CURPRONOS%NAMINDEX) = ZEMIS(:,CURPRONOS%NAMINDEX)+&
+ CURPRONOS%XCOEFF(JI)*TSEMISS(CURPRONOS%NEFINDEX(JI))%XFWORK(:)
+ END DO
+
+ IF (IVERB >= 6) THEN
+ WRITE(ILUOUT,*) 'Agregation for ',CNAMES(CURPRONOS%NAMINDEX)
+ IF (IVERB >= 10) WRITE(ILUOUT,*) 'ZEMIS = ',ZEMIS(:,CURPRONOS%NAMINDEX)
+ END IF
+ IF ((CNAMES(CURPRONOS%NAMINDEX) == "CO") .AND. ANY(ZEMIS(:,CURPRONOS%NAMINDEX).GT.0.)) THEN
+ ZFCO(:) = ZEMIS(:,CURPRONOS%NAMINDEX)
+ GCO = .TRUE.
+ END IF
+
+ CURPRONOS=>CURPRONOS%NEXT
+!
+END DO
+!
+IF ((LCH_AERO_FLUX).AND.(NSV_AERBEG > 0)) THEN
+ IF (GCO) THEN
+ CALL CH_AER_EMISSION(ZEMIS, PRHOA, CSV, NSV_CHSBEG, PFCO=ZFCO)
+ ELSE
+ CALL CH_AER_EMISSION(ZEMIS, PRHOA, CSV, NSV_CHSBEG)
+ ENDIF
+END IF
+!
+PSFSV(:,:) = PSFSV(:,:) + ZEMIS(:,:)
+!
+IF (LIOINIT) CALL END_IO_SURF_n(HPROGRAM)
+!
+IF (IVERB >= 6) WRITE(ILUOUT,*) '******** END CH_EMISSION_FLUX ********'
+IF (LHOOK) CALL DR_HOOK('CH_EMISSION_FLUX_N',1,ZHOOK_HANDLE)
+!
+END SUBROUTINE CH_EMISSION_FLUX_n
diff --git a/src/SURFEX/ch_init_snapn.F90 b/src/SURFEX/ch_init_snapn.F90
index 6519222f3..fe4ecaa9d 100644
--- a/src/SURFEX/ch_init_snapn.F90
+++ b/src/SURFEX/ch_init_snapn.F90
@@ -1,171 +1,170 @@
-!SURFEX_LIC Copyright 1994-2014 Meteo-France
-!SURFEX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SURFEX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SURFEX_LIC for details. version 1.
-! #########
- SUBROUTINE CH_INIT_SNAP_n(HPROGRAM,KLU,HINIT,KCH,PRHOA)
-! #######################################
-!
-!!**** *CH_INIT_EMIISION_TEMP_n* - routine to initialize chemical emissions data structure
-!!
-!! PURPOSE
-!! -------
-! Allocates and initialize emission surface fields
-! by reading their value in initial file.
-!
-!!** METHOD
-!! ------
-!!
-!!
-!! AUTHOR
-!! ------
-!! S.QUEGUINER
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 11/2011
-!!-----------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-!
-USE MODD_CSTS, ONLY : XAVOGADRO, XMD
-USE MODD_CH_SNAP_n
-USE MODI_GET_LUOUT
-USE MODI_READ_SURF
-USE MODI_ABOR1_SFX
-USE MODI_CH_CONVERSION_FACTOR
-USE MODI_BUILD_PRONOSLIST_n
-USE MODI_CH_OPEN_INPUTB
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! Program name
-INTEGER, INTENT(IN) :: KLU ! number of points
- CHARACTER(LEN=3), INTENT(IN) :: HINIT ! Flag to know if one initializes:
-! ! 'ALL' : all variables for a run
-! ! 'PRE' : only variables to build
-! ! an initial file
-INTEGER, INTENT(IN) :: KCH ! logical unit of input chemistry file
-REAL, DIMENSION(:),INTENT(IN) :: PRHOA ! air density
-!
-!* 0.2 declarations of local variables
-!
-INTEGER :: IRESP ! File
-INTEGER :: ILUOUT ! output listing logical unit
- CHARACTER (LEN=16) :: YRECFM ! management
- CHARACTER (LEN=100) :: YCOMMENT ! variables
-INTEGER :: JSPEC ! Loop index for chemical species
-INTEGER :: JSNAP ! Loop index for SNAP categories
-!
- CHARACTER(LEN=40) :: YSPEC_NAME ! species name
-!
-INTEGER :: IVERSION ! version of surfex file being read
-INTEGER :: IBUG ! version of SURFEX bugfix
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!-------------------------------------------------------------------------------
-IF (LHOOK) CALL DR_HOOK('CH_INIT_SNAP_N',0,ZHOOK_HANDLE)
- CALL GET_LUOUT(HPROGRAM,ILUOUT)
-!
-!* ascendant compatibility
-YRECFM='VERSION'
- CALL READ_SURF(HPROGRAM,YRECFM,IVERSION,IRESP)
-YRECFM='BUG'
- CALL READ_SURF(HPROGRAM,YRECFM,IBUG,IRESP)
-!
-!* 1. Chemical Emission snap configuration
-! ------------------------------------
-!
-! Read the number of emission species and snaps
-IF (IVERSION>7 .OR. (IVERSION==7 .AND. IBUG>=3) ) THEN
- CALL READ_SURF(HPROGRAM,'EMISPEC_NBR',NEMIS_NBR,IRESP)
- CALL READ_SURF(HPROGRAM,'SNAP_NBR',NEMIS_SNAP,IRESP)
- CALL READ_SURF(HPROGRAM,'SNAP_TIME',CSNAP_TIME_REF,IRESP)
-ELSE
- CALL ABOR1_SFX('CH_INIT_SNAPN: NO SNAP EMISSIONS IN SURFEX FILE: FILE TOO OLD')
-END IF
-!
-! Number of instants for each temporal profile.
-! For the time being, they are constant (even for the diurnal cycle)
-!
-NSNAP_M=12 ! 12 months
-NSNAP_D=7 ! 7 day a week
-NSNAP_H=24 ! 24 hours a day (=> temporal resolution = 1 hour)
-!
-!
-!* 2. Chemical Emission fields
-! ------------------------
-!
-ALLOCATE(CEMIS_NAME ( NEMIS_NBR))
-ALLOCATE(CEMIS_COMMENT ( NEMIS_NBR))
-ALLOCATE(XEMIS_FIELDS_SNAP(KLU,NEMIS_SNAP,NEMIS_NBR))
-ALLOCATE(XEMIS_FIELDS (KLU, NEMIS_NBR))
-LEMIS_FIELDS = .FALSE.
-!
-ALLOCATE(XSNAP_MONTHLY(NSNAP_M,NEMIS_SNAP,NEMIS_NBR))
-ALLOCATE(XSNAP_DAILY (NSNAP_D,NEMIS_SNAP,NEMIS_NBR))
-ALLOCATE(XSNAP_HOURLY (NSNAP_H,NEMIS_SNAP,NEMIS_NBR))
-!
-IF (CSNAP_TIME_REF=='LEGAL') THEN
- ALLOCATE(XDELTA_LEGAL_TIME(KLU))
- YRECFM='LEGALTIME'
- CALL READ_SURF(HPROGRAM,YRECFM,XDELTA_LEGAL_TIME(:),IRESP,YCOMMENT)
-END IF
-!
-DO JSPEC = 1,NEMIS_NBR ! Loop on the number of species
-!
-! Read the species name
- WRITE(YRECFM,'("EMISNAME",I3.3)') JSPEC
- CALL READ_SURF(HPROGRAM,YRECFM,YSPEC_NAME,IRESP,YCOMMENT)
- CEMIS_COMMENT(JSPEC)=YCOMMENT
- IF (IRESP/=0) THEN
- CALL ABOR1_SFX('CH_INIT_SNAPN: PROBLEM WHEN READING NAME OF EMITTED CHEMICAL SPECIES')
- END IF
- WRITE(ILUOUT,*) ' Emission ',JSPEC,' : ',TRIM(YSPEC_NAME)
- CEMIS_NAME(JSPEC) = YSPEC_NAME(1:12)
-!
-! Read the potential emission of species for each snap
- DO JSNAP=1,NEMIS_SNAP
- WRITE(YRECFM,'("SNAP",I2.2,"_",A3)') JSNAP,CEMIS_NAME(JSPEC)
- CALL READ_SURF(HPROGRAM,YRECFM,XEMIS_FIELDS_SNAP(:,JSNAP,JSPEC),IRESP,YCOMMENT)
- END DO
-!
-! Read the temporal profiles of all snaps
- YRECFM = "E_"//TRIM(CEMIS_NAME(JSPEC))//"_M"
- CALL READ_SURF(HPROGRAM,YRECFM,XSNAP_MONTHLY(:,:,JSPEC),IRESP,YCOMMENT,HDIR='-')
- YRECFM = "E_"//TRIM(CEMIS_NAME(JSPEC))//"_D"
- CALL READ_SURF(HPROGRAM,YRECFM,XSNAP_DAILY(:,:,JSPEC),IRESP,YCOMMENT,HDIR='-')
- YRECFM = "E_"//TRIM(CEMIS_NAME(JSPEC))//"_H"
- CALL READ_SURF(HPROGRAM,YRECFM,XSNAP_HOURLY(:,:,JSPEC),IRESP,YCOMMENT,HDIR='-')
-END DO
-!
-!* 3. Conversion factor
-! -----------------
-!
-IF (HINIT=='ALL') THEN
- CALL CH_OPEN_INPUTB("EMISUNIT", KCH, ILUOUT)
-!
-! read unit identifier
- READ(KCH,'(A3)') CCONVERSION
-!
- ALLOCATE (XCONVERSION(KLU))
-! determine the conversion factor
- CALL CH_CONVERSION_FACTOR(CCONVERSION,PRHOA)
-!
-!* 4. List of emissions to be aggregated into atm. chemical species
-! -------------------------------------------------------------
-!
- CALL BUILD_PRONOSLIST_n(NEMIS_NBR,CEMIS_NAME,TSPRONOSLIST,KCH,ILUOUT,6)
-!
-!-------------------------------------------------------------------------------
-END IF
-!
-IF (LHOOK) CALL DR_HOOK('CH_INIT_SNAP_N',1,ZHOOK_HANDLE)
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE CH_INIT_SNAP_n
+! #########
+ SUBROUTINE CH_INIT_SNAP_n(HPROGRAM,KLU,HINIT,KCH,PRHOA)
+! #######################################
+!
+!!**** *CH_INIT_EMIISION_TEMP_n* - routine to initialize chemical emissions data structure
+!!
+!! PURPOSE
+!! -------
+! Allocates and initialize emission surface fields
+! by reading their value in initial file.
+!
+!!** METHOD
+!! ------
+!!
+!!
+!! AUTHOR
+!! ------
+!! S.QUEGUINER
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 11/2011
+!! M.Moge 01/2016 using READ_SURF_FIELD2D for 2D surfex fields reads
+!!-----------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+USE MODD_CSTS, ONLY : XAVOGADRO, XMD
+USE MODD_CH_SNAP_n
+USE MODI_GET_LUOUT
+USE MODI_READ_SURF
+USE MODI_READ_SURF_FIELD2D
+USE MODI_ABOR1_SFX
+USE MODI_CH_CONVERSION_FACTOR
+USE MODI_BUILD_PRONOSLIST_n
+USE MODI_CH_OPEN_INPUTB
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+!
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+ CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! Program name
+INTEGER, INTENT(IN) :: KLU ! number of points
+ CHARACTER(LEN=3), INTENT(IN) :: HINIT ! Flag to know if one initializes:
+! ! 'ALL' : all variables for a run
+! ! 'PRE' : only variables to build
+! ! an initial file
+INTEGER, INTENT(IN) :: KCH ! logical unit of input chemistry file
+REAL, DIMENSION(:),INTENT(IN) :: PRHOA ! air density
+!
+!* 0.2 declarations of local variables
+!
+INTEGER :: IRESP ! File
+INTEGER :: ILUOUT ! output listing logical unit
+ CHARACTER (LEN=16) :: YRECFM ! management
+ CHARACTER (LEN=100) :: YCOMMENT ! variables
+INTEGER :: JSPEC ! Loop index for chemical species
+INTEGER :: JSNAP ! Loop index for SNAP categories
+!
+ CHARACTER(LEN=40) :: YSPEC_NAME ! species name
+!
+INTEGER :: IVERSION ! version of surfex file being read
+INTEGER :: IBUG ! version of SURFEX bugfix
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!-------------------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('CH_INIT_SNAP_N',0,ZHOOK_HANDLE)
+ CALL GET_LUOUT(HPROGRAM,ILUOUT)
+!
+!* ascendant compatibility
+YRECFM='VERSION'
+ CALL READ_SURF(HPROGRAM,YRECFM,IVERSION,IRESP)
+YRECFM='BUG'
+ CALL READ_SURF(HPROGRAM,YRECFM,IBUG,IRESP)
+!
+!* 1. Chemical Emission snap configuration
+! ------------------------------------
+!
+! Read the number of emission species and snaps
+IF (IVERSION>7 .OR. (IVERSION==7 .AND. IBUG>=3) ) THEN
+ CALL READ_SURF(HPROGRAM,'EMISPEC_NBR',NEMIS_NBR,IRESP)
+ CALL READ_SURF(HPROGRAM,'SNAP_NBR',NEMIS_SNAP,IRESP)
+ CALL READ_SURF(HPROGRAM,'SNAP_TIME',CSNAP_TIME_REF,IRESP)
+ELSE
+ CALL ABOR1_SFX('CH_INIT_SNAPN: NO SNAP EMISSIONS IN SURFEX FILE: FILE TOO OLD')
+END IF
+!
+! Number of instants for each temporal profile.
+! For the time being, they are constant (even for the diurnal cycle)
+!
+NSNAP_M=12 ! 12 months
+NSNAP_D=7 ! 7 day a week
+NSNAP_H=24 ! 24 hours a day (=> temporal resolution = 1 hour)
+!
+!
+!* 2. Chemical Emission fields
+! ------------------------
+!
+ALLOCATE(CEMIS_NAME ( NEMIS_NBR))
+ALLOCATE(CEMIS_COMMENT ( NEMIS_NBR))
+ALLOCATE(XEMIS_FIELDS_SNAP(KLU,NEMIS_SNAP,NEMIS_NBR))
+ALLOCATE(XEMIS_FIELDS (KLU, NEMIS_NBR))
+LEMIS_FIELDS = .FALSE.
+!
+ALLOCATE(XSNAP_MONTHLY(NSNAP_M,NEMIS_SNAP,NEMIS_NBR))
+ALLOCATE(XSNAP_DAILY (NSNAP_D,NEMIS_SNAP,NEMIS_NBR))
+ALLOCATE(XSNAP_HOURLY (NSNAP_H,NEMIS_SNAP,NEMIS_NBR))
+!
+IF (CSNAP_TIME_REF=='LEGAL') THEN
+ ALLOCATE(XDELTA_LEGAL_TIME(KLU))
+ YRECFM='LEGALTIME'
+ CALL READ_SURF(HPROGRAM,YRECFM,XDELTA_LEGAL_TIME(:),IRESP,YCOMMENT)
+END IF
+!
+DO JSPEC = 1,NEMIS_NBR ! Loop on the number of species
+!
+! Read the species name
+ WRITE(YRECFM,'("EMISNAME",I3.3)') JSPEC
+ CALL READ_SURF(HPROGRAM,YRECFM,YSPEC_NAME,IRESP,YCOMMENT)
+ CEMIS_COMMENT(JSPEC)=YCOMMENT
+ IF (IRESP/=0) THEN
+ CALL ABOR1_SFX('CH_INIT_SNAPN: PROBLEM WHEN READING NAME OF EMITTED CHEMICAL SPECIES')
+ END IF
+ WRITE(ILUOUT,*) ' Emission ',JSPEC,' : ',TRIM(YSPEC_NAME)
+ CEMIS_NAME(JSPEC) = YSPEC_NAME(1:12)
+!
+! Read the potential emission of species for each snap
+ DO JSNAP=1,NEMIS_SNAP
+ WRITE(YRECFM,'("SNAP",I2.2,"_",A3)') JSNAP,CEMIS_NAME(JSPEC)
+ CALL READ_SURF(HPROGRAM,YRECFM,XEMIS_FIELDS_SNAP(:,JSNAP,JSPEC),IRESP,YCOMMENT)
+ END DO
+!
+! Read the temporal profiles of all snaps
+ YRECFM = "E_"//TRIM(CEMIS_NAME(JSPEC))//"_M"
+ YRECFM = 'ICE_STO'
+ CALL READ_SURF_FIELD2D(HPROGRAM,XSNAP_MONTHLY(:,:,JSPEC),YRECFM,YCOMMENT,HDIR='-')
+ YRECFM = "E_"//TRIM(CEMIS_NAME(JSPEC))//"_D"
+ CALL READ_SURF_FIELD2D(HPROGRAM,XSNAP_DAILY(:,:,JSPEC),YRECFM,YCOMMENT,HDIR='-')
+ YRECFM = "E_"//TRIM(CEMIS_NAME(JSPEC))//"_H"
+ CALL READ_SURF_FIELD2D(HPROGRAM,XSNAP_HOURLY(:,:,JSPEC),YRECFM,YCOMMENT,HDIR='-')
+END DO
+!
+!* 3. Conversion factor
+! -----------------
+!
+IF (HINIT=='ALL') THEN
+ CALL CH_OPEN_INPUTB("EMISUNIT", KCH, ILUOUT)
+!
+! read unit identifier
+ READ(KCH,'(A3)') CCONVERSION
+!
+ ALLOCATE (XCONVERSION(KLU))
+! determine the conversion factor
+ CALL CH_CONVERSION_FACTOR(CCONVERSION,PRHOA)
+!
+!* 4. List of emissions to be aggregated into atm. chemical species
+! -------------------------------------------------------------
+!
+ CALL BUILD_PRONOSLIST_n(NEMIS_NBR,CEMIS_NAME,TSPRONOSLIST,KCH,ILUOUT,6)
+!
+!-------------------------------------------------------------------------------
+END IF
+!
+IF (LHOOK) CALL DR_HOOK('CH_INIT_SNAP_N',1,ZHOOK_HANDLE)
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE CH_INIT_SNAP_n
diff --git a/src/SURFEX/mode_read_extern.F90 b/src/SURFEX/mode_read_extern.F90
index b5417c8c9..2384cc4af 100644
--- a/src/SURFEX/mode_read_extern.F90
+++ b/src/SURFEX/mode_read_extern.F90
@@ -1,681 +1,639 @@
-!SURFEX_LIC Copyright 1994-2014 Meteo-France
-!SURFEX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SURFEX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SURFEX_LIC for details. version 1.
-! Modifications :
-! P.Marguinaud : 11-09-2012 : shorten field name
-! G.Delautier : 24-06-2015 : bug for arome compressed files
-! #####################
-MODULE MODE_READ_EXTERN
-! #####################
-!-------------------------------------------------------------------
-!
-USE MODI_READ_LECOCLIMAP
-!
-USE MODI_PUT_ON_ALL_VEGTYPES
-USE MODI_OLD_NAME
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-CONTAINS
-!
-!---------------------------------------------------------------------------------------
-!
-! #######################
- SUBROUTINE READ_EXTERN_DEPTH(HPROGRAM,KLUOUT,HISBA,HNAT,HFIELD,KNI,KLAYER, &
- KPATCH,PSOILGRID,PDEPTH,KVERSION )
-! #######################
-!
-USE MODD_SURF_PAR, ONLY : NUNDEF, XUNDEF
-USE MODD_DATA_COVER_PAR, ONLY : JPCOVER, NVEGTYPE
-!
-USE MODI_READ_SURF_ISBA_PAR_n
-USE MODI_READ_SURF
-USE MODI_CONVERT_COVER_ISBA
-USE MODI_GARDEN_SOIL_DEPTH
-
-!
-IMPLICIT NONE
-!
-!* dummy arguments
-! ---------------
-!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! type of input file
-INTEGER, INTENT(IN) :: KLUOUT ! logical unit of output listing
- CHARACTER(LEN=3), INTENT(IN) :: HISBA ! type of ISBA soil scheme
- CHARACTER(LEN=3), INTENT(IN) :: HNAT ! type of surface (nature, gardens)
- CHARACTER(LEN=7), INTENT(IN) :: HFIELD ! field name
-INTEGER, INTENT(IN) :: KNI ! number of points
-INTEGER, INTENT(INOUT) :: KLAYER ! number of layers
-INTEGER, INTENT(IN) :: KPATCH ! number of patch
-INTEGER, INTENT(IN) :: KVERSION ! surface version
-REAL, DIMENSION(:), INTENT(IN) :: PSOILGRID
-REAL, DIMENSION(:,:,:), POINTER :: PDEPTH ! middle depth of each layer
-!
-!* local variables
-! ---------------
-!
- CHARACTER(LEN=12) :: YRECFM ! Name of the article to be read
- CHARACTER(LEN=16) :: YRECFM2
- CHARACTER(LEN=100):: YCOMMENT ! Comment string
-INTEGER :: IRESP ! reading return code
-INTEGER :: ILAYER ! number of soil layers
-INTEGER :: JLAYER ! loop counter
-INTEGER :: JPATCH ! loop counter
-INTEGER :: JJ
-INTEGER :: IVERSION
-INTEGER :: IBUGFIX
-!
-LOGICAL, DIMENSION(JPCOVER) :: GCOVER ! flag to read the covers
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZCOVER ! cover fractions
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZGROUND_DEPTH ! cover fractions
-INTEGER, DIMENSION(:,:), ALLOCATABLE :: IWG_LAYER
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZD ! depth of each inter-layer
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZDG ! depth of each inter-layer
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZDEPTH ! middle of each layer for each patch
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZWORK ! work array
-REAL, DIMENSION(KNI) :: ZHVEG ! high vegetation fraction
-REAL, DIMENSION(KNI) :: ZLVEG ! low vegetation fraction
-REAL, DIMENSION(KNI) :: ZNVEG ! no vegetation fraction
- CHARACTER(LEN=4) :: YHVEG ! type of high vegetation
- CHARACTER(LEN=4) :: YLVEG ! type of low vegetation
- CHARACTER(LEN=4) :: YNVEG ! type of no vegetation
-LOGICAL :: GECOCLIMAP ! T if ecoclimap is used
-LOGICAL :: GPAR_GARDEN! T if garden data are used
-LOGICAL :: GDATA_DG
-LOGICAL :: GDATA_GROUND_DEPTH
-INTEGER :: IHYDRO_LAYER
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-!
-!------------------------------------------------------------------------------
-!
-IF (LHOOK) CALL DR_HOOK('MODE_READ_EXTERN:READ_EXTERN_DEPTH',0,ZHOOK_HANDLE)
-!
-IF (HNAT=='NAT') THEN
- CALL READ_LECOCLIMAP(HPROGRAM,GECOCLIMAP)
-ELSE
- CALL READ_SURF(HPROGRAM,'PAR_GARDEN',GPAR_GARDEN,IRESP)
- GECOCLIMAP = .NOT. GPAR_GARDEN
-END IF
-!
-!
-YRECFM='VERSION'
- CALL READ_SURF(HPROGRAM,YRECFM,IVERSION,IRESP)
-!
-YRECFM='BUG'
- CALL READ_SURF(HPROGRAM,YRECFM,IBUGFIX,IRESP)
-!
-!------------------------------------------------------------------------------
-!
-ALLOCATE(ZDG (KNI,KLAYER,KPATCH))
-ALLOCATE(IWG_LAYER (KNI,KPATCH))
-IWG_LAYER(:,:) = NUNDEF
-IHYDRO_LAYER = KLAYER
-!
-IF (GECOCLIMAP) THEN
-
- IF (IVERSION<7 .OR. IVERSION==7 .AND. IBUGFIX<=3) THEN
- !
- !* reading of the cover to obtain the depth of inter-layers
- !
- CALL OLD_NAME(HPROGRAM,'COVER_LIST ',YRECFM)
- CALL READ_SURF(HPROGRAM,YRECFM,GCOVER(:),IRESP,HDIR='-')
- !
- ALLOCATE(ZCOVER(KNI,JPCOVER))
- YRECFM='COVER'
- CALL READ_SURF(HPROGRAM,YRECFM,ZCOVER(:,:),GCOVER(:),IRESP,HDIR='A')
- !
- !* computes soil layers
- !
- CALL CONVERT_COVER_ISBA(HISBA,NUNDEF,ZCOVER,' ',HNAT,PSOILGRID=PSOILGRID,PDG=ZDG,KWG_LAYER=IWG_LAYER)
- !
- DEALLOCATE(ZCOVER)
- ELSE
-print*, '-----------------------------------------------'
-print*, '-----------------------------------------------'
-print*, '-----------------------------------------------'
-print*, '-----------------------------------------------'
-print*, 'MODE_READ_EXTERN : ==> ON NE LIT PAS LES COVERS'
-print*, '-----------------------------------------------'
-print*, '-----------------------------------------------'
-print*, '-----------------------------------------------'
-print*, '-----------------------------------------------'
-#ifdef MNH_PARALLEL
-DO JPATCH=1,SIZE(ZDG,3)
- DO JLAYER=1,SIZE(ZDG,2)
- IF (JLAYER<10) THEN
- IF (HNAT=='NAT') THEN
- WRITE(YRECFM,FMT='(A6,I1,I4.4)') 'ECO_DG',JLAYER,JPATCH
- ELSE
- WRITE(YRECFM,FMT='(A9,I1,I4.4)') 'GD_ECO_DG',JLAYER,JPATCH
- END IF
- ELSE
- IF (HNAT=='NAT') THEN
- WRITE(YRECFM,FMT='(A6,I2,I4.4)') 'ECO_DG',JLAYER,JPATCH
- ELSE
- WRITE(YRECFM,FMT='(A9,I2,I4.4)') 'GD_ECO_DG',JLAYER,JPATCH
- END IF
- ENDIF
- CALL READ_SURF(HPROGRAM,YRECFM,ZDG(:,JLAYER,JPATCH),IRESP,HDIR='A')
- END DO
-END DO
-#else
- DO JLAYER=1,SIZE(ZDG,2)
- IF (JLAYER<10) THEN
- IF (HNAT=='NAT') THEN
- WRITE(YRECFM,FMT='(A6,I1)') 'ECO_DG',JLAYER
- ELSE
- WRITE(YRECFM,FMT='(A9,I1)') 'GD_ECO_DG',JLAYER
- END IF
- ELSE
- IF (HNAT=='NAT') THEN
- WRITE(YRECFM,FMT='(A6,I2)') 'ECO_DG',JLAYER
- ELSE
- WRITE(YRECFM,FMT='(A9,I2)') 'GD_ECO_DG',JLAYER
- END IF
- ENDIF
- CALL READ_SURF(HPROGRAM,YRECFM,ZDG(:,JLAYER,:),IRESP,HDIR='A')
- END DO
-#endif
- IF (HISBA=='DIF') THEN
- YRECFM='ECO_WG_L'
- IF (HNAT=='GRD') YRECFM='GD_ECO_WG_L'
- ALLOCATE(ZWORK(KNI,KPATCH))
- CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,:),IRESP,HDIR='A')
- WHERE (ZWORK==XUNDEF) ZWORK=NUNDEF
- IWG_LAYER=NINT(ZWORK)
- DEALLOCATE(ZWORK)
- END IF
- END IF
- !
- IF (HISBA=='DIF') IHYDRO_LAYER = MAXVAL(IWG_LAYER(:,:),IWG_LAYER(:,:)/=NUNDEF)
-ENDIF
-
-!-------------------------------------------------------------------
-IF (HNAT=='NAT' .AND. (IVERSION>=7 .OR. .NOT.GECOCLIMAP)) THEN
- !
- !* directly read soil layers in the file for nature ISBA soil layers
- !
- GDATA_DG = .TRUE.
- IF (IVERSION>=7) THEN
- YRECFM='L_DG'
- YCOMMENT=YRECFM
- CALL READ_SURF(HPROGRAM,YRECFM,GDATA_DG,IRESP,HCOMMENT=YCOMMENT)
- ENDIF
- !
- IF (GDATA_DG) THEN
- !
- ALLOCATE(ZWORK(KNI,KPATCH))
- DO JLAYER=1,KLAYER
- IF (JLAYER<10) WRITE(YRECFM,FMT='(A4,I1.1)') 'D_DG',JLAYER
- IF (JLAYER>=10) WRITE(YRECFM,FMT='(A4,I2.2)') 'D_DG',JLAYER
- CALL READ_SURF_ISBA_PAR_n(HPROGRAM,YRECFM,KLUOUT,KNI,ZWORK,IRESP,IVERSION,HDIR='A')
- DO JPATCH=1,KPATCH
- ZDG(:,JLAYER,JPATCH) = ZWORK(:,JPATCH)
- END DO
- END DO
- DEALLOCATE(ZWORK)
- !
- ENDIF
- !
- GDATA_GROUND_DEPTH=.FALSE.
- IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=2) THEN
- !
- YRECFM2='L_GROUND_DEPTH'
- IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) YRECFM2='L_GROUND_DPT'
- YCOMMENT=YRECFM2
- CALL READ_SURF(HPROGRAM,YRECFM2,GDATA_GROUND_DEPTH,IRESP,HCOMMENT=YCOMMENT)
- !
- IF (GDATA_GROUND_DEPTH) THEN
- !
- YRECFM2='D_GROUND_DETPH'
- IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) YRECFM2='D_GROUND_DPT'
- ALLOCATE(ZGROUND_DEPTH(KNI,KPATCH))
- CALL READ_SURF_ISBA_PAR_n(HPROGRAM,YRECFM2,KLUOUT,KNI,ZGROUND_DEPTH(:,:),IRESP,IVERSION,HDIR='A')
- !
- DO JPATCH=1,KPATCH
- DO JJ=1,KNI
- DO JLAYER=1,KLAYER
- IF ( ZDG(JJ,JLAYER,JPATCH) <= ZGROUND_DEPTH(JJ,JPATCH) .AND. ZGROUND_DEPTH(JJ,JPATCH) < XUNDEF ) &
- IWG_LAYER(JJ,JPATCH) = JLAYER
- ENDDO
- ENDDO
- ENDDO
- DEALLOCATE(ZGROUND_DEPTH)
- !
- IF (HISBA=='DIF') IHYDRO_LAYER = MAXVAL(IWG_LAYER(:,:),IWG_LAYER(:,:)/=NUNDEF)
- !
- ENDIF
- !
- ENDIF
- !
-ELSE IF (HNAT=='GRD' .AND. .NOT.GECOCLIMAP) THEN
- !
- !* computes soil layers from vegetation fractions read in the file
- !
- CALL READ_SURF(HPROGRAM,'D_TYPE_HVEG',YHVEG,IRESP)
- CALL READ_SURF(HPROGRAM,'D_TYPE_LVEG',YLVEG,IRESP)
- CALL READ_SURF(HPROGRAM,'D_TYPE_NVEG',YNVEG,IRESP)
- CALL READ_SURF(HPROGRAM,'D_FRAC_HVEG',ZHVEG,IRESP,HDIR='A')
- CALL READ_SURF(HPROGRAM,'D_FRAC_LVEG',ZLVEG,IRESP,HDIR='A')
- CALL READ_SURF(HPROGRAM,'D_FRAC_NVEG',ZNVEG,IRESP,HDIR='A')
- ! Ground layers
- CALL GARDEN_SOIL_DEPTH(YNVEG,YLVEG,YHVEG,ZNVEG,ZLVEG,ZHVEG,ZDG)
- !
-END IF
-!
-DEALLOCATE(IWG_LAYER)
-!
-IF (HFIELD=='WG ' .OR. HFIELD=='WGI ' .OR. HFIELD=='TWN_WG ' .OR. HFIELD=='TWN_WGI ' .OR. &
- HFIELD=='GD_WG ' .OR. HFIELD=='GD_WGI ') THEN
- KLAYER = IHYDRO_LAYER
-ENDIF
-!
-!-------------------------------------------------------------------
-!
-!* In force-restore ISBA, adds a layer at bottom of surface layer and a layer
-! between root and deep layers.
-!
-IF (HISBA=='2-L' .OR. HISBA=='3-L') THEN
- ILAYER = KLAYER + 1
- IF (HISBA=='3-L') ILAYER = ILAYER + 1
- ALLOCATE(ZD (KNI,ILAYER,KPATCH))
- DO JPATCH=1,KPATCH
- ! for interpolations, middle of surface layer must be at least at 1cm
- ZD(:,1,JPATCH) = MIN(3.*ZDG(:,1,JPATCH),MAX(ZDG(:,1,JPATCH),0.02))
- ! new layer below surface layer. This layer will be at root depth layer humidity
- ZD(:,2,JPATCH) = MIN(4.*ZDG(:,1,JPATCH),0.5*(ZDG(:,1,JPATCH)+ZDG(:,2,JPATCH)))
- ! root layer
- ZD(:,3,JPATCH) = ZDG(:,2,JPATCH)
- IF (HISBA=='3-L') THEN
- ! between root and deep layers. This layer will have deep soil humidity.
- WHERE (ZDG(:,2,JPATCH)<ZDG(:,3,JPATCH))
- ZD(:,4,JPATCH) = 0.75 * ZDG(:,2,JPATCH) + 0.25 * ZDG(:,3,JPATCH)
- ELSEWHERE
- ZD(:,4,JPATCH) = ZDG(:,3,JPATCH)
- END WHERE
- ! deep layer
- ZD(:,5,JPATCH) = ZDG(:,3,JPATCH)
- END IF
- END DO
-ELSE
- ILAYER = KLAYER
- ALLOCATE(ZD (KNI,ILAYER,KPATCH))
- ZD(:,:,:) = ZDG(:,1:KLAYER,:)
-END IF
-!
-DEALLOCATE(ZDG)
-!
-!-------------------------------------------------------------------
-!* recovers middle layer depth (from the surface)
-ALLOCATE(ZDEPTH (KNI,ILAYER,KPATCH))
-ZDEPTH = XUNDEF
-DO JPATCH=1,KPATCH
- WHERE(ZD(:,1,JPATCH)/=XUNDEF) &
- ZDEPTH (:,1,JPATCH)=ZD(:,1,JPATCH)/2.
- DO JLAYER=2,ILAYER
- WHERE(ZD(:,1,JPATCH)/=XUNDEF) &
- ZDEPTH (:,JLAYER,JPATCH) = (ZD(:,JLAYER-1,JPATCH) + ZD(:,JLAYER,JPATCH))/2.
- END DO
-END DO
-DEALLOCATE(ZD)
-!-------------------------------------------------------------------
-!
-ALLOCATE(PDEPTH (KNI,ILAYER,NVEGTYPE))
- CALL PUT_ON_ALL_VEGTYPES(KNI,ILAYER,KPATCH,NVEGTYPE,ZDEPTH,PDEPTH)
-DEALLOCATE(ZDEPTH)
-
-IF (LHOOK) CALL DR_HOOK('MODE_READ_EXTERN:READ_EXTERN_DEPTH',1,ZHOOK_HANDLE)
-!-------------------------------------------------------------------
-!
-END SUBROUTINE READ_EXTERN_DEPTH
-!
-!
-!-------------------------------------------------------------------
-!---------------------------------------------------------------------------------------
-!
-! #######################
- SUBROUTINE READ_EXTERN_ISBA(HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE,&
- KLUOUT,KNI,HFIELD,HNAME,PFIELD,PDEPTH)
-! #######################
-!
-USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE
-USE MODD_SURF_PAR, ONLY : XUNDEF
-USE MODD_ISBA_PAR, ONLY : XOPTIMGRID
-!
-USE MODI_OPEN_AUX_IO_SURF
-USE MODI_CLOSE_AUX_IO_SURF
-USE MODI_READ_SURF
-USE MODE_SOIL
-!
-IMPLICIT NONE
-!
-!* dummy arguments
-! ---------------
-!
- CHARACTER(LEN=28), INTENT(IN) :: HFILE ! name of file
- CHARACTER(LEN=6), INTENT(IN) :: HFILETYPE ! type of input file
- CHARACTER(LEN=28), INTENT(IN) :: HFILEPGD ! name of file
- CHARACTER(LEN=6), INTENT(IN) :: HFILEPGDTYPE ! type of input file
-INTEGER, INTENT(IN) :: KLUOUT ! logical unit of output listing
-INTEGER, INTENT(IN) :: KNI ! number of points
- CHARACTER(LEN=7), INTENT(IN) :: HFIELD ! field name
- CHARACTER(LEN=*), INTENT(IN) :: HNAME ! field name in the file
-REAL, DIMENSION(:,:,:), POINTER :: PFIELD ! field to initialize
-REAL, DIMENSION(:,:,:), POINTER :: PDEPTH ! middle depth of each layer
-!
-!
-!* local variables
-! ---------------
-!
- CHARACTER(LEN=12) :: YRECFM ! Name of the article to be read
- CHARACTER(LEN=4) :: YLVL
-#ifdef MNH_PARALLEL
- CHARACTER(LEN=8) :: YPATCH
-#endif
- CHARACTER(LEN=3) :: YISBA ! type of ISBA soil scheme
- CHARACTER(LEN=3) :: YNAT ! type of surface (nature, garden)
- CHARACTER(LEN=4) :: YPEDOTF ! type of pedo-transfert function
-INTEGER :: IRESP ! reading return code
-INTEGER :: ILAYER ! number of layers
-INTEGER :: JLAYER ! loop counter
-INTEGER :: IPATCH ! number of patch
-INTEGER :: JPATCH ! loop counter
-INTEGER :: JVEGTYPE ! loop counter
-LOGICAL :: GTEB ! TEB field
-!
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZFIELD ! field read, one level, all patches
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZWORK ! field read, one level, all patches
-!
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZVAR ! profile of physical variable
-REAL, DIMENSION(:), ALLOCATABLE :: ZCLAY ! clay fraction
-REAL, DIMENSION(:), ALLOCATABLE :: ZSAND ! sand fraction
-REAL, DIMENSION(:), ALLOCATABLE :: ZWWILT ! wilting point
-REAL, DIMENSION(:), ALLOCATABLE :: ZWFC ! field capacity
-REAL, DIMENSION(:), ALLOCATABLE :: ZWSAT ! saturation
-REAL, DIMENSION(:), ALLOCATABLE :: ZSOILGRID
-REAL, DIMENSION(:), ALLOCATABLE :: ZNAT ! natural surface fraction
-!
-INTEGER :: IVERSION ! surface version
-INTEGER :: IBUGFIX
-!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!-------------------------------------------------------------------------------
-IF (LHOOK) CALL DR_HOOK('MODE_READ_EXTERN:READ_EXTERN_ISBA',0,ZHOOK_HANDLE)
-WRITE (KLUOUT,*) ' | Reading ',HFIELD,' in externalized file'
-!
-GTEB = (HNAME(1:3)=='TWN' .OR. HNAME(1:3)=='GD_' .OR. HNAME(1:3)=='GR_' &
- .OR. HNAME(4:6)=='GD_' .OR. HNAME(4:6)=='GR_')
-!
-!------------------------------------------------------------------------------
-!
-IF (GTEB) THEN
- CALL OPEN_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE,'TOWN ')
-ELSE
- CALL OPEN_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE,'NATURE')
-ENDIF
-!
-YRECFM='VERSION'
- CALL READ_SURF(HFILEPGDTYPE,YRECFM,IVERSION,IRESP)
-!
-YRECFM='BUG'
- CALL READ_SURF(HFILEPGDTYPE,YRECFM,IBUGFIX,IRESP)
-!
-!* Read number of soil layers
-!
-YRECFM='GROUND_LAYER'
-IF (GTEB) THEN
- YRECFM='TWN_LAYER'
- IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) YRECFM='GD_LAYER'
-ENDIF
- CALL READ_SURF(HFILEPGDTYPE,YRECFM,ILAYER,IRESP)
-!
-!* number of tiles
-!
-IPATCH=1
-IF (.NOT. GTEB) THEN
- YRECFM='PATCH_NUMBER'
- CALL READ_SURF(HFILEPGDTYPE,YRECFM,IPATCH,IRESP)
-END IF
-!
-!* soil scheme
-!
-YRECFM='ISBA'
-IF (GTEB) THEN
- YRECFM='TWN_ISBA'
- IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) YRECFM='GD_ISBA'
-ENDIF
- CALL READ_SURF(HFILEPGDTYPE,YRECFM,YISBA,IRESP)
-!
-IF (IVERSION>=7) THEN
- !
- !* Pedo-transfert function
- !
- YRECFM='PEDOTF'
- IF (GTEB) THEN
- YRECFM='TWN_PEDOTF'
- IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) YRECFM='GD_PEDOTF'
- ENDIF
- CALL READ_SURF(HFILEPGDTYPE,YRECFM,YPEDOTF,IRESP)
- !
-ELSE
- YPEDOTF = 'CH78'
-ENDIF
-!
-!Only Brook and Corey with Force-Restore scheme
-IF(YISBA/='DIF')THEN
- YPEDOTF='CH78'
-ENDIF
-!
-!-------------------------------------------------------------------------------
-!
-! *. Read clay fraction
-! ------------------
-!
-ALLOCATE(ZCLAY(KNI))
-YRECFM='CLAY'
-IF (GTEB) THEN
- YRECFM='TWN_CLAY'
- IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) YRECFM='GD_CLAY'
-ENDIF
- CALL READ_SURF(HFILEPGDTYPE,YRECFM,ZCLAY(:),IRESP,HDIR='A')
-!
-!-------------------------------------------------------------------------------
-!
-! *. Read sand fraction
-! ------------------
-!
-ALLOCATE(ZSAND(KNI))
-YRECFM='SAND'
-IF (GTEB) THEN
- YRECFM='TWN_SAND'
- IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) YRECFM='GD_SAND'
-ENDIF
- CALL READ_SURF(HFILEPGDTYPE,YRECFM,ZSAND(:),IRESP,HDIR='A')
-!
-!-------------------------------------------------------------------------------
-!
-! *. Read soil grid
-! --------------
-!
-!* Reference grid for DIF
-!
-IF(YISBA=='DIF') THEN
- ALLOCATE(ZSOILGRID(ILAYER))
- ZSOILGRID=XUNDEF
- IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=2) THEN
- YRECFM='SOILGRID'
- IF (GTEB) THEN
- YRECFM='TWN_SOILGRID'
- IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) YRECFM='GD_SOILGRID'
- ENDIF
- CALL READ_SURF(HFILEPGDTYPE,YRECFM,ZSOILGRID,IRESP,HDIR='-')
- ELSE
- ZSOILGRID(1:ILAYER) = XOPTIMGRID(1:ILAYER)
- ENDIF
-ELSE
- ALLOCATE(ZSOILGRID(0))
-ENDIF
-!
-IF ((HFIELD=='TG ') .AND. (YISBA=='2-L' .OR. YISBA=='3-L')) THEN
- ALLOCATE(PDEPTH (KNI,ILAYER,NVEGTYPE))
- DO JVEGTYPE=1,NVEGTYPE
- PDEPTH(:,1,JVEGTYPE) = 0.
- PDEPTH(:,2,JVEGTYPE) = 0.2
- IF (ILAYER==3) PDEPTH(:,3,JVEGTYPE) = 3.
- END DO
-ELSE
- YNAT='NAT'
- IF (GTEB) YNAT='GRD'
- CALL READ_EXTERN_DEPTH(HFILEPGDTYPE,KLUOUT,YISBA,YNAT,HFIELD,KNI,ILAYER,IPATCH,&
- ZSOILGRID,PDEPTH,IVERSION)
-END IF
-!
-DEALLOCATE(ZSOILGRID)
-!
-! *. Read fraction of nature
-! --------------
-!
-ALLOCATE(ZNAT(KNI))
-IF (IVERSION>=7) THEN
- CALL READ_SURF(HFILEPGDTYPE,'FRAC_NATURE',ZNAT,IRESP,HDIR='A')
-ELSE
- ZNAT=1.0
-ENDIF
-
-!
- CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
-!
-!* Allocate soil variable profile
-! ------------------------------
-!
-!
-ALLOCATE(ZVAR(KNI,ILAYER,IPATCH))
-ALLOCATE(ZWORK(KNI,IPATCH))
-ZWORK(:,:) = XUNDEF
-!
-! *. Read soil variable profile
-! --------------------------
-!
-IF (GTEB) THEN
- CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,'TOWN ')
-ELSE
- CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,'NATURE')
-ENDIF
-!
-DO JLAYER=1,ILAYER
- WRITE(YLVL,'(I4)') JLAYER
-#ifdef MNH_PARALLEL
- DO JPATCH=1,IPATCH
- IF (JLAYER >= 10) WRITE(YPATCH,'(I2,I4.4)') JLAYER,JPATCH
- IF (JLAYER < 10) WRITE(YPATCH,FMT='(I1,I4.4)') JLAYER,JPATCH
- YRECFM=TRIM(HNAME)//ADJUSTL(YPATCH(:LEN_TRIM(YPATCH)))
- CALL READ_SURF(HFILETYPE,YRECFM,ZWORK(:,JPATCH),IRESP,HDIR='A')
- ZVAR(:,JLAYER,JPATCH)=ZWORK(:,JPATCH)
- END DO
-#else
- YRECFM=TRIM(HNAME)//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
- CALL READ_SURF(HFILETYPE,YRECFM,ZWORK(:,:),IRESP,HDIR='A')
- DO JPATCH=1,IPATCH
- ZVAR(:,JLAYER,JPATCH)=ZWORK(:,JPATCH)
- END DO
-#endif
-END DO
-!
- CALL CLOSE_AUX_IO_SURF(HFILE,HFILETYPE)
-!
-DEALLOCATE(ZWORK)
-!
-!
-! *. Compute relative humidity from units kg/m^2 (SWI)
-! ------------------------------------------------
-!
-!* In case of force-restore ISBA, adds one layer at bottom of surface layer
-IF ((HFIELD=='WG ' .OR. HFIELD=='WGI ') .AND. (YISBA=='2-L' .OR. YISBA=='3-L')) THEN
- ALLOCATE(ZFIELD(KNI,ILAYER,IPATCH))
- ZFIELD(:,:,:) = ZVAR(:,:,:)
- DEALLOCATE(ZVAR)
- !
- ILAYER = ILAYER + 1
- IF ( YISBA=='3-L' ) ILAYER = ILAYER + 1
- ALLOCATE(ZVAR(KNI,ILAYER,IPATCH))
- DO JPATCH=1,IPATCH
- ZVAR(:,1,JPATCH)=ZFIELD(:,1,JPATCH)
- ZVAR(:,2,JPATCH)=ZFIELD(:,2,JPATCH) ! new layer at root layer humidity but below surface layer
- ZVAR(:,3,JPATCH)=ZFIELD(:,2,JPATCH)
- IF ( YISBA=='3-L' ) THEN
- ZVAR(:,4,JPATCH)=ZFIELD(:,3,JPATCH)
- ZVAR(:,5,JPATCH)=ZFIELD(:,3,JPATCH)
- END IF
- END DO
- DEALLOCATE(ZFIELD)
-END IF
-!
-ALLOCATE(ZFIELD(KNI,ILAYER,IPATCH))
-ZFIELD = ZVAR
-!
-IF (HFIELD=='WG ' .OR. HFIELD=='WGI ') THEN
- !
- ! Compute ISBA model constants
- !
- ALLOCATE (ZWFC (KNI))
- ALLOCATE (ZWWILT(KNI))
- ALLOCATE (ZWSAT (KNI))
- !
- ZWSAT (:) = WSAT_FUNC (ZCLAY(:),ZSAND(:),YPEDOTF)
- ZWWILT(:) = WWILT_FUNC(ZCLAY(:),ZSAND(:),YPEDOTF)
- ZWFC (:) = WFC_FUNC (ZCLAY(:),ZSAND(:),YPEDOTF)
- !
- DEALLOCATE (ZSAND)
- DEALLOCATE (ZCLAY)
-
- ZFIELD(:,:,:) = XUNDEF
- !
- IF (HFIELD=='WG ') THEN
- DO JPATCH=1,IPATCH
- DO JLAYER=1,ILAYER
- WHERE(ZNAT(:)>0.0 .AND. ZVAR(:,JLAYER,JPATCH)/=XUNDEF)
- ZVAR(:,JLAYER,JPATCH) = MAX(MIN(ZVAR(:,JLAYER,JPATCH),ZWSAT(:)),0.)
- !
- ZFIELD(:,JLAYER,JPATCH) = (ZVAR(:,JLAYER,JPATCH) - ZWWILT(:)) / (ZWFC(:) - ZWWILT(:))
- END WHERE
- END DO
- END DO
- ELSE IF (HFIELD=='WGI ') THEN
- DO JPATCH=1,IPATCH
- DO JLAYER=1,ILAYER
- WHERE(ZNAT(:)>0.0 .AND. ZVAR(:,JLAYER,JPATCH)/=XUNDEF)
- ZFIELD(:,JLAYER,JPATCH) = ZVAR(:,JLAYER,JPATCH) / ZWSAT(:)
- END WHERE
- END DO
- END DO
- END IF
-!
- DEALLOCATE (ZNAT)
- DEALLOCATE (ZWSAT)
- DEALLOCATE (ZWWILT)
- DEALLOCATE (ZWFC)
-!
-!
-END IF
-!
-DEALLOCATE(ZVAR)
-!-------------------------------------------------------------------------------
-!
-! *. Set the field on all vegtypes
-! -----------------------------
-!
-ALLOCATE(PFIELD(KNI,ILAYER,NVEGTYPE))
- CALL PUT_ON_ALL_VEGTYPES(KNI,ILAYER,IPATCH,NVEGTYPE,ZFIELD,PFIELD)
-DEALLOCATE(ZFIELD)
-IF (LHOOK) CALL DR_HOOK('MODE_READ_EXTERN:READ_EXTERN_ISBA',1,ZHOOK_HANDLE)
-!
-!------------------------------------------------------------------------------
-!
-END SUBROUTINE READ_EXTERN_ISBA
-!
-!------------------------------------------------------------------------------
-!
-END MODULE MODE_READ_EXTERN
+!SURFEX_LIC Copyright 1994-2014 Meteo-France
+!SURFEX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SURFEX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SURFEX_LIC for details. version 1.
+! Modifications :
+! P.Marguinaud : 11-09-2012 : shorten field name
+! G.Delautier : 24-06-2015 : bug for arome compressed files
+! M.Moge 01/2016 using READ_SURF_FIELD2D/3D for 2D/3D surfex fields reads
+! #####################
+MODULE MODE_READ_EXTERN
+! #####################
+!-------------------------------------------------------------------
+!
+USE MODI_READ_LECOCLIMAP
+!
+USE MODI_PUT_ON_ALL_VEGTYPES
+USE MODI_OLD_NAME
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+CONTAINS
+!
+!---------------------------------------------------------------------------------------
+!
+! #######################
+ SUBROUTINE READ_EXTERN_DEPTH(HPROGRAM,KLUOUT,HISBA,HNAT,HFIELD,KNI,KLAYER, &
+ KPATCH,PSOILGRID,PDEPTH,KVERSION )
+! #######################
+!
+USE MODD_SURF_PAR, ONLY : NUNDEF, XUNDEF
+USE MODD_DATA_COVER_PAR, ONLY : JPCOVER, NVEGTYPE
+!
+USE MODI_READ_SURF_ISBA_PAR_n
+USE MODI_READ_SURF_FIELD3D
+USE MODI_READ_SURF_FIELD2D
+USE MODI_READ_SURF
+USE MODI_CONVERT_COVER_ISBA
+USE MODI_GARDEN_SOIL_DEPTH
+
+!
+IMPLICIT NONE
+!
+!* dummy arguments
+! ---------------
+!
+ CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! type of input file
+INTEGER, INTENT(IN) :: KLUOUT ! logical unit of output listing
+ CHARACTER(LEN=3), INTENT(IN) :: HISBA ! type of ISBA soil scheme
+ CHARACTER(LEN=3), INTENT(IN) :: HNAT ! type of surface (nature, gardens)
+ CHARACTER(LEN=7), INTENT(IN) :: HFIELD ! field name
+INTEGER, INTENT(IN) :: KNI ! number of points
+INTEGER, INTENT(INOUT) :: KLAYER ! number of layers
+INTEGER, INTENT(IN) :: KPATCH ! number of patch
+INTEGER, INTENT(IN) :: KVERSION ! surface version
+REAL, DIMENSION(:), INTENT(IN) :: PSOILGRID
+REAL, DIMENSION(:,:,:), POINTER :: PDEPTH ! middle depth of each layer
+!
+!* local variables
+! ---------------
+!
+ CHARACTER(LEN=12) :: YRECFM ! Name of the article to be read
+ CHARACTER(LEN=16) :: YRECFM2
+ CHARACTER(LEN=100):: YCOMMENT ! Comment string
+INTEGER :: IRESP ! reading return code
+INTEGER :: ILAYER ! number of soil layers
+INTEGER :: JLAYER ! loop counter
+INTEGER :: JPATCH ! loop counter
+INTEGER :: JJ
+INTEGER :: IVERSION
+INTEGER :: IBUGFIX
+!
+LOGICAL, DIMENSION(JPCOVER) :: GCOVER ! flag to read the covers
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZCOVER ! cover fractions
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZGROUND_DEPTH ! cover fractions
+INTEGER, DIMENSION(:,:), ALLOCATABLE :: IWG_LAYER
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZD ! depth of each inter-layer
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZDG ! depth of each inter-layer
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZDEPTH ! middle of each layer for each patch
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZWORK ! work array
+REAL, DIMENSION(KNI) :: ZHVEG ! high vegetation fraction
+REAL, DIMENSION(KNI) :: ZLVEG ! low vegetation fraction
+REAL, DIMENSION(KNI) :: ZNVEG ! no vegetation fraction
+ CHARACTER(LEN=4) :: YHVEG ! type of high vegetation
+ CHARACTER(LEN=4) :: YLVEG ! type of low vegetation
+ CHARACTER(LEN=4) :: YNVEG ! type of no vegetation
+LOGICAL :: GECOCLIMAP ! T if ecoclimap is used
+LOGICAL :: GPAR_GARDEN! T if garden data are used
+LOGICAL :: GDATA_DG
+LOGICAL :: GDATA_GROUND_DEPTH
+INTEGER :: IHYDRO_LAYER
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+!
+!------------------------------------------------------------------------------
+!
+IF (LHOOK) CALL DR_HOOK('MODE_READ_EXTERN:READ_EXTERN_DEPTH',0,ZHOOK_HANDLE)
+!
+IF (HNAT=='NAT') THEN
+ CALL READ_LECOCLIMAP(HPROGRAM,GECOCLIMAP)
+ELSE
+ CALL READ_SURF(HPROGRAM,'PAR_GARDEN',GPAR_GARDEN,IRESP)
+ GECOCLIMAP = .NOT. GPAR_GARDEN
+END IF
+!
+!
+YRECFM='VERSION'
+ CALL READ_SURF(HPROGRAM,YRECFM,IVERSION,IRESP)
+!
+YRECFM='BUG'
+ CALL READ_SURF(HPROGRAM,YRECFM,IBUGFIX,IRESP)
+!
+!------------------------------------------------------------------------------
+!
+ALLOCATE(ZDG (KNI,KLAYER,KPATCH))
+ALLOCATE(IWG_LAYER (KNI,KPATCH))
+IWG_LAYER(:,:) = NUNDEF
+IHYDRO_LAYER = KLAYER
+!
+IF (GECOCLIMAP) THEN
+
+ IF (IVERSION<7 .OR. IVERSION==7 .AND. IBUGFIX<=3) THEN
+ !
+ !* reading of the cover to obtain the depth of inter-layers
+ !
+ CALL OLD_NAME(HPROGRAM,'COVER_LIST ',YRECFM)
+ CALL READ_SURF(HPROGRAM,YRECFM,GCOVER(:),IRESP,HDIR='-')
+ !
+ ALLOCATE(ZCOVER(KNI,JPCOVER))
+ YRECFM='COVER'
+ CALL READ_SURF(HPROGRAM,YRECFM,ZCOVER(:,:),GCOVER(:),IRESP,HDIR='A')
+ !
+ !* computes soil layers
+ !
+ CALL CONVERT_COVER_ISBA(HISBA,NUNDEF,ZCOVER,' ',HNAT,PSOILGRID=PSOILGRID,PDG=ZDG,KWG_LAYER=IWG_LAYER)
+ !
+ DEALLOCATE(ZCOVER)
+ ELSE
+print*, '-----------------------------------------------'
+print*, '-----------------------------------------------'
+print*, '-----------------------------------------------'
+print*, '-----------------------------------------------'
+print*, 'MODE_READ_EXTERN : ==> ON NE LIT PAS LES COVERS'
+print*, '-----------------------------------------------'
+print*, '-----------------------------------------------'
+print*, '-----------------------------------------------'
+print*, '-----------------------------------------------'
+ IF (HNAT=='NAT') THEN
+ YRECFM='ECO_DG'
+ ELSE
+ YRECFM='GD_ECO_DG'
+ END IF
+ CALL READ_SURF_FIELD3D(HPROGRAM,ZDG,1,SIZE(ZDG,2),YRECFM,HDIR='A')
+ !
+ IF (HISBA=='DIF') THEN
+ YRECFM='ECO_WG_L'
+ IF (HNAT=='GRD') YRECFM='GD_ECO_WG_L'
+ ALLOCATE(ZWORK(KNI,KPATCH))
+ CALL READ_SURF_FIELD2D(HPROGRAM,ZWORK(:,:),YRECFM,HDIR='A')
+ WHERE (ZWORK==XUNDEF) ZWORK=NUNDEF
+ IWG_LAYER=NINT(ZWORK)
+ DEALLOCATE(ZWORK)
+ END IF
+ END IF
+ !
+ IF (HISBA=='DIF') IHYDRO_LAYER = MAXVAL(IWG_LAYER(:,:),IWG_LAYER(:,:)/=NUNDEF)
+ENDIF
+
+!-------------------------------------------------------------------
+IF (HNAT=='NAT' .AND. (IVERSION>=7 .OR. .NOT.GECOCLIMAP)) THEN
+ !
+ !* directly read soil layers in the file for nature ISBA soil layers
+ !
+ GDATA_DG = .TRUE.
+ IF (IVERSION>=7) THEN
+ YRECFM='L_DG'
+ YCOMMENT=YRECFM
+ CALL READ_SURF(HPROGRAM,YRECFM,GDATA_DG,IRESP,HCOMMENT=YCOMMENT)
+ ENDIF
+ !
+ IF (GDATA_DG) THEN
+ !
+ ALLOCATE(ZWORK(KNI,KPATCH))
+ DO JLAYER=1,KLAYER
+ IF (JLAYER<10) WRITE(YRECFM,FMT='(A4,I1.1)') 'D_DG',JLAYER
+ IF (JLAYER>=10) WRITE(YRECFM,FMT='(A4,I2.2)') 'D_DG',JLAYER
+ CALL READ_SURF_ISBA_PAR_n(HPROGRAM,YRECFM,KLUOUT,KNI,ZWORK,IRESP,IVERSION,HDIR='A')
+ DO JPATCH=1,KPATCH
+ ZDG(:,JLAYER,JPATCH) = ZWORK(:,JPATCH)
+ END DO
+ END DO
+ DEALLOCATE(ZWORK)
+ !
+ ENDIF
+ !
+ GDATA_GROUND_DEPTH=.FALSE.
+ IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=2) THEN
+ !
+ YRECFM2='L_GROUND_DEPTH'
+ IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) YRECFM2='L_GROUND_DPT'
+ YCOMMENT=YRECFM2
+ CALL READ_SURF(HPROGRAM,YRECFM2,GDATA_GROUND_DEPTH,IRESP,HCOMMENT=YCOMMENT)
+ !
+ IF (GDATA_GROUND_DEPTH) THEN
+ !
+ YRECFM2='D_GROUND_DETPH'
+ IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) YRECFM2='D_GROUND_DPT'
+ ALLOCATE(ZGROUND_DEPTH(KNI,KPATCH))
+ CALL READ_SURF_ISBA_PAR_n(HPROGRAM,YRECFM2,KLUOUT,KNI,ZGROUND_DEPTH(:,:),IRESP,IVERSION,HDIR='A')
+ !
+ DO JPATCH=1,KPATCH
+ DO JJ=1,KNI
+ DO JLAYER=1,KLAYER
+ IF ( ZDG(JJ,JLAYER,JPATCH) <= ZGROUND_DEPTH(JJ,JPATCH) .AND. ZGROUND_DEPTH(JJ,JPATCH) < XUNDEF ) &
+ IWG_LAYER(JJ,JPATCH) = JLAYER
+ ENDDO
+ ENDDO
+ ENDDO
+ DEALLOCATE(ZGROUND_DEPTH)
+ !
+ IF (HISBA=='DIF') IHYDRO_LAYER = MAXVAL(IWG_LAYER(:,:),IWG_LAYER(:,:)/=NUNDEF)
+ !
+ ENDIF
+ !
+ ENDIF
+ !
+ELSE IF (HNAT=='GRD' .AND. .NOT.GECOCLIMAP) THEN
+ !
+ !* computes soil layers from vegetation fractions read in the file
+ !
+ CALL READ_SURF(HPROGRAM,'D_TYPE_HVEG',YHVEG,IRESP)
+ CALL READ_SURF(HPROGRAM,'D_TYPE_LVEG',YLVEG,IRESP)
+ CALL READ_SURF(HPROGRAM,'D_TYPE_NVEG',YNVEG,IRESP)
+ CALL READ_SURF(HPROGRAM,'D_FRAC_HVEG',ZHVEG,IRESP,HDIR='A')
+ CALL READ_SURF(HPROGRAM,'D_FRAC_LVEG',ZLVEG,IRESP,HDIR='A')
+ CALL READ_SURF(HPROGRAM,'D_FRAC_NVEG',ZNVEG,IRESP,HDIR='A')
+ ! Ground layers
+ CALL GARDEN_SOIL_DEPTH(YNVEG,YLVEG,YHVEG,ZNVEG,ZLVEG,ZHVEG,ZDG)
+ !
+END IF
+!
+DEALLOCATE(IWG_LAYER)
+!
+IF (HFIELD=='WG ' .OR. HFIELD=='WGI ' .OR. HFIELD=='TWN_WG ' .OR. HFIELD=='TWN_WGI ' .OR. &
+ HFIELD=='GD_WG ' .OR. HFIELD=='GD_WGI ') THEN
+ KLAYER = IHYDRO_LAYER
+ENDIF
+!
+!-------------------------------------------------------------------
+!
+!* In force-restore ISBA, adds a layer at bottom of surface layer and a layer
+! between root and deep layers.
+!
+IF (HISBA=='2-L' .OR. HISBA=='3-L') THEN
+ ILAYER = KLAYER + 1
+ IF (HISBA=='3-L') ILAYER = ILAYER + 1
+ ALLOCATE(ZD (KNI,ILAYER,KPATCH))
+ DO JPATCH=1,KPATCH
+ ! for interpolations, middle of surface layer must be at least at 1cm
+ ZD(:,1,JPATCH) = MIN(3.*ZDG(:,1,JPATCH),MAX(ZDG(:,1,JPATCH),0.02))
+ ! new layer below surface layer. This layer will be at root depth layer humidity
+ ZD(:,2,JPATCH) = MIN(4.*ZDG(:,1,JPATCH),0.5*(ZDG(:,1,JPATCH)+ZDG(:,2,JPATCH)))
+ ! root layer
+ ZD(:,3,JPATCH) = ZDG(:,2,JPATCH)
+ IF (HISBA=='3-L') THEN
+ ! between root and deep layers. This layer will have deep soil humidity.
+ WHERE (ZDG(:,2,JPATCH)<ZDG(:,3,JPATCH))
+ ZD(:,4,JPATCH) = 0.75 * ZDG(:,2,JPATCH) + 0.25 * ZDG(:,3,JPATCH)
+ ELSEWHERE
+ ZD(:,4,JPATCH) = ZDG(:,3,JPATCH)
+ END WHERE
+ ! deep layer
+ ZD(:,5,JPATCH) = ZDG(:,3,JPATCH)
+ END IF
+ END DO
+ELSE
+ ILAYER = KLAYER
+ ALLOCATE(ZD (KNI,ILAYER,KPATCH))
+ ZD(:,:,:) = ZDG(:,1:KLAYER,:)
+END IF
+!
+DEALLOCATE(ZDG)
+!
+!-------------------------------------------------------------------
+!* recovers middle layer depth (from the surface)
+ALLOCATE(ZDEPTH (KNI,ILAYER,KPATCH))
+ZDEPTH = XUNDEF
+DO JPATCH=1,KPATCH
+ WHERE(ZD(:,1,JPATCH)/=XUNDEF) &
+ ZDEPTH (:,1,JPATCH)=ZD(:,1,JPATCH)/2.
+ DO JLAYER=2,ILAYER
+ WHERE(ZD(:,1,JPATCH)/=XUNDEF) &
+ ZDEPTH (:,JLAYER,JPATCH) = (ZD(:,JLAYER-1,JPATCH) + ZD(:,JLAYER,JPATCH))/2.
+ END DO
+END DO
+DEALLOCATE(ZD)
+!-------------------------------------------------------------------
+!
+ALLOCATE(PDEPTH (KNI,ILAYER,NVEGTYPE))
+ CALL PUT_ON_ALL_VEGTYPES(KNI,ILAYER,KPATCH,NVEGTYPE,ZDEPTH,PDEPTH)
+DEALLOCATE(ZDEPTH)
+
+IF (LHOOK) CALL DR_HOOK('MODE_READ_EXTERN:READ_EXTERN_DEPTH',1,ZHOOK_HANDLE)
+!-------------------------------------------------------------------
+!
+END SUBROUTINE READ_EXTERN_DEPTH
+!
+!
+!-------------------------------------------------------------------
+!---------------------------------------------------------------------------------------
+!
+! #######################
+ SUBROUTINE READ_EXTERN_ISBA(HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE,&
+ KLUOUT,KNI,HFIELD,HNAME,PFIELD,PDEPTH)
+! #######################
+!
+USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE
+USE MODD_SURF_PAR, ONLY : XUNDEF
+USE MODD_ISBA_PAR, ONLY : XOPTIMGRID
+!
+USE MODI_OPEN_AUX_IO_SURF
+USE MODI_CLOSE_AUX_IO_SURF
+USE MODI_READ_SURF
+USE MODI_READ_SURF_FIELD3D
+USE MODE_SOIL
+!
+IMPLICIT NONE
+!
+!* dummy arguments
+! ---------------
+!
+ CHARACTER(LEN=28), INTENT(IN) :: HFILE ! name of file
+ CHARACTER(LEN=6), INTENT(IN) :: HFILETYPE ! type of input file
+ CHARACTER(LEN=28), INTENT(IN) :: HFILEPGD ! name of file
+ CHARACTER(LEN=6), INTENT(IN) :: HFILEPGDTYPE ! type of input file
+INTEGER, INTENT(IN) :: KLUOUT ! logical unit of output listing
+INTEGER, INTENT(IN) :: KNI ! number of points
+ CHARACTER(LEN=7), INTENT(IN) :: HFIELD ! field name
+ CHARACTER(LEN=*), INTENT(IN) :: HNAME ! field name in the file
+REAL, DIMENSION(:,:,:), POINTER :: PFIELD ! field to initialize
+REAL, DIMENSION(:,:,:), POINTER :: PDEPTH ! middle depth of each layer
+!
+!
+!* local variables
+! ---------------
+!
+ CHARACTER(LEN=12) :: YRECFM ! Name of the article to be read
+ CHARACTER(LEN=4) :: YLVL
+#ifdef MNH_PARALLEL
+ CHARACTER(LEN=8) :: YPATCH
+#endif
+ CHARACTER(LEN=3) :: YISBA ! type of ISBA soil scheme
+ CHARACTER(LEN=3) :: YNAT ! type of surface (nature, garden)
+ CHARACTER(LEN=4) :: YPEDOTF ! type of pedo-transfert function
+INTEGER :: IRESP ! reading return code
+INTEGER :: ILAYER ! number of layers
+INTEGER :: JLAYER ! loop counter
+INTEGER :: IPATCH ! number of patch
+INTEGER :: JPATCH ! loop counter
+INTEGER :: JVEGTYPE ! loop counter
+LOGICAL :: GTEB ! TEB field
+!
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZFIELD ! field read, one level, all patches
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZWORK ! field read, one level, all patches
+!
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZVAR ! profile of physical variable
+REAL, DIMENSION(:), ALLOCATABLE :: ZCLAY ! clay fraction
+REAL, DIMENSION(:), ALLOCATABLE :: ZSAND ! sand fraction
+REAL, DIMENSION(:), ALLOCATABLE :: ZWWILT ! wilting point
+REAL, DIMENSION(:), ALLOCATABLE :: ZWFC ! field capacity
+REAL, DIMENSION(:), ALLOCATABLE :: ZWSAT ! saturation
+REAL, DIMENSION(:), ALLOCATABLE :: ZSOILGRID
+REAL, DIMENSION(:), ALLOCATABLE :: ZNAT ! natural surface fraction
+!
+INTEGER :: IVERSION ! surface version
+INTEGER :: IBUGFIX
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!-------------------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('MODE_READ_EXTERN:READ_EXTERN_ISBA',0,ZHOOK_HANDLE)
+WRITE (KLUOUT,*) ' | Reading ',HFIELD,' in externalized file'
+!
+GTEB = (HNAME(1:3)=='TWN' .OR. HNAME(1:3)=='GD_' .OR. HNAME(1:3)=='GR_' &
+ .OR. HNAME(4:6)=='GD_' .OR. HNAME(4:6)=='GR_')
+!
+!------------------------------------------------------------------------------
+!
+IF (GTEB) THEN
+ CALL OPEN_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE,'TOWN ')
+ELSE
+ CALL OPEN_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE,'NATURE')
+ENDIF
+!
+YRECFM='VERSION'
+ CALL READ_SURF(HFILEPGDTYPE,YRECFM,IVERSION,IRESP)
+!
+YRECFM='BUG'
+ CALL READ_SURF(HFILEPGDTYPE,YRECFM,IBUGFIX,IRESP)
+!
+!* Read number of soil layers
+!
+YRECFM='GROUND_LAYER'
+IF (GTEB) THEN
+ YRECFM='TWN_LAYER'
+ IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) YRECFM='GD_LAYER'
+ENDIF
+ CALL READ_SURF(HFILEPGDTYPE,YRECFM,ILAYER,IRESP)
+!
+!* number of tiles
+!
+IPATCH=1
+IF (.NOT. GTEB) THEN
+ YRECFM='PATCH_NUMBER'
+ CALL READ_SURF(HFILEPGDTYPE,YRECFM,IPATCH,IRESP)
+END IF
+!
+!* soil scheme
+!
+YRECFM='ISBA'
+IF (GTEB) THEN
+ YRECFM='TWN_ISBA'
+ IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) YRECFM='GD_ISBA'
+ENDIF
+ CALL READ_SURF(HFILEPGDTYPE,YRECFM,YISBA,IRESP)
+!
+IF (IVERSION>=7) THEN
+ !
+ !* Pedo-transfert function
+ !
+ YRECFM='PEDOTF'
+ IF (GTEB) THEN
+ YRECFM='TWN_PEDOTF'
+ IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) YRECFM='GD_PEDOTF'
+ ENDIF
+ CALL READ_SURF(HFILEPGDTYPE,YRECFM,YPEDOTF,IRESP)
+ !
+ELSE
+ YPEDOTF = 'CH78'
+ENDIF
+!
+!Only Brook and Corey with Force-Restore scheme
+IF(YISBA/='DIF')THEN
+ YPEDOTF='CH78'
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+! *. Read clay fraction
+! ------------------
+!
+ALLOCATE(ZCLAY(KNI))
+YRECFM='CLAY'
+IF (GTEB) THEN
+ YRECFM='TWN_CLAY'
+ IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) YRECFM='GD_CLAY'
+ENDIF
+ CALL READ_SURF(HFILEPGDTYPE,YRECFM,ZCLAY(:),IRESP,HDIR='A')
+!
+!-------------------------------------------------------------------------------
+!
+! *. Read sand fraction
+! ------------------
+!
+ALLOCATE(ZSAND(KNI))
+YRECFM='SAND'
+IF (GTEB) THEN
+ YRECFM='TWN_SAND'
+ IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) YRECFM='GD_SAND'
+ENDIF
+ CALL READ_SURF(HFILEPGDTYPE,YRECFM,ZSAND(:),IRESP,HDIR='A')
+!
+!-------------------------------------------------------------------------------
+!
+! *. Read soil grid
+! --------------
+!
+!* Reference grid for DIF
+!
+IF(YISBA=='DIF') THEN
+ ALLOCATE(ZSOILGRID(ILAYER))
+ ZSOILGRID=XUNDEF
+ IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=2) THEN
+ YRECFM='SOILGRID'
+ IF (GTEB) THEN
+ YRECFM='TWN_SOILGRID'
+ IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) YRECFM='GD_SOILGRID'
+ ENDIF
+ CALL READ_SURF(HFILEPGDTYPE,YRECFM,ZSOILGRID,IRESP,HDIR='-')
+ ELSE
+ ZSOILGRID(1:ILAYER) = XOPTIMGRID(1:ILAYER)
+ ENDIF
+ELSE
+ ALLOCATE(ZSOILGRID(0))
+ENDIF
+!
+IF ((HFIELD=='TG ') .AND. (YISBA=='2-L' .OR. YISBA=='3-L')) THEN
+ ALLOCATE(PDEPTH (KNI,ILAYER,NVEGTYPE))
+ DO JVEGTYPE=1,NVEGTYPE
+ PDEPTH(:,1,JVEGTYPE) = 0.
+ PDEPTH(:,2,JVEGTYPE) = 0.2
+ IF (ILAYER==3) PDEPTH(:,3,JVEGTYPE) = 3.
+ END DO
+ELSE
+ YNAT='NAT'
+ IF (GTEB) YNAT='GRD'
+ CALL READ_EXTERN_DEPTH(HFILEPGDTYPE,KLUOUT,YISBA,YNAT,HFIELD,KNI,ILAYER,IPATCH,&
+ ZSOILGRID,PDEPTH,IVERSION)
+END IF
+!
+DEALLOCATE(ZSOILGRID)
+!
+! *. Read fraction of nature
+! --------------
+!
+ALLOCATE(ZNAT(KNI))
+IF (IVERSION>=7) THEN
+ CALL READ_SURF(HFILEPGDTYPE,'FRAC_NATURE',ZNAT,IRESP,HDIR='A')
+ELSE
+ ZNAT=1.0
+ENDIF
+
+!
+ CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
+!
+!* Allocate soil variable profile
+! ------------------------------
+!
+!
+ALLOCATE(ZVAR(KNI,ILAYER,IPATCH))
+ALLOCATE(ZWORK(KNI,IPATCH))
+ZWORK(:,:) = XUNDEF
+!
+! *. Read soil variable profile
+! --------------------------
+!
+IF (GTEB) THEN
+ CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,'TOWN ')
+ELSE
+ CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,'NATURE')
+ENDIF
+!
+ YRECFM=TRIM(HNAME)
+ CALL READ_SURF_FIELD3D(HFILETYPE,ZVAR,1,ILAYER,YRECFM,HDIR='A')
+!
+ CALL CLOSE_AUX_IO_SURF(HFILE,HFILETYPE)
+!
+DEALLOCATE(ZWORK)
+!
+!
+! *. Compute relative humidity from units kg/m^2 (SWI)
+! ------------------------------------------------
+!
+!* In case of force-restore ISBA, adds one layer at bottom of surface layer
+IF ((HFIELD=='WG ' .OR. HFIELD=='WGI ') .AND. (YISBA=='2-L' .OR. YISBA=='3-L')) THEN
+ ALLOCATE(ZFIELD(KNI,ILAYER,IPATCH))
+ ZFIELD(:,:,:) = ZVAR(:,:,:)
+ DEALLOCATE(ZVAR)
+ !
+ ILAYER = ILAYER + 1
+ IF ( YISBA=='3-L' ) ILAYER = ILAYER + 1
+ ALLOCATE(ZVAR(KNI,ILAYER,IPATCH))
+ DO JPATCH=1,IPATCH
+ ZVAR(:,1,JPATCH)=ZFIELD(:,1,JPATCH)
+ ZVAR(:,2,JPATCH)=ZFIELD(:,2,JPATCH) ! new layer at root layer humidity but below surface layer
+ ZVAR(:,3,JPATCH)=ZFIELD(:,2,JPATCH)
+ IF ( YISBA=='3-L' ) THEN
+ ZVAR(:,4,JPATCH)=ZFIELD(:,3,JPATCH)
+ ZVAR(:,5,JPATCH)=ZFIELD(:,3,JPATCH)
+ END IF
+ END DO
+ DEALLOCATE(ZFIELD)
+END IF
+!
+ALLOCATE(ZFIELD(KNI,ILAYER,IPATCH))
+ZFIELD = ZVAR
+!
+IF (HFIELD=='WG ' .OR. HFIELD=='WGI ') THEN
+ !
+ ! Compute ISBA model constants
+ !
+ ALLOCATE (ZWFC (KNI))
+ ALLOCATE (ZWWILT(KNI))
+ ALLOCATE (ZWSAT (KNI))
+ !
+ ZWSAT (:) = WSAT_FUNC (ZCLAY(:),ZSAND(:),YPEDOTF)
+ ZWWILT(:) = WWILT_FUNC(ZCLAY(:),ZSAND(:),YPEDOTF)
+ ZWFC (:) = WFC_FUNC (ZCLAY(:),ZSAND(:),YPEDOTF)
+ !
+ DEALLOCATE (ZSAND)
+ DEALLOCATE (ZCLAY)
+
+ ZFIELD(:,:,:) = XUNDEF
+ !
+ IF (HFIELD=='WG ') THEN
+ DO JPATCH=1,IPATCH
+ DO JLAYER=1,ILAYER
+ WHERE(ZNAT(:)>0.0 .AND. ZVAR(:,JLAYER,JPATCH)/=XUNDEF)
+ ZVAR(:,JLAYER,JPATCH) = MAX(MIN(ZVAR(:,JLAYER,JPATCH),ZWSAT(:)),0.)
+ !
+ ZFIELD(:,JLAYER,JPATCH) = (ZVAR(:,JLAYER,JPATCH) - ZWWILT(:)) / (ZWFC(:) - ZWWILT(:))
+ END WHERE
+ END DO
+ END DO
+ ELSE IF (HFIELD=='WGI ') THEN
+ DO JPATCH=1,IPATCH
+ DO JLAYER=1,ILAYER
+ WHERE(ZNAT(:)>0.0 .AND. ZVAR(:,JLAYER,JPATCH)/=XUNDEF)
+ ZFIELD(:,JLAYER,JPATCH) = ZVAR(:,JLAYER,JPATCH) / ZWSAT(:)
+ END WHERE
+ END DO
+ END DO
+ END IF
+!
+ DEALLOCATE (ZNAT)
+ DEALLOCATE (ZWSAT)
+ DEALLOCATE (ZWWILT)
+ DEALLOCATE (ZWFC)
+!
+!
+END IF
+!
+DEALLOCATE(ZVAR)
+!-------------------------------------------------------------------------------
+!
+! *. Set the field on all vegtypes
+! -----------------------------
+!
+ALLOCATE(PFIELD(KNI,ILAYER,NVEGTYPE))
+ CALL PUT_ON_ALL_VEGTYPES(KNI,ILAYER,IPATCH,NVEGTYPE,ZFIELD,PFIELD)
+DEALLOCATE(ZFIELD)
+IF (LHOOK) CALL DR_HOOK('MODE_READ_EXTERN:READ_EXTERN_ISBA',1,ZHOOK_HANDLE)
+!
+!------------------------------------------------------------------------------
+!
+END SUBROUTINE READ_EXTERN_ISBA
+!
+!------------------------------------------------------------------------------
+!
+END MODULE MODE_READ_EXTERN
diff --git a/src/SURFEX/prep_isba_extern.F90 b/src/SURFEX/prep_isba_extern.F90
index e71125a66..710e8c00d 100644
--- a/src/SURFEX/prep_isba_extern.F90
+++ b/src/SURFEX/prep_isba_extern.F90
@@ -1,188 +1,183 @@
-!SURFEX_LIC Copyright 1994-2014 Meteo-France
-!SURFEX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SURFEX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SURFEX_LIC for details. version 1.
-! #########
-SUBROUTINE PREP_ISBA_EXTERN(HPROGRAM,HSURF,HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE,KLUOUT,PFIELD)
-! #################################################################################
-!
-!!**** *PREP_ISBA_EXTERN* - initializes ISBA fields from operational GRIB
-!!
-!! PURPOSE
-!! -------
-!
-!!** METHOD
-!! ------
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! V. Masson
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 01/2004
-!! M.Moge 08/2015 reading 'WR' one patch at a time for Z-parallel splitting with MNH
-!!------------------------------------------------------------------
-!
-
-!
-USE MODE_READ_EXTERN
-!
-USE MODD_TYPE_DATE_SURF
-!
-USE MODI_PREP_GRID_EXTERN
-USE MODI_READ_SURF
-USE MODI_INTERP_GRID
-USE MODI_OPEN_AUX_IO_SURF
-USE MODI_CLOSE_AUX_IO_SURF
-!
-USE MODD_PREP, ONLY : CINGRID_TYPE, CINTERP_TYPE
-USE MODD_PREP_ISBA, ONLY : XGRID_SOIL, XWR_DEF
-USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE
-USE MODD_SURF_PAR, ONLY : XUNDEF
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-USE MODI_PUT_ON_ALL_VEGTYPES
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
- CHARACTER(LEN=7), INTENT(IN) :: HSURF ! type of field
- CHARACTER(LEN=28), INTENT(IN) :: HFILE ! name of file
- CHARACTER(LEN=6), INTENT(IN) :: HFILETYPE ! type of input file
- CHARACTER(LEN=28), INTENT(IN) :: HFILEPGD ! name of file
- CHARACTER(LEN=6), INTENT(IN) :: HFILEPGDTYPE ! type of input file
-INTEGER, INTENT(IN) :: KLUOUT ! logical unit of output listing
-REAL,DIMENSION(:,:,:), POINTER :: PFIELD ! field to interpolate horizontally (on final soil grid)
-!
-!* 0.2 declarations of local variables
-!
- CHARACTER(LEN=12) :: YRECFM ! Name of the article to be read
-INTEGER :: IRESP ! reading return code
-INTEGER :: INI ! total 1D dimension
-INTEGER :: IPATCH ! number of patch
-!
-REAL, DIMENSION(:,:,:), POINTER :: ZFIELD ! field read on initial MNH vertical soil grid, all patches
-REAL, DIMENSION(:,:), POINTER :: ZFIELD1 ! field read on initial MNH vertical soil grid, one patch
-REAL, DIMENSION(:,:,:), POINTER :: ZD ! depth of field in the soil
-REAL, DIMENSION(:,:), POINTER :: ZD1 ! depth of field in the soil, one patch
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZOUT !
-INTEGER :: JPATCH, JVEGTYPE ! loop counter for patch
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-!------------------------------------------------------------------------------
-!
-!* 1. Preparation of IO for reading in the file
-! -----------------------------------------
-!
-!* Note that all points are read, even those without physical meaning.
-! These points will not be used during the horizontal interpolation step.
-! Their value must be defined as XUNDEF.
-!
-IF (LHOOK) CALL DR_HOOK('PREP_ISBA_EXTERN',0,ZHOOK_HANDLE)
-!
-!------------------------------------------------------------------------------
-!
-!* 2. Reading of grid
-! ---------------
-!
- CALL OPEN_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE,'NATURE')
-!
- CALL PREP_GRID_EXTERN(HFILEPGDTYPE,KLUOUT,CINGRID_TYPE,CINTERP_TYPE,INI)
-!
-!---------------------------------------------------------------------------------------
-!
-!* 3. Transformation into physical quantity to be interpolated
-! --------------------------------------------------------
-!
-SELECT CASE(HSURF)
-!
-!* 3. Orography
-! ---------
-!
- CASE('ZS ')
- ALLOCATE(PFIELD(INI,1,1))
- YRECFM='ZS'
- CALL READ_SURF(HFILEPGDTYPE,YRECFM,PFIELD(:,1,1),IRESP,HDIR='A')
- CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
-!
-!--------------------------------------------------------------------------
-!
-!
-!* 3.1 Profile of temperature, water or ice in the soil
-!
- CASE('TG ','WG ','WGI ')
- CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
-!* reading of the profile and its depth definition
- CALL READ_EXTERN_ISBA(HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE,&
- KLUOUT,INI,HSURF,HSURF,ZFIELD,ZD)
-!
- ALLOCATE(ZFIELD1(SIZE(ZFIELD,1),SIZE(ZFIELD,2)))
- ALLOCATE(ZD1(SIZE(ZFIELD,1),SIZE(ZFIELD,2)))
- ALLOCATE(ZOUT(SIZE(ZFIELD,1),SIZE(XGRID_SOIL)))
- ALLOCATE(PFIELD(SIZE(ZFIELD,1),SIZE(XGRID_SOIL),SIZE(ZFIELD,3)))
-!
- DO JVEGTYPE=1,SIZE(ZFIELD,3)
- ZFIELD1(:,:)=ZFIELD(:,:,JVEGTYPE)
- ZD1(:,:)=ZD(:,:,JVEGTYPE)
- CALL INTERP_GRID(ZD1,ZFIELD1,XGRID_SOIL,ZOUT)
- PFIELD(:,:,JVEGTYPE)=ZOUT(:,:)
- END DO
-
-!
- DEALLOCATE(ZFIELD)
- DEALLOCATE(ZOUT)
- DEALLOCATE(ZFIELD1)
- DEALLOCATE(ZD)
-!
-!--------------------------------------------------------------------------
-!
-!* 3.4 Water content intercepted on leaves, LAI
-!
- CASE('WR ')
- ALLOCATE(PFIELD(INI,1,NVEGTYPE))
- !* number of tiles
- YRECFM='PATCH_NUMBER'
- CALL READ_SURF(HFILEPGDTYPE,YRECFM,IPATCH,IRESP)
- CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
- ALLOCATE(ZFIELD(INI,1,IPATCH))
- YRECFM = 'WR'
- CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,'NATURE')
-#ifdef MNH_PARALLEL
- DO JPATCH=1,IPATCH
- WRITE(YRECFM,'(A2,I4.4)') 'WR',JPATCH
- CALL READ_SURF(HFILETYPE,YRECFM,ZFIELD(:,1,JPATCH),IRESP,HDIR='A')
- END DO
-#else
- CALL READ_SURF(HFILETYPE,YRECFM,ZFIELD(:,1,:),IRESP,HDIR='A')
-#endif
- CALL CLOSE_AUX_IO_SURF(HFILE,HFILETYPE)
- CALL PUT_ON_ALL_VEGTYPES(INI,1,IPATCH,NVEGTYPE,ZFIELD,PFIELD)
- DEALLOCATE(ZFIELD)
-!
- CASE('LAI ')
- CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
- ALLOCATE(PFIELD(INI,1,NVEGTYPE))
- PFIELD(:,:,:) = XUNDEF
-!
-END SELECT
-!
-!
-!---------------------------------------------------------------------------
-!
-!* 6. End of IO
-! ---------
-!
-IF (LHOOK) CALL DR_HOOK('PREP_ISBA_EXTERN',1,ZHOOK_HANDLE)
-!
-!---------------------------------------------------------------------------
-!---------------------------------------------------------------------------
-END SUBROUTINE PREP_ISBA_EXTERN
+!SURFEX_LIC Copyright 1994-2014 Meteo-France
+!SURFEX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SURFEX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SURFEX_LIC for details. version 1.
+! #########
+SUBROUTINE PREP_ISBA_EXTERN(HPROGRAM,HSURF,HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE,KLUOUT,PFIELD)
+! #################################################################################
+!
+!!**** *PREP_ISBA_EXTERN* - initializes ISBA fields from operational GRIB
+!!
+!! PURPOSE
+!! -------
+!
+!!** METHOD
+!! ------
+!!
+!! REFERENCE
+!! ---------
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Masson
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 01/2004
+!! M.Moge 01/2016 using READ_SURF_FIELD2D for 2D surfex fields reads
+!!------------------------------------------------------------------
+!
+
+!
+USE MODE_READ_EXTERN
+!
+USE MODD_TYPE_DATE_SURF
+!
+USE MODI_PREP_GRID_EXTERN
+USE MODI_READ_SURF
+USE MODI_INTERP_GRID
+USE MODI_OPEN_AUX_IO_SURF
+USE MODI_CLOSE_AUX_IO_SURF
+!
+USE MODD_PREP, ONLY : CINGRID_TYPE, CINTERP_TYPE
+USE MODD_PREP_ISBA, ONLY : XGRID_SOIL, XWR_DEF
+USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE
+USE MODD_SURF_PAR, ONLY : XUNDEF
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+USE MODI_PUT_ON_ALL_VEGTYPES
+!
+USE MODI_READ_SURF_FIELD2D
+!
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+ CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
+ CHARACTER(LEN=7), INTENT(IN) :: HSURF ! type of field
+ CHARACTER(LEN=28), INTENT(IN) :: HFILE ! name of file
+ CHARACTER(LEN=6), INTENT(IN) :: HFILETYPE ! type of input file
+ CHARACTER(LEN=28), INTENT(IN) :: HFILEPGD ! name of file
+ CHARACTER(LEN=6), INTENT(IN) :: HFILEPGDTYPE ! type of input file
+INTEGER, INTENT(IN) :: KLUOUT ! logical unit of output listing
+REAL,DIMENSION(:,:,:), POINTER :: PFIELD ! field to interpolate horizontally (on final soil grid)
+!
+!* 0.2 declarations of local variables
+!
+ CHARACTER(LEN=12) :: YRECFM ! Name of the article to be read
+INTEGER :: IRESP ! reading return code
+INTEGER :: INI ! total 1D dimension
+INTEGER :: IPATCH ! number of patch
+!
+REAL, DIMENSION(:,:,:), POINTER :: ZFIELD ! field read on initial MNH vertical soil grid, all patches
+REAL, DIMENSION(:,:), POINTER :: ZFIELD1 ! field read on initial MNH vertical soil grid, one patch
+REAL, DIMENSION(:,:,:), POINTER :: ZD ! depth of field in the soil
+REAL, DIMENSION(:,:), POINTER :: ZD1 ! depth of field in the soil, one patch
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZOUT !
+INTEGER :: JVEGTYPE ! loop counter for patch
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+!------------------------------------------------------------------------------
+!
+!* 1. Preparation of IO for reading in the file
+! -----------------------------------------
+!
+!* Note that all points are read, even those without physical meaning.
+! These points will not be used during the horizontal interpolation step.
+! Their value must be defined as XUNDEF.
+!
+IF (LHOOK) CALL DR_HOOK('PREP_ISBA_EXTERN',0,ZHOOK_HANDLE)
+!
+!------------------------------------------------------------------------------
+!
+!* 2. Reading of grid
+! ---------------
+!
+ CALL OPEN_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE,'NATURE')
+!
+ CALL PREP_GRID_EXTERN(HFILEPGDTYPE,KLUOUT,CINGRID_TYPE,CINTERP_TYPE,INI)
+!
+!---------------------------------------------------------------------------------------
+!
+!* 3. Transformation into physical quantity to be interpolated
+! --------------------------------------------------------
+!
+SELECT CASE(HSURF)
+!
+!* 3. Orography
+! ---------
+!
+ CASE('ZS ')
+ ALLOCATE(PFIELD(INI,1,1))
+ YRECFM='ZS'
+ CALL READ_SURF(HFILEPGDTYPE,YRECFM,PFIELD(:,1,1),IRESP,HDIR='A')
+ CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
+!
+!--------------------------------------------------------------------------
+!
+!
+!* 3.1 Profile of temperature, water or ice in the soil
+!
+ CASE('TG ','WG ','WGI ')
+ CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
+!* reading of the profile and its depth definition
+ CALL READ_EXTERN_ISBA(HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE,&
+ KLUOUT,INI,HSURF,HSURF,ZFIELD,ZD)
+!
+ ALLOCATE(ZFIELD1(SIZE(ZFIELD,1),SIZE(ZFIELD,2)))
+ ALLOCATE(ZD1(SIZE(ZFIELD,1),SIZE(ZFIELD,2)))
+ ALLOCATE(ZOUT(SIZE(ZFIELD,1),SIZE(XGRID_SOIL)))
+ ALLOCATE(PFIELD(SIZE(ZFIELD,1),SIZE(XGRID_SOIL),SIZE(ZFIELD,3)))
+!
+ DO JVEGTYPE=1,SIZE(ZFIELD,3)
+ ZFIELD1(:,:)=ZFIELD(:,:,JVEGTYPE)
+ ZD1(:,:)=ZD(:,:,JVEGTYPE)
+ CALL INTERP_GRID(ZD1,ZFIELD1,XGRID_SOIL,ZOUT)
+ PFIELD(:,:,JVEGTYPE)=ZOUT(:,:)
+ END DO
+
+!
+ DEALLOCATE(ZFIELD)
+ DEALLOCATE(ZOUT)
+ DEALLOCATE(ZFIELD1)
+ DEALLOCATE(ZD)
+!
+!--------------------------------------------------------------------------
+!
+!* 3.4 Water content intercepted on leaves, LAI
+!
+ CASE('WR ')
+ ALLOCATE(PFIELD(INI,1,NVEGTYPE))
+ !* number of tiles
+ YRECFM='PATCH_NUMBER'
+ CALL READ_SURF(HFILEPGDTYPE,YRECFM,IPATCH,IRESP)
+ CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
+ ALLOCATE(ZFIELD(INI,1,IPATCH))
+ YRECFM = 'WR'
+ CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,'NATURE')
+ CALL READ_SURF_FIELD2D(HFILETYPE,ZFIELD(:,1,:),YRECFM,HDIR='A')
+ CALL CLOSE_AUX_IO_SURF(HFILE,HFILETYPE)
+ CALL PUT_ON_ALL_VEGTYPES(INI,1,IPATCH,NVEGTYPE,ZFIELD,PFIELD)
+ DEALLOCATE(ZFIELD)
+!
+ CASE('LAI ')
+ CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
+ ALLOCATE(PFIELD(INI,1,NVEGTYPE))
+ PFIELD(:,:,:) = XUNDEF
+!
+END SELECT
+!
+!
+!---------------------------------------------------------------------------
+!
+!* 6. End of IO
+! ---------
+!
+IF (LHOOK) CALL DR_HOOK('PREP_ISBA_EXTERN',1,ZHOOK_HANDLE)
+!
+!---------------------------------------------------------------------------
+!---------------------------------------------------------------------------
+END SUBROUTINE PREP_ISBA_EXTERN
diff --git a/src/SURFEX/prep_teb_extern.F90 b/src/SURFEX/prep_teb_extern.F90
index b998d60bc..74c1ed913 100644
--- a/src/SURFEX/prep_teb_extern.F90
+++ b/src/SURFEX/prep_teb_extern.F90
@@ -1,363 +1,370 @@
-!SURFEX_LIC Copyright 1994-2014 Meteo-France
-!SURFEX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SURFEX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SURFEX_LIC for details. version 1.
-! #########
-SUBROUTINE PREP_TEB_EXTERN(HPROGRAM,HSURF,HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE,KLUOUT,PFIELD)
-! #################################################################################
-!
-USE MODD_TYPE_DATE_SURF
-!
-USE MODI_PREP_GRID_EXTERN
-USE MODI_READ_SURF
-USE MODI_GET_TEB_DEPTHS
-USE MODI_INTERP_GRID
-USE MODI_OPEN_AUX_IO_SURF
-USE MODI_CLOSE_AUX_IO_SURF
-USE MODI_TOWN_PRESENCE
-USE MODI_READ_TEB_PATCH
-USE MODI_GET_CURRENT_TEB_PATCH
-!
-USE MODD_PREP, ONLY : CINGRID_TYPE, CINTERP_TYPE
-USE MODD_PREP_TEB, ONLY : XGRID_ROAD, XGRID_WALL, XGRID_ROOF, &
- XGRID_FLOOR, XWS_ROOF, XWS_ROAD, &
- XTI_BLD_DEF, XWS_ROOF_DEF, XWS_ROAD_DEF, XHUI_BLD_DEF
-USE MODD_DATA_COVER_PAR, ONLY : JPCOVER
-USE MODD_SURF_PAR, ONLY: XUNDEF
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
- CHARACTER(LEN=7), INTENT(IN) :: HSURF ! type of field
- CHARACTER(LEN=28), INTENT(IN) :: HFILE ! name of file
- CHARACTER(LEN=6), INTENT(IN) :: HFILETYPE ! type of input file
- CHARACTER(LEN=28), INTENT(IN) :: HFILEPGD ! name of file
- CHARACTER(LEN=6), INTENT(IN) :: HFILEPGDTYPE ! type of input file
-INTEGER, INTENT(IN) :: KLUOUT ! logical unit of output listing
-REAL,DIMENSION(:,:), POINTER :: PFIELD ! field to interpolate horizontally
-!
-!* 0.2 declarations of local variables
-!
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZFIELD ! field read
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZDEPTH ! depth of each layer
-REAL, DIMENSION(:), ALLOCATABLE :: ZDEPTH_TOT ! total depth of surface
-!
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZD ! intermediate array
-!
- CHARACTER(LEN=12) :: YRECFM ! Name of the article to be read
-INTEGER :: IRESP ! reading return code
-INTEGER :: ILAYER ! number of layers
-INTEGER :: JLAYER ! loop counter
-INTEGER :: IVERSION ! SURFEX version
-INTEGER :: IBUGFIX ! SURFEX bug version
-LOGICAL :: GOLD_NAME ! old name flag for temperatures
- CHARACTER(LEN=4) :: YWALL_OPT ! option of walls
- CHARACTER(LEN=6) :: YSURF ! Surface type
- CHARACTER(LEN=3) :: YBEM ! key of the building energy model DEF for DEFault (Masson et al. 2002) ,
- ! BEM for Building Energy Model (Bueno et al. 2012)
-!
-INTEGER :: INI ! total 1D dimension
-!
-LOGICAL :: GTEB ! flag if TEB fields are present
-INTEGER :: IPATCH ! number of soil temperature patches
-INTEGER :: ITEB_PATCH! number of TEB patches in file
-INTEGER :: ICURRENT_PATCH! current TEB patch to be initialized
- CHARACTER(LEN=3) :: YPATCH ! indentificator for TEB patch
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!-------------------------------------------------------------------------------------
-!
-!* 1. Preparation of IO for reading in the file
-! -----------------------------------------
-!
-!* Note that all points are read, even those without physical meaning.
-! These points will not be used during the horizontal interpolation step.
-! Their value must be defined as XUNDEF.
-!
-IF (LHOOK) CALL DR_HOOK('PREP_TEB_EXTERN',0,ZHOOK_HANDLE)
-!
- CALL OPEN_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE,'TOWN ')
-!
-!* reading of version of the file being read
- CALL READ_SURF(HFILEPGDTYPE,'VERSION',IVERSION,IRESP)
- CALL READ_SURF(HFILEPGDTYPE,'BUG',IBUGFIX,IRESP)
-GOLD_NAME=(IVERSION<7 .OR. (IVERSION==7 .AND. IBUGFIX<3))
-!
-IF (.NOT.GOLD_NAME) THEN
- YRECFM='BEM'
- CALL READ_SURF(HFILEPGDTYPE,YRECFM,YBEM,IRESP)
-ELSE
- YBEM='DEF'
-ENDIF
-!-------------------------------------------------------------------------------------
-!
-!* 2. Reading of grid
-! ---------------
-!
-!* reads the grid
- CALL PREP_GRID_EXTERN(HFILEPGDTYPE,KLUOUT,CINGRID_TYPE,CINTERP_TYPE,INI)
-!
-!
-!* reads if TEB fields exist in the input file
- CALL TOWN_PRESENCE(HFILEPGDTYPE,GTEB)
-!
-!---------------------------------------------------------------------------------------
-!
-!* 3. Orography
-! ---------
-!
-IF (HSURF=='ZS ') THEN
- !
- ALLOCATE(PFIELD(INI,1))
- YRECFM='ZS'
- CALL READ_SURF(HFILEPGDTYPE,YRECFM,PFIELD(:,1),IRESP,HDIR='A')
- CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
- !
- !---------------------------------------------------------------------------------------
-ELSE
-!---------------------------------------------------------------------------------------
-!
-!* 4. TEB fields are read
-! -------------------
-!
- IF (GTEB) THEN
-!
- CALL READ_TEB_PATCH(HFILEPGDTYPE,ITEB_PATCH)
- CALL GET_CURRENT_TEB_PATCH(ICURRENT_PATCH)
- YPATCH=' '
- IF (ITEB_PATCH>1) THEN
- WRITE(YPATCH,FMT='(A,I1,A)') 'T',MIN(ICURRENT_PATCH,ITEB_PATCH),'_'
- END IF
-!---------------------------------------------------------------------------------------
- SELECT CASE(HSURF)
-!---------------------------------------------------------------------------------------
-!
-!* 4.1 Profile of temperatures in roads, roofs or walls
-! ------------------------------------------------
-!
- CASE('T_ROAD','T_ROOF','T_WALLA','T_WALLB','T_FLOOR','T_MASS')
- YSURF=HSURF(1:6)
- !* reading of number of layers
- IF (YSURF=='T_ROAD') YRECFM='ROAD_LAYER'
- IF (YSURF=='T_ROOF') YRECFM='ROOF_LAYER'
- IF (YSURF=='T_WALL') YRECFM='WALL_LAYER'
- IF (YSURF=='T_FLOO' .OR. YSURF=='T_MASS') THEN
- IF (YBEM=='DEF') THEN
- YRECFM='ROAD_LAYER'
- ELSE
- YRECFM='FLOOR_LAYER'
- END IF
- END IF
- CALL READ_SURF(HFILEPGDTYPE,YRECFM,ILAYER,IRESP)
- !
- ALLOCATE(ZD(INI,ILAYER))
- IF (YSURF=='T_ROAD') CALL GET_TEB_DEPTHS(HFILEPGDTYPE,PD_ROAD=ZD)
- IF (YSURF=='T_ROOF') CALL GET_TEB_DEPTHS(HFILEPGDTYPE,PD_ROOF=ZD)
- IF (YSURF=='T_WALL') CALL GET_TEB_DEPTHS(HFILEPGDTYPE,PD_WALL=ZD)
- IF (YSURF=='T_MASS') CALL GET_TEB_DEPTHS(HFILEPGDTYPE,PD_FLOOR=ZD)
- IF (YSURF=='T_FLOO') CALL GET_TEB_DEPTHS(HFILEPGDTYPE,PD_FLOOR=ZD)
- !
- CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
- CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,'TOWN ')
- !
- !* reading option for road orientation
- YWALL_OPT = 'UNIF'
- IF (YSURF =='T_WALL' .AND. .NOT. GOLD_NAME) THEN
- CALL READ_SURF(HFILETYPE,'WALL_OPT',YWALL_OPT,IRESP)
- END IF
- !
- !* reading of the profile
- ALLOCATE(ZFIELD(INI,ILAYER))
- DO JLAYER=1,ILAYER
- IF (GOLD_NAME) THEN
- WRITE(YRECFM,'(A6,I1.1)') HSURF(1:6),JLAYER
- ELSE
- WRITE(YRECFM,'(A1,A4,I1.1)') HSURF(1:1),HSURF(3:6),JLAYER
- IF (YSURF =='T_WALL' .AND. YWALL_OPT/='UNIF') &
- WRITE(YRECFM,'(A1,A5,I1.1)') HSURF(1:1),HSURF(3:7),JLAYER
- IF ((HSURF=='T_FLOOR' .OR. HSURF=='T_MASS') .AND. YBEM=='DEF') THEN
- IF (HSURF=='T_FLOOR' .AND. JLAYER>1) THEN
- WRITE(YRECFM,'(A5,I1.1)') 'TROAD',JLAYER
- ELSE
- WRITE(YRECFM,'(A6)') 'TI_BLD'
- ENDIF
- END IF
- END IF
- YRECFM=YPATCH//YRECFM
- YRECFM=ADJUSTL(YRECFM)
- CALL READ_SURF(HFILETYPE,YRECFM,ZFIELD(:,JLAYER),IRESP,HDIR='A')
- END DO
- CALL CLOSE_AUX_IO_SURF(HFILE,HFILETYPE)
- !
- !* recovers middle layer depth (from the surface)
- ALLOCATE(ZDEPTH (INI,ILAYER))
- ALLOCATE(ZDEPTH_TOT(INI))
- ZDEPTH (:,1)=ZD(:,1)/2.
- ZDEPTH_TOT(:) =ZD(:,1)
- DO JLAYER=2,ILAYER
- ZDEPTH (:,JLAYER) = ZDEPTH_TOT(:) + ZD(:,JLAYER)/2.
- ZDEPTH_TOT(:) = ZDEPTH_TOT(:) + ZD(:,JLAYER)
- END DO
- !
- !* in case of wall or roof, normalizes by total wall or roof thickness
- IF (YSURF=='T_ROOF' .OR. YSURF=='T_WALL' .OR. HSURF == 'T_FLOOR' .OR. HSURF == 'T_MASS') THEN
- DO JLAYER=1,ILAYER
- ZDEPTH(:,JLAYER) = ZDEPTH(:,JLAYER) / ZDEPTH_TOT(:)
- END DO
- END IF
- !
- !* interpolation on the fine vertical grid
- IF (YSURF=='T_ROAD') THEN
- ALLOCATE(PFIELD(SIZE(ZFIELD,1),SIZE(XGRID_ROAD)))
- CALL INTERP_GRID(ZDEPTH,ZFIELD,XGRID_ROAD,PFIELD)
- ELSEIF (YSURF=='T_ROOF') THEN
- ALLOCATE(PFIELD(SIZE(ZFIELD,1),SIZE(XGRID_ROOF)))
- CALL INTERP_GRID(ZDEPTH,ZFIELD,XGRID_ROOF,PFIELD)
- ELSEIF (YSURF=='T_WALL') THEN
- ALLOCATE(PFIELD(SIZE(ZFIELD,1),SIZE(XGRID_WALL)))
- CALL INTERP_GRID(ZDEPTH,ZFIELD,XGRID_WALL,PFIELD)
- ELSEIF (YSURF=='T_FLOO' .OR. YSURF=='T_MASS') THEN
- ALLOCATE(PFIELD(SIZE(ZFIELD,1),SIZE(XGRID_FLOOR)))
- CALL INTERP_GRID(ZDEPTH,ZFIELD,XGRID_FLOOR,PFIELD)
- END IF
- !
- !* end
- DEALLOCATE(ZD)
- DEALLOCATE(ZFIELD)
- DEALLOCATE(ZDEPTH)
- DEALLOCATE(ZDEPTH_TOT)
-!---------------------------------------------------------------------------------------
-!
-!* 4.2 Internal moisture
-! ---------------
-!
- CASE('QI_BLD ')
- ALLOCATE(PFIELD(INI,1))
- IF (YBEM=='BEM') THEN
- YRECFM='QI_BLD'
- YRECFM=YPATCH//YRECFM
- YRECFM=ADJUSTL(YRECFM)
- CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
- CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,'TOWN ')
- CALL READ_SURF(HFILETYPE,YRECFM,PFIELD(:,1),IRESP,HDIR='A')
- CALL CLOSE_AUX_IO_SURF(HFILE,HFILETYPE)
- ELSE
- PFIELD(:,1) = XUNDEF
- ENDIF
-!
-!---------------------------------------------------------------------------------------
-!
-!* 4.2 Other variables
-! ---------------
-!
- CASE DEFAULT
- ALLOCATE(PFIELD(INI,1))
- YRECFM=HSURF
- IF (HSURF=='T_CAN ') THEN
- YRECFM='TCANYON'
- IF (GOLD_NAME) YRECFM='T_CANYON'
- ELSEIF (HSURF=='Q_CAN ') THEN
- YRECFM='QCANYON'
- IF (GOLD_NAME) YRECFM='Q_CANYON'
- ELSEIF (HSURF=='T_WIN2 ' .OR. HSURF=='T_WIN1') THEN
- IF (YBEM=='BEM') THEN
- YRECFM=HSURF
- ELSE
- YRECFM='TI_BLD'
- ENDIF
- ENDIF
- YRECFM=YPATCH//YRECFM
- YRECFM=ADJUSTL(YRECFM)
- CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
- CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,'TOWN ')
- CALL READ_SURF(HFILETYPE,YRECFM,PFIELD(:,1),IRESP,HDIR='A')
- CALL CLOSE_AUX_IO_SURF(HFILE,HFILETYPE)
-!
-!---------------------------------------------------------------------------------------
- END SELECT
-!---------------------------------------------------------------------------------------
-!
-!* 5. Subtitutes if TEB fields do not exist
-! -------------------------------------
-!
- ELSE
-
- CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
-
- SELECT CASE(HSURF)
-
- !* temperature profiles
- CASE('T_ROAD','T_ROOF','T_WALL','T_WIN1','T_FLOOR','T_CAN','TI_ROAD')
- YSURF=HSURF(1:6)
- !* reading of the soil surface temperature
- CALL OPEN_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE,'NATURE')
- CALL READ_SURF(HFILEPGDTYPE,'PATCH_NUMBER',IPATCH,IRESP)
- CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
- ALLOCATE(ZFIELD(INI,IPATCH))
- CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,'NATURE')
- IF (YSURF=='T_FLOO' .OR. YSURF=='T_CAN ' .OR. YSURF=='TI_ROA') THEN
- CALL READ_SURF(HFILETYPE,'TG2',ZFIELD(:,:),IRESP,HDIR='A')
- ELSE
- CALL READ_SURF(HFILETYPE,'TG1',ZFIELD(:,:),IRESP,HDIR='A')
- ENDIF
- CALL CLOSE_AUX_IO_SURF(HFILE,HFILETYPE)
- !* fills the whole temperature profile by this soil temperature
- IF (YSURF=='T_ROAD') ILAYER=SIZE(XGRID_ROAD)
- IF (YSURF=='T_ROOF') ILAYER=SIZE(XGRID_ROOF)
- IF (YSURF=='T_WALL') ILAYER=SIZE(XGRID_WALL)
- IF (YSURF=='T_FLOO') ILAYER=SIZE(XGRID_FLOOR)
- IF (YSURF=='T_WIN1' .OR. YSURF=='T_CAN ' .OR. YSURF=='TI_ROA') ILAYER=1
- ALLOCATE(PFIELD(INI,ILAYER))
- IF (YSURF=='T_FLOO') THEN
- !* sets the temperature equal to this deep soil temperature
- PFIELD(:,1) = XTI_BLD_DEF
- ELSE
- PFIELD(:,1) = ZFIELD(:,1)
- ENDIF
- DO JLAYER=2,ILAYER
- PFIELD(:,JLAYER) = ZFIELD(:,1)
- END DO
- DEALLOCATE(ZFIELD)
-
- CASE('T_MASS','TI_BLD','T_WIN2')
- YSURF=HSURF(1:6)
- IF (YSURF=='T_MASS') ILAYER = SIZE(XGRID_FLOOR)
- IF (YSURF=='TI_BLD'.OR.YSURF=='T_WIN2') ILAYER=1
- ALLOCATE(PFIELD(INI, ILAYER))
- PFIELD(:,:) = XTI_BLD_DEF
-
- !* building moisture
- CASE('QI_BLD ')
- ALLOCATE(PFIELD(INI,1))
- PFIELD(:,1) = XUNDEF
-
- !* water reservoirs
- CASE('WS_ROOF','WS_ROAD')
- ALLOCATE(PFIELD(INI,1))
- IF (HSURF=='WS_ROOF') PFIELD = XWS_ROOF_DEF
- IF (HSURF=='WS_ROAD') PFIELD = XWS_ROAD_DEF
-
- !* other fields
- CASE DEFAULT
- ALLOCATE(PFIELD(INI,1))
- PFIELD = 0.
-
- END SELECT
-
- END IF
-!-------------------------------------------------------------------------------------
-END IF
-!-------------------------------------------------------------------------------------
-!
-!* 6. End of IO
-! ---------
-!
-IF (LHOOK) CALL DR_HOOK('PREP_TEB_EXTERN',1,ZHOOK_HANDLE)
-!
-!---------------------------------------------------------------------------------------
-!
-END SUBROUTINE PREP_TEB_EXTERN
+!SURFEX_LIC Copyright 1994-2014 Meteo-France
+!SURFEX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SURFEX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SURFEX_LIC for details. version 1.
+!!
+!! MODIFICATIONS
+!! -------------
+!! M.Moge 01/2016 using READ_SURF_FIELD2D/3D for 2D/3D surfex fields reads
+! #########
+SUBROUTINE PREP_TEB_EXTERN(HPROGRAM,HSURF,HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE,KLUOUT,PFIELD)
+! #################################################################################
+!
+USE MODD_TYPE_DATE_SURF
+!
+USE MODI_PREP_GRID_EXTERN
+USE MODI_READ_SURF
+USE MODI_GET_TEB_DEPTHS
+USE MODI_INTERP_GRID
+USE MODI_OPEN_AUX_IO_SURF
+USE MODI_CLOSE_AUX_IO_SURF
+USE MODI_TOWN_PRESENCE
+USE MODI_READ_TEB_PATCH
+USE MODI_GET_CURRENT_TEB_PATCH
+USE MODI_READ_SURF_FIELD2D
+!
+USE MODD_PREP, ONLY : CINGRID_TYPE, CINTERP_TYPE
+USE MODD_PREP_TEB, ONLY : XGRID_ROAD, XGRID_WALL, XGRID_ROOF, &
+ XGRID_FLOOR, XWS_ROOF, XWS_ROAD, &
+ XTI_BLD_DEF, XWS_ROOF_DEF, XWS_ROAD_DEF, XHUI_BLD_DEF
+USE MODD_DATA_COVER_PAR, ONLY : JPCOVER
+USE MODD_SURF_PAR, ONLY: XUNDEF
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+ CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
+ CHARACTER(LEN=7), INTENT(IN) :: HSURF ! type of field
+ CHARACTER(LEN=28), INTENT(IN) :: HFILE ! name of file
+ CHARACTER(LEN=6), INTENT(IN) :: HFILETYPE ! type of input file
+ CHARACTER(LEN=28), INTENT(IN) :: HFILEPGD ! name of file
+ CHARACTER(LEN=6), INTENT(IN) :: HFILEPGDTYPE ! type of input file
+INTEGER, INTENT(IN) :: KLUOUT ! logical unit of output listing
+REAL,DIMENSION(:,:), POINTER :: PFIELD ! field to interpolate horizontally
+!
+!* 0.2 declarations of local variables
+!
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZFIELD ! field read
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZDEPTH ! depth of each layer
+REAL, DIMENSION(:), ALLOCATABLE :: ZDEPTH_TOT ! total depth of surface
+!
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZD ! intermediate array
+!
+ CHARACTER(LEN=12) :: YRECFM ! Name of the article to be read
+INTEGER :: IRESP ! reading return code
+INTEGER :: ILAYER ! number of layers
+INTEGER :: JLAYER ! loop counter
+INTEGER :: IVERSION ! SURFEX version
+INTEGER :: IBUGFIX ! SURFEX bug version
+LOGICAL :: GOLD_NAME ! old name flag for temperatures
+ CHARACTER(LEN=4) :: YWALL_OPT ! option of walls
+ CHARACTER(LEN=6) :: YSURF ! Surface type
+ CHARACTER(LEN=3) :: YBEM ! key of the building energy model DEF for DEFault (Masson et al. 2002) ,
+ ! BEM for Building Energy Model (Bueno et al. 2012)
+!
+INTEGER :: INI ! total 1D dimension
+!
+LOGICAL :: GTEB ! flag if TEB fields are present
+INTEGER :: IPATCH ! number of soil temperature patches
+INTEGER :: ITEB_PATCH! number of TEB patches in file
+INTEGER :: ICURRENT_PATCH! current TEB patch to be initialized
+ CHARACTER(LEN=3) :: YPATCH ! indentificator for TEB patch
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!-------------------------------------------------------------------------------------
+!
+!* 1. Preparation of IO for reading in the file
+! -----------------------------------------
+!
+!* Note that all points are read, even those without physical meaning.
+! These points will not be used during the horizontal interpolation step.
+! Their value must be defined as XUNDEF.
+!
+IF (LHOOK) CALL DR_HOOK('PREP_TEB_EXTERN',0,ZHOOK_HANDLE)
+!
+ CALL OPEN_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE,'TOWN ')
+!
+!* reading of version of the file being read
+ CALL READ_SURF(HFILEPGDTYPE,'VERSION',IVERSION,IRESP)
+ CALL READ_SURF(HFILEPGDTYPE,'BUG',IBUGFIX,IRESP)
+GOLD_NAME=(IVERSION<7 .OR. (IVERSION==7 .AND. IBUGFIX<3))
+!
+IF (.NOT.GOLD_NAME) THEN
+ YRECFM='BEM'
+ CALL READ_SURF(HFILEPGDTYPE,YRECFM,YBEM,IRESP)
+ELSE
+ YBEM='DEF'
+ENDIF
+!-------------------------------------------------------------------------------------
+!
+!* 2. Reading of grid
+! ---------------
+!
+!* reads the grid
+ CALL PREP_GRID_EXTERN(HFILEPGDTYPE,KLUOUT,CINGRID_TYPE,CINTERP_TYPE,INI)
+!
+!
+!* reads if TEB fields exist in the input file
+ CALL TOWN_PRESENCE(HFILEPGDTYPE,GTEB)
+!
+!---------------------------------------------------------------------------------------
+!
+!* 3. Orography
+! ---------
+!
+IF (HSURF=='ZS ') THEN
+ !
+ ALLOCATE(PFIELD(INI,1))
+ YRECFM='ZS'
+ CALL READ_SURF(HFILEPGDTYPE,YRECFM,PFIELD(:,1),IRESP,HDIR='A')
+ CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
+ !
+ !---------------------------------------------------------------------------------------
+ELSE
+!---------------------------------------------------------------------------------------
+!
+!* 4. TEB fields are read
+! -------------------
+!
+ IF (GTEB) THEN
+!
+ CALL READ_TEB_PATCH(HFILEPGDTYPE,ITEB_PATCH)
+ CALL GET_CURRENT_TEB_PATCH(ICURRENT_PATCH)
+ YPATCH=' '
+ IF (ITEB_PATCH>1) THEN
+ WRITE(YPATCH,FMT='(A,I1,A)') 'T',MIN(ICURRENT_PATCH,ITEB_PATCH),'_'
+ END IF
+!---------------------------------------------------------------------------------------
+ SELECT CASE(HSURF)
+!---------------------------------------------------------------------------------------
+!
+!* 4.1 Profile of temperatures in roads, roofs or walls
+! ------------------------------------------------
+!
+ CASE('T_ROAD','T_ROOF','T_WALLA','T_WALLB','T_FLOOR','T_MASS')
+ YSURF=HSURF(1:6)
+ !* reading of number of layers
+ IF (YSURF=='T_ROAD') YRECFM='ROAD_LAYER'
+ IF (YSURF=='T_ROOF') YRECFM='ROOF_LAYER'
+ IF (YSURF=='T_WALL') YRECFM='WALL_LAYER'
+ IF (YSURF=='T_FLOO' .OR. YSURF=='T_MASS') THEN
+ IF (YBEM=='DEF') THEN
+ YRECFM='ROAD_LAYER'
+ ELSE
+ YRECFM='FLOOR_LAYER'
+ END IF
+ END IF
+ CALL READ_SURF(HFILEPGDTYPE,YRECFM,ILAYER,IRESP)
+ !
+ ALLOCATE(ZD(INI,ILAYER))
+ IF (YSURF=='T_ROAD') CALL GET_TEB_DEPTHS(HFILEPGDTYPE,PD_ROAD=ZD)
+ IF (YSURF=='T_ROOF') CALL GET_TEB_DEPTHS(HFILEPGDTYPE,PD_ROOF=ZD)
+ IF (YSURF=='T_WALL') CALL GET_TEB_DEPTHS(HFILEPGDTYPE,PD_WALL=ZD)
+ IF (YSURF=='T_MASS') CALL GET_TEB_DEPTHS(HFILEPGDTYPE,PD_FLOOR=ZD)
+ IF (YSURF=='T_FLOO') CALL GET_TEB_DEPTHS(HFILEPGDTYPE,PD_FLOOR=ZD)
+ !
+ CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
+ CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,'TOWN ')
+ !
+ !* reading option for road orientation
+ YWALL_OPT = 'UNIF'
+ IF (YSURF =='T_WALL' .AND. .NOT. GOLD_NAME) THEN
+ CALL READ_SURF(HFILETYPE,'WALL_OPT',YWALL_OPT,IRESP)
+ END IF
+ !
+ !* reading of the profile
+ ALLOCATE(ZFIELD(INI,ILAYER))
+ DO JLAYER=1,ILAYER
+ IF (GOLD_NAME) THEN
+ WRITE(YRECFM,'(A6,I1.1)') HSURF(1:6),JLAYER
+ ELSE
+ WRITE(YRECFM,'(A1,A4,I1.1)') HSURF(1:1),HSURF(3:6),JLAYER
+ IF (YSURF =='T_WALL' .AND. YWALL_OPT/='UNIF') &
+ WRITE(YRECFM,'(A1,A5,I1.1)') HSURF(1:1),HSURF(3:7),JLAYER
+ IF ((HSURF=='T_FLOOR' .OR. HSURF=='T_MASS') .AND. YBEM=='DEF') THEN
+ IF (HSURF=='T_FLOOR' .AND. JLAYER>1) THEN
+ WRITE(YRECFM,'(A5,I1.1)') 'TROAD',JLAYER
+ ELSE
+ WRITE(YRECFM,'(A6)') 'TI_BLD'
+ ENDIF
+ END IF
+ END IF
+ YRECFM=YPATCH//YRECFM
+ YRECFM=ADJUSTL(YRECFM)
+ CALL READ_SURF(HFILETYPE,YRECFM,ZFIELD(:,JLAYER),IRESP,HDIR='A')
+ END DO
+ CALL CLOSE_AUX_IO_SURF(HFILE,HFILETYPE)
+ !
+ !* recovers middle layer depth (from the surface)
+ ALLOCATE(ZDEPTH (INI,ILAYER))
+ ALLOCATE(ZDEPTH_TOT(INI))
+ ZDEPTH (:,1)=ZD(:,1)/2.
+ ZDEPTH_TOT(:) =ZD(:,1)
+ DO JLAYER=2,ILAYER
+ ZDEPTH (:,JLAYER) = ZDEPTH_TOT(:) + ZD(:,JLAYER)/2.
+ ZDEPTH_TOT(:) = ZDEPTH_TOT(:) + ZD(:,JLAYER)
+ END DO
+ !
+ !* in case of wall or roof, normalizes by total wall or roof thickness
+ IF (YSURF=='T_ROOF' .OR. YSURF=='T_WALL' .OR. HSURF == 'T_FLOOR' .OR. HSURF == 'T_MASS') THEN
+ DO JLAYER=1,ILAYER
+ ZDEPTH(:,JLAYER) = ZDEPTH(:,JLAYER) / ZDEPTH_TOT(:)
+ END DO
+ END IF
+ !
+ !* interpolation on the fine vertical grid
+ IF (YSURF=='T_ROAD') THEN
+ ALLOCATE(PFIELD(SIZE(ZFIELD,1),SIZE(XGRID_ROAD)))
+ CALL INTERP_GRID(ZDEPTH,ZFIELD,XGRID_ROAD,PFIELD)
+ ELSEIF (YSURF=='T_ROOF') THEN
+ ALLOCATE(PFIELD(SIZE(ZFIELD,1),SIZE(XGRID_ROOF)))
+ CALL INTERP_GRID(ZDEPTH,ZFIELD,XGRID_ROOF,PFIELD)
+ ELSEIF (YSURF=='T_WALL') THEN
+ ALLOCATE(PFIELD(SIZE(ZFIELD,1),SIZE(XGRID_WALL)))
+ CALL INTERP_GRID(ZDEPTH,ZFIELD,XGRID_WALL,PFIELD)
+ ELSEIF (YSURF=='T_FLOO' .OR. YSURF=='T_MASS') THEN
+ ALLOCATE(PFIELD(SIZE(ZFIELD,1),SIZE(XGRID_FLOOR)))
+ CALL INTERP_GRID(ZDEPTH,ZFIELD,XGRID_FLOOR,PFIELD)
+ END IF
+ !
+ !* end
+ DEALLOCATE(ZD)
+ DEALLOCATE(ZFIELD)
+ DEALLOCATE(ZDEPTH)
+ DEALLOCATE(ZDEPTH_TOT)
+!---------------------------------------------------------------------------------------
+!
+!* 4.2 Internal moisture
+! ---------------
+!
+ CASE('QI_BLD ')
+ ALLOCATE(PFIELD(INI,1))
+ IF (YBEM=='BEM') THEN
+ YRECFM='QI_BLD'
+ YRECFM=YPATCH//YRECFM
+ YRECFM=ADJUSTL(YRECFM)
+ CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
+ CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,'TOWN ')
+ CALL READ_SURF(HFILETYPE,YRECFM,PFIELD(:,1),IRESP,HDIR='A')
+ CALL CLOSE_AUX_IO_SURF(HFILE,HFILETYPE)
+ ELSE
+ PFIELD(:,1) = XUNDEF
+ ENDIF
+!
+!---------------------------------------------------------------------------------------
+!
+!* 4.2 Other variables
+! ---------------
+!
+ CASE DEFAULT
+ ALLOCATE(PFIELD(INI,1))
+ YRECFM=HSURF
+ IF (HSURF=='T_CAN ') THEN
+ YRECFM='TCANYON'
+ IF (GOLD_NAME) YRECFM='T_CANYON'
+ ELSEIF (HSURF=='Q_CAN ') THEN
+ YRECFM='QCANYON'
+ IF (GOLD_NAME) YRECFM='Q_CANYON'
+ ELSEIF (HSURF=='T_WIN2 ' .OR. HSURF=='T_WIN1') THEN
+ IF (YBEM=='BEM') THEN
+ YRECFM=HSURF
+ ELSE
+ YRECFM='TI_BLD'
+ ENDIF
+ ENDIF
+ YRECFM=YPATCH//YRECFM
+ YRECFM=ADJUSTL(YRECFM)
+ CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
+ CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,'TOWN ')
+ CALL READ_SURF(HFILETYPE,YRECFM,PFIELD(:,1),IRESP,HDIR='A')
+ CALL CLOSE_AUX_IO_SURF(HFILE,HFILETYPE)
+!
+!---------------------------------------------------------------------------------------
+ END SELECT
+!---------------------------------------------------------------------------------------
+!
+!* 5. Subtitutes if TEB fields do not exist
+! -------------------------------------
+!
+ ELSE
+
+ CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
+
+ SELECT CASE(HSURF)
+
+ !* temperature profiles
+ CASE('T_ROAD','T_ROOF','T_WALL','T_WIN1','T_FLOOR','T_CAN','TI_ROAD')
+ YSURF=HSURF(1:6)
+ !* reading of the soil surface temperature
+ CALL OPEN_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE,'NATURE')
+ CALL READ_SURF(HFILEPGDTYPE,'PATCH_NUMBER',IPATCH,IRESP)
+ CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
+ ALLOCATE(ZFIELD(INI,IPATCH))
+ CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,'NATURE')
+ IF (YSURF=='T_FLOO' .OR. YSURF=='T_CAN ' .OR. YSURF=='TI_ROA') THEN
+ YRECFM='TG2'
+ CALL READ_SURF_FIELD2D(HFILETYPE,ZFIELD(:,:),YRECFM,HDIR='A')
+ ELSE
+ YRECFM='TG1'
+ CALL READ_SURF_FIELD2D(HFILETYPE,ZFIELD(:,:),YRECFM,HDIR='A')
+ ENDIF
+ CALL CLOSE_AUX_IO_SURF(HFILE,HFILETYPE)
+ !* fills the whole temperature profile by this soil temperature
+ IF (YSURF=='T_ROAD') ILAYER=SIZE(XGRID_ROAD)
+ IF (YSURF=='T_ROOF') ILAYER=SIZE(XGRID_ROOF)
+ IF (YSURF=='T_WALL') ILAYER=SIZE(XGRID_WALL)
+ IF (YSURF=='T_FLOO') ILAYER=SIZE(XGRID_FLOOR)
+ IF (YSURF=='T_WIN1' .OR. YSURF=='T_CAN ' .OR. YSURF=='TI_ROA') ILAYER=1
+ ALLOCATE(PFIELD(INI,ILAYER))
+ IF (YSURF=='T_FLOO') THEN
+ !* sets the temperature equal to this deep soil temperature
+ PFIELD(:,1) = XTI_BLD_DEF
+ ELSE
+ PFIELD(:,1) = ZFIELD(:,1)
+ ENDIF
+ DO JLAYER=2,ILAYER
+ PFIELD(:,JLAYER) = ZFIELD(:,1)
+ END DO
+ DEALLOCATE(ZFIELD)
+
+ CASE('T_MASS','TI_BLD','T_WIN2')
+ YSURF=HSURF(1:6)
+ IF (YSURF=='T_MASS') ILAYER = SIZE(XGRID_FLOOR)
+ IF (YSURF=='TI_BLD'.OR.YSURF=='T_WIN2') ILAYER=1
+ ALLOCATE(PFIELD(INI, ILAYER))
+ PFIELD(:,:) = XTI_BLD_DEF
+
+ !* building moisture
+ CASE('QI_BLD ')
+ ALLOCATE(PFIELD(INI,1))
+ PFIELD(:,1) = XUNDEF
+
+ !* water reservoirs
+ CASE('WS_ROOF','WS_ROAD')
+ ALLOCATE(PFIELD(INI,1))
+ IF (HSURF=='WS_ROOF') PFIELD = XWS_ROOF_DEF
+ IF (HSURF=='WS_ROAD') PFIELD = XWS_ROAD_DEF
+
+ !* other fields
+ CASE DEFAULT
+ ALLOCATE(PFIELD(INI,1))
+ PFIELD = 0.
+
+ END SELECT
+
+ END IF
+!-------------------------------------------------------------------------------------
+END IF
+!-------------------------------------------------------------------------------------
+!
+!* 6. End of IO
+! ---------
+!
+IF (LHOOK) CALL DR_HOOK('PREP_TEB_EXTERN',1,ZHOOK_HANDLE)
+!
+!---------------------------------------------------------------------------------------
+!
+END SUBROUTINE PREP_TEB_EXTERN
diff --git a/src/SURFEX/prep_teb_garden_extern.F90 b/src/SURFEX/prep_teb_garden_extern.F90
index 772ce5728..3b1bc61b8 100644
--- a/src/SURFEX/prep_teb_garden_extern.F90
+++ b/src/SURFEX/prep_teb_garden_extern.F90
@@ -1,243 +1,237 @@
-!SURFEX_LIC Copyright 1994-2014 Meteo-France
-!SURFEX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SURFEX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SURFEX_LIC for details. version 1.
-! #########
-SUBROUTINE PREP_TEB_GARDEN_EXTERN(HPROGRAM,HSURF,HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE,KLUOUT,PFIELD)
-! #################################################################################
-!
-!!**** *PREP_TEB_GARDEN_EXTERN* - initializes ISBA fields from operational GRIB
-!!
-!! PURPOSE
-!! -------
-!
-!!** METHOD
-!! ------
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! V. Masson
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 01/2004
-!! M. Moge 09/2015 reading SURFEX fields as 1D fields for each patch for Z-parallel IO with Meso-NH
-!!------------------------------------------------------------------
-!
-
-!
-USE MODE_READ_EXTERN
-!
-USE MODD_TYPE_DATE_SURF
-!
-USE MODI_PREP_GRID_EXTERN
-USE MODI_READ_SURF
-USE MODI_INTERP_GRID
-USE MODI_OPEN_AUX_IO_SURF
-USE MODI_CLOSE_AUX_IO_SURF
-USE MODI_READ_TEB_PATCH
-USE MODI_GET_CURRENT_TEB_PATCH
-USE MODI_TOWN_PRESENCE
-!
-USE MODD_PREP, ONLY : CINGRID_TYPE, CINTERP_TYPE
-USE MODD_PREP_TEB_GARDEN,ONLY : XGRID_SOIL, XWR_DEF
-USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE
-USE MODD_SURF_PAR, ONLY : XUNDEF
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-USE MODI_PUT_ON_ALL_VEGTYPES
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
- CHARACTER(LEN=7), INTENT(IN) :: HSURF ! type of field
- CHARACTER(LEN=28), INTENT(IN) :: HFILE ! name of file
- CHARACTER(LEN=6), INTENT(IN) :: HFILETYPE ! type of input file
- CHARACTER(LEN=28), INTENT(IN) :: HFILEPGD ! name of file
- CHARACTER(LEN=6), INTENT(IN) :: HFILEPGDTYPE ! type of input file
-INTEGER, INTENT(IN) :: KLUOUT ! logical unit of output listing
-REAL,DIMENSION(:,:,:), POINTER :: PFIELD ! field to interpolate horizontally (on final soil grid)
-!
-!* 0.2 declarations of local variables
-!
- CHARACTER(LEN=12) :: YRECFM ! Name of the article to be read
-INTEGER :: IRESP ! reading return code
-INTEGER :: INI ! total 1D dimension
-INTEGER :: IPATCH ! number of patch
-!
-REAL, DIMENSION(:,:,:), POINTER :: ZFIELD ! field read on initial MNH vertical soil grid, all patches
-REAL, DIMENSION(:,:), POINTER :: ZFIELD1 ! field read on initial MNH vertical soil grid, one patch
-REAL, DIMENSION(:,:,:), POINTER :: ZD ! depth of field in the soil
-REAL, DIMENSION(:,:), POINTER :: ZD1 ! depth of field in the soil, one patch
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZOUT !
-INTEGER :: JPATCH ! loop counter for patch
-INTEGER :: ITEB_PATCH ! number of TEB patches in file
-INTEGER :: ICURRENT_PATCH ! current TEB patch to be initialized
-INTEGER :: IVERSION ! SURFEX version
-INTEGER :: IBUGFIX ! SURFEX bug version
-LOGICAL :: GOLD_NAME ! old name flag for temperatures
- CHARACTER(LEN=12) :: YSURF ! type of field
- CHARACTER(LEN=3) :: YPATCH ! indentificator for TEB patch
- CHARACTER(LEN=4) :: YPATCH2 ! number of the patch
-LOGICAL :: GTEB ! flag if TEB fields are present
-LOGICAL :: GGARDEN ! T if gardens are present in the file
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-!------------------------------------------------------------------------------
-!
-!* 1. Preparation of IO for reading in the file
-! -----------------------------------------
-!
-!* Note that all points are read, even those without physical meaning.
-! These points will not be used during the horizontal interpolation step.
-! Their value must be defined as XUNDEF.
-!
-IF (LHOOK) CALL DR_HOOK('PREP_TEB_GARDEN_EXTERN',0,ZHOOK_HANDLE)
-!
-!------------------------------------------------------------------------------
-!
-!* 2. Reading of grid
-! ---------------
-!
- CALL OPEN_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE,'TOWN ')
-!
-!* reading of version of the file being read
- CALL READ_SURF(HFILEPGDTYPE,'VERSION',IVERSION,IRESP)
- CALL READ_SURF(HFILEPGDTYPE,'BUG',IBUGFIX,IRESP)
-GOLD_NAME=(IVERSION<7 .OR. (IVERSION==7 .AND. IBUGFIX<3))
-!
- CALL PREP_GRID_EXTERN(HFILEPGDTYPE,KLUOUT,CINGRID_TYPE,CINTERP_TYPE,INI)
-!
-!* reads if TEB fields exist in the input file
- CALL TOWN_PRESENCE(HFILEPGDTYPE,GTEB)
-!
-IF (GTEB) THEN
- CALL READ_TEB_PATCH(HFILEPGDTYPE,ITEB_PATCH)
- CALL GET_CURRENT_TEB_PATCH(ICURRENT_PATCH)
- YPATCH=' '
- IF (ITEB_PATCH>1) THEN
- WRITE(YPATCH,FMT='(A,I1,A)') 'T',MIN(ICURRENT_PATCH,ITEB_PATCH),'_'
- END IF
-END IF
-!
-!---------------------------------------------------------------------------------------
-!
-!* 3. Transformation into physical quantity to be interpolated
-! --------------------------------------------------------
-!
-SELECT CASE(HSURF)
-!
-!* 3. Orography
-! ---------
-!
- CASE('ZS ')
- ALLOCATE(PFIELD(INI,1,1))
- YRECFM='ZS'
- CALL READ_SURF(HFILEPGDTYPE,YRECFM,PFIELD(:,1,1),IRESP,HDIR='A')
- CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
-!
-!--------------------------------------------------------------------------
-!
-!
-!* 3.1 Profile of temperature, water or ice in the soil
-!
- CASE('TG ','WG ','WGI ')
-!* choice if one reads garden fields (if present) or ISBA fields
- GGARDEN = .FALSE.
- IF (GTEB) CALL READ_SURF(HFILEPGDTYPE,'GARDEN',GGARDEN,IRESP)
- CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
- IF (GGARDEN) THEN
- YSURF = 'GD_'//HSURF(1:3)
- IF (GOLD_NAME) YSURF = 'TWN_'//HSURF(1:3)
- YSURF = YPATCH//YSURF
- ELSE
- YSURF = HSURF
- END IF
- YSURF=ADJUSTL(YSURF)
-!* reading of the profile and its depth definition
- CALL READ_EXTERN_ISBA(HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE,KLUOUT,INI,&
- HSURF,YSURF,ZFIELD,ZD)
-!
- ALLOCATE(ZFIELD1(SIZE(ZFIELD,1),SIZE(ZFIELD,2)))
- ALLOCATE(ZD1(SIZE(ZFIELD,1),SIZE(ZFIELD,2)))
- ALLOCATE(ZOUT(SIZE(ZFIELD,1),SIZE(XGRID_SOIL)))
- ALLOCATE(PFIELD(SIZE(ZFIELD,1),SIZE(XGRID_SOIL),SIZE(ZFIELD,3)))
-!
- DO JPATCH=1,SIZE(ZFIELD,3)
- ZFIELD1(:,:)=ZFIELD(:,:,JPATCH)
- ZD1(:,:)=ZD(:,:,JPATCH)
- CALL INTERP_GRID(ZD1,ZFIELD1,XGRID_SOIL,ZOUT)
- PFIELD(:,:,JPATCH)=ZOUT(:,:)
- END DO
-!
- DEALLOCATE(ZFIELD)
- DEALLOCATE(ZOUT)
- DEALLOCATE(ZFIELD1)
- DEALLOCATE(ZD)
-!
-!--------------------------------------------------------------------------
-!
-!* 3.4 Water content intercepted on leaves, LAI
-!
- CASE('WR ')
- ALLOCATE(PFIELD(INI,1,NVEGTYPE))
- !* choice if one reads garden fields (if present) or ISBA fields
- GGARDEN = .FALSE.
- IF (GTEB) CALL READ_SURF(HFILEPGDTYPE,'GARDEN',GGARDEN,IRESP)
- CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
- IF (GGARDEN) THEN
- IPATCH = 1
- YRECFM = 'GD_WR'
- IF (GOLD_NAME) YRECFM = 'TWN_WR'
- YRECFM = YPATCH//YRECFM
- CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,'TOWN ')
- ELSE
- YRECFM = 'PATCH_NUMBER'
- CALL OPEN_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE,'NATURE')
- CALL READ_SURF(HFILEPGDTYPE,YRECFM,IPATCH,IRESP)
- CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
- CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,'NATURE')
- YRECFM = 'WR'
- END IF
- YRECFM=ADJUSTL(YRECFM)
-
- ALLOCATE(ZFIELD(INI,1,IPATCH))
-#ifdef MNH_PARALLEL
- DO JPATCH=1,IPATCH
- WRITE(YPATCH2,'(I4.4)') JPATCH
- YRECFM=ADJUSTL(YRECFM)//YPATCH2
- CALL READ_SURF(HFILETYPE,YRECFM,ZFIELD(:,1,JPATCH),IRESP,HDIR='A')
- END DO
-#else
- CALL READ_SURF(HFILETYPE,YRECFM,ZFIELD(:,1,:),IRESP,HDIR='A')
-#endif
- CALL CLOSE_AUX_IO_SURF(HFILE,HFILETYPE)
- CALL PUT_ON_ALL_VEGTYPES(INI,1,1,NVEGTYPE,ZFIELD,PFIELD)
- DEALLOCATE(ZFIELD)
-!
- CASE('LAI ')
- CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
- ALLOCATE(PFIELD(INI,1,NVEGTYPE))
- PFIELD(:,:,:) = XUNDEF
-!
-END SELECT
-!
-!
-!---------------------------------------------------------------------------
-!
-!* 6. End of IO
-! ---------
-!
-IF (LHOOK) CALL DR_HOOK('PREP_TEB_GARDEN_EXTERN',1,ZHOOK_HANDLE)
-!
-!---------------------------------------------------------------------------
-!---------------------------------------------------------------------------
-END SUBROUTINE PREP_TEB_GARDEN_EXTERN
+!SURFEX_LIC Copyright 1994-2014 Meteo-France
+!SURFEX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SURFEX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SURFEX_LIC for details. version 1.
+! #########
+SUBROUTINE PREP_TEB_GARDEN_EXTERN(HPROGRAM,HSURF,HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE,KLUOUT,PFIELD)
+! #################################################################################
+!
+!!**** *PREP_TEB_GARDEN_EXTERN* - initializes ISBA fields from operational GRIB
+!!
+!! PURPOSE
+!! -------
+!
+!!** METHOD
+!! ------
+!!
+!! REFERENCE
+!! ---------
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Masson
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 01/2004
+!! M.Moge 01/2016 using READ_SURF_FIELD2D/3D for 2D/3D surfex fields reads
+!!------------------------------------------------------------------
+!
+
+!
+USE MODE_READ_EXTERN
+!
+USE MODD_TYPE_DATE_SURF
+!
+USE MODI_PREP_GRID_EXTERN
+USE MODI_READ_SURF
+USE MODI_INTERP_GRID
+USE MODI_OPEN_AUX_IO_SURF
+USE MODI_CLOSE_AUX_IO_SURF
+USE MODI_READ_TEB_PATCH
+USE MODI_GET_CURRENT_TEB_PATCH
+USE MODI_TOWN_PRESENCE
+!
+USE MODD_PREP, ONLY : CINGRID_TYPE, CINTERP_TYPE
+USE MODD_PREP_TEB_GARDEN,ONLY : XGRID_SOIL, XWR_DEF
+USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE
+USE MODD_SURF_PAR, ONLY : XUNDEF
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+USE MODI_PUT_ON_ALL_VEGTYPES
+!
+USE MODI_READ_SURF_FIELD2D
+!
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+ CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
+ CHARACTER(LEN=7), INTENT(IN) :: HSURF ! type of field
+ CHARACTER(LEN=28), INTENT(IN) :: HFILE ! name of file
+ CHARACTER(LEN=6), INTENT(IN) :: HFILETYPE ! type of input file
+ CHARACTER(LEN=28), INTENT(IN) :: HFILEPGD ! name of file
+ CHARACTER(LEN=6), INTENT(IN) :: HFILEPGDTYPE ! type of input file
+INTEGER, INTENT(IN) :: KLUOUT ! logical unit of output listing
+REAL,DIMENSION(:,:,:), POINTER :: PFIELD ! field to interpolate horizontally (on final soil grid)
+!
+!* 0.2 declarations of local variables
+!
+ CHARACTER(LEN=12) :: YRECFM ! Name of the article to be read
+INTEGER :: IRESP ! reading return code
+INTEGER :: INI ! total 1D dimension
+INTEGER :: IPATCH ! number of patch
+!
+REAL, DIMENSION(:,:,:), POINTER :: ZFIELD ! field read on initial MNH vertical soil grid, all patches
+REAL, DIMENSION(:,:), POINTER :: ZFIELD1 ! field read on initial MNH vertical soil grid, one patch
+REAL, DIMENSION(:,:,:), POINTER :: ZD ! depth of field in the soil
+REAL, DIMENSION(:,:), POINTER :: ZD1 ! depth of field in the soil, one patch
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZOUT !
+INTEGER :: JPATCH ! loop counter for patch
+INTEGER :: ITEB_PATCH ! number of TEB patches in file
+INTEGER :: ICURRENT_PATCH ! current TEB patch to be initialized
+INTEGER :: IVERSION ! SURFEX version
+INTEGER :: IBUGFIX ! SURFEX bug version
+LOGICAL :: GOLD_NAME ! old name flag for temperatures
+ CHARACTER(LEN=12) :: YSURF ! type of field
+ CHARACTER(LEN=3) :: YPATCH ! indentificator for TEB patch
+ CHARACTER(LEN=4) :: YPATCH2 ! number of the patch
+LOGICAL :: GTEB ! flag if TEB fields are present
+LOGICAL :: GGARDEN ! T if gardens are present in the file
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+!------------------------------------------------------------------------------
+!
+!* 1. Preparation of IO for reading in the file
+! -----------------------------------------
+!
+!* Note that all points are read, even those without physical meaning.
+! These points will not be used during the horizontal interpolation step.
+! Their value must be defined as XUNDEF.
+!
+IF (LHOOK) CALL DR_HOOK('PREP_TEB_GARDEN_EXTERN',0,ZHOOK_HANDLE)
+!
+!------------------------------------------------------------------------------
+!
+!* 2. Reading of grid
+! ---------------
+!
+ CALL OPEN_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE,'TOWN ')
+!
+!* reading of version of the file being read
+ CALL READ_SURF(HFILEPGDTYPE,'VERSION',IVERSION,IRESP)
+ CALL READ_SURF(HFILEPGDTYPE,'BUG',IBUGFIX,IRESP)
+GOLD_NAME=(IVERSION<7 .OR. (IVERSION==7 .AND. IBUGFIX<3))
+!
+ CALL PREP_GRID_EXTERN(HFILEPGDTYPE,KLUOUT,CINGRID_TYPE,CINTERP_TYPE,INI)
+!
+!* reads if TEB fields exist in the input file
+ CALL TOWN_PRESENCE(HFILEPGDTYPE,GTEB)
+!
+IF (GTEB) THEN
+ CALL READ_TEB_PATCH(HFILEPGDTYPE,ITEB_PATCH)
+ CALL GET_CURRENT_TEB_PATCH(ICURRENT_PATCH)
+ YPATCH=' '
+ IF (ITEB_PATCH>1) THEN
+ WRITE(YPATCH,FMT='(A,I1,A)') 'T',MIN(ICURRENT_PATCH,ITEB_PATCH),'_'
+ END IF
+END IF
+!
+!---------------------------------------------------------------------------------------
+!
+!* 3. Transformation into physical quantity to be interpolated
+! --------------------------------------------------------
+!
+SELECT CASE(HSURF)
+!
+!* 3. Orography
+! ---------
+!
+ CASE('ZS ')
+ ALLOCATE(PFIELD(INI,1,1))
+ YRECFM='ZS'
+ CALL READ_SURF(HFILEPGDTYPE,YRECFM,PFIELD(:,1,1),IRESP,HDIR='A')
+ CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
+!
+!--------------------------------------------------------------------------
+!
+!
+!* 3.1 Profile of temperature, water or ice in the soil
+!
+ CASE('TG ','WG ','WGI ')
+!* choice if one reads garden fields (if present) or ISBA fields
+ GGARDEN = .FALSE.
+ IF (GTEB) CALL READ_SURF(HFILEPGDTYPE,'GARDEN',GGARDEN,IRESP)
+ CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
+ IF (GGARDEN) THEN
+ YSURF = 'GD_'//HSURF(1:3)
+ IF (GOLD_NAME) YSURF = 'TWN_'//HSURF(1:3)
+ YSURF = YPATCH//YSURF
+ ELSE
+ YSURF = HSURF
+ END IF
+ YSURF=ADJUSTL(YSURF)
+!* reading of the profile and its depth definition
+ CALL READ_EXTERN_ISBA(HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE,KLUOUT,INI,&
+ HSURF,YSURF,ZFIELD,ZD)
+!
+ ALLOCATE(ZFIELD1(SIZE(ZFIELD,1),SIZE(ZFIELD,2)))
+ ALLOCATE(ZD1(SIZE(ZFIELD,1),SIZE(ZFIELD,2)))
+ ALLOCATE(ZOUT(SIZE(ZFIELD,1),SIZE(XGRID_SOIL)))
+ ALLOCATE(PFIELD(SIZE(ZFIELD,1),SIZE(XGRID_SOIL),SIZE(ZFIELD,3)))
+!
+ DO JPATCH=1,SIZE(ZFIELD,3)
+ ZFIELD1(:,:)=ZFIELD(:,:,JPATCH)
+ ZD1(:,:)=ZD(:,:,JPATCH)
+ CALL INTERP_GRID(ZD1,ZFIELD1,XGRID_SOIL,ZOUT)
+ PFIELD(:,:,JPATCH)=ZOUT(:,:)
+ END DO
+!
+ DEALLOCATE(ZFIELD)
+ DEALLOCATE(ZOUT)
+ DEALLOCATE(ZFIELD1)
+ DEALLOCATE(ZD)
+!
+!--------------------------------------------------------------------------
+!
+!* 3.4 Water content intercepted on leaves, LAI
+!
+ CASE('WR ')
+ ALLOCATE(PFIELD(INI,1,NVEGTYPE))
+ !* choice if one reads garden fields (if present) or ISBA fields
+ GGARDEN = .FALSE.
+ IF (GTEB) CALL READ_SURF(HFILEPGDTYPE,'GARDEN',GGARDEN,IRESP)
+ CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
+ IF (GGARDEN) THEN
+ IPATCH = 1
+ YRECFM = 'GD_WR'
+ IF (GOLD_NAME) YRECFM = 'TWN_WR'
+ YRECFM = YPATCH//YRECFM
+ CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,'TOWN ')
+ ELSE
+ YRECFM = 'PATCH_NUMBER'
+ CALL OPEN_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE,'NATURE')
+ CALL READ_SURF(HFILEPGDTYPE,YRECFM,IPATCH,IRESP)
+ CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
+ CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,'NATURE')
+ YRECFM = 'WR'
+ END IF
+ YRECFM=ADJUSTL(YRECFM)
+
+ ALLOCATE(ZFIELD(INI,1,IPATCH))
+ CALL READ_SURF_FIELD2D(HFILETYPE,ZFIELD(:,1,:),YRECFM,HDIR='A')
+ CALL CLOSE_AUX_IO_SURF(HFILE,HFILETYPE)
+ CALL PUT_ON_ALL_VEGTYPES(INI,1,1,NVEGTYPE,ZFIELD,PFIELD)
+ DEALLOCATE(ZFIELD)
+!
+ CASE('LAI ')
+ CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
+ ALLOCATE(PFIELD(INI,1,NVEGTYPE))
+ PFIELD(:,:,:) = XUNDEF
+!
+END SELECT
+!
+!
+!---------------------------------------------------------------------------
+!
+!* 6. End of IO
+! ---------
+!
+IF (LHOOK) CALL DR_HOOK('PREP_TEB_GARDEN_EXTERN',1,ZHOOK_HANDLE)
+!
+!---------------------------------------------------------------------------
+!---------------------------------------------------------------------------
+END SUBROUTINE PREP_TEB_GARDEN_EXTERN
diff --git a/src/SURFEX/prep_teb_greenroof_extern.F90 b/src/SURFEX/prep_teb_greenroof_extern.F90
index 12677620e..54420b61b 100644
--- a/src/SURFEX/prep_teb_greenroof_extern.F90
+++ b/src/SURFEX/prep_teb_greenroof_extern.F90
@@ -1,242 +1,236 @@
-!SURFEX_LIC Copyright 1994-2014 Meteo-France
-!SURFEX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SURFEX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SURFEX_LIC for details. version 1.
-! #########
-SUBROUTINE PREP_TEB_GREENROOF_EXTERN(HPROGRAM,HSURF,HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE,KLUOUT,PFIELD)
-! #################################################################################
-!
-!!**** *PREP_TEB_GREENROOF_EXTERN* - initializes ISBA fields from operational GRIB
-!!
-!! PURPOSE
-!! -------
-!
-!!** METHOD
-!! ------
-!! Based on "prep_teb_garden_extern"
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! A. Lemonsu & C. de Munck
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 07/2011
-!! M. Moge 09/2015 reading SURFEX fields as 1D fields for each patch for Z-parallel IO with Meso-NH
-!!------------------------------------------------------------------
-!
-
-!
-USE MODE_READ_EXTERN
-!
-USE MODD_TYPE_DATE_SURF
-!
-USE MODI_PREP_GRID_EXTERN
-USE MODI_READ_SURF
-USE MODI_INTERP_GRID
-USE MODI_OPEN_AUX_IO_SURF
-USE MODI_CLOSE_AUX_IO_SURF
-USE MODI_READ_TEB_PATCH
-USE MODI_GET_CURRENT_TEB_PATCH
-USE MODI_TOWN_PRESENCE
-!
-USE MODD_PREP, ONLY : CINGRID_TYPE, CINTERP_TYPE
-USE MODD_PREP_TEB_GREENROOF, ONLY : XGRID_SOIL, XWR_DEF
-USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE
-USE MODD_SURF_PAR, ONLY : XUNDEF
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-USE MODI_PUT_ON_ALL_VEGTYPES
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
- CHARACTER(LEN=7), INTENT(IN) :: HSURF ! type of field
- CHARACTER(LEN=28), INTENT(IN) :: HFILE ! name of file
- CHARACTER(LEN=6), INTENT(IN) :: HFILETYPE ! type of input file
- CHARACTER(LEN=28), INTENT(IN) :: HFILEPGD ! name of file
- CHARACTER(LEN=6), INTENT(IN) :: HFILEPGDTYPE ! type of input file
-INTEGER, INTENT(IN) :: KLUOUT ! logical unit of output listing
-REAL,DIMENSION(:,:,:), POINTER :: PFIELD ! field to interpolate horizontally (on final soil grid)
-!
-!* 0.2 declarations of local variables
-!
- CHARACTER(LEN=12) :: YRECFM ! Name of the article to be read
-INTEGER :: IRESP ! reading return code
-INTEGER :: INI ! total 1D dimension
-INTEGER :: IPATCH ! number of patch
-!
-REAL, DIMENSION(:,:,:), POINTER :: ZFIELD ! field read on initial MNH vertical soil grid, all patches
-REAL, DIMENSION(:,:), POINTER :: ZFIELD1 ! field read on initial MNH vertical soil grid, one patch
-REAL, DIMENSION(:,:,:), POINTER :: ZD ! depth of field in the soil
-REAL, DIMENSION(:,:), POINTER :: ZD1 ! depth of field in the soil, one patch
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZOUT !
-LOGICAL :: GTEB ! flag if TEB fields are present
-INTEGER :: JPATCH ! loop counter for patch
- CHARACTER(LEN=12) :: YSURF ! type of field
-INTEGER :: ITEB_PATCH ! number of TEB patches in file
-INTEGER :: ICURRENT_PATCH ! current TEB patch to be initialized
-INTEGER :: IVERSION ! SURFEX version
-INTEGER :: IBUGFIX ! SURFEX bug version
-LOGICAL :: GOLD_NAME ! old name flag for temperatures
- CHARACTER(LEN=3) :: YPATCH ! indentificator for TEB patch
- CHARACTER(LEN=4) :: YPATCH2 ! number of the patch
-LOGICAL :: GGREENROOF ! T if gardens are present in the file
-!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-!------------------------------------------------------------------------------
-!
-!* 1. Preparation of IO for reading in the file
-! -----------------------------------------
-!
-!* Note that all points are read, even those without physical meaning.
-! These points will not be used during the horizontal interpolation step.
-! Their value must be defined as XUNDEF.
-!
-IF (LHOOK) CALL DR_HOOK('PREP_TEB_GREENROOF_EXTERN',0,ZHOOK_HANDLE)
- CALL OPEN_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE,'TOWN ')
-!
-!* reading of version of the file being read
- CALL READ_SURF(HFILEPGDTYPE,'VERSION',IVERSION,IRESP)
- CALL READ_SURF(HFILEPGDTYPE,'BUG',IBUGFIX,IRESP)
-GOLD_NAME=(IVERSION<7 .OR. (IVERSION==7 .AND. IBUGFIX<3))
-!
-!------------------------------------------------------------------------------
-!
-!* 2. Reading of grid
-! ---------------
-!
- CALL PREP_GRID_EXTERN(HFILEPGDTYPE,KLUOUT,CINGRID_TYPE,CINTERP_TYPE,INI)
-!
-!* reads if TEB fields exist in the input file
- CALL TOWN_PRESENCE(HFILEPGDTYPE,GTEB)
-!
-IF (GTEB) THEN
- CALL READ_TEB_PATCH(HFILEPGDTYPE,ITEB_PATCH)
- CALL GET_CURRENT_TEB_PATCH(ICURRENT_PATCH)
- YPATCH=' '
- IF (ITEB_PATCH>1) THEN
- WRITE(YPATCH,FMT='(A,I1,A)') 'T',MIN(ICURRENT_PATCH,ITEB_PATCH),'_'
- END IF
-END IF
-!
-! A FAIRE : VERIFIER QUE LES MODIFS DES PATCH/GTEB/GGREENROOF SONT CORRECTES
-!---------------------------------------------------------------------------------------
-!
-!* 3. Transformation into physical quantity to be interpolated
-! --------------------------------------------------------
-!
-SELECT CASE(HSURF)
-!
-!* 3. Orography
-! ---------
-!
- CASE('ZS ')
- ALLOCATE(PFIELD(INI,1,1))
- YRECFM='ZS'
- CALL READ_SURF(HFILEPGDTYPE,YRECFM,PFIELD(:,1,1),IRESP,HDIR='A')
- CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
-!
-!--------------------------------------------------------------------------
-!
-!
-!* 3.1 Profile of temperature, water or ice in the soil
-!
- CASE('TG ','WG ','WGI ')
-!* choice if one reads garden fields (if present) or ISBA fields
- GGREENROOF = .FALSE.
- IF (GTEB) CALL READ_SURF(HFILEPGDTYPE,'LGREENROOF',GGREENROOF,IRESP)
- CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
- IF (GGREENROOF) THEN
- YSURF = 'GR_'//HSURF(1:3)
- YSURF=YPATCH//YSURF
- ELSE
- YSURF = HSURF
- END IF
- YSURF=ADJUSTL(YSURF)
-!* reading of the profile and its depth definition
- CALL READ_EXTERN_ISBA(HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE,KLUOUT,INI,&
- HSURF,YSURF,ZFIELD,ZD)
-!
- ALLOCATE(ZFIELD1(SIZE(ZFIELD,1),SIZE(ZFIELD,2)))
- ALLOCATE(ZD1(SIZE(ZFIELD,1),SIZE(ZFIELD,2)))
- ALLOCATE(ZOUT(SIZE(ZFIELD,1),SIZE(XGRID_SOIL)))
- ALLOCATE(PFIELD(SIZE(ZFIELD,1),SIZE(XGRID_SOIL),SIZE(ZFIELD,3)))
-!
- DO JPATCH=1,SIZE(ZFIELD,3)
- ZFIELD1(:,:)=ZFIELD(:,:,JPATCH)
- ZD1(:,:)=ZD(:,:,JPATCH)
- CALL INTERP_GRID(ZD1,ZFIELD1,XGRID_SOIL,ZOUT)
- PFIELD(:,:,JPATCH)=ZOUT(:,:)
- END DO
-!
- DEALLOCATE(ZFIELD)
- DEALLOCATE(ZOUT)
- DEALLOCATE(ZFIELD1)
- DEALLOCATE(ZD)
-!
-!--------------------------------------------------------------------------
-!
-!* 3.4 Water content intercepted on leaves, LAI
-!
- CASE('WR ')
- ALLOCATE(PFIELD(INI,1,NVEGTYPE))
- !* choice if one reads garden fields (if present) or ISBA fields
- GGREENROOF = .FALSE.
- IF (GTEB) CALL READ_SURF(HFILEPGDTYPE,'LGREENROOF',GGREENROOF,IRESP)
- CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
- IF (GGREENROOF) THEN
- IPATCH = 1
- YRECFM = 'GD_WR'
- YRECFM=YPATCH//YRECFM
- CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,'TOWN ')
- ELSE
- YRECFM = 'PATCH_NUMBER'
- CALL OPEN_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE,'NATURE')
- CALL READ_SURF(HFILEPGDTYPE,YRECFM,IPATCH,IRESP)
- CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
- CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,'NATURE')
- YRECFM = 'WR'
- END IF
- YRECFM=ADJUSTL(YRECFM)
- ALLOCATE(ZFIELD(INI,1,IPATCH))
-#ifdef MNH_PARALLEL
- DO JPATCH=1,IPATCH
- WRITE(YPATCH2,'(I4.4)') JPATCH
- YRECFM=ADJUSTL(YRECFM)//YPATCH2
- CALL READ_SURF(HFILETYPE,YRECFM,ZFIELD(:,1,JPATCH),IRESP,HDIR='A')
- END DO
-#else
- CALL READ_SURF(HFILETYPE,YRECFM,ZFIELD(:,1,:),IRESP,HDIR='A')
-#endif
- CALL CLOSE_AUX_IO_SURF(HFILE,HFILETYPE)
- CALL PUT_ON_ALL_VEGTYPES(INI,1,1,NVEGTYPE,ZFIELD,PFIELD)
- DEALLOCATE(ZFIELD)
-!
- CASE('LAI ')
- CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
- ALLOCATE(PFIELD(INI,1,NVEGTYPE))
- PFIELD(:,:,:) = XUNDEF
-!
-END SELECT
-!
-!
-!---------------------------------------------------------------------------
-!
-!* 6. End of IO
-! ---------
-!
-IF (LHOOK) CALL DR_HOOK('PREP_TEB_GREENROOF_EXTERN',1,ZHOOK_HANDLE)
-!
-!---------------------------------------------------------------------------
-!---------------------------------------------------------------------------
-END SUBROUTINE PREP_TEB_GREENROOF_EXTERN
+!SURFEX_LIC Copyright 1994-2014 Meteo-France
+!SURFEX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SURFEX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SURFEX_LIC for details. version 1.
+! #########
+SUBROUTINE PREP_TEB_GREENROOF_EXTERN(HPROGRAM,HSURF,HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE,KLUOUT,PFIELD)
+! #################################################################################
+!
+!!**** *PREP_TEB_GREENROOF_EXTERN* - initializes ISBA fields from operational GRIB
+!!
+!! PURPOSE
+!! -------
+!
+!!** METHOD
+!! ------
+!! Based on "prep_teb_garden_extern"
+!!
+!! REFERENCE
+!! ---------
+!!
+!!
+!! AUTHOR
+!! ------
+!! A. Lemonsu & C. de Munck
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 07/2011
+!! M.Moge 01/2016 using READ_SURF_FIELD2D/3D for 2D/3D surfex fields reads
+!!------------------------------------------------------------------
+!
+
+!
+USE MODE_READ_EXTERN
+!
+USE MODD_TYPE_DATE_SURF
+!
+USE MODI_PREP_GRID_EXTERN
+USE MODI_READ_SURF
+USE MODI_INTERP_GRID
+USE MODI_OPEN_AUX_IO_SURF
+USE MODI_CLOSE_AUX_IO_SURF
+USE MODI_READ_TEB_PATCH
+USE MODI_GET_CURRENT_TEB_PATCH
+USE MODI_TOWN_PRESENCE
+!
+USE MODD_PREP, ONLY : CINGRID_TYPE, CINTERP_TYPE
+USE MODD_PREP_TEB_GREENROOF, ONLY : XGRID_SOIL, XWR_DEF
+USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE
+USE MODD_SURF_PAR, ONLY : XUNDEF
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+USE MODI_PUT_ON_ALL_VEGTYPES
+!
+USE MODI_READ_SURF_FIELD2D
+!
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+ CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes
+ CHARACTER(LEN=7), INTENT(IN) :: HSURF ! type of field
+ CHARACTER(LEN=28), INTENT(IN) :: HFILE ! name of file
+ CHARACTER(LEN=6), INTENT(IN) :: HFILETYPE ! type of input file
+ CHARACTER(LEN=28), INTENT(IN) :: HFILEPGD ! name of file
+ CHARACTER(LEN=6), INTENT(IN) :: HFILEPGDTYPE ! type of input file
+INTEGER, INTENT(IN) :: KLUOUT ! logical unit of output listing
+REAL,DIMENSION(:,:,:), POINTER :: PFIELD ! field to interpolate horizontally (on final soil grid)
+!
+!* 0.2 declarations of local variables
+!
+ CHARACTER(LEN=12) :: YRECFM ! Name of the article to be read
+INTEGER :: IRESP ! reading return code
+INTEGER :: INI ! total 1D dimension
+INTEGER :: IPATCH ! number of patch
+!
+REAL, DIMENSION(:,:,:), POINTER :: ZFIELD ! field read on initial MNH vertical soil grid, all patches
+REAL, DIMENSION(:,:), POINTER :: ZFIELD1 ! field read on initial MNH vertical soil grid, one patch
+REAL, DIMENSION(:,:,:), POINTER :: ZD ! depth of field in the soil
+REAL, DIMENSION(:,:), POINTER :: ZD1 ! depth of field in the soil, one patch
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZOUT !
+LOGICAL :: GTEB ! flag if TEB fields are present
+INTEGER :: JPATCH ! loop counter for patch
+ CHARACTER(LEN=12) :: YSURF ! type of field
+INTEGER :: ITEB_PATCH ! number of TEB patches in file
+INTEGER :: ICURRENT_PATCH ! current TEB patch to be initialized
+INTEGER :: IVERSION ! SURFEX version
+INTEGER :: IBUGFIX ! SURFEX bug version
+LOGICAL :: GOLD_NAME ! old name flag for temperatures
+ CHARACTER(LEN=3) :: YPATCH ! indentificator for TEB patch
+ CHARACTER(LEN=4) :: YPATCH2 ! number of the patch
+LOGICAL :: GGREENROOF ! T if gardens are present in the file
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+!------------------------------------------------------------------------------
+!
+!* 1. Preparation of IO for reading in the file
+! -----------------------------------------
+!
+!* Note that all points are read, even those without physical meaning.
+! These points will not be used during the horizontal interpolation step.
+! Their value must be defined as XUNDEF.
+!
+IF (LHOOK) CALL DR_HOOK('PREP_TEB_GREENROOF_EXTERN',0,ZHOOK_HANDLE)
+ CALL OPEN_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE,'TOWN ')
+!
+!* reading of version of the file being read
+ CALL READ_SURF(HFILEPGDTYPE,'VERSION',IVERSION,IRESP)
+ CALL READ_SURF(HFILEPGDTYPE,'BUG',IBUGFIX,IRESP)
+GOLD_NAME=(IVERSION<7 .OR. (IVERSION==7 .AND. IBUGFIX<3))
+!
+!------------------------------------------------------------------------------
+!
+!* 2. Reading of grid
+! ---------------
+!
+ CALL PREP_GRID_EXTERN(HFILEPGDTYPE,KLUOUT,CINGRID_TYPE,CINTERP_TYPE,INI)
+!
+!* reads if TEB fields exist in the input file
+ CALL TOWN_PRESENCE(HFILEPGDTYPE,GTEB)
+!
+IF (GTEB) THEN
+ CALL READ_TEB_PATCH(HFILEPGDTYPE,ITEB_PATCH)
+ CALL GET_CURRENT_TEB_PATCH(ICURRENT_PATCH)
+ YPATCH=' '
+ IF (ITEB_PATCH>1) THEN
+ WRITE(YPATCH,FMT='(A,I1,A)') 'T',MIN(ICURRENT_PATCH,ITEB_PATCH),'_'
+ END IF
+END IF
+!
+! A FAIRE : VERIFIER QUE LES MODIFS DES PATCH/GTEB/GGREENROOF SONT CORRECTES
+!---------------------------------------------------------------------------------------
+!
+!* 3. Transformation into physical quantity to be interpolated
+! --------------------------------------------------------
+!
+SELECT CASE(HSURF)
+!
+!* 3. Orography
+! ---------
+!
+ CASE('ZS ')
+ ALLOCATE(PFIELD(INI,1,1))
+ YRECFM='ZS'
+ CALL READ_SURF(HFILEPGDTYPE,YRECFM,PFIELD(:,1,1),IRESP,HDIR='A')
+ CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
+!
+!--------------------------------------------------------------------------
+!
+!
+!* 3.1 Profile of temperature, water or ice in the soil
+!
+ CASE('TG ','WG ','WGI ')
+!* choice if one reads garden fields (if present) or ISBA fields
+ GGREENROOF = .FALSE.
+ IF (GTEB) CALL READ_SURF(HFILEPGDTYPE,'LGREENROOF',GGREENROOF,IRESP)
+ CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
+ IF (GGREENROOF) THEN
+ YSURF = 'GR_'//HSURF(1:3)
+ YSURF=YPATCH//YSURF
+ ELSE
+ YSURF = HSURF
+ END IF
+ YSURF=ADJUSTL(YSURF)
+!* reading of the profile and its depth definition
+ CALL READ_EXTERN_ISBA(HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE,KLUOUT,INI,&
+ HSURF,YSURF,ZFIELD,ZD)
+!
+ ALLOCATE(ZFIELD1(SIZE(ZFIELD,1),SIZE(ZFIELD,2)))
+ ALLOCATE(ZD1(SIZE(ZFIELD,1),SIZE(ZFIELD,2)))
+ ALLOCATE(ZOUT(SIZE(ZFIELD,1),SIZE(XGRID_SOIL)))
+ ALLOCATE(PFIELD(SIZE(ZFIELD,1),SIZE(XGRID_SOIL),SIZE(ZFIELD,3)))
+!
+ DO JPATCH=1,SIZE(ZFIELD,3)
+ ZFIELD1(:,:)=ZFIELD(:,:,JPATCH)
+ ZD1(:,:)=ZD(:,:,JPATCH)
+ CALL INTERP_GRID(ZD1,ZFIELD1,XGRID_SOIL,ZOUT)
+ PFIELD(:,:,JPATCH)=ZOUT(:,:)
+ END DO
+!
+ DEALLOCATE(ZFIELD)
+ DEALLOCATE(ZOUT)
+ DEALLOCATE(ZFIELD1)
+ DEALLOCATE(ZD)
+!
+!--------------------------------------------------------------------------
+!
+!* 3.4 Water content intercepted on leaves, LAI
+!
+ CASE('WR ')
+ ALLOCATE(PFIELD(INI,1,NVEGTYPE))
+ !* choice if one reads garden fields (if present) or ISBA fields
+ GGREENROOF = .FALSE.
+ IF (GTEB) CALL READ_SURF(HFILEPGDTYPE,'LGREENROOF',GGREENROOF,IRESP)
+ CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
+ IF (GGREENROOF) THEN
+ IPATCH = 1
+ YRECFM = 'GD_WR'
+ YRECFM=YPATCH//YRECFM
+ CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,'TOWN ')
+ ELSE
+ YRECFM = 'PATCH_NUMBER'
+ CALL OPEN_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE,'NATURE')
+ CALL READ_SURF(HFILEPGDTYPE,YRECFM,IPATCH,IRESP)
+ CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
+ CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,'NATURE')
+ YRECFM = 'WR'
+ END IF
+ YRECFM=ADJUSTL(YRECFM)
+ ALLOCATE(ZFIELD(INI,1,IPATCH))
+ CALL READ_SURF_FIELD2D(HFILETYPE,ZFIELD(:,1,:),YRECFM,HDIR='A')
+ CALL CLOSE_AUX_IO_SURF(HFILE,HFILETYPE)
+ CALL PUT_ON_ALL_VEGTYPES(INI,1,1,NVEGTYPE,ZFIELD,PFIELD)
+ DEALLOCATE(ZFIELD)
+!
+ CASE('LAI ')
+ CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)
+ ALLOCATE(PFIELD(INI,1,NVEGTYPE))
+ PFIELD(:,:,:) = XUNDEF
+!
+END SELECT
+!
+!
+!---------------------------------------------------------------------------
+!
+!* 6. End of IO
+! ---------
+!
+IF (LHOOK) CALL DR_HOOK('PREP_TEB_GREENROOF_EXTERN',1,ZHOOK_HANDLE)
+!
+!---------------------------------------------------------------------------
+!---------------------------------------------------------------------------
+END SUBROUTINE PREP_TEB_GREENROOF_EXTERN
diff --git a/src/SURFEX/read_gr_snow.F90 b/src/SURFEX/read_gr_snow.F90
index 7e7a9760e..d6afdea05 100644
--- a/src/SURFEX/read_gr_snow.F90
+++ b/src/SURFEX/read_gr_snow.F90
@@ -1,421 +1,322 @@
-!SURFEX_LIC Copyright 1994-2014 Meteo-France
-!SURFEX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SURFEX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SURFEX_LIC for details. version 1.
-! #########
- SUBROUTINE READ_GR_SNOW(HPROGRAM,HSURFTYPE,HPREFIX, &
- KLU,KPATCH,TPSNOW,HDIR)
-! ##########################################################
-!
-!!**** *READ_GR_SNOW* - routine to read snow surface fields
-!!
-!! PURPOSE
-!! -------
-! Initialize snow surface fields.
-!
-!!** METHOD
-!! ------
-!!
-!!
-!!
-!! EXTERNAL
-!! --------
-!!
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!!
-!! AUTHOR
-!! ------
-!! V. Masson * Meteo France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 20/01/99
-! F.solmon 06/00 adaptation for patch
-! V.Masson 01/03 new version of ISBA
-! B. Decharme 2008 If no WSNOW, WSNOW = XUNDEF
-!! M. Moge 09/2015 reading SURFEX fields as 1D fields for each patch for Z-parallel IO with Meso-NH
-!-----------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-!
-USE MODD_TYPE_SNOW
-!
-USE MODI_READ_SURF
-!
-USE MODI_ALLOCATE_GR_SNOW
-!
-USE MODD_SURF_PAR, ONLY : XUNDEF
-USE MODD_PREP_SNOW, ONLY : LSNOW_FRAC_TOT
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
- CHARACTER (LEN=*), INTENT(IN) :: HSURFTYPE ! generic name used for
- ! snow characteristics
- ! storage in file
- CHARACTER (LEN=3), INTENT(IN) :: HPREFIX ! generic name for patch
-! ! identification
-INTEGER, INTENT(IN) :: KLU ! horizontal size of snow var.
-INTEGER, INTENT(IN) :: KPATCH ! number of tiles
-TYPE(SURF_SNOW) :: TPSNOW ! snow characteristics
- CHARACTER (LEN=1), INTENT(IN), OPTIONAL :: HDIR ! type of reading
-! ! HDIR = 'A' : entire field on All processors
-! ! HDIR = 'H' : distribution on each processor
-!
-!* 0.2 declarations of local variables
-!
-INTEGER :: IRESP ! Error code after redding
- CHARACTER(LEN=12) :: YRECFM ! Name of the article to be read
- CHARACTER(LEN=16) :: YRECFM2
-!
- CHARACTER (LEN=100) :: YFMT ! format for writing
-INTEGER :: ISURFTYPE_LEN !
-LOGICAL :: GSNOW ! snow written in the file
-INTEGER :: JLAYER ! loop counter
-INTEGER :: JPATCH ! loop counter
-CHARACTER(LEN=4) :: YPATCH ! number of the patch
-REAL, DIMENSION(:,:),ALLOCATABLE :: ZWORK ! 2D array to write data in file
- CHARACTER(LEN=1) :: YDIR ! type of reading
- CHARACTER(LEN=4) :: YNLAYER !Format depending on the number of layers
-INTEGER :: IVERSION, IBUGFIX
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!-------------------------------------------------------------------------------
-!
-IF (LHOOK) CALL DR_HOOK('READ_GR_SNOW',0,ZHOOK_HANDLE)
-YDIR = 'H'
-IF (PRESENT(HDIR)) YDIR = HDIR
-!
-!-------------------------------------------------------------------------------
- CALL READ_SURF(HPROGRAM,'VERSION',IVERSION,IRESP)
- CALL READ_SURF(HPROGRAM,'BUG',IBUGFIX,IRESP)
-!-------------------------------------------------------------------------------
-!
-!* 1. Type of snow scheme
-! -------------------
-!
-ISURFTYPE_LEN=LEN_TRIM(HSURFTYPE)
-IF (IVERSION <=2 .OR. (IVERSION==3 .AND. IBUGFIX<=4)) THEN
- WRITE(YFMT,'(A5,I1,A4)') '(A5,A',ISURFTYPE_LEN,',A5)'
- WRITE(YRECFM2,YFMT) 'SNOW_',HSURFTYPE,'_TYPE'
-ELSE
- IF (IVERSION<7 .OR. IVERSION==7 .AND. IBUGFIX<3) THEN
- WRITE(YFMT,'(A5,I1,A4)') '(A3,A',ISURFTYPE_LEN,',A5)'
- WRITE(YRECFM2,YFMT) 'SN_',HSURFTYPE,'_TYPE'
- ELSE
- WRITE(YFMT,'(A5,I1,A4)') '(A3,A',ISURFTYPE_LEN,',A4)'
- WRITE(YRECFM2,YFMT) 'SN_',HSURFTYPE,'_TYP'
- YRECFM2=ADJUSTL(HPREFIX//YRECFM2)
- ENDIF
-END IF
-!
- CALL READ_SURF(HPROGRAM,YRECFM2,TPSNOW%SCHEME,IRESP)
-!
-!* 2. Snow levels
-! -----------
-!
-!
-IF (IVERSION <=2 .OR. (IVERSION==3 .AND. IBUGFIX<=4)) THEN
- WRITE(YFMT,'(A5,I1,A4)') '(A5,A',ISURFTYPE_LEN,',A6)'
- WRITE(YRECFM2,YFMT) 'SNOW_',HSURFTYPE,'_LAYER'
-ELSE
- WRITE(YFMT,'(A5,I1,A4)') '(A3,A',ISURFTYPE_LEN,',A2)'
- WRITE(YRECFM2,YFMT) 'SN_',HSURFTYPE,'_N'
- IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) YRECFM2=ADJUSTL(HPREFIX//YRECFM2)
-END IF
-!
- CALL READ_SURF(HPROGRAM,YRECFM2,TPSNOW%NLAYER,IRESP)
-!
-!* 2. Presence of snow fields in the file
-! -----------------------------------
-!
-IF (IVERSION >6 .OR. (IVERSION==6 .AND. IBUGFIX>=1)) THEN
- WRITE(YFMT,'(A5,I1,A1)') '(A3,A',ISURFTYPE_LEN,')'
- WRITE(YRECFM,YFMT) 'SN_',HSURFTYPE
- IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) YRECFM=ADJUSTL(HPREFIX//YRECFM)
- CALL READ_SURF(HPROGRAM,YRECFM,GSNOW,IRESP)
-ELSE
- IF (TPSNOW%NLAYER==0) THEN
- GSNOW = .FALSE.
- IF (TPSNOW%SCHEME=='D95' .OR. TPSNOW%SCHEME=='1-L' .OR. TPSNOW%SCHEME=='EBA') TPSNOW%NLAYER=1
- IF (TPSNOW%SCHEME=='3-L' .OR. TPSNOW%SCHEME=='CRO' ) TPSNOW%NLAYER=3
- ELSE
- GSNOW = .TRUE.
- END IF
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-!* 3. Allocations
-! -----------
-!
- CALL ALLOCATE_GR_SNOW(TPSNOW,KLU,KPATCH)
-!
-IF (.NOT. GSNOW) THEN
- IF (LHOOK) CALL DR_HOOK('READ_GR_SNOW',1,ZHOOK_HANDLE)
- RETURN
-END IF
-!-------------------------------------------------------------------------------
-!
-!* 4. Additional key
-! ---------------
-!
-IF (IVERSION >= 7 .AND. HSURFTYPE=='VEG') CALL READ_SURF(HPROGRAM,'LSNOW_FRAC_T',LSNOW_FRAC_TOT,IRESP)
-!
-!-------------------------------------------------------------------------------
-!
-!* 5. Snow reservoir
-! --------------
-!
-ALLOCATE(ZWORK(SIZE(TPSNOW%WSNOW,1),SIZE(TPSNOW%WSNOW,3)))
-!
-DO JLAYER = 1,TPSNOW%NLAYER
-!
- YNLAYER='I1.1'
- IF (JLAYER>9) YNLAYER='I2.2'
-!
- IF (TPSNOW%SCHEME=='1-L' .OR. TPSNOW%SCHEME=='D95' .OR. TPSNOW%SCHEME=='EBA' .OR. TPSNOW%SCHEME=='3-L' &
- .OR. TPSNOW%SCHEME=='CRO') THEN
-!
- IF (IVERSION<7 .OR. IVERSION==7 .AND. IBUGFIX<3) THEN
- WRITE(YFMT,'(A5,I1,A6)') '(A6,A',ISURFTYPE_LEN,','//YNLAYER//')'
- WRITE(YRECFM,YFMT) 'WSNOW_',HSURFTYPE,JLAYER
- ELSE
- WRITE(YFMT,'(A5,I1,A6)') '(A4,A',ISURFTYPE_LEN,','//YNLAYER//')'
- WRITE(YRECFM,YFMT) 'WSN_',HSURFTYPE,JLAYER
- YRECFM=ADJUSTL(HPREFIX//YRECFM)
- ENDIF
-#ifdef MNH_PARALLEL
- DO JPATCH=1,SIZE(TPSNOW%WSNOW,3)
- WRITE(YPATCH,'(I4.4)') SIZE(TPSNOW%WSNOW,3)
- YRECFM=TRIM(YRECFM)//YPATCH
- CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,JPATCH),IRESP,HDIR=YDIR)
- END DO
-#else
- CALL READ_SURF(HPROGRAM,YRECFM,ZWORK,IRESP,HDIR=YDIR)
-#endif
- TPSNOW%WSNOW(:,JLAYER,:)=ZWORK
- END IF
-!
-!* 6. Snow density
-! ------------
-!
- IF (TPSNOW%SCHEME=='1-L' .OR. TPSNOW%SCHEME=='D95' .OR. TPSNOW%SCHEME=='EBA' .OR. TPSNOW%SCHEME=='3-L' &
- .OR. TPSNOW%SCHEME=='CRO') THEN
- IF (IVERSION<7 .OR. IVERSION==7 .AND. IBUGFIX<3) THEN
- WRITE(YFMT,'(A5,I1,A6)') '(A6,A',ISURFTYPE_LEN,','//YNLAYER//')'
- WRITE(YRECFM,YFMT) 'RSNOW_',HSURFTYPE,JLAYER
- ELSE
- WRITE(YFMT,'(A5,I1,A6)') '(A4,A',ISURFTYPE_LEN,','//YNLAYER//')'
- WRITE(YRECFM,YFMT) 'RSN_',HSURFTYPE,JLAYER
- YRECFM=ADJUSTL(HPREFIX//YRECFM)
- ENDIF
-#ifdef MNH_PARALLEL
- DO JPATCH=1,SIZE(TPSNOW%WSNOW,3)
- WRITE(YPATCH,'(I4.4)') SIZE(TPSNOW%WSNOW,3)
- YRECFM=TRIM(YRECFM)//YPATCH
- CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,JPATCH),IRESP,HDIR=YDIR)
- END DO
-#else
- CALL READ_SURF(HPROGRAM,YRECFM,ZWORK,IRESP,HDIR=YDIR)
-#endif
- TPSNOW%RHO(:,JLAYER,:)=ZWORK
- WHERE(TPSNOW%WSNOW(:,JLAYER,:)==0.0)TPSNOW%RHO(:,JLAYER,:)=XUNDEF
- END IF
-!
-!* 7. Snow temperature
-! ----------------
-!
- IF (TPSNOW%SCHEME=='1-L') THEN
- IF (IVERSION<7 .OR. IVERSION==7 .AND. IBUGFIX<3) THEN
- WRITE(YFMT,'(A5,I1,A6)') '(A6,A',ISURFTYPE_LEN,','//YNLAYER//')'
- WRITE(YRECFM,YFMT) 'TSNOW_',HSURFTYPE,JLAYER
- ELSE
- WRITE(YFMT,'(A5,I1,A6)') '(A4,A',ISURFTYPE_LEN,','//YNLAYER//')'
- WRITE(YRECFM,YFMT) 'TSN_',HSURFTYPE,JLAYER
- YRECFM=ADJUSTL(HPREFIX//YRECFM)
- ENDIF
-#ifdef MNH_PARALLEL
- DO JPATCH=1,SIZE(TPSNOW%WSNOW,3)
- WRITE(YPATCH,'(I4.4)') SIZE(TPSNOW%WSNOW,3)
- YRECFM=TRIM(YRECFM)//YPATCH
- CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,JPATCH),IRESP,HDIR=YDIR)
- END DO
-#else
- CALL READ_SURF(HPROGRAM,YRECFM,ZWORK,IRESP,HDIR=YDIR)
-#endif
- TPSNOW%T(:,JLAYER,:)=ZWORK
- WHERE (TPSNOW%WSNOW(:,1,:) == 0.0) TPSNOW%T(:,JLAYER,:) = XUNDEF
- END IF
-!
-!* 8. Heat content
-! ------------
-!
- IF (TPSNOW%SCHEME=='3-L' .OR. TPSNOW%SCHEME=='CRO') THEN
- IF (IVERSION<7 .OR. IVERSION==7 .AND. IBUGFIX<3) THEN
- WRITE(YFMT,'(A5,I1,A6)') '(A6,A',ISURFTYPE_LEN,','//YNLAYER//')'
- WRITE(YRECFM,YFMT) 'HSNOW_',HSURFTYPE,JLAYER
- ELSE
- WRITE(YFMT,'(A5,I1,A6)') '(A4,A',ISURFTYPE_LEN,','//YNLAYER//')'
- WRITE(YRECFM,YFMT) 'HSN_',HSURFTYPE,JLAYER
- YRECFM=ADJUSTL(HPREFIX//YRECFM)
- ENDIF
-#ifdef MNH_PARALLEL
- DO JPATCH=1,SIZE(TPSNOW%WSNOW,3)
- WRITE(YPATCH,'(I4.4)') SIZE(TPSNOW%WSNOW,3)
- YRECFM=TRIM(YRECFM)//YPATCH
- CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,JPATCH),IRESP,HDIR=YDIR)
- END DO
-#else
- CALL READ_SURF(HPROGRAM,YRECFM,ZWORK,IRESP,HDIR=YDIR)
-#endif
- TPSNOW%HEAT(:,JLAYER,:)=ZWORK
- WHERE (TPSNOW%WSNOW(:,1,:) == 0.0) TPSNOW%HEAT(:,JLAYER,:) = XUNDEF
- END IF
-!
-!* 9. Snow Gran1
-! ------------
-!
- IF (TPSNOW%SCHEME=='CRO') THEN
- IF (IVERSION<7 .OR. IVERSION==7 .AND. IBUGFIX<3) THEN
- WRITE(YFMT,'(A5,I1,A6)') '(A7,A',ISURFTYPE_LEN,','//YNLAYER//')'
- WRITE(YRECFM,YFMT) 'SGRAN1_',HSURFTYPE,JLAYER
- ELSE
- WRITE(YFMT,'(A5,I1,A6)') '(A4,A',ISURFTYPE_LEN,','//YNLAYER//')'
- WRITE(YRECFM,YFMT) 'SG1_',HSURFTYPE,JLAYER
- YRECFM=ADJUSTL(HPREFIX//YRECFM)
- ENDIF
-#ifdef MNH_PARALLEL
- DO JPATCH=1,SIZE(TPSNOW%WSNOW,3)
- WRITE(YPATCH,'(I4.4)') SIZE(TPSNOW%WSNOW,3)
- YRECFM=TRIM(YRECFM)//YPATCH
- CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,JPATCH),IRESP,HDIR=YDIR)
- END DO
-#else
- CALL READ_SURF(HPROGRAM,YRECFM,ZWORK,IRESP,HDIR=YDIR)
-#endif
- TPSNOW%GRAN1(:,JLAYER,:)=ZWORK
- WHERE (TPSNOW%WSNOW(:,1,:) == 0.0) TPSNOW%GRAN1(:,JLAYER,:) = XUNDEF
- END IF
-!
-!* 10. Snow Gran2
-! ------------
-!
- IF (TPSNOW%SCHEME=='CRO') THEN
- IF (IVERSION<7 .OR. IVERSION==7 .AND. IBUGFIX<3) THEN
- WRITE(YFMT,'(A5,I1,A6)') '(A7,A',ISURFTYPE_LEN,','//YNLAYER//')'
- WRITE(YRECFM,YFMT) 'SGRAN2_',HSURFTYPE,JLAYER
- ELSE
- WRITE(YFMT,'(A5,I1,A6)') '(A4,A',ISURFTYPE_LEN,','//YNLAYER//')'
- WRITE(YRECFM,YFMT) 'SG2_',HSURFTYPE,JLAYER
- YRECFM=ADJUSTL(HPREFIX//YRECFM)
- ENDIF
-#ifdef MNH_PARALLEL
- DO JPATCH=1,SIZE(TPSNOW%WSNOW,3)
- WRITE(YPATCH,'(I4.4)') SIZE(TPSNOW%WSNOW,3)
- YRECFM=TRIM(YRECFM)//YPATCH
- CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,JPATCH),IRESP,HDIR=YDIR)
- END DO
-#else
- CALL READ_SURF(HPROGRAM,YRECFM,ZWORK,IRESP,HDIR=YDIR)
-#endif
- TPSNOW%GRAN2(:,JLAYER,:)=ZWORK
- WHERE (TPSNOW%WSNOW(:,1,:) == 0.0) TPSNOW%GRAN2(:,JLAYER,:) = XUNDEF
- END IF
-!
-!* 11. Historical parameter
-! -------------------
-!
- IF (TPSNOW%SCHEME=='CRO') THEN
- IF (IVERSION<7 .OR. IVERSION==7 .AND. IBUGFIX<3) THEN
- WRITE(YFMT,'(A5,I1,A6)') '(A6,A',ISURFTYPE_LEN,','//YNLAYER//')'
- WRITE(YRECFM,YFMT) 'SHIST_',HSURFTYPE,JLAYER
- ELSE
- WRITE(YFMT,'(A5,I1,A6)') '(A4,A',ISURFTYPE_LEN,','//YNLAYER//')'
- WRITE(YRECFM,YFMT) 'SHI_',HSURFTYPE,JLAYER
- YRECFM=ADJUSTL(HPREFIX//YRECFM)
- ENDIF
-#ifdef MNH_PARALLEL
- DO JPATCH=1,SIZE(TPSNOW%WSNOW,3)
- WRITE(YPATCH,'(I4.4)') SIZE(TPSNOW%WSNOW,3)
- YRECFM=TRIM(YRECFM)//YPATCH
- CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,JPATCH),IRESP,HDIR=YDIR)
- END DO
-#else
- CALL READ_SURF(HPROGRAM,YRECFM,ZWORK,IRESP,HDIR=YDIR)
-#endif
- TPSNOW%HIST(:,JLAYER,:)=ZWORK
- WHERE (TPSNOW%WSNOW(:,1,:) == 0.0) TPSNOW%HIST(:,JLAYER,:) = XUNDEF
- END IF
-!
-!* 12. Age parameter
-! -------------------
-!
- IF (TPSNOW%SCHEME=='CRO') THEN
- IF (IVERSION<7 .OR. IVERSION==7 .AND. IBUGFIX<3) THEN
- WRITE(YFMT,'(A5,I1,A6)') '(A5,A',ISURFTYPE_LEN,','//YNLAYER//')'
- WRITE(YRECFM,YFMT) 'SAGE_',HSURFTYPE,JLAYER
- ELSE
- WRITE(YFMT,'(A5,I1,A6)') '(A4,A',ISURFTYPE_LEN,','//YNLAYER//')'
- WRITE(YRECFM,YFMT) 'SAG_',HSURFTYPE,JLAYER
- YRECFM=ADJUSTL(HPREFIX//YRECFM)
- ENDIF
-#ifdef MNH_PARALLEL
- DO JPATCH=1,SIZE(TPSNOW%WSNOW,3)
- WRITE(YPATCH,'(I4.4)') SIZE(TPSNOW%WSNOW,3)
- YRECFM=TRIM(YRECFM)//YPATCH
- CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,JPATCH),IRESP,HDIR=YDIR)
- END DO
-#else
- CALL READ_SURF(HPROGRAM,YRECFM,ZWORK,IRESP,HDIR=YDIR)
-#endif
- TPSNOW%AGE(:,JLAYER,:)=ZWORK
- WHERE (TPSNOW%WSNOW(:,1,:) == 0.0) TPSNOW%AGE(:,JLAYER,:) = XUNDEF
- END IF
-!-------------------------------------------------------------------------------
-!
-END DO
-!
-DEALLOCATE(ZWORK)
-!-------------------------------------------------------------------------------
-!
-!* 13. Albedo
-! ------
-!
-IF (TPSNOW%SCHEME=='D95' .OR. TPSNOW%SCHEME=='EBA' .OR. TPSNOW%SCHEME=='1-L' .OR. TPSNOW%SCHEME=='3-L' &
- .OR. TPSNOW%SCHEME=='CRO') THEN
- IF (IVERSION<7 .OR. IVERSION==7 .AND. IBUGFIX<3) THEN
- WRITE(YFMT,'(A5,I1,A1)') '(A6,A',ISURFTYPE_LEN,')'
- WRITE(YRECFM,YFMT) 'ASNOW_',HSURFTYPE
- ELSE
- WRITE(YFMT,'(A5,I1,A1)') '(A4,A',ISURFTYPE_LEN,')'
- WRITE(YRECFM,YFMT) 'ASN_',HSURFTYPE
- YRECFM=ADJUSTL(HPREFIX//YRECFM)
- ENDIF
-#ifdef MNH_PARALLEL
- DO JPATCH=1,SIZE(TPSNOW%ALB,2)
- WRITE(YPATCH,'(I4.4)') SIZE(TPSNOW%ALB,2)
- YRECFM=TRIM(YRECFM)//YPATCH
- CALL READ_SURF(HPROGRAM,YRECFM,TPSNOW%ALB(:,JPATCH),IRESP,HDIR=YDIR)
- END DO
-#else
- CALL READ_SURF(HPROGRAM,YRECFM,TPSNOW%ALB(:,:),IRESP,HDIR=YDIR)
-#endif
- WHERE (TPSNOW%WSNOW(:,1,:) == 0.0) TPSNOW%ALB(:,:) = XUNDEF
-END IF
-IF (LHOOK) CALL DR_HOOK('READ_GR_SNOW',1,ZHOOK_HANDLE)
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE READ_GR_SNOW
+!SURFEX_LIC Copyright 1994-2014 Meteo-France
+!SURFEX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SURFEX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SURFEX_LIC for details. version 1.
+! #########
+ SUBROUTINE READ_GR_SNOW(HPROGRAM,HSURFTYPE,HPREFIX, &
+ KLU,KPATCH,TPSNOW,HDIR)
+! ##########################################################
+!
+!!**** *READ_GR_SNOW* - routine to read snow surface fields
+!!
+!! PURPOSE
+!! -------
+! Initialize snow surface fields.
+!
+!!** METHOD
+!! ------
+!!
+!!
+!!
+!! EXTERNAL
+!! --------
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Masson * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 20/01/99
+! F.solmon 06/00 adaptation for patch
+! V.Masson 01/03 new version of ISBA
+! B. Decharme 2008 If no WSNOW, WSNOW = XUNDEF
+!! M.Moge 01/2016 using READ_SURF_FIELD2D/3D for 2D/3D surfex fields reads
+!-----------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+USE MODD_TYPE_SNOW
+!
+USE MODI_READ_SURF
+USE MODI_READ_SURF_FIELD2D
+USE MODI_READ_SURF_FIELD3D
+!
+USE MODI_ALLOCATE_GR_SNOW
+!
+USE MODD_SURF_PAR, ONLY : XUNDEF
+USE MODD_PREP_SNOW, ONLY : LSNOW_FRAC_TOT
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+ CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
+ CHARACTER (LEN=*), INTENT(IN) :: HSURFTYPE ! generic name used for
+ ! snow characteristics
+ ! storage in file
+ CHARACTER (LEN=3), INTENT(IN) :: HPREFIX ! generic name for patch
+! ! identification
+INTEGER, INTENT(IN) :: KLU ! horizontal size of snow var.
+INTEGER, INTENT(IN) :: KPATCH ! number of tiles
+TYPE(SURF_SNOW) :: TPSNOW ! snow characteristics
+ CHARACTER (LEN=1), INTENT(IN), OPTIONAL :: HDIR ! type of reading
+! ! HDIR = 'A' : entire field on All processors
+! ! HDIR = 'H' : distribution on each processor
+!
+!* 0.2 declarations of local variables
+!
+INTEGER :: IRESP ! Error code after redding
+ CHARACTER(LEN=12) :: YRECFM ! Name of the article to be read
+ CHARACTER(LEN=16) :: YRECFM2
+!
+ CHARACTER (LEN=100) :: YFMT ! format for writing
+INTEGER :: ISURFTYPE_LEN !
+LOGICAL :: GSNOW ! snow written in the file
+INTEGER :: JLAYER ! loop counter
+CHARACTER(LEN=4) :: YPATCH ! number of the patch
+REAL, DIMENSION(:,:),ALLOCATABLE :: ZWORK ! 2D array to write data in file
+ CHARACTER(LEN=1) :: YDIR ! type of reading
+ CHARACTER(LEN=4) :: YNLAYER !Format depending on the number of layers
+INTEGER :: IVERSION, IBUGFIX
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!-------------------------------------------------------------------------------
+!
+IF (LHOOK) CALL DR_HOOK('READ_GR_SNOW',0,ZHOOK_HANDLE)
+YDIR = 'H'
+IF (PRESENT(HDIR)) YDIR = HDIR
+!
+!-------------------------------------------------------------------------------
+ CALL READ_SURF(HPROGRAM,'VERSION',IVERSION,IRESP)
+ CALL READ_SURF(HPROGRAM,'BUG',IBUGFIX,IRESP)
+!-------------------------------------------------------------------------------
+!
+!* 1. Type of snow scheme
+! -------------------
+!
+ISURFTYPE_LEN=LEN_TRIM(HSURFTYPE)
+IF (IVERSION <=2 .OR. (IVERSION==3 .AND. IBUGFIX<=4)) THEN
+ WRITE(YFMT,'(A5,I1,A4)') '(A5,A',ISURFTYPE_LEN,',A5)'
+ WRITE(YRECFM2,YFMT) 'SNOW_',HSURFTYPE,'_TYPE'
+ELSE
+ IF (IVERSION<7 .OR. IVERSION==7 .AND. IBUGFIX<3) THEN
+ WRITE(YFMT,'(A5,I1,A4)') '(A3,A',ISURFTYPE_LEN,',A5)'
+ WRITE(YRECFM2,YFMT) 'SN_',HSURFTYPE,'_TYPE'
+ ELSE
+ WRITE(YFMT,'(A5,I1,A4)') '(A3,A',ISURFTYPE_LEN,',A4)'
+ WRITE(YRECFM2,YFMT) 'SN_',HSURFTYPE,'_TYP'
+ YRECFM2=ADJUSTL(HPREFIX//YRECFM2)
+ ENDIF
+END IF
+!
+ CALL READ_SURF(HPROGRAM,YRECFM2,TPSNOW%SCHEME,IRESP)
+!
+!* 2. Snow levels
+! -----------
+!
+!
+IF (IVERSION <=2 .OR. (IVERSION==3 .AND. IBUGFIX<=4)) THEN
+ WRITE(YFMT,'(A5,I1,A4)') '(A5,A',ISURFTYPE_LEN,',A6)'
+ WRITE(YRECFM2,YFMT) 'SNOW_',HSURFTYPE,'_LAYER'
+ELSE
+ WRITE(YFMT,'(A5,I1,A4)') '(A3,A',ISURFTYPE_LEN,',A2)'
+ WRITE(YRECFM2,YFMT) 'SN_',HSURFTYPE,'_N'
+ IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) YRECFM2=ADJUSTL(HPREFIX//YRECFM2)
+END IF
+!
+ CALL READ_SURF(HPROGRAM,YRECFM2,TPSNOW%NLAYER,IRESP)
+!
+!* 2. Presence of snow fields in the file
+! -----------------------------------
+!
+IF (IVERSION >6 .OR. (IVERSION==6 .AND. IBUGFIX>=1)) THEN
+ WRITE(YFMT,'(A5,I1,A1)') '(A3,A',ISURFTYPE_LEN,')'
+ WRITE(YRECFM,YFMT) 'SN_',HSURFTYPE
+ IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) YRECFM=ADJUSTL(HPREFIX//YRECFM)
+ CALL READ_SURF(HPROGRAM,YRECFM,GSNOW,IRESP)
+ELSE
+ IF (TPSNOW%NLAYER==0) THEN
+ GSNOW = .FALSE.
+ IF (TPSNOW%SCHEME=='D95' .OR. TPSNOW%SCHEME=='1-L' .OR. TPSNOW%SCHEME=='EBA') TPSNOW%NLAYER=1
+ IF (TPSNOW%SCHEME=='3-L' .OR. TPSNOW%SCHEME=='CRO' ) TPSNOW%NLAYER=3
+ ELSE
+ GSNOW = .TRUE.
+ END IF
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* 3. Allocations
+! -----------
+!
+ CALL ALLOCATE_GR_SNOW(TPSNOW,KLU,KPATCH)
+!
+IF (.NOT. GSNOW) THEN
+ IF (LHOOK) CALL DR_HOOK('READ_GR_SNOW',1,ZHOOK_HANDLE)
+ RETURN
+END IF
+!-------------------------------------------------------------------------------
+!
+!* 4. Additional key
+! ---------------
+!
+IF (IVERSION >= 7 .AND. HSURFTYPE=='VEG') CALL READ_SURF(HPROGRAM,'LSNOW_FRAC_T',LSNOW_FRAC_TOT,IRESP)
+!
+!-------------------------------------------------------------------------------
+!
+!* 5. Snow reservoir
+! --------------
+!
+ALLOCATE(ZWORK(SIZE(TPSNOW%WSNOW,1),SIZE(TPSNOW%WSNOW,3)))
+!
+ IF (TPSNOW%SCHEME=='1-L' .OR. TPSNOW%SCHEME=='D95' .OR. TPSNOW%SCHEME=='EBA' .OR. TPSNOW%SCHEME=='3-L' &
+ .OR. TPSNOW%SCHEME=='CRO') THEN
+!
+ IF (IVERSION<7 .OR. IVERSION==7 .AND. IBUGFIX<3) THEN
+ YRECFM='WSNOW_'//HSURFTYPE
+ ELSE
+ YRECFM=ADJUSTL(HPREFIX//'WSN_'//HSURFTYPE)
+ ENDIF
+ CALL READ_SURF_FIELD3D(HPROGRAM,TPSNOW%WSNOW,1,TPSNOW%NLAYER,YRECFM,HDIR=YDIR)
+ END IF
+!
+!* 6. Snow density
+! ------------
+!
+ IF (TPSNOW%SCHEME=='1-L' .OR. TPSNOW%SCHEME=='D95' .OR. TPSNOW%SCHEME=='EBA' .OR. TPSNOW%SCHEME=='3-L' &
+ .OR. TPSNOW%SCHEME=='CRO') THEN
+ IF (IVERSION<7 .OR. IVERSION==7 .AND. IBUGFIX<3) THEN
+ YRECFM='RSNOW_'//HSURFTYPE
+ ELSE
+ YRECFM=ADJUSTL(HPREFIX//'RSN_'//HSURFTYPE)
+ ENDIF
+ CALL READ_SURF_FIELD3D(HPROGRAM,TPSNOW%RHO,1,TPSNOW%NLAYER,YRECFM,HDIR=YDIR)
+ WHERE(TPSNOW%WSNOW(:,1:TPSNOW%NLAYER,:)==0.0)TPSNOW%RHO(:,1:TPSNOW%NLAYER,:)=XUNDEF
+ END IF
+!
+!* 7. Snow temperature
+! ----------------
+!
+ IF (TPSNOW%SCHEME=='1-L') THEN
+ IF (IVERSION<7 .OR. IVERSION==7 .AND. IBUGFIX<3) THEN
+ YRECFM='TSNOW_'//HSURFTYPE
+ ELSE
+ YRECFM=ADJUSTL(HPREFIX//'TSN_'//HSURFTYPE)
+ ENDIF
+ CALL READ_SURF_FIELD3D(HPROGRAM,TPSNOW%T,1,TPSNOW%NLAYER,YRECFM,HDIR=YDIR)
+ DO JLAYER = 1,TPSNOW%NLAYER
+ WHERE (TPSNOW%WSNOW(:,1,:) == 0.0) TPSNOW%T(:,JLAYER,:) = XUNDEF
+ ENDDO
+ END IF
+!
+!* 8. Heat content
+! ------------
+!
+ IF (TPSNOW%SCHEME=='3-L' .OR. TPSNOW%SCHEME=='CRO') THEN
+ IF (IVERSION<7 .OR. IVERSION==7 .AND. IBUGFIX<3) THEN
+ YRECFM='HSNOW_'//HSURFTYPE
+ ELSE
+ YRECFM=ADJUSTL(HPREFIX//'HSN_'//HSURFTYPE)
+ ENDIF
+ CALL READ_SURF_FIELD3D(HPROGRAM,TPSNOW%HEAT,1,TPSNOW%NLAYER,YRECFM,HDIR=YDIR)
+ DO JLAYER = 1,TPSNOW%NLAYER
+ WHERE (TPSNOW%WSNOW(:,1,:) == 0.0) TPSNOW%HEAT(:,JLAYER,:) = XUNDEF
+ ENDDO
+ END IF
+!
+!* 9. Snow Gran1
+! ------------
+!
+ IF (TPSNOW%SCHEME=='CRO') THEN
+ IF (IVERSION<7 .OR. IVERSION==7 .AND. IBUGFIX<3) THEN
+ YRECFM='SGRAN1_'//HSURFTYPE
+ ELSE
+ YRECFM=ADJUSTL(HPREFIX//'SG1_'//HSURFTYPE)
+ ENDIF
+ CALL READ_SURF_FIELD3D(HPROGRAM,TPSNOW%GRAN1,1,TPSNOW%NLAYER,YRECFM,HDIR=YDIR)
+ DO JLAYER = 1,TPSNOW%NLAYER
+ WHERE (TPSNOW%WSNOW(:,1,:) == 0.0) TPSNOW%GRAN1(:,JLAYER,:) = XUNDEF
+ ENDDO
+ END IF
+!
+!* 10. Snow Gran2
+! ------------
+!
+ IF (TPSNOW%SCHEME=='CRO') THEN
+ IF (IVERSION<7 .OR. IVERSION==7 .AND. IBUGFIX<3) THEN
+ YRECFM='SGRAN2_'//HSURFTYPE
+ ELSE
+ YRECFM=ADJUSTL(HPREFIX//'SG2_'//HSURFTYPE)
+ ENDIF
+ CALL READ_SURF_FIELD3D(HPROGRAM,TPSNOW%GRAN2,1,TPSNOW%NLAYER,YRECFM,HDIR=YDIR)
+ DO JLAYER = 1,TPSNOW%NLAYER
+ WHERE (TPSNOW%WSNOW(:,1,:) == 0.0) TPSNOW%GRAN2(:,JLAYER,:) = XUNDEF
+ ENDDO
+ END IF
+!
+!* 11. Historical parameter
+! -------------------
+!
+ IF (TPSNOW%SCHEME=='CRO') THEN
+ IF (IVERSION<7 .OR. IVERSION==7 .AND. IBUGFIX<3) THEN
+ YRECFM='SHIST_'//HSURFTYPE
+ ELSE
+ YRECFM=ADJUSTL(HPREFIX//'SHI_'//HSURFTYPE)
+ ENDIF
+ CALL READ_SURF_FIELD3D(HPROGRAM,TPSNOW%HIST,1,TPSNOW%NLAYER,YRECFM,HDIR=YDIR)
+ DO JLAYER = 1,TPSNOW%NLAYER
+ WHERE (TPSNOW%WSNOW(:,1,:) == 0.0) TPSNOW%HIST(:,JLAYER,:) = XUNDEF
+ ENDDO
+ END IF
+!
+!* 12. Age parameter
+! -------------------
+!
+ IF (TPSNOW%SCHEME=='CRO') THEN
+ IF (IVERSION<7 .OR. IVERSION==7 .AND. IBUGFIX<3) THEN
+ YRECFM='SAGE_'//HSURFTYPE
+ ELSE
+ YRECFM=ADJUSTL(HPREFIX//'SAG_'//HSURFTYPE)
+ ENDIF
+ CALL READ_SURF_FIELD3D(HPROGRAM,TPSNOW%AGE,1,TPSNOW%NLAYER,YRECFM,HDIR=YDIR)
+ DO JLAYER = 1,TPSNOW%NLAYER
+ WHERE (TPSNOW%WSNOW(:,1,:) == 0.0) TPSNOW%AGE(:,JLAYER,:) = XUNDEF
+ ENDDO
+ END IF
+!-------------------------------------------------------------------------------
+!
+!
+DEALLOCATE(ZWORK)
+!-------------------------------------------------------------------------------
+!
+!* 13. Albedo
+! ------
+!
+IF (TPSNOW%SCHEME=='D95' .OR. TPSNOW%SCHEME=='EBA' .OR. TPSNOW%SCHEME=='1-L' .OR. TPSNOW%SCHEME=='3-L' &
+ .OR. TPSNOW%SCHEME=='CRO') THEN
+
+ IF (IVERSION<7 .OR. IVERSION==7 .AND. IBUGFIX<3) THEN
+ YRECFM='ASNOW_'//HSURFTYPE
+ ELSE
+ YRECFM=ADJUSTL(HPREFIX//'ASN_'//HSURFTYPE)
+ ENDIF
+ CALL READ_SURF_FIELD2D(HPROGRAM,TPSNOW%ALB,YRECFM,HDIR=YDIR)
+ WHERE (TPSNOW%WSNOW(:,1,:) == 0.0) TPSNOW%ALB(:,:) = XUNDEF
+END IF
+IF (LHOOK) CALL DR_HOOK('READ_GR_SNOW',1,ZHOOK_HANDLE)
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE READ_GR_SNOW
diff --git a/src/SURFEX/read_isban.F90 b/src/SURFEX/read_isban.F90
index 5fe79ab65..9c84ca754 100644
--- a/src/SURFEX/read_isban.F90
+++ b/src/SURFEX/read_isban.F90
@@ -1,543 +1,336 @@
-!SURFEX_LIC Copyright 1994-2014 Meteo-France
-!SURFEX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SURFEX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SURFEX_LIC for details. version 1.
-! #########
- SUBROUTINE READ_ISBA_n(HPROGRAM)
-! ##################################
-!
-!!**** *READ_ISBA_n* - routine to initialise ISBA variables
-!!
-!!
-!! PURPOSE
-!! -------
-!!
-!!** METHOD
-!! ------
-!!
-!! EXTERNAL
-!! --------
-!!
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! V. Masson *Meteo France*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 01/2003
-!!
-!! READ_SURF for general reading : 08/2003 (S.Malardel)
-!! B. Decharme 2008 : Floodplains
-!! B. Decharme 01/2009 : Optional Arpege deep soil temperature read
-!! A.L. Gibelin 03/09 : modifications for CENTURY model
-!! A.L. Gibelin 04/2009 : BIOMASS and RESP_BIOMASS arrays
-!! A.L. Gibelin 06/2009 : Soil carbon variables for CNT option
-!! B. Decharme 09/2012 : suppress NWG_LAYER (parallelization problems)
-!! M.Moge 08/2015 reading SURFEX 3D fields one patch at a time for Z-parallel splitting with MNH
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-!
-USE MODD_CO2V_PAR, ONLY : XANFMINIT, XCONDCTMIN
-USE MODD_ISBA_n, ONLY : NGROUND_LAYER, NPATCH, NNBIOMASS, &
- NNLITTER, NNLITTLEVS, NNSOILCARB, &
- CPHOTO, CRESPSL, XTSRAD_NAT, &
- XTG, XWG, XWGI, XWR, XLAI, TSNOW, &
- XRESA, XANFM, XAN, XLE, XANDAY, &
- XBSLAI, XBIOMASS, XRESP_BIOMASS, &
- XLITTER, XSOILCARB, XLIGNIN_STRUC, &
- LFLOOD, XZ0_FLOOD, LTEMP_ARP, &
- NTEMPLAYER_ARP, LGLACIER, XICE_STO
-!
-USE MODD_SURF_PAR, ONLY : XUNDEF, NUNDEF
-USE MODD_SNOW_PAR, ONLY : XZ0SN
-!
-USE MODI_READ_SURF
-!
-USE MODI_READ_GR_SNOW
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-USE MODI_GET_TYPE_DIM_n
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of arguments
-! -------------------------
-!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
-!
-!* 0.2 Declarations of local variables
-! -------------------------------
-INTEGER :: ILU ! 1D physical dimension
-!
-INTEGER :: IRESP ! Error code after redding
-!
- CHARACTER(LEN=12) :: YRECFM ! Name of the article to be read
-!
- CHARACTER(LEN=4) :: YLVL
- CHARACTER(LEN=8) :: YPATCH
-!
-REAL, DIMENSION(:,:),ALLOCATABLE :: ZWORK ! 2D array to write data in file
-!
-INTEGER :: IWORK ! Work integer
-!
-INTEGER :: JP, JL, JNBIOMASS, JNLITTER, JNSOILCARB, JNLITTLEVS ! loop counter on layers
-INTEGER :: JPATCH ! loop counter on patches
-!
-INTEGER :: IVERSION ! surface version
-INTEGER :: IBUGFIX
-!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* 1D physical dimension
-!
-IF (LHOOK) CALL DR_HOOK('READ_ISBA_N',0,ZHOOK_HANDLE)
-YRECFM='SIZE_NATURE'
- CALL GET_TYPE_DIM_n('NATURE',ILU)
-!
-!
-!* 2. Prognostic fields:
-! -----------------
-!
-ALLOCATE(ZWORK(ILU,NPATCH))
-!* soil temperatures
-!
-IF(LTEMP_ARP)THEN
- IWORK=NTEMPLAYER_ARP
-ELSE
- IWORK=NGROUND_LAYER
-ENDIF
-!
-ALLOCATE(XTG(ILU,IWORK,NPATCH))
-!
-DO JL=1,IWORK
-#ifdef MNH_PARALLEL
- DO JPATCH=1,NPATCH
- IF (JL >= 10) WRITE(YPATCH,'(I2,I4.4)') JL,JPATCH
- IF (JL < 10) WRITE(YPATCH,FMT='(I1,I4.4)') JL,JPATCH
- YRECFM='TG'//ADJUSTL(YPATCH(:LEN_TRIM(YPATCH)))
- CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,JPATCH),IRESP)
- XTG(:,JL,JPATCH)=ZWORK(:,JPATCH)
- END DO
-#else
- WRITE(YLVL,'(I4)') JL
- YRECFM='TG'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
- CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,:),IRESP)
- XTG(:,JL,:)=ZWORK
-#endif
-END DO
-!
-!
-!* soil liquid and ice water contents
-!
-ALLOCATE(XWG (ILU,NGROUND_LAYER,NPATCH))
-ALLOCATE(XWGI(ILU,NGROUND_LAYER,NPATCH))
-!
-XWG (:,:,:)=XUNDEF
-XWGI(:,:,:)=XUNDEF
-!
-DO JL=1,NGROUND_LAYER
-#ifdef MNH_PARALLEL
- DO JPATCH=1,NPATCH
- IF (JL >= 10) WRITE(YPATCH,'(I2,I4.4)') JL,JPATCH
- IF (JL < 10) WRITE(YPATCH,FMT='(I1,I4.4)') JL,JPATCH
- YRECFM='WG'//ADJUSTL(YPATCH(:LEN_TRIM(YPATCH)))
- CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,JPATCH),IRESP)
- XWG(:,JL,JPATCH)=ZWORK(:,JPATCH)
- END DO
-#else
- WRITE(YLVL,'(I4)') JL
- YRECFM='WG'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
- CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,:),IRESP)
- XWG(:,JL,:)=ZWORK
-#endif
-END DO
-!
-DO JL=1,NGROUND_LAYER
-#ifdef MNH_PARALLEL
- DO JPATCH=1,NPATCH
- IF (JL >= 10) WRITE(YPATCH,'(I2,I4.4)') JL,JPATCH
- IF (JL < 10) WRITE(YPATCH,FMT='(I1,I4.4)') JL,JPATCH
- YRECFM='WGI'//ADJUSTL(YPATCH(:LEN_TRIM(YPATCH)))
- CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,JPATCH),IRESP)
- XWGI(:,JL,JPATCH)=ZWORK(:,JPATCH)
- END DO
-#else
- WRITE(YLVL,'(I4)') JL
- YRECFM='WGI'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
- CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,:),IRESP)
- XWGI(:,JL,:)=ZWORK
-#endif
-END DO
-!
-!* water intercepted on leaves
-!
-ALLOCATE(XWR(ILU,NPATCH))
-!
-YRECFM = 'WR'
-#ifdef MNH_PARALLEL
-DO JPATCH=1,NPATCH
- WRITE(YRECFM,'(A2,I4.4)') 'WR',JPATCH
- CALL READ_SURF(HPROGRAM,YRECFM,XWR(:,JPATCH),IRESP)
-END DO
-#else
- CALL READ_SURF(HPROGRAM,YRECFM,XWR(:,:),IRESP)
-#endif
-!
-!* roughness length of Flood water
-!
-IF(LFLOOD)THEN
- ALLOCATE(XZ0_FLOOD(ILU,NPATCH))
- YRECFM = 'Z0_FLOOD'
-#ifdef MNH_PARALLEL
- DO JPATCH=1,NPATCH
- WRITE(YRECFM,'(A8,I4.4)') 'Z0_FLOOD',JPATCH
- CALL READ_SURF(HPROGRAM,YRECFM,XZ0_FLOOD(:,JPATCH),IRESP)
- END DO
-#else
- CALL READ_SURF(HPROGRAM,YRECFM,XZ0_FLOOD(:,:),IRESP)
-#endif
-ENDIF
-!
-!* Leaf Area Index
-!
-IF (CPHOTO=='LAI' .OR. CPHOTO=='LST' .OR. CPHOTO=='NIT' .OR. CPHOTO=='NCB') THEN
- YRECFM = 'LAI'
-#ifdef MNH_PARALLEL
- DO JPATCH=1,NPATCH
- WRITE(YRECFM,'(A3,I4.4)') 'LAI',JPATCH
- CALL READ_SURF(HPROGRAM,YRECFM,XLAI(:,JPATCH),IRESP)
- END DO
-#else
- CALL READ_SURF(HPROGRAM,YRECFM,XLAI(:,:),IRESP)
-#endif
-END IF
-!
-!* snow mantel
-!
- CALL READ_GR_SNOW(HPROGRAM,'VEG',' ',ILU,NPATCH,TSNOW )
-!
-YRECFM='VERSION'
- CALL READ_SURF(HPROGRAM,YRECFM,IVERSION,IRESP)
-!
-YRECFM='BUG'
- CALL READ_SURF(HPROGRAM,YRECFM,IBUGFIX,IRESP)
-!
-IF(LGLACIER)THEN
- ALLOCATE(XICE_STO(ILU,NPATCH))
- IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=2) THEN
- YRECFM = 'ICE_STO'
-#ifdef MNH_PARALLEL
- DO JPATCH=1,NPATCH
- WRITE(YRECFM,'(A7,I4.4)') 'ICE_STO',JPATCH
- CALL READ_SURF(HPROGRAM,YRECFM,XICE_STO(:,JPATCH),IRESP)
- END DO
-#else
- CALL READ_SURF(HPROGRAM,YRECFM,XICE_STO(:,:),IRESP)
-#endif
- ELSE
- XICE_STO(:,:) = 0.0
- ENDIF
-ENDIF
-!
-!-------------------------------------------------------------------------------
-!
-!* 4. Semi-prognostic variables
-! -------------------------
-!
-ALLOCATE(XRESA(ILU,NPATCH))
-ALLOCATE(XLE (ILU,NPATCH))
-IF (CPHOTO/='NON') THEN
- ALLOCATE(XANFM (ILU,NPATCH))
- ALLOCATE(XAN (ILU,NPATCH))
- ALLOCATE(XANDAY (ILU,NPATCH))
-END IF
-!
-IF(CPHOTO/='NON') THEN
- ALLOCATE(XBIOMASS (ILU,NNBIOMASS,NPATCH))
- ALLOCATE(XRESP_BIOMASS (ILU,NNBIOMASS,NPATCH))
-END IF
-!
-!
-!* aerodynamical resistance
-!
-YRECFM = 'RESA'
-XRESA(:,:) = 100.
-#ifdef MNH_PARALLEL
-DO JPATCH=1,NPATCH
- WRITE(YRECFM,'(A4,I4.4)') 'RESA',JPATCH
- CALL READ_SURF(HPROGRAM,YRECFM,XRESA(:,JPATCH),IRESP)
-END DO
-#else
- CALL READ_SURF(HPROGRAM,YRECFM,XRESA(:,:),IRESP)
-#endif
-!
-!* patch averaged radiative temperature (K)
-!
-ALLOCATE(XTSRAD_NAT(ILU))
-IF (IVERSION<6) THEN
- XTSRAD_NAT(:)=0.
- DO JP=1,NPATCH
- XTSRAD_NAT(:)=XTSRAD_NAT(:)+XTG(:,1,JP)
- ENDDO
- XTSRAD_NAT(:)=XTSRAD_NAT(:)/NPATCH
-ELSE
- YRECFM='TSRAD_NAT'
- CALL READ_SURF(HPROGRAM,YRECFM,XTSRAD_NAT(:),IRESP)
-ENDIF
-!
-XLE(:,:) = XUNDEF
-!
-!* 5. ISBA-AGS variables
-!
-IF (CPHOTO/='NON') THEN
- YRECFM = 'AN'
- XAN(:,:) = 0.
-#ifdef MNH_PARALLEL
- DO JPATCH=1,NPATCH
- WRITE(YRECFM,'(A2,I4.4)') 'AN',JPATCH
- CALL READ_SURF(HPROGRAM,YRECFM,XAN(:,JPATCH),IRESP)
- END DO
-#else
- CALL READ_SURF(HPROGRAM,YRECFM,XAN(:,:),IRESP)
-#endif
- !
- YRECFM = 'ANDAY'
- XANDAY(:,:) = 0.
-#ifdef MNH_PARALLEL
- DO JPATCH=1,NPATCH
- WRITE(YRECFM,'(A5,I4.4)') 'ANDAY',JPATCH
- CALL READ_SURF(HPROGRAM,YRECFM,XANDAY(:,JPATCH),IRESP)
- END DO
-#else
- CALL READ_SURF(HPROGRAM,YRECFM,XANDAY(:,:),IRESP)
-#endif
- !
- YRECFM = 'ANFM'
- XANFM(:,:) = XANFMINIT
-#ifdef MNH_PARALLEL
- DO JPATCH=1,NPATCH
- WRITE(YRECFM,'(A4,I4.4)') 'ANFM',JPATCH
- CALL READ_SURF(HPROGRAM,YRECFM,XANFM(:,JPATCH),IRESP)
- END DO
-#else
- CALL READ_SURF(HPROGRAM,YRECFM,XANFM(:,:),IRESP)
-#endif
- !
- YRECFM = 'LE_AGS'
- XLE(:,:) = 0.
-#ifdef MNH_PARALLEL
- DO JPATCH=1,NPATCH
- WRITE(YRECFM,'(A6,I4.4)') 'LE_AGS',JPATCH
- CALL READ_SURF(HPROGRAM,YRECFM,XLE(:,JPATCH),IRESP)
- END DO
-#else
- CALL READ_SURF(HPROGRAM,YRECFM,XLE(:,:),IRESP)
-#endif
-END IF
-!
-IF (CPHOTO=='AGS' .OR. CPHOTO=='AST') THEN
- !
- XBIOMASS(:,:,:) = 0.
- XRESP_BIOMASS(:,:,:) = 0.
-
-ELSEIF (CPHOTO=='LAI' .OR. CPHOTO=='LST') THEN
- !
- XBIOMASS(:,1,:) = XBSLAI(:,:) * XLAI(:,:)
- XRESP_BIOMASS(:,:,:) = 0.
-
-ELSEIF (CPHOTO=='NIT') THEN
- !
- XBIOMASS(:,:,:) = 0.
- DO JNBIOMASS=1,NNBIOMASS
-#ifdef MNH_PARALLEL
- DO JPATCH=1,NPATCH
- WRITE(YPATCH,'(I1,I4.4)') JNBIOMASS,JPATCH
- IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) THEN
- YRECFM='BIOMA'//ADJUSTL(YPATCH(:LEN_TRIM(YPATCH)))
- ELSE
- YRECFM='BIOMASS'//ADJUSTL(YPATCH(:LEN_TRIM(YPATCH)))
- ENDIF
- CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,JPATCH),IRESP)
- XBIOMASS(:,JNBIOMASS,JPATCH)=ZWORK(:,JPATCH)
- END DO
-#else
- WRITE(YLVL,'(I1)') JNBIOMASS
- IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) THEN
- YRECFM='BIOMA'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
- ELSE
- YRECFM='BIOMASS'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
- ENDIF
- CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,:),IRESP)
- XBIOMASS(:,JNBIOMASS,:)=ZWORK
-#endif
- END DO
-
- XRESP_BIOMASS(:,:,:) = 0.
- DO JNBIOMASS=2,NNBIOMASS
-#ifdef MNH_PARALLEL
- DO JPATCH=1,NPATCH
- WRITE(YPATCH,'(I1,I4.4)') JNBIOMASS,JPATCH
- IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) THEN
- YRECFM='RESPI'//ADJUSTL(YPATCH(:LEN_TRIM(YPATCH)))
- ELSE
- YRECFM='RESP_BIOM'//ADJUSTL(YPATCH(:LEN_TRIM(YPATCH)))
- ENDIF
- CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,JPATCH),IRESP)
- XRESP_BIOMASS(:,JNBIOMASS,JPATCH)=ZWORK(:,JPATCH)
- END DO
-#else
- WRITE(YLVL,'(I1)') JNBIOMASS
- IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) THEN
- YRECFM='RESPI'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
- ELSE
- YRECFM='RESP_BIOM'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
- ENDIF
- CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,:),IRESP)
- XRESP_BIOMASS(:,JNBIOMASS,:)=ZWORK
-#endif
- END DO
-
-ELSEIF (CPHOTO=='NCB') THEN
- !
- XBIOMASS(:,:,:) = 0.
- DO JNBIOMASS=1,NNBIOMASS
-#ifdef MNH_PARALLEL
- DO JPATCH=1,NPATCH
- WRITE(YPATCH,'(I1,I4.4)') JNBIOMASS,JPATCH
- IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) THEN
- YRECFM='BIOMA'//ADJUSTL(YPATCH(:LEN_TRIM(YPATCH)))
- ELSE
- YRECFM='BIOMASS'//ADJUSTL(YPATCH(:LEN_TRIM(YPATCH)))
- ENDIF
- CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,JPATCH),IRESP)
- XBIOMASS(:,JNBIOMASS,JPATCH)=ZWORK(:,JPATCH)
- END DO
-#else
- WRITE(YLVL,'(I1)') JNBIOMASS
- IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) THEN
- YRECFM='BIOMA'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
- ELSE
- YRECFM='BIOMASS'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
- ENDIF
- CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,:),IRESP)
- XBIOMASS(:,JNBIOMASS,:)=ZWORK
-#endif
- END DO
-
- XRESP_BIOMASS(:,:,:) = 0.
- DO JNBIOMASS=2,NNBIOMASS-2
-#ifdef MNH_PARALLEL
- DO JPATCH=1,NPATCH
- WRITE(YPATCH,'(I1,I4.4)') JNBIOMASS,JPATCH
- IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) THEN
- YRECFM='RESPI'//ADJUSTL(YPATCH(:LEN_TRIM(YPATCH)))
- ELSE
- YRECFM='RESP_BIOM'//ADJUSTL(YPATCH(:LEN_TRIM(YPATCH)))
- ENDIF
- CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,JPATCH),IRESP)
- XRESP_BIOMASS(:,JNBIOMASS,JPATCH)=ZWORK(:,JPATCH)
- END DO
-#else
- WRITE(YLVL,'(I1)') JNBIOMASS
- IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) THEN
- YRECFM='RESPI'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
- ELSE
- YRECFM='RESP_BIOM'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
- ENDIF
- CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,:),IRESP)
- XRESP_BIOMASS(:,JNBIOMASS,:)=ZWORK
-#endif
- END DO
- !
-ENDIF
-!
-!* 6. Soil carbon
-!
-!
-IF (CRESPSL=='CNT') THEN
- ALLOCATE(XLITTER (ILU,NNLITTER,NNLITTLEVS,NPATCH))
- ALLOCATE(XSOILCARB (ILU,NNSOILCARB,NPATCH))
- ALLOCATE(XLIGNIN_STRUC (ILU,NNLITTLEVS,NPATCH))
-END IF
-!
-IF (CRESPSL=='CNT') THEN
- !
- XLITTER(:,:,:,:) = 0.
- DO JNLITTER=1,NNLITTER
- DO JNLITTLEVS=1,NNLITTLEVS
-#ifdef MNH_PARALLEL
- DO JPATCH=1,NPATCH
- WRITE(YPATCH,'(I1,A1,I1,I4.4)') JNLITTER,'_',JNLITTLEVS,JPATCH
- YRECFM='LITTER'//ADJUSTL(YPATCH(:LEN_TRIM(YPATCH)))
- CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,JPATCH),IRESP)
- XLITTER(:,JNLITTER,JNLITTLEVS,JPATCH)=ZWORK(:,JPATCH)
- END DO
-#else
- WRITE(YLVL,'(I1,A1,I1)') JNLITTER,'_',JNLITTLEVS
- YRECFM='LITTER'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
- CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,:),IRESP)
- XLITTER(:,JNLITTER,JNLITTLEVS,:)=ZWORK
-#endif
- END DO
- END DO
-
- XSOILCARB(:,:,:) = 0.
- DO JNSOILCARB=1,NNSOILCARB
-#ifdef MNH_PARALLEL
- DO JPATCH=1,NPATCH
- WRITE(YPATCH,'(I4,I4.4)') JNSOILCARB,JPATCH
- YRECFM='SOILCARB'//ADJUSTL(YPATCH(:LEN_TRIM(YPATCH)))
- CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,JPATCH),IRESP)
- XSOILCARB(:,JNSOILCARB,JPATCH)=ZWORK(:,JPATCH)
- END DO
-#else
- WRITE(YLVL,'(I4)') JNSOILCARB
- YRECFM='SOILCARB'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
- CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,:),IRESP)
- XSOILCARB(:,JNSOILCARB,:)=ZWORK
-#endif
- END DO
-!
- XLIGNIN_STRUC(:,:,:) = 0.
- DO JNLITTLEVS=1,NNLITTLEVS
-#ifdef MNH_PARALLEL
- DO JPATCH=1,NPATCH
- WRITE(YPATCH,'(I4,I4.4)') JNLITTLEVS,JPATCH
- YRECFM='LIGNIN_STR'//ADJUSTL(YPATCH(:LEN_TRIM(YPATCH)))
- CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,JPATCH),IRESP)
- XLIGNIN_STRUC(:,JNLITTLEVS,JPATCH)=ZWORK(:,JPATCH)
- END DO
-#else
- WRITE(YLVL,'(I4)') JNLITTLEVS
- YRECFM='LIGNIN_STR'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
- CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,:),IRESP)
- XLIGNIN_STRUC(:,JNLITTLEVS,:)=ZWORK
-#endif
- END DO
-!
-ENDIF
-!
-!
-DEALLOCATE(ZWORK)
-IF (LHOOK) CALL DR_HOOK('READ_ISBA_N',1,ZHOOK_HANDLE)
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE READ_ISBA_n
+!SURFEX_LIC Copyright 1994-2014 Meteo-France
+!SURFEX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SURFEX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SURFEX_LIC for details. version 1.
+! #########
+ SUBROUTINE READ_ISBA_n(HPROGRAM)
+! ##################################
+!
+!!**** *READ_ISBA_n* - routine to initialise ISBA variables
+!!
+!!
+!! PURPOSE
+!! -------
+!!
+!!** METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Masson *Meteo France*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 01/2003
+!!
+!! READ_SURF for general reading : 08/2003 (S.Malardel)
+!! B. Decharme 2008 : Floodplains
+!! B. Decharme 01/2009 : Optional Arpege deep soil temperature read
+!! A.L. Gibelin 03/09 : modifications for CENTURY model
+!! A.L. Gibelin 04/2009 : BIOMASS and RESP_BIOMASS arrays
+!! A.L. Gibelin 06/2009 : Soil carbon variables for CNT option
+!! B. Decharme 09/2012 : suppress NWG_LAYER (parallelization problems)
+!! M.Moge 01/2016 using READ_SURF_FIELD2D/3D for 2D/3D surfex fields reads
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+!
+USE MODD_CO2V_PAR, ONLY : XANFMINIT, XCONDCTMIN
+USE MODD_ISBA_n, ONLY : NGROUND_LAYER, NPATCH, NNBIOMASS, &
+ NNLITTER, NNLITTLEVS, NNSOILCARB, &
+ CPHOTO, CRESPSL, XTSRAD_NAT, &
+ XTG, XWG, XWGI, XWR, XLAI, TSNOW, &
+ XRESA, XANFM, XAN, XLE, XANDAY, &
+ XBSLAI, XBIOMASS, XRESP_BIOMASS, &
+ XLITTER, XSOILCARB, XLIGNIN_STRUC, &
+ LFLOOD, XZ0_FLOOD, LTEMP_ARP, &
+ NTEMPLAYER_ARP, LGLACIER, XICE_STO
+!
+USE MODD_SURF_PAR, ONLY : XUNDEF, NUNDEF
+USE MODD_SNOW_PAR, ONLY : XZ0SN
+!
+USE MODI_READ_SURF
+USE MODI_READ_SURF_FIELD3D
+USE MODI_READ_SURF_FIELD2D
+!
+USE MODI_READ_GR_SNOW
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+USE MODI_GET_TYPE_DIM_n
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of arguments
+! -------------------------
+!
+ CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
+!
+!* 0.2 Declarations of local variables
+! -------------------------------
+INTEGER :: ILU ! 1D physical dimension
+!
+INTEGER :: IRESP ! Error code after redding
+!
+ CHARACTER(LEN=12) :: YRECFM ! Name of the article to be read
+!
+ CHARACTER(LEN=4) :: YLVL
+ CHARACTER(LEN=8) :: YPATCH
+!
+REAL, DIMENSION(:,:),ALLOCATABLE :: ZWORK ! 2D array to write data in file
+!
+INTEGER :: IWORK ! Work integer
+!
+INTEGER :: JP, JL, JNBIOMASS, JNLITTER, JNSOILCARB, JNLITTLEVS ! loop counter on layers
+!
+INTEGER :: IVERSION ! surface version
+INTEGER :: IBUGFIX
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 1D physical dimension
+!
+IF (LHOOK) CALL DR_HOOK('READ_ISBA_N',0,ZHOOK_HANDLE)
+YRECFM='SIZE_NATURE'
+ CALL GET_TYPE_DIM_n('NATURE',ILU)
+!
+!
+!* 2. Prognostic fields:
+! -----------------
+!
+ALLOCATE(ZWORK(ILU,NPATCH))
+!* soil temperatures
+!
+IF(LTEMP_ARP)THEN
+ IWORK=NTEMPLAYER_ARP
+ELSE
+ IWORK=NGROUND_LAYER
+ENDIF
+!
+ALLOCATE(XTG(ILU,IWORK,NPATCH))
+!
+YRECFM='TG'
+CALL READ_SURF_FIELD3D(HPROGRAM,XTG,1,IWORK,YRECFM)
+!
+!
+!* soil liquid and ice water contents
+!
+ALLOCATE(XWG (ILU,NGROUND_LAYER,NPATCH))
+ALLOCATE(XWGI(ILU,NGROUND_LAYER,NPATCH))
+!
+XWG (:,:,:)=XUNDEF
+XWGI(:,:,:)=XUNDEF
+!
+YRECFM='WG'
+CALL READ_SURF_FIELD3D(HPROGRAM,XWG,1,NGROUND_LAYER,YRECFM)
+!
+YRECFM='WGI'
+CALL READ_SURF_FIELD3D(HPROGRAM,XWGI,1,NGROUND_LAYER,YRECFM)
+!
+!* water intercepted on leaves
+!
+ALLOCATE(XWR(ILU,NPATCH))
+!
+YRECFM='WR'
+CALL READ_SURF_FIELD2D(HPROGRAM,XWR,YRECFM)
+!
+!* roughness length of Flood water
+!
+IF(LFLOOD)THEN
+ ALLOCATE(XZ0_FLOOD(ILU,NPATCH))
+ YRECFM = 'Z0_FLOOD'
+ CALL READ_SURF_FIELD2D(HPROGRAM,XZ0_FLOOD,YRECFM)
+ENDIF
+!
+!* Leaf Area Index
+!
+IF (CPHOTO=='LAI' .OR. CPHOTO=='LST' .OR. CPHOTO=='NIT' .OR. CPHOTO=='NCB') THEN
+ YRECFM = 'LAI'
+ CALL READ_SURF_FIELD2D(HPROGRAM,XLAI,YRECFM)
+END IF
+!
+!* snow mantel
+!
+ CALL READ_GR_SNOW(HPROGRAM,'VEG',' ',ILU,NPATCH,TSNOW )
+!
+YRECFM='VERSION'
+ CALL READ_SURF(HPROGRAM,YRECFM,IVERSION,IRESP)
+!
+YRECFM='BUG'
+ CALL READ_SURF(HPROGRAM,YRECFM,IBUGFIX,IRESP)
+!
+IF(LGLACIER)THEN
+ ALLOCATE(XICE_STO(ILU,NPATCH))
+ IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=2) THEN
+ YRECFM = 'ICE_STO'
+ CALL READ_SURF_FIELD2D(HPROGRAM,XICE_STO,YRECFM)
+ ELSE
+ XICE_STO(:,:) = 0.0
+ ENDIF
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+!* 4. Semi-prognostic variables
+! -------------------------
+!
+ALLOCATE(XRESA(ILU,NPATCH))
+ALLOCATE(XLE (ILU,NPATCH))
+IF (CPHOTO/='NON') THEN
+ ALLOCATE(XANFM (ILU,NPATCH))
+ ALLOCATE(XAN (ILU,NPATCH))
+ ALLOCATE(XANDAY (ILU,NPATCH))
+END IF
+!
+IF(CPHOTO/='NON') THEN
+ ALLOCATE(XBIOMASS (ILU,NNBIOMASS,NPATCH))
+ ALLOCATE(XRESP_BIOMASS (ILU,NNBIOMASS,NPATCH))
+END IF
+!
+!
+!* aerodynamical resistance
+!
+YRECFM = 'RESA'
+XRESA(:,:) = 100.
+CALL READ_SURF_FIELD2D(HPROGRAM,XRESA,YRECFM)
+!
+!* patch averaged radiative temperature (K)
+!
+ALLOCATE(XTSRAD_NAT(ILU))
+IF (IVERSION<6) THEN
+ XTSRAD_NAT(:)=0.
+ DO JP=1,NPATCH
+ XTSRAD_NAT(:)=XTSRAD_NAT(:)+XTG(:,1,JP)
+ ENDDO
+ XTSRAD_NAT(:)=XTSRAD_NAT(:)/NPATCH
+ELSE
+ YRECFM='TSRAD_NAT'
+ CALL READ_SURF(HPROGRAM,YRECFM,XTSRAD_NAT(:),IRESP)
+ENDIF
+!
+XLE(:,:) = XUNDEF
+!
+!* 5. ISBA-AGS variables
+!
+IF (CPHOTO/='NON') THEN
+ YRECFM = 'AN'
+ XAN(:,:) = 0.
+ CALL READ_SURF_FIELD2D(HPROGRAM,XAN,YRECFM)
+ !
+ YRECFM = 'ANDAY'
+ XANDAY(:,:) = 0.
+ CALL READ_SURF_FIELD2D(HPROGRAM,XANDAY,YRECFM)
+ !
+ YRECFM = 'ANFM'
+ XANFM(:,:) = XANFMINIT
+ CALL READ_SURF_FIELD2D(HPROGRAM,XANFM,YRECFM)
+ !
+ YRECFM = 'LE_AGS'
+ XLE(:,:) = 0.
+ CALL READ_SURF_FIELD2D(HPROGRAM,XLE,YRECFM)
+END IF
+!
+IF (CPHOTO=='AGS' .OR. CPHOTO=='AST') THEN
+ !
+ XBIOMASS(:,:,:) = 0.
+ XRESP_BIOMASS(:,:,:) = 0.
+
+ELSEIF (CPHOTO=='LAI' .OR. CPHOTO=='LST') THEN
+ !
+ XBIOMASS(:,1,:) = XBSLAI(:,:) * XLAI(:,:)
+ XRESP_BIOMASS(:,:,:) = 0.
+
+ELSEIF (CPHOTO=='NIT') THEN
+ !
+ XBIOMASS(:,:,:) = 0.
+ IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) THEN
+ YRECFM='BIOMA'
+ ELSE
+ YRECFM='BIOMASS'
+ ENDIF
+ CALL READ_SURF_FIELD3D(HPROGRAM,XBIOMASS,1,NNBIOMASS,YRECFM)
+ !
+ XRESP_BIOMASS(:,:,:) = 0.
+ IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) THEN
+ YRECFM='RESPI'
+ ELSE
+ YRECFM='RESP_BIOM'
+ ENDIF
+ CALL READ_SURF_FIELD3D(HPROGRAM,XRESP_BIOMASS,2,NNBIOMASS,YRECFM)
+ !
+ELSEIF (CPHOTO=='NCB') THEN
+ !
+ XBIOMASS(:,:,:) = 0.
+ IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) THEN
+ YRECFM='BIOMA'
+ ELSE
+ YRECFM='BIOMASS'
+ ENDIF
+ CALL READ_SURF_FIELD3D(HPROGRAM,XBIOMASS,1,NNBIOMASS,YRECFM)
+ !
+ XRESP_BIOMASS(:,:,:) = 0.
+ IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) THEN
+ YRECFM='RESPI'
+ ELSE
+ YRECFM='RESP_BIOM'
+ ENDIF
+ CALL READ_SURF_FIELD3D(HPROGRAM,XRESP_BIOMASS,2,NNBIOMASS-2,YRECFM)
+ !
+ENDIF
+!
+!* 6. Soil carbon
+!
+!
+IF (CRESPSL=='CNT') THEN
+ ALLOCATE(XLITTER (ILU,NNLITTER,NNLITTLEVS,NPATCH))
+ ALLOCATE(XSOILCARB (ILU,NNSOILCARB,NPATCH))
+ ALLOCATE(XLIGNIN_STRUC (ILU,NNLITTLEVS,NPATCH))
+END IF
+!
+IF (CRESPSL=='CNT') THEN
+ !
+ XLITTER(:,:,:,:) = 0.
+ DO JNLITTER=1,NNLITTER
+ DO JNLITTLEVS=1,NNLITTLEVS
+ WRITE(YLVL,'(I1,A1,I1)') JNLITTER,'_',JNLITTLEVS
+ YRECFM='LITTER'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
+ CALL READ_SURF_FIELD2D(HPROGRAM,ZWORK(:,:),YRECFM)
+ XLITTER(:,JNLITTER,JNLITTLEVS,:)=ZWORK
+ END DO
+ END DO
+
+ XSOILCARB(:,:,:) = 0.
+ YRECFM='SOILCARB'
+ CALL READ_SURF_FIELD3D(HPROGRAM,XSOILCARB,1,NNSOILCARB,YRECFM)
+!
+ XLIGNIN_STRUC(:,:,:) = 0.
+ YRECFM='LIGNIN_STR'
+ CALL READ_SURF_FIELD3D(HPROGRAM,XLIGNIN_STRUC,1,NNLITTLEVS,YRECFM)
+!
+ENDIF
+!
+!
+DEALLOCATE(ZWORK)
+IF (LHOOK) CALL DR_HOOK('READ_ISBA_N',1,ZHOOK_HANDLE)
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE READ_ISBA_n
diff --git a/src/SURFEX/read_pgd_isba_parn.F90 b/src/SURFEX/read_pgd_isba_parn.F90
index c7a4971c7..1c70cab75 100644
--- a/src/SURFEX/read_pgd_isba_parn.F90
+++ b/src/SURFEX/read_pgd_isba_parn.F90
@@ -1,678 +1,680 @@
-!SURFEX_LIC Copyright 1994-2014 Meteo-France
-!SURFEX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SURFEX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SURFEX_LIC for details. version 1.
-! #########
- SUBROUTINE READ_PGD_ISBA_PAR_n(HPROGRAM,KSIZE,OLAND_USE,HDIR)
-! ################################################
-!
-!!**** *READ_PGD_ISBA_PAR_n* - reads ISBA physiographic fields
-!!
-!! PURPOSE
-!! -------
-!!
-!!** METHOD
-!! ------
-!!
-!! EXTERNAL
-!! --------
-!!
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! V. Masson *Meteo France*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 01/2003
-!! P. Le Moigne 12/2004 : add type of photosynthesis
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE
-USE MODD_PREP, ONLY : LINTERP
-!
-USE MODD_ISBA_GRID_n, ONLY : NDIM
-USE MODD_ISBA_n, ONLY : LECOCLIMAP, NGROUND_LAYER
-USE MODD_DATA_ISBA_n, ONLY : NTIME, XPAR_VEG, XPAR_LAI,XPAR_RSMIN,XPAR_GAMMA,XPAR_WRMAX_CF, &
- XPAR_RGL,XPAR_CV,XPAR_DG,XPAR_Z0,XPAR_Z0_O_Z0H, &
- XPAR_ALBNIR_VEG,XPAR_ALBVIS_VEG, XPAR_ALBUV_VEG, &
- XPAR_ALBNIR_SOIL,XPAR_ALBVIS_SOIL, XPAR_ALBUV_SOIL, &
- XPAR_EMIS, XPAR_DICE, &
- XPAR_VEGTYPE,XPAR_ROOTFRAC, &
- XPAR_GMES,XPAR_BSLAI,XPAR_LAIMIN,XPAR_SEFOLD,XPAR_GC, &
- XPAR_DMAX, XPAR_F2I, LPAR_STRESS, XPAR_H_TREE,XPAR_RE25,&
- XPAR_CE_NITRO,XPAR_CF_NITRO,XPAR_CNA_NITRO, &
- XPAR_GROUND_DEPTH, XPAR_ROOT_DEPTH, &
- XPAR_ROOT_EXTINCTION, XPAR_ROOT_LIN, &
- LPAR_STRESS, XPAR_IRRIG, XPAR_WATSUP, &
- LDATA_VEGTYPE, LDATA_LAI, LDATA_H_TREE, LDATA_DG, LDATA_ROOTFRAC,&
- LDATA_VEG, LDATA_Z0, LDATA_EMIS, LDATA_DICE, &
- LDATA_RSMIN, LDATA_GAMMA, LDATA_WRMAX_CF, LDATA_RGL, &
- LDATA_CV, LDATA_Z0_O_Z0H, &
- LDATA_ALBNIR_VEG, LDATA_ALBVIS_VEG, LDATA_ALBUV_VEG, &
- LDATA_ALBVIS_SOIL, LDATA_ALBNIR_SOIL, LDATA_ALBUV_SOIL, &
- LDATA_GMES, LDATA_BSLAI, LDATA_SEFOLD, LDATA_GC, LDATA_DMAX, &
- LDATA_RE25, LDATA_LAIMIN, LDATA_F2I, &
- LDATA_CE_NITRO,LDATA_CF_NITRO, LDATA_CNA_NITRO,&
- LDATA_STRESS, LDATA_IRRIG, LDATA_WATSUP ,&
- LDATA_GROUND_DEPTH, LDATA_ROOT_DEPTH, &
- LDATA_ROOT_EXTINCTION, LDATA_ROOT_LIN, LDATA_MIXPAR
-!
-USE MODI_GET_LUOUT
-USE MODI_READ_SURF
-USE MODI_HOR_INTERPOL
-USE MODI_READ_SURF_ISBA_PAR_n
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of arguments
-! -------------------------
-!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling
-INTEGER, INTENT(IN) :: KSIZE
-LOGICAL, INTENT(IN) :: OLAND_USE !
- CHARACTER(LEN=1),OPTIONAL,INTENT(IN) :: HDIR ! type of field :
-! ! 'H' : field with
-! ! horizontal spatial dim.
-! ! '-' : no horizontal dim.
-!
-!* 0.2 Declarations of local variables
-! -------------------------------
-!
-REAL, DIMENSION(KSIZE,NVEGTYPE) :: ZFIELD
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZWORK
-INTEGER :: ILUOUT
-INTEGER :: ITIME
-INTEGER :: IRESP ! IRESP : return-code if a problem appears
- CHARACTER(LEN=12) :: YRECFM ! Name of the article to be read
- CHARACTER(LEN=16) :: YRECFM2
- CHARACTER(LEN=100):: YCOMMENT ! Comment string
- CHARACTER(LEN=1) :: YDIR
-INTEGER :: JTIME ! loop index
-INTEGER :: JLAYER ! loop index
-INTEGER :: JPATCH ! loop index
-INTEGER :: IVERSION ! surface version
-INTEGER :: IBUGFIX
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-!
-!-------------------------------------------------------------------------------
-!
-IF (LHOOK) CALL DR_HOOK('READ_PGD_ISBA_PAR_N',0,ZHOOK_HANDLE)
-!
- CALL GET_LUOUT(HPROGRAM,ILUOUT)
-!
-YDIR = 'H'
-IF (PRESENT(HDIR)) YDIR = HDIR
-!
-YRECFM='VERSION'
- CALL READ_SURF(HPROGRAM,YRECFM,IVERSION,IRESP)
-WRITE(ILUOUT,*) 'read version ',IVERSION
-!
-YRECFM='BUG'
- CALL READ_SURF(HPROGRAM,YRECFM,IBUGFIX,IRESP)
-!
-LDATA_MIXPAR = .FALSE.
-!
-IF (IVERSION<7 .AND. .NOT.LECOCLIMAP) THEN
- !
- LDATA_VEGTYPE=.TRUE.
- LDATA_VEG=.TRUE.
- LDATA_LAI=.TRUE.
- LDATA_Z0=.TRUE.
- LDATA_EMIS=.TRUE.
- LDATA_RSMIN=.TRUE.
- LDATA_GAMMA=.TRUE.
- LDATA_WRMAX_CF=.TRUE.
- LDATA_RGL=.TRUE.
- LDATA_CV=.TRUE.
- LDATA_Z0_O_Z0H=.TRUE.
- LDATA_DG=.TRUE.
- LDATA_ROOTFRAC=.TRUE.
- !
- LDATA_DICE=.FALSE.
- LDATA_GROUND_DEPTH=.FALSE.
- LDATA_ROOT_DEPTH=.FALSE.
- LDATA_ROOT_LIN=.FALSE.
- LDATA_ROOT_EXTINCTION=.FALSE.
- !
- LDATA_ALBNIR_VEG=.TRUE.
- LDATA_ALBVIS_VEG=.TRUE.
- LDATA_ALBUV_VEG=.TRUE.
- LDATA_ALBNIR_SOIL=.TRUE.
- LDATA_ALBVIS_SOIL=.TRUE.
- LDATA_ALBUV_SOIL=.TRUE.
- LDATA_GMES=.TRUE.
- LDATA_BSLAI=.TRUE.
- LDATA_LAIMIN=.TRUE.
- LDATA_SEFOLD=.TRUE.
- LDATA_GC=.TRUE.
- LDATA_DMAX=.TRUE.
- LDATA_F2I=.TRUE.
- LDATA_STRESS=.TRUE.
- LDATA_H_TREE=.TRUE.
- LDATA_RE25=.TRUE.
- LDATA_CE_NITRO=.TRUE.
- LDATA_CF_NITRO=.TRUE.
- LDATA_CNA_NITRO=.TRUE.
- !
- LDATA_IRRIG=.FALSE.
- LDATA_WATSUP=.FALSE.
- !
-ENDIF
-!
-IF (.NOT.OLAND_USE) THEN
- !
- IF (IVERSION>=7) THEN
- !
- YRECFM='L_VEGTYPE'
- YCOMMENT=YRECFM
- CALL READ_SURF(HPROGRAM,YRECFM,LDATA_VEGTYPE,IRESP,HCOMMENT=YCOMMENT)
- IF (LDATA_VEGTYPE) LDATA_MIXPAR = .TRUE.
- !
- YRECFM='L_VEG'
- YCOMMENT=YRECFM
- CALL READ_SURF(HPROGRAM,YRECFM,LDATA_VEG,IRESP,HCOMMENT=YCOMMENT)
- IF (LDATA_VEG) LDATA_MIXPAR = .TRUE.
- YRECFM='L_LAI'
- YCOMMENT=YRECFM
- CALL READ_SURF(HPROGRAM,YRECFM,LDATA_LAI,IRESP,HCOMMENT=YCOMMENT)
- IF (LDATA_LAI) LDATA_MIXPAR = .TRUE.
- YRECFM='L_Z0'
- YCOMMENT=YRECFM
- CALL READ_SURF(HPROGRAM,YRECFM,LDATA_Z0,IRESP,HCOMMENT=YCOMMENT)
- IF (LDATA_Z0) LDATA_MIXPAR = .TRUE.
- YRECFM='L_EMIS'
- YCOMMENT=YRECFM
- CALL READ_SURF(HPROGRAM,YRECFM,LDATA_EMIS,IRESP,HCOMMENT=YCOMMENT)
- IF (LDATA_EMIS) LDATA_MIXPAR = .TRUE.
- !
- YRECFM='L_RSMIN'
- YCOMMENT=YRECFM
- CALL READ_SURF(HPROGRAM,YRECFM,LDATA_RSMIN,IRESP,HCOMMENT=YCOMMENT)
- IF (LDATA_RSMIN) LDATA_MIXPAR = .TRUE.
- YRECFM='L_GAMMA'
- YCOMMENT=YRECFM
- CALL READ_SURF(HPROGRAM,YRECFM,LDATA_GAMMA,IRESP,HCOMMENT=YCOMMENT)
- IF (LDATA_GAMMA) LDATA_MIXPAR = .TRUE.
- YRECFM='L_WRMAX_CF'
- YCOMMENT=YRECFM
- CALL READ_SURF(HPROGRAM,YRECFM,LDATA_WRMAX_CF,IRESP,HCOMMENT=YCOMMENT)
- IF (LDATA_WRMAX_CF) LDATA_MIXPAR = .TRUE.
- YRECFM='L_RGL'
- YCOMMENT=YRECFM
- CALL READ_SURF(HPROGRAM,YRECFM,LDATA_RGL,IRESP,HCOMMENT=YCOMMENT)
- IF (LDATA_RGL) LDATA_MIXPAR = .TRUE.
- YRECFM='L_CV'
- YCOMMENT=YRECFM
- CALL READ_SURF(HPROGRAM,YRECFM,LDATA_CV,IRESP,HCOMMENT=YCOMMENT)
- IF (LDATA_CV) LDATA_MIXPAR = .TRUE.
- YRECFM='L_Z0_O_Z0H'
- YCOMMENT=YRECFM
- CALL READ_SURF(HPROGRAM,YRECFM,LDATA_Z0_O_Z0H,IRESP,HCOMMENT=YCOMMENT)
- IF (LDATA_Z0_O_Z0H) LDATA_MIXPAR = .TRUE.
- YRECFM='L_DG'
- YCOMMENT=YRECFM
- CALL READ_SURF(HPROGRAM,YRECFM,LDATA_DG,IRESP,HCOMMENT=YCOMMENT)
- IF (LDATA_DG) LDATA_MIXPAR = .TRUE.
- YRECFM='L_ROOTFRAC'
- YCOMMENT=YRECFM
- CALL READ_SURF(HPROGRAM,YRECFM,LDATA_ROOTFRAC,IRESP,HCOMMENT=YCOMMENT)
- IF (LDATA_ROOTFRAC) LDATA_MIXPAR = .TRUE.
- YRECFM='L_DICE'
- YCOMMENT=YRECFM
- CALL READ_SURF(HPROGRAM,YRECFM,LDATA_DICE,IRESP,HCOMMENT=YCOMMENT)
- IF (LDATA_DICE) LDATA_MIXPAR = .TRUE.
- !
- IF (IBUGFIX>=2) THEN
- YRECFM2='L_GROUND_DEPTH'
- IF (IBUGFIX>=3) YRECFM2='L_GROUND_DPT'
- YCOMMENT=YRECFM
- CALL READ_SURF(HPROGRAM,YRECFM2,LDATA_GROUND_DEPTH,IRESP,HCOMMENT=YCOMMENT)
- IF (LDATA_GROUND_DEPTH) LDATA_MIXPAR = .TRUE.
- YRECFM='L_ROOT_DEPTH'
- YCOMMENT=YRECFM
- CALL READ_SURF(HPROGRAM,YRECFM,LDATA_ROOT_DEPTH,IRESP,HCOMMENT=YCOMMENT)
- IF (LDATA_ROOT_DEPTH) LDATA_MIXPAR = .TRUE.
- YRECFM='L_ROOT_EXT'
- YCOMMENT=YRECFM
- CALL READ_SURF(HPROGRAM,YRECFM,LDATA_ROOT_EXTINCTION,IRESP,HCOMMENT=YCOMMENT)
- IF (LDATA_ROOT_EXTINCTION) LDATA_MIXPAR = .TRUE.
- YRECFM='L_ROOT_LIN'
- YCOMMENT=YRECFM
- CALL READ_SURF(HPROGRAM,YRECFM,LDATA_ROOT_LIN,IRESP,HCOMMENT=YCOMMENT)
- IF (LDATA_ROOT_LIN) LDATA_MIXPAR = .TRUE.
- ELSE
- LDATA_GROUND_DEPTH = .FALSE.
- LDATA_ROOT_DEPTH = .FALSE.
- LDATA_ROOT_EXTINCTION = .FALSE.
- LDATA_ROOT_LIN = .FALSE.
- ENDIF
- !
- YRECFM='L_ALBNIR_VEG'
- YCOMMENT=YRECFM
- CALL READ_SURF(HPROGRAM,YRECFM,LDATA_ALBNIR_VEG,IRESP,HCOMMENT=YCOMMENT)
- IF (LDATA_ALBNIR_VEG) LDATA_MIXPAR = .TRUE.
- YRECFM='L_ALBVIS_VEG'
- YCOMMENT=YRECFM
- CALL READ_SURF(HPROGRAM,YRECFM,LDATA_ALBVIS_VEG,IRESP,HCOMMENT=YCOMMENT)
- IF (LDATA_ALBVIS_VEG) LDATA_MIXPAR = .TRUE.
- YRECFM='L_ALBUV_VEG'
- YCOMMENT=YRECFM
- CALL READ_SURF(HPROGRAM,YRECFM,LDATA_ALBUV_VEG,IRESP,HCOMMENT=YCOMMENT)
- IF (LDATA_ALBUV_VEG) LDATA_MIXPAR = .TRUE.
- YRECFM='L_ALBNIR_SOI'
- YCOMMENT=YRECFM
- CALL READ_SURF(HPROGRAM,YRECFM,LDATA_ALBNIR_SOIL,IRESP,HCOMMENT=YCOMMENT)
- IF (LDATA_ALBNIR_SOIL) LDATA_MIXPAR = .TRUE.
- YRECFM='L_ALBVIS_SOI'
- YCOMMENT=YRECFM
- CALL READ_SURF(HPROGRAM,YRECFM,LDATA_ALBVIS_SOIL,IRESP,HCOMMENT=YCOMMENT)
- IF (LDATA_ALBVIS_SOIL) LDATA_MIXPAR = .TRUE.
- YRECFM='L_ALBUV_SOI'
- YCOMMENT=YRECFM
- CALL READ_SURF(HPROGRAM,YRECFM,LDATA_ALBUV_SOIL,IRESP,HCOMMENT=YCOMMENT)
- IF (LDATA_ALBUV_SOIL) LDATA_MIXPAR = .TRUE.
- YRECFM='L_GMES'
- YCOMMENT=YRECFM
- CALL READ_SURF(HPROGRAM,YRECFM,LDATA_GMES,IRESP,HCOMMENT=YCOMMENT)
- IF (LDATA_GMES) LDATA_MIXPAR = .TRUE.
- YRECFM='L_BSLAI'
- YCOMMENT=YRECFM
- CALL READ_SURF(HPROGRAM,YRECFM,LDATA_BSLAI,IRESP,HCOMMENT=YCOMMENT)
- IF (LDATA_BSLAI) LDATA_MIXPAR = .TRUE.
- YRECFM='L_LAIMIN'
- YCOMMENT=YRECFM
- CALL READ_SURF(HPROGRAM,YRECFM,LDATA_LAIMIN,IRESP,HCOMMENT=YCOMMENT)
- IF (LDATA_LAIMIN) LDATA_MIXPAR = .TRUE.
- YRECFM='L_SEFOLD'
- YCOMMENT=YRECFM
- CALL READ_SURF(HPROGRAM,YRECFM,LDATA_SEFOLD,IRESP,HCOMMENT=YCOMMENT)
- IF (LDATA_SEFOLD) LDATA_MIXPAR = .TRUE.
- YRECFM='L_GC'
- YCOMMENT=YRECFM
- CALL READ_SURF(HPROGRAM,YRECFM,LDATA_GC,IRESP,HCOMMENT=YCOMMENT)
- IF (LDATA_GC) LDATA_MIXPAR = .TRUE.
- YRECFM='L_DMAX'
- YCOMMENT=YRECFM
- CALL READ_SURF(HPROGRAM,YRECFM,LDATA_DMAX,IRESP,HCOMMENT=YCOMMENT)
- IF (LDATA_DMAX) LDATA_MIXPAR = .TRUE.
- YRECFM='L_F2I'
- YCOMMENT=YRECFM
- CALL READ_SURF(HPROGRAM,YRECFM,LDATA_F2I,IRESP,HCOMMENT=YCOMMENT)
- IF (LDATA_F2I) LDATA_MIXPAR = .TRUE.
- YRECFM='L_STRESS'
- YCOMMENT=YRECFM
- CALL READ_SURF(HPROGRAM,YRECFM,LDATA_STRESS,IRESP,HCOMMENT=YCOMMENT)
- IF (LDATA_STRESS) LDATA_MIXPAR = .TRUE.
- YRECFM='L_H_TREE'
- YCOMMENT=YRECFM
- CALL READ_SURF(HPROGRAM,YRECFM,LDATA_H_TREE,IRESP,HCOMMENT=YCOMMENT)
- IF (LDATA_H_TREE) LDATA_MIXPAR = .TRUE.
- YRECFM='L_RE25'
- YCOMMENT=YRECFM
- CALL READ_SURF(HPROGRAM,YRECFM,LDATA_RE25,IRESP,HCOMMENT=YCOMMENT)
- IF (LDATA_RE25) LDATA_MIXPAR = .TRUE.
- YRECFM='L_CE_NITRO'
- YCOMMENT=YRECFM
- CALL READ_SURF(HPROGRAM,YRECFM,LDATA_CE_NITRO,IRESP,HCOMMENT=YCOMMENT)
- IF (LDATA_CE_NITRO) LDATA_MIXPAR = .TRUE.
- YRECFM='L_CF_NITRO'
- YCOMMENT=YRECFM
- CALL READ_SURF(HPROGRAM,YRECFM,LDATA_CF_NITRO,IRESP,HCOMMENT=YCOMMENT)
- IF (LDATA_CF_NITRO) LDATA_MIXPAR = .TRUE.
- YRECFM='L_CNA_NITRO'
- YCOMMENT=YRECFM
- CALL READ_SURF(HPROGRAM,YRECFM,LDATA_CNA_NITRO,IRESP,HCOMMENT=YCOMMENT)
- IF (LDATA_CNA_NITRO) LDATA_MIXPAR = .TRUE.
- YRECFM='L_IRRIG'
- YCOMMENT=YRECFM
- CALL READ_SURF(HPROGRAM,YRECFM,LDATA_IRRIG,IRESP,HCOMMENT=YCOMMENT)
- IF (LDATA_IRRIG) LDATA_MIXPAR = .TRUE.
- YRECFM='L_WATSUP'
- YCOMMENT=YRECFM
- CALL READ_SURF(HPROGRAM,YRECFM,LDATA_WATSUP,IRESP,HCOMMENT=YCOMMENT)
- IF (LDATA_WATSUP) LDATA_MIXPAR = .TRUE.
- !
- ENDIF
- !
- IF (ALLOCATED(LINTERP)) LINTERP(:) = .TRUE.
- !
- IF (LDATA_VEGTYPE) THEN
- YRECFM='D_VEGTYPE'
- CALL READ_SURF(HPROGRAM,YRECFM,ZFIELD(:,:),IRESP,HCOMMENT=YCOMMENT,HDIR=YDIR)
- ALLOCATE(XPAR_VEGTYPE (NDIM,NVEGTYPE))
- IF (NDIM/=KSIZE) THEN
- CALL HOR_INTERPOL(ILUOUT,ZFIELD,XPAR_VEGTYPE)
- ELSE
- XPAR_VEGTYPE(:,:) = ZFIELD(:,:)
- ENDIF
- ENDIF
-!
- IF (LDATA_LAI .OR. LDATA_VEG .OR. LDATA_Z0 .OR. LDATA_EMIS) THEN
- YRECFM='NDATA_TIME'
- CALL READ_SURF(HPROGRAM,YRECFM,NTIME,IRESP,HCOMMENT=YCOMMENT)
- ITIME = NTIME
- ELSE
- NTIME = 1
- ENDIF
-!
- IF (LDATA_VEG) THEN
- ALLOCATE(XPAR_VEG(NDIM,NTIME,NVEGTYPE))
- DO JTIME=1,ITIME
- WRITE(YRECFM,FMT='(A7,I2.2)') 'D_VEG_T',JTIME
- CALL READ_SURF_ISBA_PAR_n(HPROGRAM,YRECFM,ILUOUT,KSIZE,XPAR_VEG(:,JTIME,:),IRESP,IVERSION,&
- HCOMMENT=YCOMMENT,HDIR=YDIR)
- END DO
- ENDIF
-!
- IF (LDATA_LAI) THEN
- ALLOCATE(XPAR_LAI(NDIM,NTIME,NVEGTYPE))
- DO JTIME=1,ITIME
- WRITE(YRECFM,FMT='(A7,I2.2)') 'D_LAI_T',JTIME
- CALL READ_SURF_ISBA_PAR_n(HPROGRAM,YRECFM,ILUOUT,KSIZE,XPAR_LAI(:,JTIME,:),IRESP,IVERSION,&
- HCOMMENT=YCOMMENT,HDIR=YDIR)
- END DO
- ENDIF
-!
- IF (LDATA_Z0) THEN
- ALLOCATE(XPAR_Z0 (NDIM,NTIME,NVEGTYPE))
- DO JTIME=1,ITIME
- WRITE(YRECFM,FMT='(A6,I2.2)') 'D_Z0_T',JTIME
- CALL READ_SURF_ISBA_PAR_n(HPROGRAM,YRECFM,ILUOUT,KSIZE,XPAR_Z0(:,JTIME,:),IRESP,IVERSION,&
- HCOMMENT=YCOMMENT,HDIR=YDIR)
- END DO
- ENDIF
-!
- IF (LDATA_EMIS) THEN
- ALLOCATE(XPAR_EMIS (NDIM,NTIME,NVEGTYPE))
- DO JTIME=1,ITIME
- WRITE(YRECFM,FMT='(A8,I2.2)') 'D_EMIS_T',JTIME
- CALL READ_SURF_ISBA_PAR_n(HPROGRAM,YRECFM,ILUOUT,KSIZE,XPAR_EMIS(:,JTIME,:),IRESP,IVERSION,&
- HCOMMENT=YCOMMENT,HDIR=YDIR)
- END DO
- ENDIF
-!
- IF (LDATA_RSMIN) THEN
- ALLOCATE(XPAR_RSMIN (NDIM,NVEGTYPE))
- YRECFM='D_RSMIN'
- CALL READ_SURF_ISBA_PAR_n(HPROGRAM,YRECFM,ILUOUT,KSIZE,XPAR_RSMIN(:,:),IRESP,IVERSION,&
- HCOMMENT=YCOMMENT,HDIR=YDIR)
- ENDIF
-!
- IF (LDATA_GAMMA) THEN
- ALLOCATE(XPAR_GAMMA (NDIM,NVEGTYPE))
- YRECFM='D_GAMMA'
- CALL READ_SURF_ISBA_PAR_n(HPROGRAM,YRECFM,ILUOUT,KSIZE,XPAR_GAMMA(:,:),IRESP,IVERSION,&
- HCOMMENT=YCOMMENT,HDIR=YDIR)
- ENDIF
-!
- IF (LDATA_WRMAX_CF) THEN
- ALLOCATE(XPAR_WRMAX_CF (NDIM,NVEGTYPE))
- YRECFM='D_WRMAX_CF'
- CALL READ_SURF_ISBA_PAR_n(HPROGRAM,YRECFM,ILUOUT,KSIZE,XPAR_WRMAX_CF(:,:),IRESP,IVERSION,&
- HCOMMENT=YCOMMENT,HDIR=YDIR)
- ENDIF
-!
- IF (LDATA_RGL) THEN
- ALLOCATE(XPAR_RGL (NDIM,NVEGTYPE))
- YRECFM='D_RGL'
- CALL READ_SURF_ISBA_PAR_n(HPROGRAM,YRECFM,ILUOUT,KSIZE,XPAR_RGL(:,:),IRESP,IVERSION,&
- HCOMMENT=YCOMMENT,HDIR=YDIR)
- ENDIF
-!
- IF (LDATA_CV) THEN
- ALLOCATE(XPAR_CV (NDIM,NVEGTYPE))
- YRECFM='D_CV'
- CALL READ_SURF_ISBA_PAR_n(HPROGRAM,YRECFM,ILUOUT,KSIZE,XPAR_CV(:,:),IRESP,IVERSION,&
- HCOMMENT=YCOMMENT,HDIR=YDIR)
- ENDIF
-!
- IF (LDATA_Z0_O_Z0H) THEN
- ALLOCATE(XPAR_Z0_O_Z0H (NDIM,NVEGTYPE))
- YRECFM='D_Z0_O_Z0H'
- CALL READ_SURF_ISBA_PAR_n(HPROGRAM,YRECFM,ILUOUT,KSIZE,XPAR_Z0_O_Z0H(:,:),IRESP,IVERSION,&
- HCOMMENT=YCOMMENT,HDIR=YDIR)
- ENDIF
-!
- IF (LDATA_DG) THEN
- ALLOCATE(XPAR_DG (NDIM,NGROUND_LAYER,NVEGTYPE))
- ALLOCATE(ZWORK(SIZE(XPAR_DG,1),SIZE(XPAR_DG,3)))
- DO JLAYER=1,SIZE(XPAR_DG,2)
- IF (JLAYER<10) WRITE(YRECFM,FMT='(A4,I1.1)') 'D_DG',JLAYER
- IF (JLAYER>=10) WRITE(YRECFM,FMT='(A4,I2.2)') 'D_DG',JLAYER
- CALL READ_SURF_ISBA_PAR_n(HPROGRAM,YRECFM,ILUOUT,KSIZE,ZWORK,IRESP,IVERSION,&
- HCOMMENT=YCOMMENT,HDIR=YDIR)
- DO JPATCH=1,SIZE(XPAR_DG,3)
- XPAR_DG(:,JLAYER,JPATCH) = ZWORK(:,JPATCH)
- END DO
- END DO
- DEALLOCATE(ZWORK)
- ENDIF
-!
- IF (LDATA_ROOTFRAC) THEN
- ALLOCATE(XPAR_ROOTFRAC (NDIM,NGROUND_LAYER,NVEGTYPE))
- ALLOCATE(ZWORK(SIZE(XPAR_ROOTFRAC,1),SIZE(XPAR_ROOTFRAC,3)))
- DO JLAYER=1,SIZE(XPAR_ROOTFRAC,2)
- IF (JLAYER<10) WRITE(YRECFM,FMT='(A10,I1.1)') 'D_ROOTFRAC',JLAYER
- IF (JLAYER>=10) WRITE(YRECFM,FMT='(A10,I2.2)') 'D_ROOTFRAC',JLAYER
- CALL READ_SURF_ISBA_PAR_n(HPROGRAM,YRECFM,ILUOUT,KSIZE,ZWORK,IRESP,IVERSION,&
- HCOMMENT=YCOMMENT,HDIR=YDIR)
- DO JPATCH=1,SIZE(XPAR_ROOTFRAC,3)
- XPAR_ROOTFRAC(:,JLAYER,JPATCH) = ZWORK(:,JPATCH)
- END DO
- END DO
- DEALLOCATE(ZWORK)
- ENDIF
-!
- IF (LDATA_DICE) THEN
- ALLOCATE(XPAR_DICE (NDIM,NVEGTYPE))
- YRECFM='D_DICE'
- CALL READ_SURF_ISBA_PAR_n(HPROGRAM,YRECFM,ILUOUT,KSIZE,XPAR_DICE(:,:),IRESP,IVERSION,&
- HCOMMENT=YCOMMENT,HDIR=YDIR)
- ENDIF
-!
- IF (LDATA_GROUND_DEPTH) THEN
- ALLOCATE(XPAR_GROUND_DEPTH(NDIM,NVEGTYPE))
- YRECFM2='D_GROUND_DEPTH'
- IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) YRECFM2='D_GROUND_DPT'
- CALL READ_SURF_ISBA_PAR_n(HPROGRAM,YRECFM2,ILUOUT,KSIZE,XPAR_GROUND_DEPTH(:,:),IRESP,IVERSION,&
- HCOMMENT=YCOMMENT,HDIR=YDIR)
- ENDIF
-!
- IF (LDATA_ROOT_DEPTH) THEN
- ALLOCATE(XPAR_ROOT_DEPTH(NDIM,NVEGTYPE))
- YRECFM='D_ROOT_DEPTH'
- CALL READ_SURF_ISBA_PAR_n(HPROGRAM,YRECFM,ILUOUT,KSIZE,XPAR_ROOT_DEPTH(:,:),IRESP,IVERSION,&
- HCOMMENT=YCOMMENT,HDIR=YDIR)
- ENDIF
-!
- IF (LDATA_ROOT_EXTINCTION) THEN
- ALLOCATE(XPAR_ROOT_EXTINCTION(NDIM,NVEGTYPE))
- YRECFM='D_ROOT_EXT'
- CALL READ_SURF_ISBA_PAR_n(HPROGRAM,YRECFM,ILUOUT,KSIZE,XPAR_ROOT_EXTINCTION(:,:),IRESP,IVERSION,&
- HCOMMENT=YCOMMENT,HDIR=YDIR)
- ENDIF
-!
- IF (LDATA_ROOT_LIN) THEN
- ALLOCATE(XPAR_ROOT_LIN(NDIM,NVEGTYPE))
- YRECFM='D_ROOT_LIN'
- CALL READ_SURF_ISBA_PAR_n(HPROGRAM,YRECFM,ILUOUT,KSIZE,XPAR_ROOT_LIN(:,:),IRESP,IVERSION,&
- HCOMMENT=YCOMMENT,HDIR=YDIR)
- ENDIF
-!
- IF (LDATA_ALBNIR_VEG) THEN
- ALLOCATE(XPAR_ALBNIR_VEG(NDIM,NVEGTYPE))
- YRECFM='D_ALBNIR_VEG'
- CALL READ_SURF_ISBA_PAR_n(HPROGRAM,YRECFM,ILUOUT,KSIZE,XPAR_ALBNIR_VEG(:,:),IRESP,IVERSION,&
- HCOMMENT=YCOMMENT,HDIR=YDIR)
- ENDIF
-!
- IF (LDATA_ALBVIS_VEG) THEN
- ALLOCATE(XPAR_ALBVIS_VEG(NDIM,NVEGTYPE))
- YRECFM='D_ALBVIS_VEG'
- CALL READ_SURF_ISBA_PAR_n(HPROGRAM,YRECFM,ILUOUT,KSIZE,XPAR_ALBVIS_VEG(:,:),IRESP,IVERSION,&
- HCOMMENT=YCOMMENT,HDIR=YDIR)
- ENDIF
-!
- IF (LDATA_ALBUV_VEG) THEN
- ALLOCATE(XPAR_ALBUV_VEG (NDIM,NVEGTYPE))
- YRECFM='D_ALBUV_VEG'
- CALL READ_SURF_ISBA_PAR_n(HPROGRAM,YRECFM,ILUOUT,KSIZE,XPAR_ALBUV_VEG(:,:),IRESP,IVERSION,&
- HCOMMENT=YCOMMENT,HDIR=YDIR)
- ENDIF
-!
- IF (LDATA_ALBNIR_SOIL) THEN
- ALLOCATE(XPAR_ALBNIR_SOIL(NDIM,NVEGTYPE))
- YRECFM='D_ALBNIR_SOI'
- CALL READ_SURF_ISBA_PAR_n(HPROGRAM,YRECFM,ILUOUT,KSIZE,XPAR_ALBNIR_SOIL(:,:),IRESP,IVERSION,&
- HCOMMENT=YCOMMENT,HDIR=YDIR)
- ENDIF
-!
- IF (LDATA_ALBVIS_SOIL) THEN
- ALLOCATE(XPAR_ALBVIS_SOIL(NDIM,NVEGTYPE))
- YRECFM='D_ALBVIS_SOI'
- CALL READ_SURF_ISBA_PAR_n(HPROGRAM,YRECFM,ILUOUT,KSIZE,XPAR_ALBVIS_SOIL(:,:),IRESP,IVERSION,&
- HCOMMENT=YCOMMENT,HDIR=YDIR)
- ENDIF
-!
- IF (LDATA_ALBUV_SOIL) THEN
- ALLOCATE(XPAR_ALBUV_SOIL (NDIM,NVEGTYPE))
- YRECFM='D_ALBUV_SOI'
- CALL READ_SURF_ISBA_PAR_n(HPROGRAM,YRECFM,ILUOUT,KSIZE,XPAR_ALBUV_SOIL(:,:),IRESP,IVERSION,&
- HCOMMENT=YCOMMENT,HDIR=YDIR)
- ENDIF
-!
- IF (LDATA_GMES) THEN
- ALLOCATE(XPAR_GMES (NDIM,NVEGTYPE))
- YRECFM='D_GMES'
- CALL READ_SURF_ISBA_PAR_n(HPROGRAM,YRECFM,ILUOUT,KSIZE,XPAR_GMES(:,:),IRESP,IVERSION,&
- HCOMMENT=YCOMMENT,HDIR=YDIR)
- ENDIF
-!
- IF (LDATA_BSLAI) THEN
- ALLOCATE(XPAR_BSLAI (NDIM,NVEGTYPE))
- YRECFM='D_BSLAI'
- CALL READ_SURF_ISBA_PAR_n(HPROGRAM,YRECFM,ILUOUT,KSIZE,XPAR_BSLAI(:,:),IRESP,IVERSION,&
- HCOMMENT=YCOMMENT,HDIR=YDIR)
- ENDIF
-!
- IF (LDATA_LAIMIN) THEN
- ALLOCATE(XPAR_LAIMIN (NDIM,NVEGTYPE))
- YRECFM='D_LAIMIN'
- CALL READ_SURF_ISBA_PAR_n(HPROGRAM,YRECFM,ILUOUT,KSIZE,XPAR_LAIMIN(:,:),IRESP,IVERSION,&
- HCOMMENT=YCOMMENT,HDIR=YDIR)
- ENDIF
-!
- IF (LDATA_SEFOLD) THEN
- ALLOCATE(XPAR_SEFOLD (NDIM,NVEGTYPE))
- YRECFM='D_SEFOLD'
- CALL READ_SURF_ISBA_PAR_n(HPROGRAM,YRECFM,ILUOUT,KSIZE,XPAR_SEFOLD(:,:),IRESP,IVERSION,&
- HCOMMENT=YCOMMENT,HDIR=YDIR)
- ENDIF
-!
- IF (LDATA_GC) THEN
- ALLOCATE(XPAR_GC (NDIM,NVEGTYPE))
- YRECFM='D_GC'
- CALL READ_SURF_ISBA_PAR_n(HPROGRAM,YRECFM,ILUOUT,KSIZE,XPAR_GC(:,:),IRESP,IVERSION,&
- HCOMMENT=YCOMMENT,HDIR=YDIR)
- ENDIF
-!
- IF (LDATA_DMAX) THEN
- ALLOCATE(XPAR_DMAX (NDIM,NVEGTYPE))
- YRECFM='D_DMAX'
- CALL READ_SURF_ISBA_PAR_n(HPROGRAM,YRECFM,ILUOUT,KSIZE,XPAR_DMAX(:,:),IRESP,IVERSION,&
- HCOMMENT=YCOMMENT,HDIR=YDIR)
- ENDIF
-!
- IF (LDATA_F2I) THEN
- ALLOCATE(XPAR_F2I (NDIM,NVEGTYPE))
- YRECFM='D_F2I'
- CALL READ_SURF_ISBA_PAR_n(HPROGRAM,YRECFM,ILUOUT,KSIZE,XPAR_F2I(:,:),IRESP,IVERSION,&
- HCOMMENT=YCOMMENT,HDIR=YDIR)
- ENDIF
-!
- IF (LDATA_STRESS) THEN
- ALLOCATE(LPAR_STRESS (NDIM,NVEGTYPE))
- ALLOCATE(ZWORK(SIZE(LPAR_STRESS,1),SIZE(LPAR_STRESS,2)))
- YRECFM='D_STRESS'
- CALL READ_SURF_ISBA_PAR_n(HPROGRAM,YRECFM,ILUOUT,KSIZE,ZWORK(:,:),IRESP,IVERSION,&
- HCOMMENT=YCOMMENT,HDIR=YDIR)
- LPAR_STRESS = .FALSE.
- WHERE(ZWORK==1.) LPAR_STRESS = .TRUE.
- DEALLOCATE(ZWORK)
- ENDIF
-!
- IF (LDATA_H_TREE) THEN
- ALLOCATE(XPAR_H_TREE (NDIM,NVEGTYPE))
- YRECFM='D_H_TREE'
- CALL READ_SURF_ISBA_PAR_n(HPROGRAM,YRECFM,ILUOUT,KSIZE,XPAR_H_TREE(:,:),IRESP,IVERSION,&
- HCOMMENT=YCOMMENT,HDIR=YDIR)
- ENDIF
-!
- IF (LDATA_RE25) THEN
- ALLOCATE(XPAR_RE25 (NDIM,NVEGTYPE))
- YRECFM='D_RE25'
- CALL READ_SURF_ISBA_PAR_n(HPROGRAM,YRECFM,ILUOUT,KSIZE,XPAR_RE25(:,:),IRESP,IVERSION,&
- HCOMMENT=YCOMMENT,HDIR=YDIR)
- ENDIF
-!
- IF (LDATA_CE_NITRO) THEN
- ALLOCATE(XPAR_CE_NITRO (NDIM,NVEGTYPE))
- YRECFM='D_CE_NITRO'
- CALL READ_SURF_ISBA_PAR_n(HPROGRAM,YRECFM,ILUOUT,KSIZE,XPAR_CE_NITRO(:,:),IRESP,IVERSION,&
- HCOMMENT=YCOMMENT,HDIR=YDIR)
- ENDIF
-!
- IF (LDATA_CF_NITRO) THEN
- ALLOCATE(XPAR_CF_NITRO (NDIM,NVEGTYPE))
- YRECFM='D_CF_NITRO'
- CALL READ_SURF_ISBA_PAR_n(HPROGRAM,YRECFM,ILUOUT,KSIZE,XPAR_CF_NITRO(:,:),IRESP,IVERSION,&
- HCOMMENT=YCOMMENT,HDIR=YDIR)
- ENDIF
-!
- IF (LDATA_CNA_NITRO) THEN
- ALLOCATE(XPAR_CNA_NITRO (NDIM,NVEGTYPE))
- YRECFM='D_CNA_NITRO'
- CALL READ_SURF_ISBA_PAR_n(HPROGRAM,YRECFM,ILUOUT,KSIZE,XPAR_CNA_NITRO(:,:),IRESP,IVERSION,&
- HCOMMENT=YCOMMENT,HDIR=YDIR)
- ENDIF
-!
- IF (LDATA_IRRIG) THEN
- ALLOCATE(XPAR_IRRIG (NDIM,NTIME,NVEGTYPE))
- DO JTIME=1,ITIME
- WRITE(YRECFM,FMT='(A9,I2.2)') 'D_IRRIG_T',JTIME
- CALL READ_SURF_ISBA_PAR_n(HPROGRAM,YRECFM,ILUOUT,KSIZE,XPAR_IRRIG(:,JTIME,:),IRESP,IVERSION,&
- HCOMMENT=YCOMMENT,HDIR=YDIR)
- END DO
- ENDIF
-!
- IF (LDATA_WATSUP) THEN
- ALLOCATE(XPAR_WATSUP (NDIM,NTIME,NVEGTYPE))
- DO JTIME=1,ITIME
- WRITE(YRECFM,FMT='(A10,I2.2)') 'D_WATSUP_T',JTIME
- CALL READ_SURF_ISBA_PAR_n(HPROGRAM,YRECFM,ILUOUT,KSIZE,XPAR_WATSUP(:,JTIME,:),IRESP,IVERSION,&
- HCOMMENT=YCOMMENT,HDIR=YDIR)
- END DO
- ENDIF
-!
-ENDIF
-!
-IF (LHOOK) CALL DR_HOOK('READ_PGD_ISBA_PAR_N',1,ZHOOK_HANDLE)
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE READ_PGD_ISBA_PAR_n
+!SURFEX_LIC Copyright 1994-2014 Meteo-France
+!SURFEX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SURFEX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SURFEX_LIC for details. version 1.
+! #########
+ SUBROUTINE READ_PGD_ISBA_PAR_n(HPROGRAM,KSIZE,OLAND_USE,HDIR)
+! ################################################
+!
+!!**** *READ_PGD_ISBA_PAR_n* - reads ISBA physiographic fields
+!!
+!! PURPOSE
+!! -------
+!!
+!!** METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Masson *Meteo France*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 01/2003
+!! P. Le Moigne 12/2004 : add type of photosynthesis
+!! M.Moge 01/2016 using READ_SURF_FIELD2D/3D for 2D/3D surfex fields reads
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE
+USE MODD_PREP, ONLY : LINTERP
+!
+USE MODD_ISBA_GRID_n, ONLY : NDIM
+USE MODD_ISBA_n, ONLY : LECOCLIMAP, NGROUND_LAYER
+USE MODD_DATA_ISBA_n, ONLY : NTIME, XPAR_VEG, XPAR_LAI,XPAR_RSMIN,XPAR_GAMMA,XPAR_WRMAX_CF, &
+ XPAR_RGL,XPAR_CV,XPAR_DG,XPAR_Z0,XPAR_Z0_O_Z0H, &
+ XPAR_ALBNIR_VEG,XPAR_ALBVIS_VEG, XPAR_ALBUV_VEG, &
+ XPAR_ALBNIR_SOIL,XPAR_ALBVIS_SOIL, XPAR_ALBUV_SOIL, &
+ XPAR_EMIS, XPAR_DICE, &
+ XPAR_VEGTYPE,XPAR_ROOTFRAC, &
+ XPAR_GMES,XPAR_BSLAI,XPAR_LAIMIN,XPAR_SEFOLD,XPAR_GC, &
+ XPAR_DMAX, XPAR_F2I, LPAR_STRESS, XPAR_H_TREE,XPAR_RE25,&
+ XPAR_CE_NITRO,XPAR_CF_NITRO,XPAR_CNA_NITRO, &
+ XPAR_GROUND_DEPTH, XPAR_ROOT_DEPTH, &
+ XPAR_ROOT_EXTINCTION, XPAR_ROOT_LIN, &
+ LPAR_STRESS, XPAR_IRRIG, XPAR_WATSUP, &
+ LDATA_VEGTYPE, LDATA_LAI, LDATA_H_TREE, LDATA_DG, LDATA_ROOTFRAC,&
+ LDATA_VEG, LDATA_Z0, LDATA_EMIS, LDATA_DICE, &
+ LDATA_RSMIN, LDATA_GAMMA, LDATA_WRMAX_CF, LDATA_RGL, &
+ LDATA_CV, LDATA_Z0_O_Z0H, &
+ LDATA_ALBNIR_VEG, LDATA_ALBVIS_VEG, LDATA_ALBUV_VEG, &
+ LDATA_ALBVIS_SOIL, LDATA_ALBNIR_SOIL, LDATA_ALBUV_SOIL, &
+ LDATA_GMES, LDATA_BSLAI, LDATA_SEFOLD, LDATA_GC, LDATA_DMAX, &
+ LDATA_RE25, LDATA_LAIMIN, LDATA_F2I, &
+ LDATA_CE_NITRO,LDATA_CF_NITRO, LDATA_CNA_NITRO,&
+ LDATA_STRESS, LDATA_IRRIG, LDATA_WATSUP ,&
+ LDATA_GROUND_DEPTH, LDATA_ROOT_DEPTH, &
+ LDATA_ROOT_EXTINCTION, LDATA_ROOT_LIN, LDATA_MIXPAR
+!
+USE MODI_GET_LUOUT
+USE MODI_READ_SURF
+USE MODI_READ_SURF_FIELD2D
+USE MODI_HOR_INTERPOL
+USE MODI_READ_SURF_ISBA_PAR_n
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of arguments
+! -------------------------
+!
+ CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling
+INTEGER, INTENT(IN) :: KSIZE
+LOGICAL, INTENT(IN) :: OLAND_USE !
+ CHARACTER(LEN=1),OPTIONAL,INTENT(IN) :: HDIR ! type of field :
+! ! 'H' : field with
+! ! horizontal spatial dim.
+! ! '-' : no horizontal dim.
+!
+!* 0.2 Declarations of local variables
+! -------------------------------
+!
+REAL, DIMENSION(KSIZE,NVEGTYPE) :: ZFIELD
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZWORK
+INTEGER :: ILUOUT
+INTEGER :: ITIME
+INTEGER :: IRESP ! IRESP : return-code if a problem appears
+ CHARACTER(LEN=12) :: YRECFM ! Name of the article to be read
+ CHARACTER(LEN=16) :: YRECFM2
+ CHARACTER(LEN=100):: YCOMMENT ! Comment string
+ CHARACTER(LEN=1) :: YDIR
+INTEGER :: JTIME ! loop index
+INTEGER :: JLAYER ! loop index
+INTEGER :: JPATCH ! loop index
+INTEGER :: IVERSION ! surface version
+INTEGER :: IBUGFIX
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+!
+!-------------------------------------------------------------------------------
+!
+IF (LHOOK) CALL DR_HOOK('READ_PGD_ISBA_PAR_N',0,ZHOOK_HANDLE)
+!
+ CALL GET_LUOUT(HPROGRAM,ILUOUT)
+!
+YDIR = 'H'
+IF (PRESENT(HDIR)) YDIR = HDIR
+!
+YRECFM='VERSION'
+ CALL READ_SURF(HPROGRAM,YRECFM,IVERSION,IRESP)
+WRITE(ILUOUT,*) 'read version ',IVERSION
+!
+YRECFM='BUG'
+ CALL READ_SURF(HPROGRAM,YRECFM,IBUGFIX,IRESP)
+!
+LDATA_MIXPAR = .FALSE.
+!
+IF (IVERSION<7 .AND. .NOT.LECOCLIMAP) THEN
+ !
+ LDATA_VEGTYPE=.TRUE.
+ LDATA_VEG=.TRUE.
+ LDATA_LAI=.TRUE.
+ LDATA_Z0=.TRUE.
+ LDATA_EMIS=.TRUE.
+ LDATA_RSMIN=.TRUE.
+ LDATA_GAMMA=.TRUE.
+ LDATA_WRMAX_CF=.TRUE.
+ LDATA_RGL=.TRUE.
+ LDATA_CV=.TRUE.
+ LDATA_Z0_O_Z0H=.TRUE.
+ LDATA_DG=.TRUE.
+ LDATA_ROOTFRAC=.TRUE.
+ !
+ LDATA_DICE=.FALSE.
+ LDATA_GROUND_DEPTH=.FALSE.
+ LDATA_ROOT_DEPTH=.FALSE.
+ LDATA_ROOT_LIN=.FALSE.
+ LDATA_ROOT_EXTINCTION=.FALSE.
+ !
+ LDATA_ALBNIR_VEG=.TRUE.
+ LDATA_ALBVIS_VEG=.TRUE.
+ LDATA_ALBUV_VEG=.TRUE.
+ LDATA_ALBNIR_SOIL=.TRUE.
+ LDATA_ALBVIS_SOIL=.TRUE.
+ LDATA_ALBUV_SOIL=.TRUE.
+ LDATA_GMES=.TRUE.
+ LDATA_BSLAI=.TRUE.
+ LDATA_LAIMIN=.TRUE.
+ LDATA_SEFOLD=.TRUE.
+ LDATA_GC=.TRUE.
+ LDATA_DMAX=.TRUE.
+ LDATA_F2I=.TRUE.
+ LDATA_STRESS=.TRUE.
+ LDATA_H_TREE=.TRUE.
+ LDATA_RE25=.TRUE.
+ LDATA_CE_NITRO=.TRUE.
+ LDATA_CF_NITRO=.TRUE.
+ LDATA_CNA_NITRO=.TRUE.
+ !
+ LDATA_IRRIG=.FALSE.
+ LDATA_WATSUP=.FALSE.
+ !
+ENDIF
+!
+IF (.NOT.OLAND_USE) THEN
+ !
+ IF (IVERSION>=7) THEN
+ !
+ YRECFM='L_VEGTYPE'
+ YCOMMENT=YRECFM
+ CALL READ_SURF(HPROGRAM,YRECFM,LDATA_VEGTYPE,IRESP,HCOMMENT=YCOMMENT)
+ IF (LDATA_VEGTYPE) LDATA_MIXPAR = .TRUE.
+ !
+ YRECFM='L_VEG'
+ YCOMMENT=YRECFM
+ CALL READ_SURF(HPROGRAM,YRECFM,LDATA_VEG,IRESP,HCOMMENT=YCOMMENT)
+ IF (LDATA_VEG) LDATA_MIXPAR = .TRUE.
+ YRECFM='L_LAI'
+ YCOMMENT=YRECFM
+ CALL READ_SURF(HPROGRAM,YRECFM,LDATA_LAI,IRESP,HCOMMENT=YCOMMENT)
+ IF (LDATA_LAI) LDATA_MIXPAR = .TRUE.
+ YRECFM='L_Z0'
+ YCOMMENT=YRECFM
+ CALL READ_SURF(HPROGRAM,YRECFM,LDATA_Z0,IRESP,HCOMMENT=YCOMMENT)
+ IF (LDATA_Z0) LDATA_MIXPAR = .TRUE.
+ YRECFM='L_EMIS'
+ YCOMMENT=YRECFM
+ CALL READ_SURF(HPROGRAM,YRECFM,LDATA_EMIS,IRESP,HCOMMENT=YCOMMENT)
+ IF (LDATA_EMIS) LDATA_MIXPAR = .TRUE.
+ !
+ YRECFM='L_RSMIN'
+ YCOMMENT=YRECFM
+ CALL READ_SURF(HPROGRAM,YRECFM,LDATA_RSMIN,IRESP,HCOMMENT=YCOMMENT)
+ IF (LDATA_RSMIN) LDATA_MIXPAR = .TRUE.
+ YRECFM='L_GAMMA'
+ YCOMMENT=YRECFM
+ CALL READ_SURF(HPROGRAM,YRECFM,LDATA_GAMMA,IRESP,HCOMMENT=YCOMMENT)
+ IF (LDATA_GAMMA) LDATA_MIXPAR = .TRUE.
+ YRECFM='L_WRMAX_CF'
+ YCOMMENT=YRECFM
+ CALL READ_SURF(HPROGRAM,YRECFM,LDATA_WRMAX_CF,IRESP,HCOMMENT=YCOMMENT)
+ IF (LDATA_WRMAX_CF) LDATA_MIXPAR = .TRUE.
+ YRECFM='L_RGL'
+ YCOMMENT=YRECFM
+ CALL READ_SURF(HPROGRAM,YRECFM,LDATA_RGL,IRESP,HCOMMENT=YCOMMENT)
+ IF (LDATA_RGL) LDATA_MIXPAR = .TRUE.
+ YRECFM='L_CV'
+ YCOMMENT=YRECFM
+ CALL READ_SURF(HPROGRAM,YRECFM,LDATA_CV,IRESP,HCOMMENT=YCOMMENT)
+ IF (LDATA_CV) LDATA_MIXPAR = .TRUE.
+ YRECFM='L_Z0_O_Z0H'
+ YCOMMENT=YRECFM
+ CALL READ_SURF(HPROGRAM,YRECFM,LDATA_Z0_O_Z0H,IRESP,HCOMMENT=YCOMMENT)
+ IF (LDATA_Z0_O_Z0H) LDATA_MIXPAR = .TRUE.
+ YRECFM='L_DG'
+ YCOMMENT=YRECFM
+ CALL READ_SURF(HPROGRAM,YRECFM,LDATA_DG,IRESP,HCOMMENT=YCOMMENT)
+ IF (LDATA_DG) LDATA_MIXPAR = .TRUE.
+ YRECFM='L_ROOTFRAC'
+ YCOMMENT=YRECFM
+ CALL READ_SURF(HPROGRAM,YRECFM,LDATA_ROOTFRAC,IRESP,HCOMMENT=YCOMMENT)
+ IF (LDATA_ROOTFRAC) LDATA_MIXPAR = .TRUE.
+ YRECFM='L_DICE'
+ YCOMMENT=YRECFM
+ CALL READ_SURF(HPROGRAM,YRECFM,LDATA_DICE,IRESP,HCOMMENT=YCOMMENT)
+ IF (LDATA_DICE) LDATA_MIXPAR = .TRUE.
+ !
+ IF (IBUGFIX>=2) THEN
+ YRECFM2='L_GROUND_DEPTH'
+ IF (IBUGFIX>=3) YRECFM2='L_GROUND_DPT'
+ YCOMMENT=YRECFM
+ CALL READ_SURF(HPROGRAM,YRECFM2,LDATA_GROUND_DEPTH,IRESP,HCOMMENT=YCOMMENT)
+ IF (LDATA_GROUND_DEPTH) LDATA_MIXPAR = .TRUE.
+ YRECFM='L_ROOT_DEPTH'
+ YCOMMENT=YRECFM
+ CALL READ_SURF(HPROGRAM,YRECFM,LDATA_ROOT_DEPTH,IRESP,HCOMMENT=YCOMMENT)
+ IF (LDATA_ROOT_DEPTH) LDATA_MIXPAR = .TRUE.
+ YRECFM='L_ROOT_EXT'
+ YCOMMENT=YRECFM
+ CALL READ_SURF(HPROGRAM,YRECFM,LDATA_ROOT_EXTINCTION,IRESP,HCOMMENT=YCOMMENT)
+ IF (LDATA_ROOT_EXTINCTION) LDATA_MIXPAR = .TRUE.
+ YRECFM='L_ROOT_LIN'
+ YCOMMENT=YRECFM
+ CALL READ_SURF(HPROGRAM,YRECFM,LDATA_ROOT_LIN,IRESP,HCOMMENT=YCOMMENT)
+ IF (LDATA_ROOT_LIN) LDATA_MIXPAR = .TRUE.
+ ELSE
+ LDATA_GROUND_DEPTH = .FALSE.
+ LDATA_ROOT_DEPTH = .FALSE.
+ LDATA_ROOT_EXTINCTION = .FALSE.
+ LDATA_ROOT_LIN = .FALSE.
+ ENDIF
+ !
+ YRECFM='L_ALBNIR_VEG'
+ YCOMMENT=YRECFM
+ CALL READ_SURF(HPROGRAM,YRECFM,LDATA_ALBNIR_VEG,IRESP,HCOMMENT=YCOMMENT)
+ IF (LDATA_ALBNIR_VEG) LDATA_MIXPAR = .TRUE.
+ YRECFM='L_ALBVIS_VEG'
+ YCOMMENT=YRECFM
+ CALL READ_SURF(HPROGRAM,YRECFM,LDATA_ALBVIS_VEG,IRESP,HCOMMENT=YCOMMENT)
+ IF (LDATA_ALBVIS_VEG) LDATA_MIXPAR = .TRUE.
+ YRECFM='L_ALBUV_VEG'
+ YCOMMENT=YRECFM
+ CALL READ_SURF(HPROGRAM,YRECFM,LDATA_ALBUV_VEG,IRESP,HCOMMENT=YCOMMENT)
+ IF (LDATA_ALBUV_VEG) LDATA_MIXPAR = .TRUE.
+ YRECFM='L_ALBNIR_SOI'
+ YCOMMENT=YRECFM
+ CALL READ_SURF(HPROGRAM,YRECFM,LDATA_ALBNIR_SOIL,IRESP,HCOMMENT=YCOMMENT)
+ IF (LDATA_ALBNIR_SOIL) LDATA_MIXPAR = .TRUE.
+ YRECFM='L_ALBVIS_SOI'
+ YCOMMENT=YRECFM
+ CALL READ_SURF(HPROGRAM,YRECFM,LDATA_ALBVIS_SOIL,IRESP,HCOMMENT=YCOMMENT)
+ IF (LDATA_ALBVIS_SOIL) LDATA_MIXPAR = .TRUE.
+ YRECFM='L_ALBUV_SOI'
+ YCOMMENT=YRECFM
+ CALL READ_SURF(HPROGRAM,YRECFM,LDATA_ALBUV_SOIL,IRESP,HCOMMENT=YCOMMENT)
+ IF (LDATA_ALBUV_SOIL) LDATA_MIXPAR = .TRUE.
+ YRECFM='L_GMES'
+ YCOMMENT=YRECFM
+ CALL READ_SURF(HPROGRAM,YRECFM,LDATA_GMES,IRESP,HCOMMENT=YCOMMENT)
+ IF (LDATA_GMES) LDATA_MIXPAR = .TRUE.
+ YRECFM='L_BSLAI'
+ YCOMMENT=YRECFM
+ CALL READ_SURF(HPROGRAM,YRECFM,LDATA_BSLAI,IRESP,HCOMMENT=YCOMMENT)
+ IF (LDATA_BSLAI) LDATA_MIXPAR = .TRUE.
+ YRECFM='L_LAIMIN'
+ YCOMMENT=YRECFM
+ CALL READ_SURF(HPROGRAM,YRECFM,LDATA_LAIMIN,IRESP,HCOMMENT=YCOMMENT)
+ IF (LDATA_LAIMIN) LDATA_MIXPAR = .TRUE.
+ YRECFM='L_SEFOLD'
+ YCOMMENT=YRECFM
+ CALL READ_SURF(HPROGRAM,YRECFM,LDATA_SEFOLD,IRESP,HCOMMENT=YCOMMENT)
+ IF (LDATA_SEFOLD) LDATA_MIXPAR = .TRUE.
+ YRECFM='L_GC'
+ YCOMMENT=YRECFM
+ CALL READ_SURF(HPROGRAM,YRECFM,LDATA_GC,IRESP,HCOMMENT=YCOMMENT)
+ IF (LDATA_GC) LDATA_MIXPAR = .TRUE.
+ YRECFM='L_DMAX'
+ YCOMMENT=YRECFM
+ CALL READ_SURF(HPROGRAM,YRECFM,LDATA_DMAX,IRESP,HCOMMENT=YCOMMENT)
+ IF (LDATA_DMAX) LDATA_MIXPAR = .TRUE.
+ YRECFM='L_F2I'
+ YCOMMENT=YRECFM
+ CALL READ_SURF(HPROGRAM,YRECFM,LDATA_F2I,IRESP,HCOMMENT=YCOMMENT)
+ IF (LDATA_F2I) LDATA_MIXPAR = .TRUE.
+ YRECFM='L_STRESS'
+ YCOMMENT=YRECFM
+ CALL READ_SURF(HPROGRAM,YRECFM,LDATA_STRESS,IRESP,HCOMMENT=YCOMMENT)
+ IF (LDATA_STRESS) LDATA_MIXPAR = .TRUE.
+ YRECFM='L_H_TREE'
+ YCOMMENT=YRECFM
+ CALL READ_SURF(HPROGRAM,YRECFM,LDATA_H_TREE,IRESP,HCOMMENT=YCOMMENT)
+ IF (LDATA_H_TREE) LDATA_MIXPAR = .TRUE.
+ YRECFM='L_RE25'
+ YCOMMENT=YRECFM
+ CALL READ_SURF(HPROGRAM,YRECFM,LDATA_RE25,IRESP,HCOMMENT=YCOMMENT)
+ IF (LDATA_RE25) LDATA_MIXPAR = .TRUE.
+ YRECFM='L_CE_NITRO'
+ YCOMMENT=YRECFM
+ CALL READ_SURF(HPROGRAM,YRECFM,LDATA_CE_NITRO,IRESP,HCOMMENT=YCOMMENT)
+ IF (LDATA_CE_NITRO) LDATA_MIXPAR = .TRUE.
+ YRECFM='L_CF_NITRO'
+ YCOMMENT=YRECFM
+ CALL READ_SURF(HPROGRAM,YRECFM,LDATA_CF_NITRO,IRESP,HCOMMENT=YCOMMENT)
+ IF (LDATA_CF_NITRO) LDATA_MIXPAR = .TRUE.
+ YRECFM='L_CNA_NITRO'
+ YCOMMENT=YRECFM
+ CALL READ_SURF(HPROGRAM,YRECFM,LDATA_CNA_NITRO,IRESP,HCOMMENT=YCOMMENT)
+ IF (LDATA_CNA_NITRO) LDATA_MIXPAR = .TRUE.
+ YRECFM='L_IRRIG'
+ YCOMMENT=YRECFM
+ CALL READ_SURF(HPROGRAM,YRECFM,LDATA_IRRIG,IRESP,HCOMMENT=YCOMMENT)
+ IF (LDATA_IRRIG) LDATA_MIXPAR = .TRUE.
+ YRECFM='L_WATSUP'
+ YCOMMENT=YRECFM
+ CALL READ_SURF(HPROGRAM,YRECFM,LDATA_WATSUP,IRESP,HCOMMENT=YCOMMENT)
+ IF (LDATA_WATSUP) LDATA_MIXPAR = .TRUE.
+ !
+ ENDIF
+ !
+ IF (ALLOCATED(LINTERP)) LINTERP(:) = .TRUE.
+ !
+ IF (LDATA_VEGTYPE) THEN
+ YRECFM='D_VEGTYPE'
+ CALL READ_SURF_FIELD2D(HPROGRAM,ZFIELD(:,:),YRECFM,HCOMMENT=YCOMMENT,HDIR=YDIR)
+ ALLOCATE(XPAR_VEGTYPE (NDIM,NVEGTYPE))
+ IF (NDIM/=KSIZE) THEN
+ CALL HOR_INTERPOL(ILUOUT,ZFIELD,XPAR_VEGTYPE)
+ ELSE
+ XPAR_VEGTYPE(:,:) = ZFIELD(:,:)
+ ENDIF
+ ENDIF
+!
+ IF (LDATA_LAI .OR. LDATA_VEG .OR. LDATA_Z0 .OR. LDATA_EMIS) THEN
+ YRECFM='NDATA_TIME'
+ CALL READ_SURF(HPROGRAM,YRECFM,NTIME,IRESP,HCOMMENT=YCOMMENT)
+ ITIME = NTIME
+ ELSE
+ NTIME = 1
+ ENDIF
+!
+ IF (LDATA_VEG) THEN
+ ALLOCATE(XPAR_VEG(NDIM,NTIME,NVEGTYPE))
+ DO JTIME=1,ITIME
+ WRITE(YRECFM,FMT='(A7,I2.2)') 'D_VEG_T',JTIME
+ CALL READ_SURF_ISBA_PAR_n(HPROGRAM,YRECFM,ILUOUT,KSIZE,XPAR_VEG(:,JTIME,:),IRESP,IVERSION,&
+ HCOMMENT=YCOMMENT,HDIR=YDIR)
+ END DO
+ ENDIF
+!
+ IF (LDATA_LAI) THEN
+ ALLOCATE(XPAR_LAI(NDIM,NTIME,NVEGTYPE))
+ DO JTIME=1,ITIME
+ WRITE(YRECFM,FMT='(A7,I2.2)') 'D_LAI_T',JTIME
+ CALL READ_SURF_ISBA_PAR_n(HPROGRAM,YRECFM,ILUOUT,KSIZE,XPAR_LAI(:,JTIME,:),IRESP,IVERSION,&
+ HCOMMENT=YCOMMENT,HDIR=YDIR)
+ END DO
+ ENDIF
+!
+ IF (LDATA_Z0) THEN
+ ALLOCATE(XPAR_Z0 (NDIM,NTIME,NVEGTYPE))
+ DO JTIME=1,ITIME
+ WRITE(YRECFM,FMT='(A6,I2.2)') 'D_Z0_T',JTIME
+ CALL READ_SURF_ISBA_PAR_n(HPROGRAM,YRECFM,ILUOUT,KSIZE,XPAR_Z0(:,JTIME,:),IRESP,IVERSION,&
+ HCOMMENT=YCOMMENT,HDIR=YDIR)
+ END DO
+ ENDIF
+!
+ IF (LDATA_EMIS) THEN
+ ALLOCATE(XPAR_EMIS (NDIM,NTIME,NVEGTYPE))
+ DO JTIME=1,ITIME
+ WRITE(YRECFM,FMT='(A8,I2.2)') 'D_EMIS_T',JTIME
+ CALL READ_SURF_ISBA_PAR_n(HPROGRAM,YRECFM,ILUOUT,KSIZE,XPAR_EMIS(:,JTIME,:),IRESP,IVERSION,&
+ HCOMMENT=YCOMMENT,HDIR=YDIR)
+ END DO
+ ENDIF
+!
+ IF (LDATA_RSMIN) THEN
+ ALLOCATE(XPAR_RSMIN (NDIM,NVEGTYPE))
+ YRECFM='D_RSMIN'
+ CALL READ_SURF_ISBA_PAR_n(HPROGRAM,YRECFM,ILUOUT,KSIZE,XPAR_RSMIN(:,:),IRESP,IVERSION,&
+ HCOMMENT=YCOMMENT,HDIR=YDIR)
+ ENDIF
+!
+ IF (LDATA_GAMMA) THEN
+ ALLOCATE(XPAR_GAMMA (NDIM,NVEGTYPE))
+ YRECFM='D_GAMMA'
+ CALL READ_SURF_ISBA_PAR_n(HPROGRAM,YRECFM,ILUOUT,KSIZE,XPAR_GAMMA(:,:),IRESP,IVERSION,&
+ HCOMMENT=YCOMMENT,HDIR=YDIR)
+ ENDIF
+!
+ IF (LDATA_WRMAX_CF) THEN
+ ALLOCATE(XPAR_WRMAX_CF (NDIM,NVEGTYPE))
+ YRECFM='D_WRMAX_CF'
+ CALL READ_SURF_ISBA_PAR_n(HPROGRAM,YRECFM,ILUOUT,KSIZE,XPAR_WRMAX_CF(:,:),IRESP,IVERSION,&
+ HCOMMENT=YCOMMENT,HDIR=YDIR)
+ ENDIF
+!
+ IF (LDATA_RGL) THEN
+ ALLOCATE(XPAR_RGL (NDIM,NVEGTYPE))
+ YRECFM='D_RGL'
+ CALL READ_SURF_ISBA_PAR_n(HPROGRAM,YRECFM,ILUOUT,KSIZE,XPAR_RGL(:,:),IRESP,IVERSION,&
+ HCOMMENT=YCOMMENT,HDIR=YDIR)
+ ENDIF
+!
+ IF (LDATA_CV) THEN
+ ALLOCATE(XPAR_CV (NDIM,NVEGTYPE))
+ YRECFM='D_CV'
+ CALL READ_SURF_ISBA_PAR_n(HPROGRAM,YRECFM,ILUOUT,KSIZE,XPAR_CV(:,:),IRESP,IVERSION,&
+ HCOMMENT=YCOMMENT,HDIR=YDIR)
+ ENDIF
+!
+ IF (LDATA_Z0_O_Z0H) THEN
+ ALLOCATE(XPAR_Z0_O_Z0H (NDIM,NVEGTYPE))
+ YRECFM='D_Z0_O_Z0H'
+ CALL READ_SURF_ISBA_PAR_n(HPROGRAM,YRECFM,ILUOUT,KSIZE,XPAR_Z0_O_Z0H(:,:),IRESP,IVERSION,&
+ HCOMMENT=YCOMMENT,HDIR=YDIR)
+ ENDIF
+!
+ IF (LDATA_DG) THEN
+ ALLOCATE(XPAR_DG (NDIM,NGROUND_LAYER,NVEGTYPE))
+ ALLOCATE(ZWORK(SIZE(XPAR_DG,1),SIZE(XPAR_DG,3)))
+ DO JLAYER=1,SIZE(XPAR_DG,2)
+ IF (JLAYER<10) WRITE(YRECFM,FMT='(A4,I1.1)') 'D_DG',JLAYER
+ IF (JLAYER>=10) WRITE(YRECFM,FMT='(A4,I2.2)') 'D_DG',JLAYER
+ CALL READ_SURF_ISBA_PAR_n(HPROGRAM,YRECFM,ILUOUT,KSIZE,ZWORK,IRESP,IVERSION,&
+ HCOMMENT=YCOMMENT,HDIR=YDIR)
+ DO JPATCH=1,SIZE(XPAR_DG,3)
+ XPAR_DG(:,JLAYER,JPATCH) = ZWORK(:,JPATCH)
+ END DO
+ END DO
+ DEALLOCATE(ZWORK)
+ ENDIF
+!
+ IF (LDATA_ROOTFRAC) THEN
+ ALLOCATE(XPAR_ROOTFRAC (NDIM,NGROUND_LAYER,NVEGTYPE))
+ ALLOCATE(ZWORK(SIZE(XPAR_ROOTFRAC,1),SIZE(XPAR_ROOTFRAC,3)))
+ DO JLAYER=1,SIZE(XPAR_ROOTFRAC,2)
+ IF (JLAYER<10) WRITE(YRECFM,FMT='(A10,I1.1)') 'D_ROOTFRAC',JLAYER
+ IF (JLAYER>=10) WRITE(YRECFM,FMT='(A10,I2.2)') 'D_ROOTFRAC',JLAYER
+ CALL READ_SURF_ISBA_PAR_n(HPROGRAM,YRECFM,ILUOUT,KSIZE,ZWORK,IRESP,IVERSION,&
+ HCOMMENT=YCOMMENT,HDIR=YDIR)
+ DO JPATCH=1,SIZE(XPAR_ROOTFRAC,3)
+ XPAR_ROOTFRAC(:,JLAYER,JPATCH) = ZWORK(:,JPATCH)
+ END DO
+ END DO
+ DEALLOCATE(ZWORK)
+ ENDIF
+!
+ IF (LDATA_DICE) THEN
+ ALLOCATE(XPAR_DICE (NDIM,NVEGTYPE))
+ YRECFM='D_DICE'
+ CALL READ_SURF_ISBA_PAR_n(HPROGRAM,YRECFM,ILUOUT,KSIZE,XPAR_DICE(:,:),IRESP,IVERSION,&
+ HCOMMENT=YCOMMENT,HDIR=YDIR)
+ ENDIF
+!
+ IF (LDATA_GROUND_DEPTH) THEN
+ ALLOCATE(XPAR_GROUND_DEPTH(NDIM,NVEGTYPE))
+ YRECFM2='D_GROUND_DEPTH'
+ IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) YRECFM2='D_GROUND_DPT'
+ CALL READ_SURF_ISBA_PAR_n(HPROGRAM,YRECFM2,ILUOUT,KSIZE,XPAR_GROUND_DEPTH(:,:),IRESP,IVERSION,&
+ HCOMMENT=YCOMMENT,HDIR=YDIR)
+ ENDIF
+!
+ IF (LDATA_ROOT_DEPTH) THEN
+ ALLOCATE(XPAR_ROOT_DEPTH(NDIM,NVEGTYPE))
+ YRECFM='D_ROOT_DEPTH'
+ CALL READ_SURF_ISBA_PAR_n(HPROGRAM,YRECFM,ILUOUT,KSIZE,XPAR_ROOT_DEPTH(:,:),IRESP,IVERSION,&
+ HCOMMENT=YCOMMENT,HDIR=YDIR)
+ ENDIF
+!
+ IF (LDATA_ROOT_EXTINCTION) THEN
+ ALLOCATE(XPAR_ROOT_EXTINCTION(NDIM,NVEGTYPE))
+ YRECFM='D_ROOT_EXT'
+ CALL READ_SURF_ISBA_PAR_n(HPROGRAM,YRECFM,ILUOUT,KSIZE,XPAR_ROOT_EXTINCTION(:,:),IRESP,IVERSION,&
+ HCOMMENT=YCOMMENT,HDIR=YDIR)
+ ENDIF
+!
+ IF (LDATA_ROOT_LIN) THEN
+ ALLOCATE(XPAR_ROOT_LIN(NDIM,NVEGTYPE))
+ YRECFM='D_ROOT_LIN'
+ CALL READ_SURF_ISBA_PAR_n(HPROGRAM,YRECFM,ILUOUT,KSIZE,XPAR_ROOT_LIN(:,:),IRESP,IVERSION,&
+ HCOMMENT=YCOMMENT,HDIR=YDIR)
+ ENDIF
+!
+ IF (LDATA_ALBNIR_VEG) THEN
+ ALLOCATE(XPAR_ALBNIR_VEG(NDIM,NVEGTYPE))
+ YRECFM='D_ALBNIR_VEG'
+ CALL READ_SURF_ISBA_PAR_n(HPROGRAM,YRECFM,ILUOUT,KSIZE,XPAR_ALBNIR_VEG(:,:),IRESP,IVERSION,&
+ HCOMMENT=YCOMMENT,HDIR=YDIR)
+ ENDIF
+!
+ IF (LDATA_ALBVIS_VEG) THEN
+ ALLOCATE(XPAR_ALBVIS_VEG(NDIM,NVEGTYPE))
+ YRECFM='D_ALBVIS_VEG'
+ CALL READ_SURF_ISBA_PAR_n(HPROGRAM,YRECFM,ILUOUT,KSIZE,XPAR_ALBVIS_VEG(:,:),IRESP,IVERSION,&
+ HCOMMENT=YCOMMENT,HDIR=YDIR)
+ ENDIF
+!
+ IF (LDATA_ALBUV_VEG) THEN
+ ALLOCATE(XPAR_ALBUV_VEG (NDIM,NVEGTYPE))
+ YRECFM='D_ALBUV_VEG'
+ CALL READ_SURF_ISBA_PAR_n(HPROGRAM,YRECFM,ILUOUT,KSIZE,XPAR_ALBUV_VEG(:,:),IRESP,IVERSION,&
+ HCOMMENT=YCOMMENT,HDIR=YDIR)
+ ENDIF
+!
+ IF (LDATA_ALBNIR_SOIL) THEN
+ ALLOCATE(XPAR_ALBNIR_SOIL(NDIM,NVEGTYPE))
+ YRECFM='D_ALBNIR_SOI'
+ CALL READ_SURF_ISBA_PAR_n(HPROGRAM,YRECFM,ILUOUT,KSIZE,XPAR_ALBNIR_SOIL(:,:),IRESP,IVERSION,&
+ HCOMMENT=YCOMMENT,HDIR=YDIR)
+ ENDIF
+!
+ IF (LDATA_ALBVIS_SOIL) THEN
+ ALLOCATE(XPAR_ALBVIS_SOIL(NDIM,NVEGTYPE))
+ YRECFM='D_ALBVIS_SOI'
+ CALL READ_SURF_ISBA_PAR_n(HPROGRAM,YRECFM,ILUOUT,KSIZE,XPAR_ALBVIS_SOIL(:,:),IRESP,IVERSION,&
+ HCOMMENT=YCOMMENT,HDIR=YDIR)
+ ENDIF
+!
+ IF (LDATA_ALBUV_SOIL) THEN
+ ALLOCATE(XPAR_ALBUV_SOIL (NDIM,NVEGTYPE))
+ YRECFM='D_ALBUV_SOI'
+ CALL READ_SURF_ISBA_PAR_n(HPROGRAM,YRECFM,ILUOUT,KSIZE,XPAR_ALBUV_SOIL(:,:),IRESP,IVERSION,&
+ HCOMMENT=YCOMMENT,HDIR=YDIR)
+ ENDIF
+!
+ IF (LDATA_GMES) THEN
+ ALLOCATE(XPAR_GMES (NDIM,NVEGTYPE))
+ YRECFM='D_GMES'
+ CALL READ_SURF_ISBA_PAR_n(HPROGRAM,YRECFM,ILUOUT,KSIZE,XPAR_GMES(:,:),IRESP,IVERSION,&
+ HCOMMENT=YCOMMENT,HDIR=YDIR)
+ ENDIF
+!
+ IF (LDATA_BSLAI) THEN
+ ALLOCATE(XPAR_BSLAI (NDIM,NVEGTYPE))
+ YRECFM='D_BSLAI'
+ CALL READ_SURF_ISBA_PAR_n(HPROGRAM,YRECFM,ILUOUT,KSIZE,XPAR_BSLAI(:,:),IRESP,IVERSION,&
+ HCOMMENT=YCOMMENT,HDIR=YDIR)
+ ENDIF
+!
+ IF (LDATA_LAIMIN) THEN
+ ALLOCATE(XPAR_LAIMIN (NDIM,NVEGTYPE))
+ YRECFM='D_LAIMIN'
+ CALL READ_SURF_ISBA_PAR_n(HPROGRAM,YRECFM,ILUOUT,KSIZE,XPAR_LAIMIN(:,:),IRESP,IVERSION,&
+ HCOMMENT=YCOMMENT,HDIR=YDIR)
+ ENDIF
+!
+ IF (LDATA_SEFOLD) THEN
+ ALLOCATE(XPAR_SEFOLD (NDIM,NVEGTYPE))
+ YRECFM='D_SEFOLD'
+ CALL READ_SURF_ISBA_PAR_n(HPROGRAM,YRECFM,ILUOUT,KSIZE,XPAR_SEFOLD(:,:),IRESP,IVERSION,&
+ HCOMMENT=YCOMMENT,HDIR=YDIR)
+ ENDIF
+!
+ IF (LDATA_GC) THEN
+ ALLOCATE(XPAR_GC (NDIM,NVEGTYPE))
+ YRECFM='D_GC'
+ CALL READ_SURF_ISBA_PAR_n(HPROGRAM,YRECFM,ILUOUT,KSIZE,XPAR_GC(:,:),IRESP,IVERSION,&
+ HCOMMENT=YCOMMENT,HDIR=YDIR)
+ ENDIF
+!
+ IF (LDATA_DMAX) THEN
+ ALLOCATE(XPAR_DMAX (NDIM,NVEGTYPE))
+ YRECFM='D_DMAX'
+ CALL READ_SURF_ISBA_PAR_n(HPROGRAM,YRECFM,ILUOUT,KSIZE,XPAR_DMAX(:,:),IRESP,IVERSION,&
+ HCOMMENT=YCOMMENT,HDIR=YDIR)
+ ENDIF
+!
+ IF (LDATA_F2I) THEN
+ ALLOCATE(XPAR_F2I (NDIM,NVEGTYPE))
+ YRECFM='D_F2I'
+ CALL READ_SURF_ISBA_PAR_n(HPROGRAM,YRECFM,ILUOUT,KSIZE,XPAR_F2I(:,:),IRESP,IVERSION,&
+ HCOMMENT=YCOMMENT,HDIR=YDIR)
+ ENDIF
+!
+ IF (LDATA_STRESS) THEN
+ ALLOCATE(LPAR_STRESS (NDIM,NVEGTYPE))
+ ALLOCATE(ZWORK(SIZE(LPAR_STRESS,1),SIZE(LPAR_STRESS,2)))
+ YRECFM='D_STRESS'
+ CALL READ_SURF_ISBA_PAR_n(HPROGRAM,YRECFM,ILUOUT,KSIZE,ZWORK(:,:),IRESP,IVERSION,&
+ HCOMMENT=YCOMMENT,HDIR=YDIR)
+ LPAR_STRESS = .FALSE.
+ WHERE(ZWORK==1.) LPAR_STRESS = .TRUE.
+ DEALLOCATE(ZWORK)
+ ENDIF
+!
+ IF (LDATA_H_TREE) THEN
+ ALLOCATE(XPAR_H_TREE (NDIM,NVEGTYPE))
+ YRECFM='D_H_TREE'
+ CALL READ_SURF_ISBA_PAR_n(HPROGRAM,YRECFM,ILUOUT,KSIZE,XPAR_H_TREE(:,:),IRESP,IVERSION,&
+ HCOMMENT=YCOMMENT,HDIR=YDIR)
+ ENDIF
+!
+ IF (LDATA_RE25) THEN
+ ALLOCATE(XPAR_RE25 (NDIM,NVEGTYPE))
+ YRECFM='D_RE25'
+ CALL READ_SURF_ISBA_PAR_n(HPROGRAM,YRECFM,ILUOUT,KSIZE,XPAR_RE25(:,:),IRESP,IVERSION,&
+ HCOMMENT=YCOMMENT,HDIR=YDIR)
+ ENDIF
+!
+ IF (LDATA_CE_NITRO) THEN
+ ALLOCATE(XPAR_CE_NITRO (NDIM,NVEGTYPE))
+ YRECFM='D_CE_NITRO'
+ CALL READ_SURF_ISBA_PAR_n(HPROGRAM,YRECFM,ILUOUT,KSIZE,XPAR_CE_NITRO(:,:),IRESP,IVERSION,&
+ HCOMMENT=YCOMMENT,HDIR=YDIR)
+ ENDIF
+!
+ IF (LDATA_CF_NITRO) THEN
+ ALLOCATE(XPAR_CF_NITRO (NDIM,NVEGTYPE))
+ YRECFM='D_CF_NITRO'
+ CALL READ_SURF_ISBA_PAR_n(HPROGRAM,YRECFM,ILUOUT,KSIZE,XPAR_CF_NITRO(:,:),IRESP,IVERSION,&
+ HCOMMENT=YCOMMENT,HDIR=YDIR)
+ ENDIF
+!
+ IF (LDATA_CNA_NITRO) THEN
+ ALLOCATE(XPAR_CNA_NITRO (NDIM,NVEGTYPE))
+ YRECFM='D_CNA_NITRO'
+ CALL READ_SURF_ISBA_PAR_n(HPROGRAM,YRECFM,ILUOUT,KSIZE,XPAR_CNA_NITRO(:,:),IRESP,IVERSION,&
+ HCOMMENT=YCOMMENT,HDIR=YDIR)
+ ENDIF
+!
+ IF (LDATA_IRRIG) THEN
+ ALLOCATE(XPAR_IRRIG (NDIM,NTIME,NVEGTYPE))
+ DO JTIME=1,ITIME
+ WRITE(YRECFM,FMT='(A9,I2.2)') 'D_IRRIG_T',JTIME
+ CALL READ_SURF_ISBA_PAR_n(HPROGRAM,YRECFM,ILUOUT,KSIZE,XPAR_IRRIG(:,JTIME,:),IRESP,IVERSION,&
+ HCOMMENT=YCOMMENT,HDIR=YDIR)
+ END DO
+ ENDIF
+!
+ IF (LDATA_WATSUP) THEN
+ ALLOCATE(XPAR_WATSUP (NDIM,NTIME,NVEGTYPE))
+ DO JTIME=1,ITIME
+ WRITE(YRECFM,FMT='(A10,I2.2)') 'D_WATSUP_T',JTIME
+ CALL READ_SURF_ISBA_PAR_n(HPROGRAM,YRECFM,ILUOUT,KSIZE,XPAR_WATSUP(:,JTIME,:),IRESP,IVERSION,&
+ HCOMMENT=YCOMMENT,HDIR=YDIR)
+ END DO
+ ENDIF
+!
+ENDIF
+!
+IF (LHOOK) CALL DR_HOOK('READ_PGD_ISBA_PAR_N',1,ZHOOK_HANDLE)
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE READ_PGD_ISBA_PAR_n
diff --git a/src/SURFEX/read_surf_field2d.F90 b/src/SURFEX/read_surf_field2d.F90
new file mode 100644
index 000000000..ad023c152
--- /dev/null
+++ b/src/SURFEX/read_surf_field2d.F90
@@ -0,0 +1,132 @@
+!SURFEX_LIC Copyright 1994-2014 Meteo-France
+!SURFEX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SURFEX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SURFEX_LIC for details. version 1.
+! #########
+ SUBROUTINE READ_SURF_FIELD2D( HPROGRAM,PFIELD2D,HFIELDNAME,HCOMMENT,HDIR)
+! #####################################
+!
+!!**** *READ_SURF_FIELD2D* - reads surfex field in input file using READ_SURF,
+!! patch by patch if needed in MESONH
+!! with Z-parallel IO in MESO-NH, we force surfex to write 2D fields
+!! because Z-parallel IO are not supported for 2D SURFEX fields.
+!!
+!!
+!! PURPOSE
+!! -------
+!! reads surfex field in output file using WRITE_SURF,
+!! patch by patch if needed in MESONH
+!! and NB_PROCIO_R > 1
+!! examples of HFIELDNAME : 'TG', 'soil depth from ecoclimap'
+!! with Z-parallel IO in MESO-NH, we force surfex to write 2D fields
+!! because Z-parallel IO are not supported for 2D SURFEX fields.
+!!
+!!** METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!!
+!! AUTHOR
+!! ------
+!! M.Moge *LA - UPS*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 08/01/2016
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_SURF_PAR, ONLY : NUNDEF
+!
+USE MODI_READ_SURF
+#ifdef MNH
+USE MODI_GET_NB_PROCIO_READ_MNH
+#endif
+!
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of arguments
+! -------------------------
+!
+CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PFIELD2D ! 2D field to be read
+CHARACTER(LEN=12), INTENT(IN) :: HFIELDNAME ! name of the field PFIELD2D. Example : 'X_Y_TG'
+CHARACTER(LEN=*), OPTIONAL, INTENT(OUT) :: HCOMMENT !comment string
+CHARACTER(LEN=1),OPTIONAL, INTENT(IN) :: HDIR ! type of field :
+! ! 'H' : field with
+! ! horizontal spatial dim.
+! ! '-' : no horizontal dim.
+!
+!* 0.2 Declarations of local variables
+! -------------------------------
+!
+REAL, DIMENSION(SIZE(PFIELD2D,1)) :: ZWORK
+INTEGER :: IRESP ! IRESP : return-code if a problem appears
+INTEGER :: IPATCH ! number of patches in PFIELD2D
+CHARACTER(LEN=100):: YCOMMENT ! Comment string
+CHARACTER(LEN=16) :: YRECFM ! Name of the article to be read
+CHARACTER(LEN=4 ) :: YPATCH ! current patch
+INTEGER :: INB_PROCIO ! number of processes used for Z-parallel IO with MESO-NH
+!
+CHARACTER(LEN=1) :: YDIR
+INTEGER :: JPATCH ! loop counter on patches
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+!------------------------------------------------------------------------------
+!
+!
+IF (LHOOK) CALL DR_HOOK('READ_SURF_FIELD2D',0,ZHOOK_HANDLE)
+!
+YDIR = 'H'
+IF (PRESENT(HDIR)) YDIR = HDIR
+!
+IPATCH = SIZE( PFIELD2D, 2 )
+!
+INB_PROCIO = 1
+#ifdef MNH
+IF (HPROGRAM=='MESONH') THEN
+ CALL GET_NB_PROCIO_READ_MNH( INB_PROCIO, IRESP )
+ENDIF
+#endif
+!
+IF ( INB_PROCIO > 1 ) THEN
+!
+ DO JPATCH=1,IPATCH
+ YRECFM=ADJUSTL(HFIELDNAME(:LEN_TRIM(HFIELDNAME)))
+ WRITE(YPATCH,'(I4.4)') JPATCH
+ IF ( IPATCH > 1 ) THEN
+ YRECFM=ADJUSTL(YRECFM(:LEN_TRIM(YRECFM)))//YPATCH
+ ENDIF
+ CALL READ_SURF(HPROGRAM,YRECFM,PFIELD2D(:,JPATCH),IRESP,HCOMMENT=YCOMMENT,HDIR=YDIR)
+ ENDDO
+!
+ELSE
+!
+ YRECFM=ADJUSTL(HFIELDNAME(:LEN_TRIM(HFIELDNAME)))
+ CALL READ_SURF(HPROGRAM,YRECFM,PFIELD2D(:,:),IRESP,HCOMMENT=YCOMMENT,HDIR=YDIR)
+!
+ENDIF
+!
+IF (PRESENT(HDIR)) HCOMMENT = YCOMMENT
+!
+IF (LHOOK) CALL DR_HOOK('READ_SURF_FIELD2D',1,ZHOOK_HANDLE)
+!
+!-------------------------------------------------------------------------------
+!
+ END SUBROUTINE READ_SURF_FIELD2D
\ No newline at end of file
diff --git a/src/SURFEX/read_surf_field3d.F90 b/src/SURFEX/read_surf_field3d.F90
new file mode 100644
index 000000000..5ff77358a
--- /dev/null
+++ b/src/SURFEX/read_surf_field3d.F90
@@ -0,0 +1,148 @@
+!SURFEX_LIC Copyright 1994-2014 Meteo-France
+!SURFEX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SURFEX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SURFEX_LIC for details. version 1.
+! #########
+ SUBROUTINE READ_SURF_FIELD3D( HPROGRAM,PFIELD3D,KFIRSTLAYER,KLASTLAYER,HFIELDNAME,HCOMMENT,HDIR)
+! #####################################
+!
+!!**** *READ_SURF_FIELD3D* - reads surfex field in input file using READ_SURF,
+!! layer by layer and patch by patch if needed in MESONH
+!! with Z-parallel IO in MESO-NH, we force surfex to write 2D fields
+!! because Z-parallel IO are not supported for 3D SURFEX fields.
+!!
+!!
+!! PURPOSE
+!! -------
+!! reads surfex field in output file using WRITE_SURF, layer by layer
+!! and patch by patch if needed in MESONH
+!! and NB_PROCIO_R > 1
+!! examples of HFIELDNAME : 'TG', 'soil depth from ecoclimap'
+!! with Z-parallel IO in MESO-NH, we force surfex to write 2D fields
+!! because Z-parallel IO are not supported for 3D SURFEX fields.
+!!
+!!** METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!!
+!! AUTHOR
+!! ------
+!! M.Moge *LA - UPS*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 08/01/2016
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_SURF_PAR, ONLY : NUNDEF
+!
+USE MODI_READ_SURF
+#ifdef MNH
+USE MODI_GET_NB_PROCIO_READ_MNH
+#endif
+!
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of arguments
+! -------------------------
+!
+CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
+REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PFIELD3D ! 3D field to be read
+INTEGER, INTENT(IN) :: KFIRSTLAYER ! first layer of PFIELD3D to be read
+INTEGER, INTENT(IN) :: KLASTLAYER ! last layer of PFIELD3D to be read
+CHARACTER(LEN=12), INTENT(IN) :: HFIELDNAME ! name of the field PFIELD3D. Example : 'X_Y_TG'
+ CHARACTER(LEN=*), OPTIONAL, INTENT(OUT) :: HCOMMENT !comment string
+CHARACTER(LEN=1),OPTIONAL, INTENT(IN) :: HDIR ! type of field :
+! ! 'H' : field with
+! ! horizontal spatial dim.
+! ! '-' : no horizontal dim.
+!
+!* 0.2 Declarations of local variables
+! -------------------------------
+!
+REAL, DIMENSION(SIZE(PFIELD3D,1),SIZE(PFIELD3D,3)) :: ZWORK
+INTEGER :: IRESP ! IRESP : return-code if a problem appears
+INTEGER :: ILAYER ! number of layers in PFIELD3D
+INTEGER :: IPATCH ! number of patches in PFIELD3D
+CHARACTER(LEN=100):: YCOMMENT ! Comment string
+CHARACTER(LEN=16) :: YRECFM ! Name of the article to be read
+CHARACTER(LEN=4 ) :: YLVL ! current level/layer
+CHARACTER(LEN=4 ) :: YPATCH ! current patch
+INTEGER :: INB_PROCIO ! number of processes used for Z-parallel IO with MESO-NH
+!
+CHARACTER(LEN=1) :: YDIR
+INTEGER :: JJ, JLAYER ! loop counter on levels
+INTEGER :: JPATCH ! loop counter on patches
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+!------------------------------------------------------------------------------
+!
+!
+IF (LHOOK) CALL DR_HOOK('READ_SURF_FIELD3D',0,ZHOOK_HANDLE)
+!
+YDIR = 'H'
+IF (PRESENT(HDIR)) YDIR = HDIR
+!
+ILAYER = SIZE( PFIELD3D, 2 )
+IPATCH = SIZE( PFIELD3D, 3 )
+!
+INB_PROCIO = 1
+#ifdef MNH
+IF (HPROGRAM=='MESONH') THEN
+ CALL GET_NB_PROCIO_READ_MNH( INB_PROCIO, IRESP )
+ENDIF
+#endif
+!
+IF ( INB_PROCIO > 1 ) THEN
+!
+ DO JLAYER=KFIRSTLAYER,KLASTLAYER
+!
+ DO JPATCH=1,IPATCH
+ WRITE(YLVL,'(I4)') JLAYER
+ YRECFM=ADJUSTL(HFIELDNAME(:LEN_TRIM(HFIELDNAME)))//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
+ WRITE(YPATCH,'(I4.4)') JPATCH
+ IF ( IPATCH > 1 ) THEN
+ YRECFM=ADJUSTL(YRECFM(:LEN_TRIM(YRECFM)))//YPATCH
+ ENDIF
+ CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,JPATCH),IRESP,HCOMMENT=YCOMMENT,HDIR=YDIR)
+ ENDDO
+ PFIELD3D(:,JLAYER,:)=ZWORK
+!
+ END DO
+!
+ELSE
+!
+ DO JLAYER=KFIRSTLAYER,KLASTLAYER
+ WRITE(YLVL,'(I4)') JLAYER
+ YRECFM=ADJUSTL(HFIELDNAME(:LEN_TRIM(HFIELDNAME)))//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
+ CALL READ_SURF(HPROGRAM,YRECFM,ZWORK(:,:),IRESP,HCOMMENT=YCOMMENT,HDIR=YDIR)
+ PFIELD3D(:,JLAYER,:)=ZWORK
+ END DO
+!
+ENDIF
+!
+IF (PRESENT(HDIR)) HCOMMENT = YCOMMENT
+!
+IF (LHOOK) CALL DR_HOOK('READ_SURF_FIELD3D',1,ZHOOK_HANDLE)
+!
+!-------------------------------------------------------------------------------
+!
+ END SUBROUTINE READ_SURF_FIELD3D
\ No newline at end of file
diff --git a/src/SURFEX/read_surf_isba_parn.F90 b/src/SURFEX/read_surf_isba_parn.F90
index 055533fcd..62802e483 100644
--- a/src/SURFEX/read_surf_isba_parn.F90
+++ b/src/SURFEX/read_surf_isba_parn.F90
@@ -1,89 +1,95 @@
-!SURFEX_LIC Copyright 1994-2014 Meteo-France
-!SURFEX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SURFEX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SURFEX_LIC for details. version 1.
-! #######################
- SUBROUTINE READ_SURF_ISBA_PAR_n(HPROGRAM,HREC,KLUOUT,KSIZE,PFIELD,KRESP,KVERSION,HCOMMENT,HDIR)
-! #######################
-!
-USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE
-USE MODD_ISBA_n, ONLY : NPATCH
-!
-USE MODI_READ_SURF
-USE MODI_HOR_INTERPOL
-USE MODI_PUT_ON_ALL_VEGTYPES
-USE MODI_VEGTYPE_TO_PATCH
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
- CHARACTER(LEN=*), INTENT(IN) :: HREC ! name of the article to be read
-!
-INTEGER, INTENT(IN) :: KLUOUT
-INTEGER, INTENT(IN) :: KSIZE
-REAL, DIMENSION(:,:), INTENT(OUT):: PFIELD ! array containing the data field
-
-INTEGER ,INTENT(OUT) :: KRESP ! KRESP : return-code if a problem appears
-INTEGER, INTENT(IN) :: KVERSION
- CHARACTER(LEN=*),OPTIONAL,INTENT(OUT) :: HCOMMENT ! name of the article to be read
- CHARACTER(LEN=1),OPTIONAL,INTENT(IN) :: HDIR ! type of field :
-! ! 'H' : field with
-! ! horizontal spatial dim.
-! ! '-' : no horizontal dim.
-!
-!* local variables
-! ---------------
-!
-REAL, DIMENSION(KSIZE, NVEGTYPE) :: ZFIELD
-REAL, DIMENSION(SIZE(PFIELD,1),1,NPATCH) :: ZFIELD_PATCH
-REAL, DIMENSION(SIZE(PFIELD,1),1,NVEGTYPE) :: ZFIELD_VEGTYPE
- CHARACTER(LEN=1) :: YDIR
-INTEGER :: INI, JPATCH, IPATCH, JVEGTYPE
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-!-------------------------------------------------------------------
-IF (LHOOK) CALL DR_HOOK('READ_SURF_ISBA_PAR_n',0,ZHOOK_HANDLE)
-!
-YDIR = 'H'
-IF (PRESENT(HDIR)) YDIR = HDIR
-!
-INI = SIZE(PFIELD,1)
-!
-IF (KVERSION<7) THEN
- CALL READ_SURF(HPROGRAM,HREC,ZFIELD(:,1:NPATCH),KRESP,HCOMMENT=HCOMMENT,HDIR=YDIR)
- IF (INI.NE.KSIZE) THEN
- CALL HOR_INTERPOL(KLUOUT,ZFIELD(:,1:NPATCH),PFIELD(:,1:NPATCH))
- ELSE
- PFIELD(:,1:NPATCH) = ZFIELD(:,1:NPATCH)
- ENDIF
- DO JPATCH = 1, NPATCH
- ZFIELD_PATCH(:,1,JPATCH) = PFIELD(:,JPATCH)
- ENDDO
- CALL PUT_ON_ALL_VEGTYPES(INI,1,NPATCH,NVEGTYPE,ZFIELD_PATCH,ZFIELD_VEGTYPE)
- PFIELD(:,:) = ZFIELD_VEGTYPE(:,1,:)
-ELSE
- CALL READ_SURF(HPROGRAM,HREC,ZFIELD(:,:),KRESP,HCOMMENT=HCOMMENT,HDIR=YDIR)
- IF (INI.NE.KSIZE) THEN
- CALL HOR_INTERPOL(KLUOUT,ZFIELD(:,:),ZFIELD_VEGTYPE(:,1,:))
- ELSE
- ZFIELD_VEGTYPE(:,1,:) = ZFIELD(:,:)
- ENDIF
- IF (SIZE(PFIELD,2).NE.NVEGTYPE) THEN
- IPATCH = SIZE(PFIELD,2)
- PFIELD(:,:) = 0.
- DO JVEGTYPE = 1, NVEGTYPE
- JPATCH = VEGTYPE_TO_PATCH(JVEGTYPE,IPATCH)
- IF (JPATCH<=IPATCH) PFIELD(:,JPATCH) = MAX(PFIELD(:,JPATCH),ZFIELD_VEGTYPE(:,1,JVEGTYPE))
- ENDDO
- ELSE
- PFIELD(:,:) = ZFIELD_VEGTYPE(:,1,:)
- ENDIF
-ENDIF
-!
-IF (LHOOK) CALL DR_HOOK('READ_SURF_ISBA_PAR_n',1,ZHOOK_HANDLE)
-!-------------------------------------------------------------------
-!
-END SUBROUTINE READ_SURF_ISBA_PAR_n
+!SURFEX_LIC Copyright 1994-2014 Meteo-France
+!SURFEX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SURFEX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SURFEX_LIC for details. version 1.
+!!
+!! MODIFICATIONS
+!! -------------
+!! M.Moge 01/2016 using READ_SURF_FIELD2D/3D for 2D/3D surfex fields reads
+! #######################
+ SUBROUTINE READ_SURF_ISBA_PAR_n(HPROGRAM,HREC,KLUOUT,KSIZE,PFIELD,KRESP,KVERSION,HCOMMENT,HDIR)
+! #######################
+!
+USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE
+USE MODD_ISBA_n, ONLY : NPATCH
+!
+USE MODI_READ_SURF_FIELD2D
+USE MODI_HOR_INTERPOL
+USE MODI_PUT_ON_ALL_VEGTYPES
+USE MODI_VEGTYPE_TO_PATCH
+!
+USE MODI_READ_SURF_FIELD2D
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+IMPLICIT NONE
+!
+ CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
+ CHARACTER(LEN=*), INTENT(IN) :: HREC ! name of the article to be read
+!
+INTEGER, INTENT(IN) :: KLUOUT
+INTEGER, INTENT(IN) :: KSIZE
+REAL, DIMENSION(:,:), INTENT(OUT):: PFIELD ! array containing the data field
+
+INTEGER ,INTENT(OUT) :: KRESP ! KRESP : return-code if a problem appears
+INTEGER, INTENT(IN) :: KVERSION
+ CHARACTER(LEN=*),OPTIONAL,INTENT(OUT) :: HCOMMENT ! name of the article to be read
+ CHARACTER(LEN=1),OPTIONAL,INTENT(IN) :: HDIR ! type of field :
+! ! 'H' : field with
+! ! horizontal spatial dim.
+! ! '-' : no horizontal dim.
+!
+!* local variables
+! ---------------
+!
+REAL, DIMENSION(KSIZE, NVEGTYPE) :: ZFIELD
+REAL, DIMENSION(SIZE(PFIELD,1),1,NPATCH) :: ZFIELD_PATCH
+REAL, DIMENSION(SIZE(PFIELD,1),1,NVEGTYPE) :: ZFIELD_VEGTYPE
+ CHARACTER(LEN=1) :: YDIR
+INTEGER :: INI, JPATCH, IPATCH, JVEGTYPE
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+!-------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('READ_SURF_ISBA_PAR_n',0,ZHOOK_HANDLE)
+!
+YDIR = 'H'
+IF (PRESENT(HDIR)) YDIR = HDIR
+!
+INI = SIZE(PFIELD,1)
+!
+IF (KVERSION<7) THEN
+ CALL READ_SURF_FIELD2D(HPROGRAM,ZFIELD(:,1:NPATCH),HREC,HCOMMENT=HCOMMENT,HDIR=YDIR)
+ IF (INI.NE.KSIZE) THEN
+ CALL HOR_INTERPOL(KLUOUT,ZFIELD(:,1:NPATCH),PFIELD(:,1:NPATCH))
+ ELSE
+ PFIELD(:,1:NPATCH) = ZFIELD(:,1:NPATCH)
+ ENDIF
+ DO JPATCH = 1, NPATCH
+ ZFIELD_PATCH(:,1,JPATCH) = PFIELD(:,JPATCH)
+ ENDDO
+ CALL PUT_ON_ALL_VEGTYPES(INI,1,NPATCH,NVEGTYPE,ZFIELD_PATCH,ZFIELD_VEGTYPE)
+ PFIELD(:,:) = ZFIELD_VEGTYPE(:,1,:)
+ELSE
+ CALL READ_SURF_FIELD2D(HPROGRAM,ZFIELD,HREC,HCOMMENT=HCOMMENT,HDIR=YDIR)
+ IF (INI.NE.KSIZE) THEN
+ CALL HOR_INTERPOL(KLUOUT,ZFIELD(:,:),ZFIELD_VEGTYPE(:,1,:))
+ ELSE
+ ZFIELD_VEGTYPE(:,1,:) = ZFIELD(:,:)
+ ENDIF
+ IF (SIZE(PFIELD,2).NE.NVEGTYPE) THEN
+ IPATCH = SIZE(PFIELD,2)
+ PFIELD(:,:) = 0.
+ DO JVEGTYPE = 1, NVEGTYPE
+ JPATCH = VEGTYPE_TO_PATCH(JVEGTYPE,IPATCH)
+ IF (JPATCH<=IPATCH) PFIELD(:,JPATCH) = MAX(PFIELD(:,JPATCH),ZFIELD_VEGTYPE(:,1,JVEGTYPE))
+ ENDDO
+ ELSE
+ PFIELD(:,:) = ZFIELD_VEGTYPE(:,1,:)
+ ENDIF
+ENDIF
+!
+IF (LHOOK) CALL DR_HOOK('READ_SURF_ISBA_PAR_n',1,ZHOOK_HANDLE)
+!-------------------------------------------------------------------
+!
+END SUBROUTINE READ_SURF_ISBA_PAR_n
diff --git a/src/SURFEX/regular_grid_spawn.F90 b/src/SURFEX/regular_grid_spawn.F90
index f88bd968b..2bd50d320 100644
--- a/src/SURFEX/regular_grid_spawn.F90
+++ b/src/SURFEX/regular_grid_spawn.F90
@@ -1,605 +1,619 @@
-!SURFEX_LIC Copyright 1994-2014 Meteo-France
-!SURFEX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SURFEX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SURFEX_LIC for details. version 1.
-! ################################################################
- SUBROUTINE REGULAR_GRID_SPAWN(KLUOUT, &
- KL1, KIMAX1,KJMAX1,PX1,PY1,PDX1,PDY1, &
- KXOR, KYOR, KDXRATIO, KDYRATIO, &
- KXSIZE, KYSIZE, &
- KL2, KIMAX_C_ll,KJMAX_C_ll,PX2,PY2,PDX2,PDY2 )
-! ################################################################
-!
-!!**** *REGULAR_GRID_SPAWN* - routine to read in namelist the horizontal grid
-!!
-!! PURPOSE
-!! -------
-!!
-!!** METHOD
-!! ------
-!!
-!! EXTERNAL
-!! --------
-!!
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! V. Masson *Meteo France*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 01/2004
-!! M.Moge 04/2015 Parallelization using routines from MNH/SURCOUCHE
-!! M.Moge 06/2015 bug fix for reproductibility using UPDATE_NHALO1D
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_SURF_PAR, ONLY : NUNDEF
-!
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-USE MODD_SURF_ATM_n, ONLY : NIMAX_SURF_ll, NJMAX_SURF_ll
-!
-USE MODI_ABOR1_SFX
-#ifdef MNH_PARALLEL
-USE MODE_ll
-USE MODE_MODELN_HANDLER
-
-USE MODE_SPLITTING_ll, ONLY : SPLIT2
-USE MODD_VAR_ll, ONLY : NPROC, IP, YSPLITTING
-USE MODD_STRUCTURE_ll, ONLY : ZONE_ll, CRSPD_ll
-USE MODD_PARAMETERS, ONLY : JPHEXT
-USE MODE_TOOLS_ll, ONLY : INTERSECTION
-USE MODE_EXCHANGE_ll, ONLY : SEND_RECV_FIELD
-USE MODI_UPDATE_NHALO1D
-#endif
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of arguments
-! -------------------------
-!
-INTEGER, INTENT(IN) :: KLUOUT ! output listing logical unit
-INTEGER, INTENT(IN) :: KL1 ! total number of points KIMAX1 * KJMAX1
-INTEGER, INTENT(IN) :: KIMAX1 ! number of points in x direction
-INTEGER, INTENT(IN) :: KJMAX1 ! number of points in y direction
-REAL, DIMENSION(KL1), INTENT(IN) :: PX1 ! X coordinate of all points
-REAL, DIMENSION(KL1), INTENT(IN) :: PY1 ! Y coordinate of all points
-REAL, DIMENSION(KL1), INTENT(IN) :: PDX1 ! X mesh size of all points
-REAL, DIMENSION(KL1), INTENT(IN) :: PDY1 ! Y mesh size of all points
-INTEGER, INTENT(IN) :: KXOR ! position of modified bottom left point
-INTEGER, INTENT(IN) :: KYOR ! according to initial grid
-INTEGER, INTENT(IN) :: KXSIZE ! number of grid meshes in initial grid to be
-INTEGER, INTENT(IN) :: KYSIZE ! covered by the modified grid
-INTEGER, INTENT(IN) :: KDXRATIO ! resolution ratio between modified grid
-INTEGER, INTENT(IN) :: KDYRATIO ! and initial grid
-INTEGER, INTENT(IN) :: KL2 ! total number of points KIMAX_C_ll * KJMAX_C_ll
-#ifdef MNH_PARALLEL
-INTEGER, INTENT(INOUT) :: KIMAX_C_ll ! number of points in x direction (glb on entry, lcl on exit)
-INTEGER, INTENT(INOUT) :: KJMAX_C_ll ! number of points in y direction (glb on entry, lcl on exit)
-REAL, DIMENSION(:),ALLOCATABLE, INTENT(OUT) :: PX2 ! X coordinate of all points
-REAL, DIMENSION(:),ALLOCATABLE, INTENT(OUT) :: PY2 ! Y coordinate of all points
-REAL, DIMENSION(:),ALLOCATABLE, INTENT(OUT) :: PDX2 ! X mesh size of all points
-REAL, DIMENSION(:),ALLOCATABLE, INTENT(OUT) :: PDY2 ! Y mesh size of all points
-#else
-INTEGER, INTENT(IN) :: KIMAX_C_ll ! number of points in x direction
-INTEGER, INTENT(IN) :: KJMAX_C_ll ! number of points in y direction
-REAL, DIMENSION(KL2), INTENT(OUT) :: PX2 ! X coordinate of all points
-REAL, DIMENSION(KL2), INTENT(OUT) :: PY2 ! Y coordinate of all points
-REAL, DIMENSION(KL2), INTENT(OUT) :: PDX2 ! X mesh size of all points
-REAL, DIMENSION(KL2), INTENT(OUT) :: PDY2 ! Y mesh size of all points
-#endif
-!
-!* 0.2 Declarations of local variables
-! -------------------------------
-!
-!* coarse/father grid
-!
-REAL, DIMENSION(:), ALLOCATABLE :: ZXM1 ! X coordinate of center of mesh (IIMAX1 points)
-REAL, DIMENSION(:), ALLOCATABLE :: ZYM1 ! Y coordinate of center of mesh (IJMAX1 points)
-REAL, DIMENSION(:), ALLOCATABLE :: ZXHAT1 ! X coordinate of left side (IIMAX1+1 points)
-REAL, DIMENSION(:), ALLOCATABLE :: ZYHAT1 ! Y coordinate of bottom side (IJMAX1+1 points)
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZXHAT1_3D, ZYHAT1_3D ! ZXHAT1 and ZXHAT1 copied in a 3D field for the communications
-!
-!* fine/son grid
-!
-REAL, DIMENSION(:), ALLOCATABLE :: ZXHAT2 ! X coordinate of left side (IIMAX2 points)
-REAL, DIMENSION(:), ALLOCATABLE :: ZYHAT2 ! Y coordinate of bottom side (IJMAX2 points)
-REAL, DIMENSION(:), ALLOCATABLE :: ZXHAT2_F_TMP
-REAL, DIMENSION(:), ALLOCATABLE :: ZYHAT2_F_TMP
-REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZXHAT2_F, ZYHAT2_F ! temporary 3D fields to communicate the values on the father grid to the local son subgrid
-!
-!* other variables
-!
-INTEGER :: JL ! loop counter
-INTEGER :: JI,JJ ! loop controls relatively to modified grid
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-INTEGER :: IMI
-INTEGER :: IINFO_ll
-INTEGER :: IXOR_F_ll, IYOR_F_ll ! origin of local father subdomain in global coordinates
-INTEGER :: IXDIM_C, IYDIM_C ! size of local son subdomain (in coarse/father grid)
-INTEGER :: IXOR_C_ll, IYOR_C_ll ! origin of local son subdomain (in global fine/son grid)
-INTEGER :: IXEND_C_ll, IYEND_C_ll ! end of local son subdomain (in global fine/son grid)
-INTEGER :: IXOR_C_COARSE_ll, IYOR_C_COARSE_ll ! origin of local son subdomain (in global coarse/father grid)
-INTEGER :: IIMAX_C ! number of points in x direction in local portion of son model (in fine grid)
-INTEGER :: IJMAX_C ! number of points in y direction in local portion of son model (in fine grid)
-REAL, DIMENSION(KDXRATIO) :: ZCOEFX ! ponderation coefficients for linear interpolation
-REAL, DIMENSION(KDYRATIO) :: ZCOEFY ! ponderation coefficients for linear interpolation
-!
-! structures for the partitionning
-!
-#ifdef MNH_PARALLEL
-TYPE(ZONE_ll), DIMENSION(NPROC) :: TZSPLITTING_C !splitting of child model
-TYPE(ZONE_ll), ALLOCATABLE, DIMENSION(:) :: TZCOARSEFATHER ! Coarse father grid splitting
-TYPE(ZONE_ll), ALLOCATABLE, DIMENSION(:) :: TZCOARSESONSPLIT ! coarse son grid intersection with local father subdomain : coordinates in the father grid
-!
-! structures for the communications
-!
-TYPE(ZONE_ll), ALLOCATABLE, DIMENSION(:) :: TZSEND, TZRECV
-TYPE(CRSPD_ll), POINTER :: TZCRSPDSEND, TZCRSPDRECV
-TYPE(CRSPD_ll), ALLOCATABLE, DIMENSION(:), TARGET :: TZCRSPDSENDTAB, TZCRSPDRECVTAB
-#endif
-!
-INTEGER :: J
-INTEGER :: INBMSG
-INTEGER :: ICARD
-INTEGER :: ICARDDIF
-!
-!------------------------------------------------------------------------------
-!
-!* 1. Coherence tests
-! ---------------
-!
-!* tests
-!
-IF (LHOOK) CALL DR_HOOK('REGULAR_GRID_SPAWN',0,ZHOOK_HANDLE)
-IF ( KXOR+KXSIZE-1 > NIMAX_SURF_ll ) THEN
- WRITE(KLUOUT,*) 'spawned domain is not contained in the input domain'
- WRITE(KLUOUT,*) 'IXOR = ', KXOR, ' IXSIZE = ', KXSIZE,&
- ' with NIMAX(file) = ', NIMAX_SURF_ll
- CALL ABOR1_SFX('REGULAR_GRID_SPAWN: (1) SPAWNED DOMAIN NOT CONTAINED IN INPUT DOMAIN')
-END IF
-IF ( KYOR+KYSIZE-1 > NJMAX_SURF_ll ) THEN
- WRITE(KLUOUT,*) 'spawned domain is not contained in the input domain'
- WRITE(KLUOUT,*) 'IYOR = ', KYOR, ' IYSIZE = ', KYSIZE,&
- ' with NJMAX(file) = ', NJMAX_SURF_ll
- CALL ABOR1_SFX('REGULAR_GRID_SPAWN: (2) SPAWNED DOMAIN NOT CONTAINED IN INPUT DOMAIN')
-END IF
-!
-!------------------------------------------------------------------------------
-!
-!* 2. Partitionning of the son subdomain
-! --------------------------------------------------------------
-!
-#ifdef MNH_PARALLEL
-! get origin of local father subdomain in global coordinates
-!
-CALL GET_OR_ll( "B", IXOR_F_ll, IYOR_F_ll )
-!
-! origin of local son subdomain in global father coordinates
-!
-!IXOR_C_COARSE_ll = MAX( IXOR_F_ll, KXOR+1 )
-!IYOR_C_COARSE_ll = MAX( IYOR_F_ll, KYOR+1 )
-IXOR_C_COARSE_ll = MAX( IXOR_F_ll-1, KXOR ) ! we have to add one point on the west and south sides -> hence the "- 1"
-IYOR_C_COARSE_ll = MAX( IYOR_F_ll-1, KYOR ) ! we have to add one point on the west and south sides -> hence the "- 1"
-!
-ALLOCATE(TZCOARSEFATHER(NPROC))
-ALLOCATE(TZCOARSESONSPLIT(NPROC))
-!
-! compute father partitioning
-!
-CALL SPLIT2(NIMAX_SURF_ll, NJMAX_SURF_ll, 1, NPROC,TZCOARSEFATHER, YSPLITTING)
-! we don't want the halo
-DO J = 1, NPROC
- TZCOARSEFATHER(J)%NXOR = TZCOARSEFATHER(J)%NXOR - JPHEXT
- TZCOARSEFATHER(J)%NYOR = TZCOARSEFATHER(J)%NYOR - JPHEXT
- TZCOARSEFATHER(J)%NXEND = TZCOARSEFATHER(J)%NXEND - JPHEXT
- TZCOARSEFATHER(J)%NYEND = TZCOARSEFATHER(J)%NYEND - JPHEXT
-ENDDO
-!
-! partition son domain on father grid (with global coordinates on father grid)
-!
-! we have to add one point on the west and south sides -> hence the "- 1"
-CALL SPLIT2(KXSIZE, KYSIZE, 1, NPROC, TZCOARSESONSPLIT, YSPLITTING)
-! compute the local size of son grid
-! KIMAX_C_ll, KJMAX_C_ll are the global sizes of son domain
-IIMAX_C = ( TZCOARSESONSPLIT(IP)%NXEND - TZCOARSESONSPLIT(IP)%NXOR + 1 ) * KDXRATIO
-IJMAX_C = ( TZCOARSESONSPLIT(IP)%NYEND - TZCOARSESONSPLIT(IP)%NYOR + 1 ) * KDYRATIO
-! get the coordinates of the son domain partition on father grid
-DO J = 1, NPROC
- TZCOARSESONSPLIT(J)%NXOR = TZCOARSESONSPLIT(J)%NXOR + KXOR - JPHEXT - 1
- TZCOARSESONSPLIT(J)%NYOR = TZCOARSESONSPLIT(J)%NYOR + KYOR - JPHEXT - 1
- TZCOARSESONSPLIT(J)%NXEND = TZCOARSESONSPLIT(J)%NXEND + KXOR - JPHEXT
- TZCOARSESONSPLIT(J)%NYEND = TZCOARSESONSPLIT(J)%NYEND + KYOR - JPHEXT
-ENDDO
-!
-! compute the local size of son grid
-! KIMAX_C_ll, KJMAX_C_ll are the global sizes of son domain
-!
-!CALL SPLIT2 ( KIMAX_C_ll, KJMAX_C_ll, 1, NPROC, TZSPLITTING_C, YSPLITTING )
-!IXOR_C_ll = TZSPLITTING_C(IP)%NXOR - JPHEXT
-!IXEND_C_ll = TZSPLITTING_C(IP)%NXEND - JPHEXT
-!IYOR_C_ll = TZSPLITTING_C(IP)%NYOR - JPHEXT
-!IYEND_C_ll = TZSPLITTING_C(IP)%NYEND - JPHEXT
-!!
-!IIMAX_C = IXEND_C_ll - IXOR_C_ll + 1
-!IJMAX_C = IYEND_C_ll - IYOR_C_ll + 1
-!IIMAX_C = ( TZCOARSESONSPLIT(IP)%NXEND - TZCOARSESONSPLIT(IP)%NXOR + 1 ) * KDXRATIO
-!IJMAX_C = ( TZCOARSESONSPLIT(IP)%NYEND - TZCOARSESONSPLIT(IP)%NYOR + 1 ) * KDYRATIO
-!
-!------------------------------------------------------------------------------
-!
-!* 3. Preparing the structures for the communications for the initialization of son fields using father fields
-! --------------------------------------------------------------
-!
- !
- ! ######## initializing the structures for the SEND ########
- !
- ALLOCATE(TZSEND(NPROC))
- CALL INTERSECTION( TZCOARSESONSPLIT, NPROC, TZCOARSEFATHER(IP), TZSEND)
- ! il faut initialiser le TAG de manière a avoir un meme tag unique pour le send et le recv :
- ! on concatene le num du proc qui envoie et le num du proc qui recoit
- DO J = 1, NPROC
- IF ( TZSEND(J)%NUMBER > 0 ) THEN
- IF (TZSEND(J)%NUMBER == 1) THEN
- TZSEND(J)%MSSGTAG = IP * 10 + 1
- ELSE
- TZSEND(J)%MSSGTAG = IP * 10**(CEILING(LOG10(real(TZSEND(J)%NUMBER)))) + TZSEND(J)%NUMBER
- ENDIF
- ENDIF
- ENDDO
- ! switching to local coordinates
- DO J = 1, NPROC
- IF ( TZSEND(J)%NUMBER > 0 ) THEN
- TZSEND(J)%NXOR = TZSEND(J)%NXOR - IXOR_F_ll + 1
- TZSEND(J)%NXEND = TZSEND(J)%NXEND - IXOR_F_ll + 1
- TZSEND(J)%NYOR = TZSEND(J)%NYOR - IYOR_F_ll + 1
- TZSEND(J)%NYEND = TZSEND(J)%NYEND - IYOR_F_ll + 1
- ENDIF
- ENDDO
- ! we do not need the Z dimension
- DO J = 1, NPROC
- IF ( TZSEND(J)%NUMBER > 0 ) THEN
- TZSEND(J)%NZOR = 1
- TZSEND(J)%NZEND = 1
- ENDIF
- ENDDO
- ! switching from an array of CRSPD_ll to a CRSPD_ll pointer
- INBMSG = 0
- DO J = 1, NPROC
- IF ( TZSEND(J)%NUMBER > 0 ) THEN
- INBMSG = INBMSG+1
- ENDIF
- ENDDO
- IF ( INBMSG > 0 ) THEN
- ALLOCATE( TZCRSPDSENDTAB(INBMSG) )
- ICARD = 0
- ICARDDIF = 0
- DO J = 1, NPROC
- IF ( TZSEND(J)%NUMBER > 0 ) THEN
- ICARD = ICARD+1
- IF ( TZSEND(ICARD)%NUMBER /= IP ) THEN
- ICARDDIF = ICARDDIF+1
- ENDIF
- TZCRSPDSENDTAB(ICARD)%TELT = TZSEND(J)
- IF ( ICARD == INBMSG ) THEN
- TZCRSPDSENDTAB(ICARD)%TNEXT => NULL()
- ELSE
- TZCRSPDSENDTAB(ICARD)%TNEXT => TZCRSPDSENDTAB(ICARD+1)
- ENDIF
- ENDIF
- ENDDO
- DO J = 1, ICARD
- TZCRSPDSENDTAB(J)%NCARD = ICARD
- TZCRSPDSENDTAB(J)%NCARDDIF = ICARDDIF
- ENDDO
- ELSE
- !il faut tout de meme mettre un element de taille 0 dans TZCRSPDSENDTAB
- !sinon SEND_RECV_FIELD plante en 02
- ALLOCATE( TZCRSPDSENDTAB(1) )
- ICARD = 0
- ICARDDIF = 0
- TZCRSPDSENDTAB(1)%TELT = TZSEND(1)
- TZCRSPDSENDTAB(1)%TNEXT => NULL()
- TZCRSPDSENDTAB(1)%NCARD = 0
- TZCRSPDSENDTAB(1)%NCARDDIF = 0
- ENDIF
-! IF (ICARD > 0) THEN
- TZCRSPDSEND => TZCRSPDSENDTAB(1)
-! ELSE
-! TZCRSPDSEND => NULL()
-! ENDIF
- !
- ! ######## initializing the structures for the RECV ########
- !
- ALLOCATE(TZRECV(NPROC))
- CALL INTERSECTION( TZCOARSEFATHER, NPROC, TZCOARSESONSPLIT(IP), TZRECV )
- ! il faut initialiser le TAG de manière a avoir un meme tag unique pour le send et le recv :
- ! on concatene le num du proc qui envoie et le num du proc qui recoit
- DO J = 1, NPROC
- IF ( TZRECV(J)%NUMBER > 0 ) THEN
- IF (IP == 1) THEN
- TZRECV(J)%MSSGTAG = TZRECV(J)%NUMBER * 10 + 1
- ELSE
- TZRECV(J)%MSSGTAG = TZRECV(J)%NUMBER * 10**(CEILING(LOG10(real(IP)))) + IP
- ENDIF
- ENDIF
- ENDDO
- ! switching to local coordinates
- DO J = 1, NPROC
- IF ( TZRECV(J)%NUMBER > 0 ) THEN
- TZRECV(J)%NXOR = TZRECV(J)%NXOR - TZCOARSESONSPLIT(IP)%NXOR + 1
- TZRECV(J)%NXEND = TZRECV(J)%NXEND - TZCOARSESONSPLIT(IP)%NXOR + 1
- TZRECV(J)%NYOR = TZRECV(J)%NYOR - TZCOARSESONSPLIT(IP)%NYOR + 1
- TZRECV(J)%NYEND = TZRECV(J)%NYEND - TZCOARSESONSPLIT(IP)%NYOR + 1
- ENDIF
- ENDDO
- ! we do not need the Z dimension
- DO J = 1, NPROC
- IF ( TZRECV(J)%NUMBER > 0 ) THEN
- TZRECV(J)%NZOR = 1
- TZRECV(J)%NZEND = 1
- ENDIF
- ENDDO
- ! switching from an array of CRSPD_ll to a CRSPD_ll pointer
- INBMSG = 0
- DO J = 1, NPROC
- IF ( TZRECV(J)%NUMBER > 0 ) THEN
- INBMSG = INBMSG+1
- ENDIF
- ENDDO
- IF ( INBMSG > 0 ) THEN
- ALLOCATE( TZCRSPDRECVTAB(INBMSG) )
- ICARD = 0
- ICARDDIF = 0
- DO J = 1, NPROC
- IF ( TZRECV(J)%NUMBER > 0 ) THEN
- ICARD = ICARD+1
- IF ( TZRECV(ICARD)%NUMBER /= IP ) THEN
- ICARDDIF = ICARDDIF+1
- ENDIF
- TZCRSPDRECVTAB(ICARD)%TELT = TZRECV(J)
- IF ( ICARD == INBMSG ) THEN
- TZCRSPDRECVTAB(ICARD)%TNEXT => NULL()
- ELSE
- TZCRSPDRECVTAB(ICARD)%TNEXT => TZCRSPDRECVTAB(ICARD+1)
- ENDIF
- ENDIF
- ENDDO
- DO J = 1, ICARD
- TZCRSPDRECVTAB(J)%NCARD = ICARD
- TZCRSPDRECVTAB(J)%NCARDDIF = ICARDDIF
- ENDDO
- ELSE
- !il faut tout de meme mettre un element de taille 0 dans TZCRSPDRECVTAB
- !sinon SEND_RECV_FIELD plante en 02
- ALLOCATE( TZCRSPDRECVTAB(1) )
- ICARD = 0
- ICARDDIF = 0
- TZCRSPDRECVTAB(1)%TELT = TZSEND(1)
- TZCRSPDRECVTAB(1)%TNEXT => NULL()
- TZCRSPDRECVTAB(1)%NCARD = 0
- TZCRSPDRECVTAB(1)%NCARDDIF = 0
- ENDIF
-! IF (ICARD > 0) THEN
- TZCRSPDRECV => TZCRSPDRECVTAB(1)
-! ELSE
-! TZCRSPDRECV => NULL()
-! ENDIF
-#else
-IIMAX_C = KIMAX_C_ll
-IJMAX_C = KJMAX_C_ll
-#endif
-!
-!------------------------------------------------------------------------------
-!
-!* 4. Center of mesh coordinate arrays for each direction separately
-! --------------------------------------------------------------
-!
-! allocate the fields on the local son grid
-!
-#ifdef MNH_PARALLEL
-ALLOCATE(PX2(IIMAX_C*IJMAX_C))
-ALLOCATE(PY2(IIMAX_C*IJMAX_C))
-ALLOCATE(PDX2(IIMAX_C*IJMAX_C))
-ALLOCATE(PDY2(IIMAX_C*IJMAX_C))
-#endif
-ALLOCATE(ZXHAT2(IIMAX_C+1))
-ALLOCATE(ZYHAT2(IJMAX_C+1))
-!
-! allocate the fields on the local father grid
-!
-ALLOCATE(ZXM1 (KIMAX1))
-ALLOCATE(ZYM1 (KJMAX1))
-ALLOCATE(ZXHAT1(KIMAX1+1))
-ALLOCATE(ZYHAT1(KJMAX1+1))
-!
-ZXM1(:) = PX1(1:KIMAX1)
-DO JL=1,KL1
- IF (MOD(JL,KIMAX1)==0) ZYM1(JL/KIMAX1) = PY1(JL)
-END DO
-!
-!------------------------------------------------------------------------------
-!
-!* 5. side of mesh coordinate arrays for each direction separately
-! ------------------------------------------------------------
-!
-!
-IF (KIMAX1==1) THEN
- ZXHAT1(1) = ZXM1(1) - 0.5 * PDX1(1)
- ZXHAT1(2) = ZXM1(1) + 0.5 * PDX1(1)
-ELSE
- ZXHAT1(1) = 1.5 * ZXM1(1) - 0.5 * ZXM1(2)
- DO JI=2,KIMAX1
- ZXHAT1(JI) = 0.5 * ZXM1(JI-1) + 0.5 * ZXM1(JI)
- END DO
- ZXHAT1(KIMAX1+1) = 1.5 * ZXM1(KIMAX1) - 0.5 * ZXM1(KIMAX1-1)
-END IF
-!
-IF (KJMAX1==1) THEN
- ZYHAT1(1) = ZYM1(1) - 0.5 * PDY1(1)
- ZYHAT1(2) = ZYM1(1) + 0.5 * PDY1(1)
-ELSE
- ZYHAT1(1) = 1.5 * ZYM1(1) - 0.5 * ZYM1(2)
- DO JJ=2,KJMAX1
- ZYHAT1(JJ) = 0.5 * ZYM1(JJ-1) + 0.5 * ZYM1(JJ)
- END DO
- ZYHAT1(KJMAX1+1) = 1.5 * ZYM1(KJMAX1) - 0.5 * ZYM1(KJMAX1-1)
-END IF
-#ifdef MNH_PARALLEL
- !
- ! do the communication
- !
- IXDIM_C = TZCOARSESONSPLIT(IP)%NXEND-TZCOARSESONSPLIT(IP)%NXOR+1
- IYDIM_C = TZCOARSESONSPLIT(IP)%NYEND-TZCOARSESONSPLIT(IP)%NYOR+1
- ALLOCATE(ZXHAT2_F(IXDIM_C,IYDIM_C,1))
- ALLOCATE(ZYHAT2_F(IXDIM_C,IYDIM_C,1))
- ALLOCATE(ZXHAT1_3D(KIMAX1,KJMAX1,1))
- ALLOCATE(ZYHAT1_3D(KIMAX1,KJMAX1,1))
- ZXHAT1_3D(:,:,:) = 0
- ZYHAT1_3D(:,:,:) = 0
- ZXHAT2_F(:,:,:) = 0
- ZYHAT2_F(:,:,:) = 0
- DO J=1, KJMAX1
- ZXHAT1_3D(:,J,1) = ZXHAT1(1:KIMAX1)
- ENDDO
- DO J=1, KIMAX1
- ZYHAT1_3D(J,:,1) = ZYHAT1(1:KJMAX1)
- ENDDO
- CALL SEND_RECV_FIELD( TZCRSPDSEND, TZCRSPDRECV, ZXHAT1_3D, ZXHAT2_F, IINFO_ll)
- CALL SEND_RECV_FIELD( TZCRSPDSEND, TZCRSPDRECV, ZYHAT1_3D, ZYHAT2_F, IINFO_ll)
-!
-! We have to copy the entries of ZXHAT1_3D and ZYHAT1_3D that are local to the current process,
-! and that are therefore not communicated in SEND_RECV_FIELD, in ZXHAT2_F and ZYHAT2_F
-!
- IF ( TZSEND(IP)%NUMBER /= 0 ) THEN !if there are entries of ZXHAT1_3D and ZYHAT1_3D that are local to the current process
-! DO J=TZSEND(IP)%NXOR-KXOR,TZSEND(IP)%NXEND-KXOR
- ZXHAT2_F( TZRECV(IP)%NXOR:TZRECV(IP)%NXEND, 1, 1) = ZXHAT1_3D( TZSEND(IP)%NXOR:TZSEND(IP)%NXEND, 1, 1)
-! ENDDO
-! DO J=TZSEND(IP)%NYOR-KYOR,TZSEND(IP)%NYEND-KYOR
- ZYHAT2_F( 1,TZRECV(IP)%NYOR:TZRECV(IP)%NYEND, 1) = ZYHAT1_3D( 1,TZSEND(IP)%NYOR:TZSEND(IP)%NYEND, 1)
-! ENDDO
- ENDIF
- !
- ! We need one halo point on the east and north sides of each local subdomain to do a proper interpolation
- !
- ALLOCATE( ZXHAT2_F_TMP(IXDIM_C+1) )
- ALLOCATE( ZYHAT2_F_TMP(IYDIM_C+1) )
- ZXHAT2_F_TMP(:) = 0.
- ZYHAT2_F_TMP(:) = 0.
- ZXHAT2_F_TMP(1:IXDIM_C) = ZXHAT2_F(:,1,1)
- ZYHAT2_F_TMP(1:IYDIM_C) = ZYHAT2_F(1,:,1)
- CALL SPLIT2(KXSIZE, KYSIZE, 1, NPROC, TZCOARSESONSPLIT, YSPLITTING)
- CALL UPDATE_NHALO1D( 1, ZXHAT2_F_TMP, KXSIZE, KYSIZE,TZCOARSESONSPLIT(IP)%NXOR, &
- TZCOARSESONSPLIT(IP)%NXEND,TZCOARSESONSPLIT(IP)%NYOR,TZCOARSESONSPLIT(IP)%NYEND, 'XX ')
- CALL UPDATE_NHALO1D( 1, ZYHAT2_F_TMP, KXSIZE, KYSIZE,TZCOARSESONSPLIT(IP)%NXOR, &
- TZCOARSESONSPLIT(IP)%NXEND,TZCOARSESONSPLIT(IP)%NYOR,TZCOARSESONSPLIT(IP)%NYEND, 'YY ')
-#endif
-!
-!------------------------------------------------------------------------------
-!
-!* 6. Interpolation of coordinate arrays for each direction separately
-! ----------------------------------------------------------------
-!
-!* X coordinate array
-!
-DO J=0,KDXRATIO-1
- ZCOEFX(J+1) = FLOAT(J)/FLOAT(KDXRATIO)
-ENDDO
-DO JI=1,IXDIM_C-1
- DO JJ=1,KDXRATIO
- ZXHAT2((JI-1)*KDXRATIO+JJ)=(1.-ZCOEFX(JJ))*ZXHAT2_F(JI,1,1)+ZCOEFX(JJ)*ZXHAT2_F(JI+1,1,1)
- ENDDO
-ENDDO
-IF (IIMAX_C==1) THEN
- ZXHAT2(IIMAX_C+1) = ZXHAT2(IIMAX_C) + ZXHAT2_F(JI,1,1) - ZXHAT2_F(JI,1,1)
-ELSE
-#ifdef MNH_PARALLEL
- IF ( LEAST_ll() ) THEN ! the east halo point does not have a correct value so have to do an extrapolation
- ZXHAT2(IIMAX_C+1) = 2. * ZXHAT2(IIMAX_C) - ZXHAT2(IIMAX_C-1)
- ELSE
- ZXHAT2(IIMAX_C+1)=(1.-ZCOEFX(1))*ZXHAT2_F_TMP(IXDIM_C)+ZCOEFX(1)*ZXHAT2_F_TMP(IXDIM_C+1)
- ENDIF
-#else
- ZXHAT2(IIMAX_C+1) = 2. * ZXHAT2(IIMAX_C) - ZXHAT2(IIMAX_C-1)
-#endif
-END IF
-!
-!* Y coordinate array
-!
-DO J=0,KDYRATIO-1
- ZCOEFY(J+1) = FLOAT(J)/FLOAT(KDYRATIO)
-ENDDO
-DO JI=1,IYDIM_C-1
- DO JJ=1,KDYRATIO
- ZYHAT2((JI-1)*KDYRATIO+JJ)=(1.-ZCOEFY(JJ))*ZYHAT2_F(1,JI,1)+ZCOEFY(JJ)*ZYHAT2_F(1,JI+1,1)
- ENDDO
-ENDDO
-IF (IJMAX_C==1) THEN
- ZYHAT2(IJMAX_C+1) = ZYHAT2(IJMAX_C) + ZYHAT2_F(1,JI,1) - ZYHAT2_F(1,JI,1)
-ELSE
-#ifdef MNH_PARALLEL
- IF ( LNORTH_ll() ) THEN ! the east halo point does not have a correct value so have to do an extrapolation
- ZYHAT2(IJMAX_C+1) = 2. * ZYHAT2(IJMAX_C) - ZYHAT2(IJMAX_C-1)
- ELSE
- ZYHAT2(IJMAX_C+1)=(1.-ZCOEFY(1))*ZYHAT2_F_TMP(IYDIM_C)+ZCOEFY(1)*ZYHAT2_F_TMP(IYDIM_C+1)
- ENDIF
-#else
- ZYHAT2(IJMAX_C+1) = 2. * ZYHAT2(IJMAX_C) - ZYHAT2(IJMAX_C-1)
-#endif
-END IF
-!---------------------------------------------------------------------------
-DEALLOCATE(ZXM1)
-DEALLOCATE(ZYM1)
-DEALLOCATE(ZXHAT1)
-DEALLOCATE(ZYHAT1)
-#ifdef MNH_PARALLEL
-DEALLOCATE(ZXHAT1_3D)
-DEALLOCATE(ZYHAT1_3D)
-#endif
-!------------------------------------------------------------------------------
-!
-!* 7. Coordinate arrays of all points
-! -------------------------------
-!
-DO JJ=1,IJMAX_C
- DO JI=1,IIMAX_C
- JL = (JJ-1) * IIMAX_C + JI
- PX2 (JL) = 0.5 * ZXHAT2(JI) + 0.5 * ZXHAT2(JI+1)
- PDX2(JL) = ZXHAT2(JI+1) - ZXHAT2(JI)
- PY2 (JL) = 0.5 * ZYHAT2(JJ) + 0.5 * ZYHAT2(JJ+1)
- PDY2(JL) = ZYHAT2(JJ+1) - ZYHAT2(JJ)
- END DO
-END DO
-!
-#ifdef MNH_PARALLEL
-KIMAX_C_ll = IIMAX_C
-KJMAX_C_ll = IJMAX_C
-#endif
-!---------------------------------------------------------------------------
-#ifdef MNH_PARALLEL
-DEALLOCATE(ZXHAT2_F)
-DEALLOCATE(ZYHAT2_F)
-DEALLOCATE(TZCRSPDSENDTAB)
-DEALLOCATE(TZCRSPDRECVTAB)
-DEALLOCATE(TZSEND)
-DEALLOCATE(TZRECV)
-DEALLOCATE(TZCOARSEFATHER)
-DEALLOCATE(TZCOARSESONSPLIT)
-#endif
-DEALLOCATE(ZXHAT2)
-DEALLOCATE(ZYHAT2)
-IF (LHOOK) CALL DR_HOOK('REGULAR_GRID_SPAWN',1,ZHOOK_HANDLE)
-!---------------------------------------------------------------------------
-!
-END SUBROUTINE REGULAR_GRID_SPAWN
+!SURFEX_LIC Copyright 1994-2014 Meteo-France
+!SURFEX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SURFEX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SURFEX_LIC for details. version 1.
+! ################################################################
+ SUBROUTINE REGULAR_GRID_SPAWN(KLUOUT, &
+ KL1, KIMAX1,KJMAX1,PX1,PY1,PDX1,PDY1, &
+ KXOR, KYOR, KDXRATIO, KDYRATIO, &
+ KXSIZE, KYSIZE, &
+ KL2, KIMAX_C_ll,KJMAX_C_ll,PX2,PY2,PDX2,PDY2 )
+! ################################################################
+!
+!!**** *REGULAR_GRID_SPAWN* - routine to read in namelist the horizontal grid
+!!
+!! PURPOSE
+!! -------
+!!
+!!** METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Masson *Meteo France*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 01/2004
+!! M.Moge 04/2015 Parallelization using routines from MNH/SURCOUCHE
+!! M.Moge 06/2015 bug fix for reproductibility using UPDATE_NHALO1D
+!! M.Moge 01/2016 bug fix for parallel execution with SPLIT2
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_SURF_PAR, ONLY : NUNDEF
+!
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+USE MODD_SURF_ATM_n, ONLY : NIMAX_SURF_ll, NJMAX_SURF_ll
+!
+USE MODI_ABOR1_SFX
+#ifdef MNH_PARALLEL
+USE MODE_ll
+USE MODE_MODELN_HANDLER
+
+USE MODE_SPLITTING_ll, ONLY : SPLIT2, DEF_SPLITTING2
+USE MODD_VAR_ll, ONLY : NPROC, IP, YSPLITTING
+USE MODD_STRUCTURE_ll, ONLY : ZONE_ll, CRSPD_ll
+USE MODD_PARAMETERS, ONLY : JPHEXT
+USE MODE_TOOLS_ll, ONLY : INTERSECTION
+USE MODE_EXCHANGE_ll, ONLY : SEND_RECV_FIELD
+USE MODI_UPDATE_NHALO1D
+#endif
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of arguments
+! -------------------------
+!
+INTEGER, INTENT(IN) :: KLUOUT ! output listing logical unit
+INTEGER, INTENT(IN) :: KL1 ! total number of points KIMAX1 * KJMAX1
+INTEGER, INTENT(IN) :: KIMAX1 ! number of points in x direction
+INTEGER, INTENT(IN) :: KJMAX1 ! number of points in y direction
+REAL, DIMENSION(KL1), INTENT(IN) :: PX1 ! X coordinate of all points
+REAL, DIMENSION(KL1), INTENT(IN) :: PY1 ! Y coordinate of all points
+REAL, DIMENSION(KL1), INTENT(IN) :: PDX1 ! X mesh size of all points
+REAL, DIMENSION(KL1), INTENT(IN) :: PDY1 ! Y mesh size of all points
+INTEGER, INTENT(IN) :: KXOR ! position of modified bottom left point
+INTEGER, INTENT(IN) :: KYOR ! according to initial grid
+INTEGER, INTENT(IN) :: KXSIZE ! number of grid meshes in initial grid to be
+INTEGER, INTENT(IN) :: KYSIZE ! covered by the modified grid
+INTEGER, INTENT(IN) :: KDXRATIO ! resolution ratio between modified grid
+INTEGER, INTENT(IN) :: KDYRATIO ! and initial grid
+INTEGER, INTENT(IN) :: KL2 ! total number of points KIMAX_C_ll * KJMAX_C_ll
+#ifdef MNH_PARALLEL
+INTEGER, INTENT(INOUT) :: KIMAX_C_ll ! number of points in x direction (glb on entry, lcl on exit)
+INTEGER, INTENT(INOUT) :: KJMAX_C_ll ! number of points in y direction (glb on entry, lcl on exit)
+REAL, DIMENSION(:),ALLOCATABLE, INTENT(OUT) :: PX2 ! X coordinate of all points
+REAL, DIMENSION(:),ALLOCATABLE, INTENT(OUT) :: PY2 ! Y coordinate of all points
+REAL, DIMENSION(:),ALLOCATABLE, INTENT(OUT) :: PDX2 ! X mesh size of all points
+REAL, DIMENSION(:),ALLOCATABLE, INTENT(OUT) :: PDY2 ! Y mesh size of all points
+#else
+INTEGER, INTENT(IN) :: KIMAX_C_ll ! number of points in x direction
+INTEGER, INTENT(IN) :: KJMAX_C_ll ! number of points in y direction
+REAL, DIMENSION(KL2), INTENT(OUT) :: PX2 ! X coordinate of all points
+REAL, DIMENSION(KL2), INTENT(OUT) :: PY2 ! Y coordinate of all points
+REAL, DIMENSION(KL2), INTENT(OUT) :: PDX2 ! X mesh size of all points
+REAL, DIMENSION(KL2), INTENT(OUT) :: PDY2 ! Y mesh size of all points
+#endif
+!
+!* 0.2 Declarations of local variables
+! -------------------------------
+!
+!* coarse/father grid
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZXM1 ! X coordinate of center of mesh (IIMAX1 points)
+REAL, DIMENSION(:), ALLOCATABLE :: ZYM1 ! Y coordinate of center of mesh (IJMAX1 points)
+REAL, DIMENSION(:), ALLOCATABLE :: ZXHAT1 ! X coordinate of left side (IIMAX1+1 points)
+REAL, DIMENSION(:), ALLOCATABLE :: ZYHAT1 ! Y coordinate of bottom side (IJMAX1+1 points)
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZXHAT1_3D, ZYHAT1_3D ! ZXHAT1 and ZXHAT1 copied in a 3D field for the communications
+!
+!* fine/son grid
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZXHAT2 ! X coordinate of left side (IIMAX2 points)
+REAL, DIMENSION(:), ALLOCATABLE :: ZYHAT2 ! Y coordinate of bottom side (IJMAX2 points)
+REAL, DIMENSION(:), ALLOCATABLE :: ZXHAT2_F_TMP
+REAL, DIMENSION(:), ALLOCATABLE :: ZYHAT2_F_TMP
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZXHAT2_F, ZYHAT2_F ! temporary 3D fields to communicate the values on the father grid to the local son subgrid
+!
+!* other variables
+!
+INTEGER :: JL ! loop counter
+INTEGER :: JI,JJ ! loop controls relatively to modified grid
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+INTEGER :: IMI
+INTEGER :: IINFO_ll
+INTEGER :: IXDOMAINS, IYDOMAINS ! number of subdomains in X and Y directions
+LOGICAL :: GPREM ! needed for DEF_SPLITTING2, true if NPROC is a prime number
+INTEGER :: IXOR_F_ll, IYOR_F_ll ! origin of local father subdomain in global coordinates
+INTEGER :: IXDIM_C, IYDIM_C ! size of local son subdomain (in coarse/father grid)
+INTEGER :: IXOR_C_ll, IYOR_C_ll ! origin of local son subdomain (in global fine/son grid)
+INTEGER :: IXEND_C_ll, IYEND_C_ll ! end of local son subdomain (in global fine/son grid)
+INTEGER :: IXOR_C_COARSE_ll, IYOR_C_COARSE_ll ! origin of local son subdomain (in global coarse/father grid)
+INTEGER :: IIMAX_C ! number of points in x direction in local portion of son model (in fine grid)
+INTEGER :: IJMAX_C ! number of points in y direction in local portion of son model (in fine grid)
+REAL, DIMENSION(KDXRATIO) :: ZCOEFX ! ponderation coefficients for linear interpolation
+REAL, DIMENSION(KDYRATIO) :: ZCOEFY ! ponderation coefficients for linear interpolation
+!
+! structures for the partitionning
+!
+#ifdef MNH_PARALLEL
+TYPE(ZONE_ll), DIMENSION(NPROC) :: TZSPLITTING_C !splitting of child model
+TYPE(ZONE_ll), ALLOCATABLE, DIMENSION(:) :: TZCOARSEFATHER ! Coarse father grid splitting
+TYPE(ZONE_ll), ALLOCATABLE, DIMENSION(:) :: TZCOARSESONSPLIT ! coarse son grid intersection with local father subdomain : coordinates in the father grid
+!
+! structures for the communications
+!
+TYPE(ZONE_ll), ALLOCATABLE, DIMENSION(:) :: TZSEND, TZRECV
+TYPE(CRSPD_ll), POINTER :: TZCRSPDSEND, TZCRSPDRECV
+TYPE(CRSPD_ll), ALLOCATABLE, DIMENSION(:), TARGET :: TZCRSPDSENDTAB, TZCRSPDRECVTAB
+#endif
+!
+INTEGER :: J
+INTEGER :: INBMSG
+INTEGER :: ICARD
+INTEGER :: ICARDDIF
+!
+!------------------------------------------------------------------------------
+!
+!* 1. Coherence tests
+! ---------------
+!
+!* tests
+!
+IF (LHOOK) CALL DR_HOOK('REGULAR_GRID_SPAWN',0,ZHOOK_HANDLE)
+IF ( KXOR+KXSIZE-1 > NIMAX_SURF_ll ) THEN
+ WRITE(KLUOUT,*) 'spawned domain is not contained in the input domain'
+ WRITE(KLUOUT,*) 'IXOR = ', KXOR, ' IXSIZE = ', KXSIZE,&
+ ' with NIMAX(file) = ', NIMAX_SURF_ll
+ CALL ABOR1_SFX('REGULAR_GRID_SPAWN: (1) SPAWNED DOMAIN NOT CONTAINED IN INPUT DOMAIN')
+END IF
+IF ( KYOR+KYSIZE-1 > NJMAX_SURF_ll ) THEN
+ WRITE(KLUOUT,*) 'spawned domain is not contained in the input domain'
+ WRITE(KLUOUT,*) 'IYOR = ', KYOR, ' IYSIZE = ', KYSIZE,&
+ ' with NJMAX(file) = ', NJMAX_SURF_ll
+ CALL ABOR1_SFX('REGULAR_GRID_SPAWN: (2) SPAWNED DOMAIN NOT CONTAINED IN INPUT DOMAIN')
+END IF
+!
+!------------------------------------------------------------------------------
+!
+!* 2. Partitionning of the son subdomain
+! --------------------------------------------------------------
+!
+#ifdef MNH_PARALLEL
+! get origin of local father subdomain in global coordinates
+!
+CALL GET_OR_ll( "B", IXOR_F_ll, IYOR_F_ll )
+!
+! origin of local son subdomain in global father coordinates
+!
+!IXOR_C_COARSE_ll = MAX( IXOR_F_ll, KXOR+1 )
+!IYOR_C_COARSE_ll = MAX( IYOR_F_ll, KYOR+1 )
+IXOR_C_COARSE_ll = MAX( IXOR_F_ll-1, KXOR ) ! we have to add one point on the west and south sides -> hence the "- 1"
+IYOR_C_COARSE_ll = MAX( IYOR_F_ll-1, KYOR ) ! we have to add one point on the west and south sides -> hence the "- 1"
+!
+ALLOCATE(TZCOARSEFATHER(NPROC))
+ALLOCATE(TZCOARSESONSPLIT(NPROC))
+!
+! compute father partitioning
+!
+CALL SPLIT2(NIMAX_SURF_ll, NJMAX_SURF_ll, 1, NPROC,TZCOARSEFATHER, YSPLITTING)
+! we don't want the halo
+DO J = 1, NPROC
+ TZCOARSEFATHER(J)%NXOR = TZCOARSEFATHER(J)%NXOR - JPHEXT
+ TZCOARSEFATHER(J)%NYOR = TZCOARSEFATHER(J)%NYOR - JPHEXT
+ TZCOARSEFATHER(J)%NXEND = TZCOARSEFATHER(J)%NXEND - JPHEXT
+ TZCOARSEFATHER(J)%NYEND = TZCOARSEFATHER(J)%NYEND - JPHEXT
+ENDDO
+!
+! partition son domain on father grid (with global coordinates on father grid)
+!
+! we have to add one point on the west and south sides -> hence the "- 1"
+! Warning : we cannot just call SPLIT2(KXSIZE, KYSIZE, 1, NPROC, TZCOARSESONSPLIT, YSPLITTING) as it would not
+! necessarily split the son domain the same way the father domain was splitted
+! example : if father domain is 30x40 and son domain is 6x5 (in father grid dimensions) then
+! with NPROC = 2, SPLIT2 will split father domain along Y dimension -> 30x20 local domains
+! but SPLIT2 will split son domain along X dimension -> 3x5 local domains.
+! therefore we have to use DEF_SPLITTING2 and force the decomposition in the call to SPLIT2
+! we want the same domain partitioning for the child domain and for the father domain
+CALL DEF_SPLITTING2(IXDOMAINS,IYDOMAINS,NIMAX_SURF_ll,NJMAX_SURF_ll,NPROC,GPREM)
+CALL SPLIT2(KXSIZE, KYSIZE, 1, NPROC, TZCOARSESONSPLIT, YSPLITTING, IXDOMAINS, IYDOMAINS)
+
+! compute the local size of son grid
+! KIMAX_C_ll, KJMAX_C_ll are the global sizes of son domain
+IIMAX_C = ( TZCOARSESONSPLIT(IP)%NXEND - TZCOARSESONSPLIT(IP)%NXOR + 1 ) * KDXRATIO
+IJMAX_C = ( TZCOARSESONSPLIT(IP)%NYEND - TZCOARSESONSPLIT(IP)%NYOR + 1 ) * KDYRATIO
+! get the coordinates of the son domain partition on father grid
+DO J = 1, NPROC
+ TZCOARSESONSPLIT(J)%NXOR = TZCOARSESONSPLIT(J)%NXOR + KXOR - JPHEXT - 1
+ TZCOARSESONSPLIT(J)%NYOR = TZCOARSESONSPLIT(J)%NYOR + KYOR - JPHEXT - 1
+ TZCOARSESONSPLIT(J)%NXEND = TZCOARSESONSPLIT(J)%NXEND + KXOR - JPHEXT
+ TZCOARSESONSPLIT(J)%NYEND = TZCOARSESONSPLIT(J)%NYEND + KYOR - JPHEXT
+ENDDO
+!
+! compute the local size of son grid
+! KIMAX_C_ll, KJMAX_C_ll are the global sizes of son domain
+!
+!CALL SPLIT2 ( KIMAX_C_ll, KJMAX_C_ll, 1, NPROC, TZSPLITTING_C, YSPLITTING )
+!IXOR_C_ll = TZSPLITTING_C(IP)%NXOR - JPHEXT
+!IXEND_C_ll = TZSPLITTING_C(IP)%NXEND - JPHEXT
+!IYOR_C_ll = TZSPLITTING_C(IP)%NYOR - JPHEXT
+!IYEND_C_ll = TZSPLITTING_C(IP)%NYEND - JPHEXT
+!!
+!IIMAX_C = IXEND_C_ll - IXOR_C_ll + 1
+!IJMAX_C = IYEND_C_ll - IYOR_C_ll + 1
+!IIMAX_C = ( TZCOARSESONSPLIT(IP)%NXEND - TZCOARSESONSPLIT(IP)%NXOR + 1 ) * KDXRATIO
+!IJMAX_C = ( TZCOARSESONSPLIT(IP)%NYEND - TZCOARSESONSPLIT(IP)%NYOR + 1 ) * KDYRATIO
+!
+!------------------------------------------------------------------------------
+!
+!* 3. Preparing the structures for the communications for the initialization of son fields using father fields
+! --------------------------------------------------------------
+!
+ !
+ ! ######## initializing the structures for the SEND ########
+ !
+ ALLOCATE(TZSEND(NPROC))
+ CALL INTERSECTION( TZCOARSESONSPLIT, NPROC, TZCOARSEFATHER(IP), TZSEND)
+ ! il faut initialiser le TAG de manière a avoir un meme tag unique pour le send et le recv :
+ ! on concatene le num du proc qui envoie et le num du proc qui recoit
+ DO J = 1, NPROC
+ IF ( TZSEND(J)%NUMBER > 0 ) THEN
+ IF (TZSEND(J)%NUMBER == 1) THEN
+ TZSEND(J)%MSSGTAG = IP * 10 + 1
+ ELSE
+ TZSEND(J)%MSSGTAG = IP * 10**(CEILING(LOG10(real(TZSEND(J)%NUMBER)))) + TZSEND(J)%NUMBER
+ ENDIF
+ ENDIF
+ ENDDO
+ ! switching to local coordinates
+ DO J = 1, NPROC
+ IF ( TZSEND(J)%NUMBER > 0 ) THEN
+ TZSEND(J)%NXOR = TZSEND(J)%NXOR - IXOR_F_ll + 1
+ TZSEND(J)%NXEND = TZSEND(J)%NXEND - IXOR_F_ll + 1
+ TZSEND(J)%NYOR = TZSEND(J)%NYOR - IYOR_F_ll + 1
+ TZSEND(J)%NYEND = TZSEND(J)%NYEND - IYOR_F_ll + 1
+ ENDIF
+ ENDDO
+ ! we do not need the Z dimension
+ DO J = 1, NPROC
+ IF ( TZSEND(J)%NUMBER > 0 ) THEN
+ TZSEND(J)%NZOR = 1
+ TZSEND(J)%NZEND = 1
+ ENDIF
+ ENDDO
+ ! switching from an array of CRSPD_ll to a CRSPD_ll pointer
+ INBMSG = 0
+ DO J = 1, NPROC
+ IF ( TZSEND(J)%NUMBER > 0 ) THEN
+ INBMSG = INBMSG+1
+ ENDIF
+ ENDDO
+ IF ( INBMSG > 0 ) THEN
+ ALLOCATE( TZCRSPDSENDTAB(INBMSG) )
+ ICARD = 0
+ ICARDDIF = 0
+ DO J = 1, NPROC
+ IF ( TZSEND(J)%NUMBER > 0 ) THEN
+ ICARD = ICARD+1
+ IF ( TZSEND(ICARD)%NUMBER /= IP ) THEN
+ ICARDDIF = ICARDDIF+1
+ ENDIF
+ TZCRSPDSENDTAB(ICARD)%TELT = TZSEND(J)
+ IF ( ICARD == INBMSG ) THEN
+ TZCRSPDSENDTAB(ICARD)%TNEXT => NULL()
+ ELSE
+ TZCRSPDSENDTAB(ICARD)%TNEXT => TZCRSPDSENDTAB(ICARD+1)
+ ENDIF
+ ENDIF
+ ENDDO
+ DO J = 1, ICARD
+ TZCRSPDSENDTAB(J)%NCARD = ICARD
+ TZCRSPDSENDTAB(J)%NCARDDIF = ICARDDIF
+ ENDDO
+ ELSE
+ !il faut tout de meme mettre un element de taille 0 dans TZCRSPDSENDTAB
+ !sinon SEND_RECV_FIELD plante en 02
+ ALLOCATE( TZCRSPDSENDTAB(1) )
+ ICARD = 0
+ ICARDDIF = 0
+ TZCRSPDSENDTAB(1)%TELT = TZSEND(1)
+ TZCRSPDSENDTAB(1)%TNEXT => NULL()
+ TZCRSPDSENDTAB(1)%NCARD = 0
+ TZCRSPDSENDTAB(1)%NCARDDIF = 0
+ ENDIF
+! IF (ICARD > 0) THEN
+ TZCRSPDSEND => TZCRSPDSENDTAB(1)
+! ELSE
+! TZCRSPDSEND => NULL()
+! ENDIF
+ !
+ ! ######## initializing the structures for the RECV ########
+ !
+ ALLOCATE(TZRECV(NPROC))
+ CALL INTERSECTION( TZCOARSEFATHER, NPROC, TZCOARSESONSPLIT(IP), TZRECV )
+ ! il faut initialiser le TAG de manière a avoir un meme tag unique pour le send et le recv :
+ ! on concatene le num du proc qui envoie et le num du proc qui recoit
+ DO J = 1, NPROC
+ IF ( TZRECV(J)%NUMBER > 0 ) THEN
+ IF (IP == 1) THEN
+ TZRECV(J)%MSSGTAG = TZRECV(J)%NUMBER * 10 + 1
+ ELSE
+ TZRECV(J)%MSSGTAG = TZRECV(J)%NUMBER * 10**(CEILING(LOG10(real(IP)))) + IP
+ ENDIF
+ ENDIF
+ ENDDO
+ ! switching to local coordinates
+ DO J = 1, NPROC
+ IF ( TZRECV(J)%NUMBER > 0 ) THEN
+ TZRECV(J)%NXOR = TZRECV(J)%NXOR - TZCOARSESONSPLIT(IP)%NXOR + 1
+ TZRECV(J)%NXEND = TZRECV(J)%NXEND - TZCOARSESONSPLIT(IP)%NXOR + 1
+ TZRECV(J)%NYOR = TZRECV(J)%NYOR - TZCOARSESONSPLIT(IP)%NYOR + 1
+ TZRECV(J)%NYEND = TZRECV(J)%NYEND - TZCOARSESONSPLIT(IP)%NYOR + 1
+ ENDIF
+ ENDDO
+ ! we do not need the Z dimension
+ DO J = 1, NPROC
+ IF ( TZRECV(J)%NUMBER > 0 ) THEN
+ TZRECV(J)%NZOR = 1
+ TZRECV(J)%NZEND = 1
+ ENDIF
+ ENDDO
+ ! switching from an array of CRSPD_ll to a CRSPD_ll pointer
+ INBMSG = 0
+ DO J = 1, NPROC
+ IF ( TZRECV(J)%NUMBER > 0 ) THEN
+ INBMSG = INBMSG+1
+ ENDIF
+ ENDDO
+ IF ( INBMSG > 0 ) THEN
+ ALLOCATE( TZCRSPDRECVTAB(INBMSG) )
+ ICARD = 0
+ ICARDDIF = 0
+ DO J = 1, NPROC
+ IF ( TZRECV(J)%NUMBER > 0 ) THEN
+ ICARD = ICARD+1
+ IF ( TZRECV(ICARD)%NUMBER /= IP ) THEN
+ ICARDDIF = ICARDDIF+1
+ ENDIF
+ TZCRSPDRECVTAB(ICARD)%TELT = TZRECV(J)
+ IF ( ICARD == INBMSG ) THEN
+ TZCRSPDRECVTAB(ICARD)%TNEXT => NULL()
+ ELSE
+ TZCRSPDRECVTAB(ICARD)%TNEXT => TZCRSPDRECVTAB(ICARD+1)
+ ENDIF
+ ENDIF
+ ENDDO
+ DO J = 1, ICARD
+ TZCRSPDRECVTAB(J)%NCARD = ICARD
+ TZCRSPDRECVTAB(J)%NCARDDIF = ICARDDIF
+ ENDDO
+ ELSE
+ !il faut tout de meme mettre un element de taille 0 dans TZCRSPDRECVTAB
+ !sinon SEND_RECV_FIELD plante en 02
+ ALLOCATE( TZCRSPDRECVTAB(1) )
+ ICARD = 0
+ ICARDDIF = 0
+ TZCRSPDRECVTAB(1)%TELT = TZSEND(1)
+ TZCRSPDRECVTAB(1)%TNEXT => NULL()
+ TZCRSPDRECVTAB(1)%NCARD = 0
+ TZCRSPDRECVTAB(1)%NCARDDIF = 0
+ ENDIF
+! IF (ICARD > 0) THEN
+ TZCRSPDRECV => TZCRSPDRECVTAB(1)
+! ELSE
+! TZCRSPDRECV => NULL()
+! ENDIF
+#else
+IIMAX_C = KIMAX_C_ll
+IJMAX_C = KJMAX_C_ll
+#endif
+!
+!------------------------------------------------------------------------------
+!
+!* 4. Center of mesh coordinate arrays for each direction separately
+! --------------------------------------------------------------
+!
+! allocate the fields on the local son grid
+!
+#ifdef MNH_PARALLEL
+ALLOCATE(PX2(IIMAX_C*IJMAX_C))
+ALLOCATE(PY2(IIMAX_C*IJMAX_C))
+ALLOCATE(PDX2(IIMAX_C*IJMAX_C))
+ALLOCATE(PDY2(IIMAX_C*IJMAX_C))
+#endif
+ALLOCATE(ZXHAT2(IIMAX_C+1))
+ALLOCATE(ZYHAT2(IJMAX_C+1))
+!
+! allocate the fields on the local father grid
+!
+ALLOCATE(ZXM1 (KIMAX1))
+ALLOCATE(ZYM1 (KJMAX1))
+ALLOCATE(ZXHAT1(KIMAX1+1))
+ALLOCATE(ZYHAT1(KJMAX1+1))
+!
+ZXM1(:) = PX1(1:KIMAX1)
+DO JL=1,KL1
+ IF (MOD(JL,KIMAX1)==0) ZYM1(JL/KIMAX1) = PY1(JL)
+END DO
+!
+!------------------------------------------------------------------------------
+!
+!* 5. side of mesh coordinate arrays for each direction separately
+! ------------------------------------------------------------
+!
+!
+IF (KIMAX1==1) THEN
+ ZXHAT1(1) = ZXM1(1) - 0.5 * PDX1(1)
+ ZXHAT1(2) = ZXM1(1) + 0.5 * PDX1(1)
+ELSE
+ ZXHAT1(1) = 1.5 * ZXM1(1) - 0.5 * ZXM1(2)
+ DO JI=2,KIMAX1
+ ZXHAT1(JI) = 0.5 * ZXM1(JI-1) + 0.5 * ZXM1(JI)
+ END DO
+ ZXHAT1(KIMAX1+1) = 1.5 * ZXM1(KIMAX1) - 0.5 * ZXM1(KIMAX1-1)
+END IF
+!
+IF (KJMAX1==1) THEN
+ ZYHAT1(1) = ZYM1(1) - 0.5 * PDY1(1)
+ ZYHAT1(2) = ZYM1(1) + 0.5 * PDY1(1)
+ELSE
+ ZYHAT1(1) = 1.5 * ZYM1(1) - 0.5 * ZYM1(2)
+ DO JJ=2,KJMAX1
+ ZYHAT1(JJ) = 0.5 * ZYM1(JJ-1) + 0.5 * ZYM1(JJ)
+ END DO
+ ZYHAT1(KJMAX1+1) = 1.5 * ZYM1(KJMAX1) - 0.5 * ZYM1(KJMAX1-1)
+END IF
+#ifdef MNH_PARALLEL
+ !
+ ! do the communication
+ !
+ IXDIM_C = TZCOARSESONSPLIT(IP)%NXEND-TZCOARSESONSPLIT(IP)%NXOR+1
+ IYDIM_C = TZCOARSESONSPLIT(IP)%NYEND-TZCOARSESONSPLIT(IP)%NYOR+1
+ ALLOCATE(ZXHAT2_F(IXDIM_C,IYDIM_C,1))
+ ALLOCATE(ZYHAT2_F(IXDIM_C,IYDIM_C,1))
+ ALLOCATE(ZXHAT1_3D(KIMAX1,KJMAX1,1))
+ ALLOCATE(ZYHAT1_3D(KIMAX1,KJMAX1,1))
+ ZXHAT1_3D(:,:,:) = 0
+ ZYHAT1_3D(:,:,:) = 0
+ ZXHAT2_F(:,:,:) = 0
+ ZYHAT2_F(:,:,:) = 0
+ DO J=1, KJMAX1
+ ZXHAT1_3D(:,J,1) = ZXHAT1(1:KIMAX1)
+ ENDDO
+ DO J=1, KIMAX1
+ ZYHAT1_3D(J,:,1) = ZYHAT1(1:KJMAX1)
+ ENDDO
+ CALL SEND_RECV_FIELD( TZCRSPDSEND, TZCRSPDRECV, ZXHAT1_3D, ZXHAT2_F, IINFO_ll)
+ CALL SEND_RECV_FIELD( TZCRSPDSEND, TZCRSPDRECV, ZYHAT1_3D, ZYHAT2_F, IINFO_ll)
+!
+! We have to copy the entries of ZXHAT1_3D and ZYHAT1_3D that are local to the current process,
+! and that are therefore not communicated in SEND_RECV_FIELD, in ZXHAT2_F and ZYHAT2_F
+!
+ IF ( TZSEND(IP)%NUMBER /= 0 ) THEN !if there are entries of ZXHAT1_3D and ZYHAT1_3D that are local to the current process
+! DO J=TZSEND(IP)%NXOR-KXOR,TZSEND(IP)%NXEND-KXOR
+ ZXHAT2_F( TZRECV(IP)%NXOR:TZRECV(IP)%NXEND, 1, 1) = ZXHAT1_3D( TZSEND(IP)%NXOR:TZSEND(IP)%NXEND, 1, 1)
+! ENDDO
+! DO J=TZSEND(IP)%NYOR-KYOR,TZSEND(IP)%NYEND-KYOR
+ ZYHAT2_F( 1,TZRECV(IP)%NYOR:TZRECV(IP)%NYEND, 1) = ZYHAT1_3D( 1,TZSEND(IP)%NYOR:TZSEND(IP)%NYEND, 1)
+! ENDDO
+ ENDIF
+ !
+ ! We need one halo point on the east and north sides of each local subdomain to do a proper interpolation
+ !
+ ALLOCATE( ZXHAT2_F_TMP(IXDIM_C+1) )
+ ALLOCATE( ZYHAT2_F_TMP(IYDIM_C+1) )
+ ZXHAT2_F_TMP(:) = 0.
+ ZYHAT2_F_TMP(:) = 0.
+ ZXHAT2_F_TMP(1:IXDIM_C) = ZXHAT2_F(:,1,1)
+ ZYHAT2_F_TMP(1:IYDIM_C) = ZYHAT2_F(1,:,1)
+! we want the same domain partitioning for the child domain and for the father domain
+ CALL DEF_SPLITTING2(IXDOMAINS,IYDOMAINS,NIMAX_SURF_ll,NJMAX_SURF_ll,NPROC,GPREM)
+ CALL SPLIT2(KXSIZE, KYSIZE, 1, NPROC, TZCOARSESONSPLIT, YSPLITTING, IXDOMAINS, IYDOMAINS)
+ CALL UPDATE_NHALO1D( 1, ZXHAT2_F_TMP, KXSIZE, KYSIZE,TZCOARSESONSPLIT(IP)%NXOR, &
+ TZCOARSESONSPLIT(IP)%NXEND,TZCOARSESONSPLIT(IP)%NYOR,TZCOARSESONSPLIT(IP)%NYEND, 'XX ')
+ CALL UPDATE_NHALO1D( 1, ZYHAT2_F_TMP, KXSIZE, KYSIZE,TZCOARSESONSPLIT(IP)%NXOR, &
+ TZCOARSESONSPLIT(IP)%NXEND,TZCOARSESONSPLIT(IP)%NYOR,TZCOARSESONSPLIT(IP)%NYEND, 'YY ')
+#endif
+!
+!------------------------------------------------------------------------------
+!
+!* 6. Interpolation of coordinate arrays for each direction separately
+! ----------------------------------------------------------------
+!
+!* X coordinate array
+!
+DO J=0,KDXRATIO-1
+ ZCOEFX(J+1) = FLOAT(J)/FLOAT(KDXRATIO)
+ENDDO
+DO JI=1,IXDIM_C-1
+ DO JJ=1,KDXRATIO
+ ZXHAT2((JI-1)*KDXRATIO+JJ)=(1.-ZCOEFX(JJ))*ZXHAT2_F(JI,1,1)+ZCOEFX(JJ)*ZXHAT2_F(JI+1,1,1)
+ ENDDO
+ENDDO
+IF (IIMAX_C==1) THEN
+ ZXHAT2(IIMAX_C+1) = ZXHAT2(IIMAX_C) + ZXHAT2_F(JI,1,1) - ZXHAT2_F(JI,1,1)
+ELSE
+#ifdef MNH_PARALLEL
+ IF ( LEAST_ll() ) THEN ! the east halo point does not have a correct value so have to do an extrapolation
+ ZXHAT2(IIMAX_C+1) = 2. * ZXHAT2(IIMAX_C) - ZXHAT2(IIMAX_C-1)
+ ELSE
+ ZXHAT2(IIMAX_C+1)=(1.-ZCOEFX(1))*ZXHAT2_F_TMP(IXDIM_C)+ZCOEFX(1)*ZXHAT2_F_TMP(IXDIM_C+1)
+ ENDIF
+#else
+ ZXHAT2(IIMAX_C+1) = 2. * ZXHAT2(IIMAX_C) - ZXHAT2(IIMAX_C-1)
+#endif
+END IF
+!
+!* Y coordinate array
+!
+DO J=0,KDYRATIO-1
+ ZCOEFY(J+1) = FLOAT(J)/FLOAT(KDYRATIO)
+ENDDO
+DO JI=1,IYDIM_C-1
+ DO JJ=1,KDYRATIO
+ ZYHAT2((JI-1)*KDYRATIO+JJ)=(1.-ZCOEFY(JJ))*ZYHAT2_F(1,JI,1)+ZCOEFY(JJ)*ZYHAT2_F(1,JI+1,1)
+ ENDDO
+ENDDO
+IF (IJMAX_C==1) THEN
+ ZYHAT2(IJMAX_C+1) = ZYHAT2(IJMAX_C) + ZYHAT2_F(1,JI,1) - ZYHAT2_F(1,JI,1)
+ELSE
+#ifdef MNH_PARALLEL
+ IF ( LNORTH_ll() ) THEN ! the east halo point does not have a correct value so have to do an extrapolation
+ ZYHAT2(IJMAX_C+1) = 2. * ZYHAT2(IJMAX_C) - ZYHAT2(IJMAX_C-1)
+ ELSE
+ ZYHAT2(IJMAX_C+1)=(1.-ZCOEFY(1))*ZYHAT2_F_TMP(IYDIM_C)+ZCOEFY(1)*ZYHAT2_F_TMP(IYDIM_C+1)
+ ENDIF
+#else
+ ZYHAT2(IJMAX_C+1) = 2. * ZYHAT2(IJMAX_C) - ZYHAT2(IJMAX_C-1)
+#endif
+END IF
+!---------------------------------------------------------------------------
+DEALLOCATE(ZXM1)
+DEALLOCATE(ZYM1)
+DEALLOCATE(ZXHAT1)
+DEALLOCATE(ZYHAT1)
+#ifdef MNH_PARALLEL
+DEALLOCATE(ZXHAT1_3D)
+DEALLOCATE(ZYHAT1_3D)
+#endif
+!------------------------------------------------------------------------------
+!
+!* 7. Coordinate arrays of all points
+! -------------------------------
+!
+DO JJ=1,IJMAX_C
+ DO JI=1,IIMAX_C
+ JL = (JJ-1) * IIMAX_C + JI
+ PX2 (JL) = 0.5 * ZXHAT2(JI) + 0.5 * ZXHAT2(JI+1)
+ PDX2(JL) = ZXHAT2(JI+1) - ZXHAT2(JI)
+ PY2 (JL) = 0.5 * ZYHAT2(JJ) + 0.5 * ZYHAT2(JJ+1)
+ PDY2(JL) = ZYHAT2(JJ+1) - ZYHAT2(JJ)
+ END DO
+END DO
+!
+#ifdef MNH_PARALLEL
+KIMAX_C_ll = IIMAX_C
+KJMAX_C_ll = IJMAX_C
+#endif
+!---------------------------------------------------------------------------
+#ifdef MNH_PARALLEL
+DEALLOCATE(ZXHAT2_F)
+DEALLOCATE(ZYHAT2_F)
+DEALLOCATE(TZCRSPDSENDTAB)
+DEALLOCATE(TZCRSPDRECVTAB)
+DEALLOCATE(TZSEND)
+DEALLOCATE(TZRECV)
+DEALLOCATE(TZCOARSEFATHER)
+DEALLOCATE(TZCOARSESONSPLIT)
+#endif
+DEALLOCATE(ZXHAT2)
+DEALLOCATE(ZYHAT2)
+IF (LHOOK) CALL DR_HOOK('REGULAR_GRID_SPAWN',1,ZHOOK_HANDLE)
+!---------------------------------------------------------------------------
+!
+END SUBROUTINE REGULAR_GRID_SPAWN
diff --git a/src/SURFEX/write_diag_misc_isban.F90 b/src/SURFEX/write_diag_misc_isban.F90
index 5cc6d594a..a28920c82 100644
--- a/src/SURFEX/write_diag_misc_isban.F90
+++ b/src/SURFEX/write_diag_misc_isban.F90
@@ -1,542 +1,572 @@
-!SURFEX_LIC Copyright 1994-2014 Meteo-France
-!SURFEX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SURFEX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SURFEX_LIC for details. version 1.
-! #########
- SUBROUTINE WRITE_DIAG_MISC_ISBA_n(HPROGRAM)
-! #################################
-!
-!!**** *WRITE_DIAG_MISC_ISBA* - writes the ISBA diagnostic fields
-!!
-!! PURPOSE
-!! -------
-!!
-!!
-!!** METHOD
-!! ------
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! P. Le Moigne *Meteo France*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 10/2004
-!! B. Decharme 2008 Total Albedo, Total SWI and Floodplains
-!! B. Decharme 06/2009 key to write (or not) patch result
-!! A.L. Gibelin 04/09 : Add respiration diagnostics
-!! A.L. Gibelin 05/09 : Add carbon spinup
-!! A.L. Gibelin 07/09 : Suppress RDK and transform GPP as a diagnostic
-!! D. Carrer 04/11 : Add FAPAR and effective LAI
-!! B. Decharme 09/2012 : suppress NWG_LAYER (parallelization problems)
-!! B. Decharme 09/12 : Carbon fluxes in diag_evap
-!! B. Decharme 09/12 New diag for DIF:
-!! F2 stress
-!! Root zone swi, wg and wgi
-!! swi, wg and wgi comparable to ISBA-FR-DG2 and DG3 layers
-!! active layer thickness over permafrost
-!! frozen layer thickness over non-permafrost
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_SURFEX_MPI, ONLY : NWG_SIZE
-!
-USE MODD_SURF_PAR, ONLY : NUNDEF, XUNDEF
-USE MODD_ISBA_n, ONLY : NGROUND_LAYER, &
- CRUNOFF, CRAIN, CISBA, LTR_ML, &
- XMUF, NWG_LAYER, &
- CPHOTO, CRESPSL, LFLOOD, &
- XFFLOOD, XPIFLOOD, TSNOW
-!
-USE MODD_DIAG_ISBA_n, ONLY : LPATCH_BUDGET, XTS, XAVG_TS, &
- XTSRAD, XAVG_TSRAD
-!
-USE MODD_AGRI, ONLY : LAGRIP
-USE MODD_DIAG_MISC_ISBA_n,ONLY : LSURF_MISC_BUDGET, LSURF_MISC_DIF, &
- XHV, XAVG_HV, XSWI, XAVG_SWI, &
- XTSWI, XAVG_TSWI, XDPSNG, XAVG_PSNG, &
- XDPSNV, XAVG_PSNV, XDPSN, XAVG_PSN, &
- XSEUIL, XSOIL_TSWI, XALBT, XAVG_ALBT,&
- XTWSNOW, XAVG_TWSNOW, XTDSNOW, &
- XAVG_TDSNOW,XTTSNOW, XAVG_TTSNOW, &
- XDFFG, XAVG_FFG, XDFFV, XAVG_FFV, &
- XDFF, XAVG_FF, XSOIL_TWG, XSOIL_TWGI,&
- XDFSAT , XAVG_FSAT, &
- XSURF_TSWI, XSURF_TWG, XSURF_TWGI, &
- XROOT_TSWI, XROOT_TWG, XROOT_TWGI, &
- XFRD2_TSWI, XFRD2_TWG, XFRD2_TWGI, &
- XFRD3_TSWI, XFRD3_TWG, XFRD3_TWGI, &
- XSNOWLIQ, XSNOWTEMP, XDLAI_EFFC, &
- XFAPAR, XFAPIR, XDFAPARC, XDFAPIRC, &
- XFAPAR_BS, XFAPIR_BS, XALT, XAVG_ALT,&
- XFLT, XAVG_FLT, XAVG_LAI
-!
-USE MODI_INIT_IO_SURF_n
-USE MODI_WRITE_SURF
-USE MODI_END_IO_SURF_n
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of arguments
-! -------------------------
-!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling
-!
-!* 0.2 Declarations of local variables
-! -------------------------------
-!
-INTEGER :: IRESP ! IRESP : return-code if a problem appears
- CHARACTER(LEN=12) :: YRECFM ! Name of the article to be read
- CHARACTER(LEN=100):: YCOMMENT ! Comment string
- CHARACTER(LEN=2) :: YLVL
- CHARACTER(LEN=20) :: YFORM
-!
-INTEGER :: JLAYER, IWORK, JJ, IDEPTH
-!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-!-------------------------------------------------------------------------------
-!
-! Initialisation for IO
-!
-IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_MISC_ISBA_N',0,ZHOOK_HANDLE)
- CALL INIT_IO_SURF_n(HPROGRAM,'NATURE','ISBA ','WRITE')
-!
-!-------------------------------------------------------------------------------
-!
-IF (LSURF_MISC_BUDGET) THEN
- !
- !* 2. Miscellaneous fields :
- !
- !-------------------------------------------------------------------------------
- !
- ! 2.1 Halstead coefficient
- ! --------------------
- !
- YRECFM='HV_ISBA'
- YCOMMENT='Halstead coefficient averaged over tile nature (-)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_HV(:),IRESP,HCOMMENT=YCOMMENT)
- !
- ! 2.2 Snow fractions
- ! --------------
- !
- YRECFM='PSNG_ISBA'
- YCOMMENT='snow fraction over ground averaged over tile nature (-)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_PSNG(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='PSNV_ISBA'
- YCOMMENT='snow fraction over vegetation averaged over tile nature (-)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_PSNV(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='PSN_ISBA'
- YCOMMENT='total snow fraction averaged over tile nature (-)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_PSN(:),IRESP,HCOMMENT=YCOMMENT)
- !
- ! 2.3 Total Albedo and surface temperature
- ! ------------------------------------
- !
- YRECFM='TALB_ISBA'
- YCOMMENT='total albedo over tile nature (-)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_ALBT(:),IRESP,HCOMMENT=YCOMMENT)
- !
- IF (TSNOW%SCHEME=='3-L' .OR. TSNOW%SCHEME=='CRO') THEN
- !
- YRECFM='TS_ISBA'
- YCOMMENT='total surface temperature (isba+snow) over tile nature'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_TS(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='TSRAD_ISBA'
- YCOMMENT='total radiative surface temperature (isba+snow) over tile nature'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_TSRAD(:),IRESP,HCOMMENT=YCOMMENT)
- !
- END IF
- !
- ! 2.4 Soil Wetness Index, Water content and active layer depth
- ! --------------------------------------------------------
- !
- IF(CISBA=='DIF')THEN
- !
- IWORK = NWG_SIZE
- !
- DO JLAYER = 1,NGROUND_LAYER
- DO JJ=1,SIZE(NWG_LAYER,1)
- IDEPTH=MAXVAL(NWG_LAYER(JJ,:),NWG_LAYER(JJ,:)/=NUNDEF)
- IF(JLAYER>IDEPTH)THEN
- XAVG_SWI (JJ,JLAYER) = XUNDEF
- XAVG_TSWI(JJ,JLAYER) = XUNDEF
- ENDIF
- ENDDO
- ENDDO
- ELSE
- IWORK = NGROUND_LAYER
- ENDIF
- !
- DO JLAYER=1,IWORK
- !
- WRITE(YLVL,'(I2)') JLAYER
- !
- YRECFM='SWI'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
- YRECFM=YRECFM(:LEN_TRIM(YRECFM))//'_ISBA'
- YFORM='(A29,I1.1,A4)'
- IF (JLAYER >= 10) YFORM='(A29,I2.2,A4)'
- WRITE(YCOMMENT,FMT=YFORM) 'soil wetness index for layer ',JLAYER,' (-)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_SWI(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='TSWI'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
- YRECFM=YRECFM(:LEN_TRIM(YRECFM))//'_ISBA'
- YFORM='(A29,I1.1,A4)'
- IF (JLAYER >= 10) YFORM='(A29,I2.2,A4)'
- WRITE(YCOMMENT,FMT=YFORM) 'total swi (liquid+solid) for layer ',JLAYER,' (-)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_TSWI(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
- !
- END DO
- !
- YRECFM='TSWI_T_ISBA'
- YCOMMENT='total soil wetness index over the soil column (-)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XSOIL_TSWI(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='WGTOT_T_ISBA'
- YCOMMENT='total water content (liquid+solid) over the soil column (kg/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XSOIL_TWG(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='WGI_T_ISBA'
- YCOMMENT='total ice content (solid) over the soil column (kg/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XSOIL_TWGI(:),IRESP,HCOMMENT=YCOMMENT)
- !
- IF(CISBA=='DIF') THEN
- !
- IF (LSURF_MISC_DIF)THEN
- !
- YRECFM='TSWI_R_ISBA'
- YCOMMENT='total soil wetness index over the root zone (-)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XROOT_TSWI(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='WGTOT_R_ISBA'
- YCOMMENT='total water content (liquid+solid) over the root zone (kg/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XROOT_TWG(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='WGI_R_ISBA'
- YCOMMENT='total ice content (solid) over the root zone (kg/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XROOT_TWGI(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='TSWI_S_ISBA'
- YCOMMENT='total soil wetness index over the surface (-)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XSURF_TSWI(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='WG_S_ISBA'
- YCOMMENT='liquid water content over the surface (m3/m3)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XSURF_TWG(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='WGI_S_ISBA'
- YCOMMENT='ice content over the surface (m3/m3)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XSURF_TWGI(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='TSWI_D2_ISBA'
- YCOMMENT='total soil wetness index over comparable FR-DG2 reservoir (-)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XFRD2_TSWI(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='WG_D2_ISBA'
- YCOMMENT='liquid water content over comparable FR-DG2 reservoir (m3/m3)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XFRD2_TWG(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='WGI_D2_ISBA'
- YCOMMENT='ice content over comparable FR-DG2 reservoir (m3/m3)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XFRD2_TWGI(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='TSWI_D3_ISBA'
- YCOMMENT='total soil wetness index over comparable FR-DG3 reservoir (-)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XFRD3_TSWI(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='WG_D3_ISBA'
- YCOMMENT='liquid water content over comparable FR-DG3 reservoir (m3/m3)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XFRD3_TWG(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='WGI_D3_ISBA'
- YCOMMENT='ice content over comparable FR-DG3 reservoir (m3/m3)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XFRD3_TWGI(:),IRESP,HCOMMENT=YCOMMENT)
- !
- ENDIF
- !
- YRECFM='ALT_ISBA'
- YCOMMENT='active layer thickness over permafrost (m)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_ALT(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='FLT_ISBA'
- YCOMMENT='frozen layer thickness over non-permafrost (m)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_FLT(:),IRESP,HCOMMENT=YCOMMENT)
- !
- ENDIF
- !
- ! 2.5 Snow outputs
- ! -------------
- !
- YRECFM='WSNOW_T_ISBA'
- YCOMMENT='Total_snow_reservoir (kg/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_TWSNOW(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='DSNOW_T_ISBA'
- YCOMMENT='Total_snow_depth (m)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_TDSNOW(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='TSNOW_T_ISBA'
- YCOMMENT='Total_snow_temperature (K)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_TTSNOW(:),IRESP,HCOMMENT=YCOMMENT)
- !
- ! 2.6 SGH scheme
- ! ----------
- !
- IF(CRUNOFF=='SGH '.OR.CRUNOFF=='DT92')THEN
- YRECFM='FSAT_ISBA'
- YCOMMENT='Soil saturated fraction (-)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_FSAT(:),IRESP,HCOMMENT=YCOMMENT)
- ENDIF
- !
- IF(CRAIN=='SGH ')THEN
- YRECFM='MUF_ISBA'
- YCOMMENT='fraction of the grid cell reached by the rainfall (-)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XMUF(:),IRESP,HCOMMENT=YCOMMENT)
- ENDIF
- !
- ! 2.7 Flooding scheme
- ! ---------------
- !
- IF(LFLOOD)THEN
- !
- YRECFM='FFG_ISBA'
- YCOMMENT='flood fraction over ground averaged over tile nature (-)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_FFG(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='FFV_ISBA'
- YCOMMENT='flood fraction over vegetation averaged over tile nature (-)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_FFV(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='FF_ISBA'
- YCOMMENT='total flood fraction averaged over tile nature (-)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_FF(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='FFLOOD_ISBA'
- YCOMMENT='Grdi-cell potential flood fraction (-)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XFFLOOD(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='PIFLOOD_ISBA'
- YCOMMENT='Grdi-cell Potential_floodplain_infiltration (kg/m2s)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XPIFLOOD(:),IRESP,HCOMMENT=YCOMMENT)
- !
- ENDIF
- !
- ! 2.8 Total LAI
- ! ---------
- !
- IF(CPHOTO/='NON')THEN
- YRECFM='LAI_ISBA'
- YCOMMENT='leaf area index (m2/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LAI(:),IRESP,HCOMMENT=YCOMMENT)
- ENDIF
- !
- !* 3. Miscellaneous fields for each patch :
- ! -------------------------------------
- !
- !----------------------------------------------------------------------------
- !User wants (or not) patch output
- IF(LPATCH_BUDGET)THEN
- !----------------------------------------------------------------------------
- !
- ! 3.1 Soil Wetness Index and active layer depth
- ! -----------------------------------------
- !
- DO JLAYER=1,IWORK
- !
- WRITE(YLVL,'(I2)') JLAYER
- !
- YRECFM='SWI'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
- YFORM='(A39,I1.1,A4)'
- IF (JLAYER >= 10) YFORM='(A39,I2.2,A4)'
- WRITE(YCOMMENT,FMT=YFORM) 'soil wetness index per patch for layer ',JLAYER,' (-)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XSWI(:,JLAYER,:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='TSWI'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
- YFORM='(A39,I1.1,A4)'
- IF (JLAYER >= 10) YFORM='(A39,I2.2,A4)'
- WRITE(YCOMMENT,FMT=YFORM) 'total swi (liquid+solid) per patch for layer ',JLAYER,' (-)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XTSWI(:,JLAYER,:),IRESP,HCOMMENT=YCOMMENT)
- !
- END DO
- !
- IF(CISBA=='DIF')THEN
- !
- YRECFM='ALT_P'
- YCOMMENT='active layer thickness over permafrost per patch (m)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XALT(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='FLT_P'
- YCOMMENT='frozen layer thickness over non-permafrost per patch (m)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XFLT(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- ENDIF
- !
- ! 3.2 Snow fractions
- ! --------------
- !
- YRECFM='PSNG'
- YCOMMENT='snow fraction per patch over ground '
- CALL WRITE_SURF(HPROGRAM,YRECFM,XDPSNG(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='PSNV'
- YCOMMENT='snow fraction per patch over vegetation'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XDPSNV(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='PSN'
- YCOMMENT='total snow fraction per patch'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XDPSN(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- ! 3.3 SGH scheme
- ! ----------
- !
- IF(CRUNOFF=='DT92')THEN
- YRECFM='FSAT_P'
- YCOMMENT='Soil saturated fraction per patch (-)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XDFSAT(:,:),IRESP,HCOMMENT=YCOMMENT)
- ENDIF
- !
- ! 3.3 Flood fractions
- ! --------------
- !
- IF(LFLOOD)THEN
- !
- YRECFM='FFG_P'
- YCOMMENT='flood fraction per patch over ground '
- CALL WRITE_SURF(HPROGRAM,YRECFM,XDFFG(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='FFV_P'
- YCOMMENT='flood fraction per patch over vegetation'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XDFFV(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='FF_P'
- YCOMMENT='total flood fraction per patch'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XDFF(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- ENDIF
- !
- ! 3.4 Total Albedo
- ! ------------
- !
- YRECFM='TALB'
- YCOMMENT='total albedo per patch'
- !
- CALL WRITE_SURF(HPROGRAM,YRECFM,XALBT(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- IF (TSNOW%SCHEME=='3-L' .OR. TSNOW%SCHEME=='CRO') THEN
- YRECFM='TS_P'
- YCOMMENT='total surface temperature (isba+snow) per patch'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XTS(:,:),IRESP,HCOMMENT=YCOMMENT)
- YRECFM='TSRAD_P'
- YCOMMENT='total radiative surface temperature (isba+snow) per patch'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XTSRAD(:,:),IRESP,HCOMMENT=YCOMMENT)
- ENDIF
- !
- ! 3.5 Halstead coefficient
- ! --------------------
- !
- YRECFM='HV'
- YCOMMENT='Halstead coefficient per patch'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XHV(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- ! 3.6 Snow outputs
- ! -----------------
- !
- YRECFM='WSNOW_VEGT'
- YCOMMENT='X_Y_WSNOW_VEG_TOT (kg/m2) per patch'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XTWSNOW(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='DSNOW_VEGT'
- YCOMMENT='X_Y_DSNOW_VEG_TOT (m) per patch'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XTDSNOW(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='TSNOW_VEGT'
- YCOMMENT='X_Y_TSNOW_VEG_TOT (k) per patch'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XTTSNOW(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- IF (TSNOW%SCHEME=='3-L' .OR. TSNOW%SCHEME=='CRO') THEN
- !
- DO JLAYER=1,TSNOW%NLAYER
- !
- WRITE(YLVL,'(I2)') JLAYER
- !
- YRECFM='SNOWLIQ'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
- YFORM='(A17,I1.1,A4)'
- IF (JLAYER >= 10) YFORM='(A17,I2.2,A4)'
- WRITE(YCOMMENT,FMT=YFORM) 'snow liquid water',JLAYER,' (m)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XSNOWLIQ(:,JLAYER,:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='SNOWTEMP'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
- YFORM='(A16,I1.1,A4)'
- IF (JLAYER >= 10) YFORM='(A16,I2.2,A4)'
- WRITE(YCOMMENT,FMT=YFORM) 'snow temperature',JLAYER,' (K)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XSNOWTEMP(:,JLAYER,:),IRESP,HCOMMENT=YCOMMENT)
- !
- END DO
- !
- ENDIF
- !
- END IF
- !
- IF (LAGRIP) THEN
- !
- ! 2.8 Irrigation threshold
- ! --------------------
- !
- YRECFM='IRRISEUIL'
- YCOMMENT='irrigation threshold per patch'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XSEUIL(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- ENDIF
- !
- IF (LTR_ML) THEN
- !
- YRECFM='FAPAR'
- YCOMMENT='FAPAR (-)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XFAPAR(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='FAPIR'
- YCOMMENT='FAPIR (-)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XFAPIR(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='FAPAR_BS'
- YCOMMENT='FAPAR_BS (-)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XFAPAR_BS(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='FAPIR_BS'
- YCOMMENT='FAPIR_BS (-)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XFAPIR_BS(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='DFAPARC'
- YCOMMENT='DFAPARC (-)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XDFAPARC(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='DFAPIRC'
- YCOMMENT='DFAPIRC (-)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XDFAPIRC(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='DLAI_EFFC'
- YCOMMENT='DLAI_EFFC (m2/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XDLAI_EFFC(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- ENDIF
- !
-ENDIF
-! End of IO
-!
- CALL END_IO_SURF_n(HPROGRAM)
-IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_MISC_ISBA_N',1,ZHOOK_HANDLE)
-!
-END SUBROUTINE WRITE_DIAG_MISC_ISBA_n
+!SURFEX_LIC Copyright 1994-2014 Meteo-France
+!SURFEX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SURFEX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SURFEX_LIC for details. version 1.
+! #########
+ SUBROUTINE WRITE_DIAG_MISC_ISBA_n(HPROGRAM)
+! #################################
+!
+!!**** *WRITE_DIAG_MISC_ISBA* - writes the ISBA diagnostic fields
+!!
+!! PURPOSE
+!! -------
+!!
+!!
+!!** METHOD
+!! ------
+!!
+!! REFERENCE
+!! ---------
+!!
+!!
+!! AUTHOR
+!! ------
+!! P. Le Moigne *Meteo France*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 10/2004
+!! B. Decharme 2008 Total Albedo, Total SWI and Floodplains
+!! B. Decharme 06/2009 key to write (or not) patch result
+!! A.L. Gibelin 04/09 : Add respiration diagnostics
+!! A.L. Gibelin 05/09 : Add carbon spinup
+!! A.L. Gibelin 07/09 : Suppress RDK and transform GPP as a diagnostic
+!! D. Carrer 04/11 : Add FAPAR and effective LAI
+!! B. Decharme 09/2012 : suppress NWG_LAYER (parallelization problems)
+!! B. Decharme 09/12 : Carbon fluxes in diag_evap
+!! B. Decharme 09/12 New diag for DIF:
+!! F2 stress
+!! Root zone swi, wg and wgi
+!! swi, wg and wgi comparable to ISBA-FR-DG2 and DG3 layers
+!! active layer thickness over permafrost
+!! frozen layer thickness over non-permafrost
+!! M.Moge 01/2016 using WRITE_SURF_FIELD2D/3D for 2D/3D surfex fields writes
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_SURFEX_MPI, ONLY : NWG_SIZE
+!
+USE MODD_SURF_PAR, ONLY : NUNDEF, XUNDEF
+USE MODD_ISBA_n, ONLY : NGROUND_LAYER, &
+ CRUNOFF, CRAIN, CISBA, LTR_ML, &
+ XMUF, NWG_LAYER, &
+ CPHOTO, CRESPSL, LFLOOD, &
+ XFFLOOD, XPIFLOOD, TSNOW
+!
+USE MODD_DIAG_ISBA_n, ONLY : LPATCH_BUDGET, XTS, XAVG_TS, &
+ XTSRAD, XAVG_TSRAD
+!
+USE MODD_AGRI, ONLY : LAGRIP
+USE MODD_DIAG_MISC_ISBA_n,ONLY : LSURF_MISC_BUDGET, LSURF_MISC_DIF, &
+ XHV, XAVG_HV, XSWI, XAVG_SWI, &
+ XTSWI, XAVG_TSWI, XDPSNG, XAVG_PSNG, &
+ XDPSNV, XAVG_PSNV, XDPSN, XAVG_PSN, &
+ XSEUIL, XSOIL_TSWI, XALBT, XAVG_ALBT,&
+ XTWSNOW, XAVG_TWSNOW, XTDSNOW, &
+ XAVG_TDSNOW,XTTSNOW, XAVG_TTSNOW, &
+ XDFFG, XAVG_FFG, XDFFV, XAVG_FFV, &
+ XDFF, XAVG_FF, XSOIL_TWG, XSOIL_TWGI,&
+ XDFSAT , XAVG_FSAT, &
+ XSURF_TSWI, XSURF_TWG, XSURF_TWGI, &
+ XROOT_TSWI, XROOT_TWG, XROOT_TWGI, &
+ XFRD2_TSWI, XFRD2_TWG, XFRD2_TWGI, &
+ XFRD3_TSWI, XFRD3_TWG, XFRD3_TWGI, &
+ XSNOWLIQ, XSNOWTEMP, XDLAI_EFFC, &
+ XFAPAR, XFAPIR, XDFAPARC, XDFAPIRC, &
+ XFAPAR_BS, XFAPIR_BS, XALT, XAVG_ALT,&
+ XFLT, XAVG_FLT, XAVG_LAI
+!
+USE MODI_INIT_IO_SURF_n
+USE MODI_WRITE_SURF
+USE MODI_WRITE_SURF_FIELD2D
+USE MODI_END_IO_SURF_n
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of arguments
+! -------------------------
+!
+ CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling
+!
+!* 0.2 Declarations of local variables
+! -------------------------------
+!
+INTEGER :: IRESP ! IRESP : return-code if a problem appears
+ CHARACTER(LEN=12) :: YRECFM ! Name of the article to be read
+ CHARACTER(LEN=100):: YCOMMENT ! Comment string
+ CHARACTER(LEN=100):: YCOMMENTUNIT ! Comment string : unit of the datas in the field to write
+ CHARACTER(LEN=2) :: YLVL
+ CHARACTER(LEN=20) :: YFORM
+!
+INTEGER :: JLAYER, IWORK, JJ, IDEPTH
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+!-------------------------------------------------------------------------------
+!
+! Initialisation for IO
+!
+IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_MISC_ISBA_N',0,ZHOOK_HANDLE)
+ CALL INIT_IO_SURF_n(HPROGRAM,'NATURE','ISBA ','WRITE')
+!
+!-------------------------------------------------------------------------------
+!
+IF (LSURF_MISC_BUDGET) THEN
+ !
+ !* 2. Miscellaneous fields :
+ !
+ !-------------------------------------------------------------------------------
+ !
+ ! 2.1 Halstead coefficient
+ ! --------------------
+ !
+ YRECFM='HV_ISBA'
+ YCOMMENT='Halstead coefficient averaged over tile nature (-)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_HV(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ ! 2.2 Snow fractions
+ ! --------------
+ !
+ YRECFM='PSNG_ISBA'
+ YCOMMENT='snow fraction over ground averaged over tile nature (-)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_PSNG(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='PSNV_ISBA'
+ YCOMMENT='snow fraction over vegetation averaged over tile nature (-)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_PSNV(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='PSN_ISBA'
+ YCOMMENT='total snow fraction averaged over tile nature (-)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_PSN(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ ! 2.3 Total Albedo and surface temperature
+ ! ------------------------------------
+ !
+ YRECFM='TALB_ISBA'
+ YCOMMENT='total albedo over tile nature (-)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_ALBT(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ IF (TSNOW%SCHEME=='3-L' .OR. TSNOW%SCHEME=='CRO') THEN
+ !
+ YRECFM='TS_ISBA'
+ YCOMMENT='total surface temperature (isba+snow) over tile nature'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_TS(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='TSRAD_ISBA'
+ YCOMMENT='total radiative surface temperature (isba+snow) over tile nature'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_TSRAD(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ END IF
+ !
+ ! 2.4 Soil Wetness Index, Water content and active layer depth
+ ! --------------------------------------------------------
+ !
+ IF(CISBA=='DIF')THEN
+ !
+ IWORK = NWG_SIZE
+ !
+ DO JLAYER = 1,NGROUND_LAYER
+ DO JJ=1,SIZE(NWG_LAYER,1)
+ IDEPTH=MAXVAL(NWG_LAYER(JJ,:),NWG_LAYER(JJ,:)/=NUNDEF)
+ IF(JLAYER>IDEPTH)THEN
+ XAVG_SWI (JJ,JLAYER) = XUNDEF
+ XAVG_TSWI(JJ,JLAYER) = XUNDEF
+ ENDIF
+ ENDDO
+ ENDDO
+ ELSE
+ IWORK = NGROUND_LAYER
+ ENDIF
+ !
+ DO JLAYER=1,IWORK
+ !
+ WRITE(YLVL,'(I2)') JLAYER
+ !
+ YRECFM='SWI'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
+ YRECFM=YRECFM(:LEN_TRIM(YRECFM))//'_ISBA'
+ YFORM='(A29,I1.1,A4)'
+ IF (JLAYER >= 10) YFORM='(A29,I2.2,A4)'
+ WRITE(YCOMMENT,FMT=YFORM) 'soil wetness index for layer ',JLAYER,' (-)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_SWI(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='TSWI'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
+ YRECFM=YRECFM(:LEN_TRIM(YRECFM))//'_ISBA'
+ YFORM='(A29,I1.1,A4)'
+ IF (JLAYER >= 10) YFORM='(A29,I2.2,A4)'
+ WRITE(YCOMMENT,FMT=YFORM) 'total swi (liquid+solid) for layer ',JLAYER,' (-)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_TSWI(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
+ !
+ END DO
+ !
+ YRECFM='TSWI_T_ISBA'
+ YCOMMENT='total soil wetness index over the soil column (-)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XSOIL_TSWI(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='WGTOT_T_ISBA'
+ YCOMMENT='total water content (liquid+solid) over the soil column (kg/m2)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XSOIL_TWG(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='WGI_T_ISBA'
+ YCOMMENT='total ice content (solid) over the soil column (kg/m2)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XSOIL_TWGI(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ IF(CISBA=='DIF') THEN
+ !
+ IF (LSURF_MISC_DIF)THEN
+ !
+ YRECFM='TSWI_R_ISBA'
+ YCOMMENT='total soil wetness index over the root zone (-)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XROOT_TSWI(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='WGTOT_R_ISBA'
+ YCOMMENT='total water content (liquid+solid) over the root zone (kg/m2)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XROOT_TWG(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='WGI_R_ISBA'
+ YCOMMENT='total ice content (solid) over the root zone (kg/m2)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XROOT_TWGI(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='TSWI_S_ISBA'
+ YCOMMENT='total soil wetness index over the surface (-)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XSURF_TSWI(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='WG_S_ISBA'
+ YCOMMENT='liquid water content over the surface (m3/m3)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XSURF_TWG(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='WGI_S_ISBA'
+ YCOMMENT='ice content over the surface (m3/m3)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XSURF_TWGI(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='TSWI_D2_ISBA'
+ YCOMMENT='total soil wetness index over comparable FR-DG2 reservoir (-)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XFRD2_TSWI(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='WG_D2_ISBA'
+ YCOMMENT='liquid water content over comparable FR-DG2 reservoir (m3/m3)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XFRD2_TWG(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='WGI_D2_ISBA'
+ YCOMMENT='ice content over comparable FR-DG2 reservoir (m3/m3)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XFRD2_TWGI(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='TSWI_D3_ISBA'
+ YCOMMENT='total soil wetness index over comparable FR-DG3 reservoir (-)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XFRD3_TSWI(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='WG_D3_ISBA'
+ YCOMMENT='liquid water content over comparable FR-DG3 reservoir (m3/m3)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XFRD3_TWG(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='WGI_D3_ISBA'
+ YCOMMENT='ice content over comparable FR-DG3 reservoir (m3/m3)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XFRD3_TWGI(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ ENDIF
+ !
+ YRECFM='ALT_ISBA'
+ YCOMMENT='active layer thickness over permafrost (m)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_ALT(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='FLT_ISBA'
+ YCOMMENT='frozen layer thickness over non-permafrost (m)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_FLT(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ ENDIF
+ !
+ ! 2.5 Snow outputs
+ ! -------------
+ !
+ YRECFM='WSNOW_T_ISBA'
+ YCOMMENT='Total_snow_reservoir (kg/m2)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_TWSNOW(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='DSNOW_T_ISBA'
+ YCOMMENT='Total_snow_depth (m)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_TDSNOW(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='TSNOW_T_ISBA'
+ YCOMMENT='Total_snow_temperature (K)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_TTSNOW(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ ! 2.6 SGH scheme
+ ! ----------
+ !
+ IF(CRUNOFF=='SGH '.OR.CRUNOFF=='DT92')THEN
+ YRECFM='FSAT_ISBA'
+ YCOMMENT='Soil saturated fraction (-)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_FSAT(:),IRESP,HCOMMENT=YCOMMENT)
+ ENDIF
+ !
+ IF(CRAIN=='SGH ')THEN
+ YRECFM='MUF_ISBA'
+ YCOMMENT='fraction of the grid cell reached by the rainfall (-)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XMUF(:),IRESP,HCOMMENT=YCOMMENT)
+ ENDIF
+ !
+ ! 2.7 Flooding scheme
+ ! ---------------
+ !
+ IF(LFLOOD)THEN
+ !
+ YRECFM='FFG_ISBA'
+ YCOMMENT='flood fraction over ground averaged over tile nature (-)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_FFG(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='FFV_ISBA'
+ YCOMMENT='flood fraction over vegetation averaged over tile nature (-)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_FFV(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='FF_ISBA'
+ YCOMMENT='total flood fraction averaged over tile nature (-)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_FF(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='FFLOOD_ISBA'
+ YCOMMENT='Grdi-cell potential flood fraction (-)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XFFLOOD(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='PIFLOOD_ISBA'
+ YCOMMENT='Grdi-cell Potential_floodplain_infiltration (kg/m2s)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XPIFLOOD(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ ENDIF
+ !
+ ! 2.8 Total LAI
+ ! ---------
+ !
+ IF(CPHOTO/='NON')THEN
+ YRECFM='LAI_ISBA'
+ YCOMMENT='leaf area index (m2/m2)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LAI(:),IRESP,HCOMMENT=YCOMMENT)
+ ENDIF
+ !
+ !* 3. Miscellaneous fields for each patch :
+ ! -------------------------------------
+ !
+ !----------------------------------------------------------------------------
+ !User wants (or not) patch output
+ IF(LPATCH_BUDGET)THEN
+ !----------------------------------------------------------------------------
+ !
+ ! 3.1 Soil Wetness Index and active layer depth
+ ! -----------------------------------------
+ !
+ DO JLAYER=1,IWORK
+ !
+ WRITE(YLVL,'(I2)') JLAYER
+ !
+ YRECFM='SWI'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
+ YFORM='(A39,I1.1)'
+ IF (JLAYER >= 10) YFORM='(A39,I2.2)'
+ WRITE(YCOMMENT,FMT=YFORM) 'soil wetness index per patch for layer ',JLAYER
+ YCOMMENTUNIT='-'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XSWI(:,JLAYER,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ YRECFM='TSWI'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
+ YFORM='(A39,I1.1)'
+ IF (JLAYER >= 10) YFORM='(A39,I2.2)'
+ WRITE(YCOMMENT,FMT=YFORM) 'total swi (liquid+solid) per patch for layer ',JLAYER
+ YCOMMENTUNIT='-'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XTSWI(:,JLAYER,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ END DO
+ !
+ IF(CISBA=='DIF')THEN
+ !
+ YRECFM='ALT_P'
+ YCOMMENT='active layer thickness over permafrost per patch'
+ YCOMMENTUNIT='m'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XALT(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ YRECFM='FLT_P'
+ YCOMMENT='frozen layer thickness over non-permafrost per patch'
+ YCOMMENTUNIT='m'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XFLT(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ ENDIF
+ !
+ ! 3.2 Snow fractions
+ ! --------------
+ !
+ YRECFM='PSNG'
+ YCOMMENT='snow fraction per patch over ground'
+ YCOMMENTUNIT='-'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XDPSNG(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ YRECFM='PSNV'
+ YCOMMENT='snow fraction per patch over vegetation'
+ YCOMMENTUNIT='-'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XDPSNV(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ YRECFM='PSN'
+ YCOMMENT='total snow fraction per patch'
+ YCOMMENTUNIT='-'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XDPSN(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ ! 3.3 SGH scheme
+ ! ----------
+ !
+ IF(CRUNOFF=='DT92')THEN
+ YRECFM='FSAT_P'
+ YCOMMENT='Soil saturated fraction per patch'
+ YCOMMENTUNIT='-'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XDFSAT(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ ENDIF
+ !
+ ! 3.3 Flood fractions
+ ! --------------
+ !
+ IF(LFLOOD)THEN
+ !
+ YRECFM='FFG_P'
+ YCOMMENT='flood fraction per patch over ground'
+ YCOMMENTUNIT='-'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XDFFG(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ YRECFM='FFV_P'
+ YCOMMENT='flood fraction per patch over vegetation'
+ YCOMMENTUNIT='-'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XDFFV(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ YRECFM='FF_P'
+ YCOMMENT='total flood fraction per patch'
+ YCOMMENTUNIT='-'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XDFF(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ ENDIF
+ !
+ ! 3.4 Total Albedo
+ ! ------------
+ !
+ YRECFM='TALB'
+ YCOMMENT='total albedo per patch'
+ !
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XALBT(:,:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ IF (TSNOW%SCHEME=='3-L' .OR. TSNOW%SCHEME=='CRO') THEN
+ YRECFM='TS_P'
+ YCOMMENT='total surface temperature (isba+snow) per patch'
+ YCOMMENTUNIT='-'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XTS(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ YRECFM='TSRAD_P'
+ YCOMMENT='total radiative surface temperature (isba+snow) per patch'
+ YCOMMENTUNIT='-'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XTSRAD(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ ENDIF
+ !
+ ! 3.5 Halstead coefficient
+ ! --------------------
+ !
+ YRECFM='HV'
+ YCOMMENT='Halstead coefficient per patch'
+ YCOMMENTUNIT='-'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XHV(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ ! 3.6 Snow outputs
+ ! -----------------
+ !
+ YRECFM='WSNOW_VEGT'
+ YCOMMENT='X_Y_WSNOW_VEG_TOT per patch'
+ YCOMMENTUNIT='kg/m2'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XTWSNOW(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ YRECFM='DSNOW_VEGT'
+ YCOMMENT='X_Y_DSNOW_VEG_TOT per patch'
+ YCOMMENTUNIT='m'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XTDSNOW(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ YRECFM='TSNOW_VEGT'
+ YCOMMENT='X_Y_TSNOW_VEG_TOT per patch'
+ YCOMMENTUNIT='k'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XTTSNOW(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ IF (TSNOW%SCHEME=='3-L' .OR. TSNOW%SCHEME=='CRO') THEN
+ !
+ DO JLAYER=1,TSNOW%NLAYER
+ !
+ WRITE(YLVL,'(I2)') JLAYER
+ !
+ YRECFM='SNOWLIQ'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
+ YFORM='(A17,I1.1)'
+ IF (JLAYER >= 10) YFORM='(A17,I2.2)'
+ WRITE(YCOMMENT,FMT=YFORM) 'snow liquid water',JLAYER
+ YCOMMENTUNIT='m'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XSNOWLIQ(:,JLAYER,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ YRECFM='SNOWTEMP'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
+ YFORM='(A16,I1.1)'
+ IF (JLAYER >= 10) YFORM='(A16,I2.2)'
+ WRITE(YCOMMENT,FMT=YFORM) 'snow temperature',JLAYER
+ YCOMMENTUNIT='K'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XSNOWTEMP(:,JLAYER,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ END DO
+ !
+ ENDIF
+ !
+ END IF
+ !
+ IF (LAGRIP) THEN
+ !
+ ! 2.8 Irrigation threshold
+ ! --------------------
+ !
+ YRECFM='IRRISEUIL'
+ YCOMMENT='irrigation threshold per patch'
+ YCOMMENTUNIT='-'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XSEUIL(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ ENDIF
+ !
+ IF (LTR_ML) THEN
+ !
+ YRECFM='FAPAR'
+ YCOMMENT='FAPAR'
+ YCOMMENTUNIT='-'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XFAPAR(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ YRECFM='FAPIR'
+ YCOMMENT='FAPIR'
+ YCOMMENTUNIT='-'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XFAPIR(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ YRECFM='FAPAR_BS'
+ YCOMMENT='FAPAR_BS'
+ YCOMMENTUNIT='-'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XFAPAR_BS(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ YRECFM='FAPIR_BS'
+ YCOMMENT='FAPIR_BS'
+ YCOMMENTUNIT='-'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XFAPIR_BS(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ YRECFM='DFAPARC'
+ YCOMMENT='DFAPARC'
+ YCOMMENTUNIT='-'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XDFAPARC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ YRECFM='DFAPIRC'
+ YCOMMENT='DFAPIRC'
+ YCOMMENTUNIT='-'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XDFAPIRC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ YRECFM='DLAI_EFFC'
+ YCOMMENT='DLAI_EFFC'
+ YCOMMENTUNIT='m2/m2'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XDLAI_EFFC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ ENDIF
+ !
+ENDIF
+! End of IO
+!
+ CALL END_IO_SURF_n(HPROGRAM)
+IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_MISC_ISBA_N',1,ZHOOK_HANDLE)
+!
+END SUBROUTINE WRITE_DIAG_MISC_ISBA_n
diff --git a/src/SURFEX/write_diag_pgd_isban.F90 b/src/SURFEX/write_diag_pgd_isban.F90
index ec299f543..5da3b9508 100644
--- a/src/SURFEX/write_diag_pgd_isban.F90
+++ b/src/SURFEX/write_diag_pgd_isban.F90
@@ -1,412 +1,443 @@
-!SURFEX_LIC Copyright 1994-2014 Meteo-France
-!SURFEX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SURFEX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SURFEX_LIC for details. version 1.
-! #########
- SUBROUTINE WRITE_DIAG_PGD_ISBA_n(HPROGRAM)
-! #########################################
-!
-!!**** *WRITE_DIAG_PGD_ISBA_n* - writes the ISBA physiographic diagnostic fields
-!!
-!! PURPOSE
-!! -------
-!!
-!!** METHOD
-!! ------
-!!
-!! EXTERNAL
-!! --------
-!!
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! V. Masson *Meteo France*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 01/2004
-!! Modified 10/2004 by P. Le Moigne: add XZ0REL, XVEGTYPE_PATCH
-!! Modified 11/2005 by P. Le Moigne: limit length of VEGTYPE_PATCH field names
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_SURF_PAR, ONLY : XUNDEF, NUNDEF
-USE MODD_ISBA_n, ONLY : NPATCH, CPHOTO, CHORT, CISBA, &
- XLAI, XVEG, XZ0,XALBNIR_SOIL,XALBVIS_SOIL,XALBUV_SOIL,&
- XRSMIN, XGAMMA, XRGL, XCV, XEMIS, XDG, XWRMAX_CF, &
- XZ0REL, XVEGTYPE_PATCH, XALBNIR, XALBVIS, XALBUV, &
- XPATCH, XWATSUP, TSEED, TREAP, XIRRIG, XD_ICE, &
- XROOTFRAC, NWG_LAYER, XDROOT, XDG2, &
- XWSAT, XWFC, XWWILT, XRUNOFFD, CSOC, XFRACSOC
-USE MODD_AGRI, ONLY : LAGRIP
-!
-USE MODD_DIAG_MISC_ISBA_n,ONLY : LSURF_DIAG_ALBEDO
-!
-USE MODD_IO_SURF_FA, ONLY : LFANOCOMPACT, LPREP
-!
-USE MODD_CH_ISBA_n, ONLY : XSOILRC_SO2, XSOILRC_O3, CCH_DRY_DEP, NBEQ
-USE MODI_INIT_IO_SURF_n
-USE MODI_WRITE_SURF
-USE MODI_END_IO_SURF_n
-!
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of arguments
-! -------------------------
-!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling
-!
-!* 0.2 Declarations of local variables
-! -------------------------------
-!
-REAL, DIMENSION(SIZE(XDG,1),SIZE(XDG,3)) :: ZWORK ! Work array
-!
-INTEGER :: IRESP ! IRESP : return-code if a problem appears
- CHARACTER(LEN=12) :: YRECFM ! Name of the article to be read
- CHARACTER(LEN=100):: YCOMMENT ! Comment string
- CHARACTER(LEN=2) :: YLVLV, YPAS
-!
-INTEGER :: JJ, JL, JP, ILAYER
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!-------------------------------------------------------------------------------
-!
-! Initialisation for IO
-!
-IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_PGD_ISBA_N',0,ZHOOK_HANDLE)
- CALL INIT_IO_SURF_n(HPROGRAM,'NATURE','ISBA ','WRITE')
-!
-!-------------------------------------------------------------------------------
-!
-!* Leaf Area Index
-!
-IF (CPHOTO=='NON' .OR. CPHOTO=='AGS' .OR. CPHOTO=='AST') THEN
- !
- YRECFM='LAI'
- YCOMMENT='leaf area index (-)'
- !
- CALL WRITE_SURF(HPROGRAM,YRECFM,XLAI(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
-ENDIF
-!
-!-------------------------------------------------------------------------------
-!
-!* Vegetation fraction
-!
-YRECFM='VEG'
-YCOMMENT='vegetation fraction (-)'
-!
- CALL WRITE_SURF(HPROGRAM,YRECFM,XVEG(:,:),IRESP,HCOMMENT=YCOMMENT)
-!
-!* Surface roughness length (without snow)
-!
-YRECFM='Z0VEG'
-YCOMMENT='surface roughness length (without snow) (M)'
-!
- CALL WRITE_SURF(HPROGRAM,YRECFM,XZ0(:,:),IRESP,HCOMMENT=YCOMMENT)
-!
-!-------------------------------------------------------------------------------
-!
-!* Fraction for each patch
-!
-IF(.NOT.LFANOCOMPACT.OR.LPREP)THEN
- YRECFM='PATCH'
- YCOMMENT='fraction for each patch (-)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XPATCH(:,:),IRESP,HCOMMENT=YCOMMENT)
-ENDIF
-!-------------------------------------------------------------------------------
-!
-!* Soil depth for each patch
-!
-DO JL=1,SIZE(XDG,2)
- IF (JL<10) THEN
- WRITE(YRECFM,FMT='(A2,I1)') 'DG',JL
- ELSE
- WRITE(YRECFM,FMT='(A2,I2)') 'DG',JL
- ENDIF
- YCOMMENT='soil depth'//' (M)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XDG(:,JL,:),IRESP,HCOMMENT=YCOMMENT)
-END DO
-!-------------------------------------------------------------------------------
-!
-IF(CISBA=='DIF')THEN
-!
-!* Root depth
-!
- YRECFM='DROOT_DIF'
- YCOMMENT='Root depth in ISBA-DIF'
-!
- CALL WRITE_SURF(HPROGRAM,YRECFM,XDROOT(:,:),IRESP,HCOMMENT=YCOMMENT)
-!
- YRECFM='DG2_DIF'
- YCOMMENT='DG2 depth in ISBA-DIF'
-!
- CALL WRITE_SURF(HPROGRAM,YRECFM,XDG2(:,:),IRESP,HCOMMENT=YCOMMENT)
-!
-!* Runoff depth
-!
- YRECFM='RUNOFFD'
- YCOMMENT='Runoff deph in ISBA-DIF'
-!
- CALL WRITE_SURF(HPROGRAM,YRECFM,XRUNOFFD(:,:),IRESP,HCOMMENT=YCOMMENT)
-!
-!* Total soil depth for mositure
-!
- ZWORK(:,:)=XUNDEF
- DO JP=1,SIZE(XDG,3)
- DO JJ=1,SIZE(XDG,1)
- JL=NWG_LAYER(JJ,JP)
- IF(JL/=NUNDEF)THEN
- ZWORK(JJ,JP)=XDG(JJ,JL,JP)
- ENDIF
- ENDDO
- ENDDO
- YRECFM='DTOT_DIF'
- YCOMMENT='Total soil depth for moisture in ISBA-DIF'
- CALL WRITE_SURF(HPROGRAM,YRECFM,ZWORK(:,:),IRESP,HCOMMENT=YCOMMENT)
-!
-!* Root fraction for each patch
-!
- DO JL=1,SIZE(XROOTFRAC,2)
- IF (JL<10) THEN
- WRITE(YRECFM,FMT='(A8,I1)') 'ROOTFRAC',JL
- ELSE
- WRITE(YRECFM,FMT='(A8,I2)') 'ROOTFRAC',JL
- ENDIF
- YCOMMENT='root fraction by layer (-)'
- ZWORK(:,:)=XUNDEF
- DO JJ=1,SIZE(XDG,1)
- WHERE(JL<=NWG_LAYER(JJ,:).AND.NWG_LAYER(JJ,:)/=NUNDEF)
- ZWORK(JJ,:)=XROOTFRAC(JJ,JL,:)
- ENDWHERE
- ENDDO
- CALL WRITE_SURF(HPROGRAM,YRECFM,ZWORK(:,:),IRESP,HCOMMENT=YCOMMENT)
- END DO
-!
-!* SOC fraction for each layer
-!
- IF(CSOC=='SGH')THEN
- DO JL=1,SIZE(XDG,2)
- IF (JL<10) THEN
- WRITE(YRECFM,FMT='(A7,I1)') 'FRACSOC',JL
- ELSE
- WRITE(YRECFM,FMT='(A7,I2)') 'FRACSOC',JL
- ENDIF
- YCOMMENT='SOC fraction by layer (-)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XFRACSOC(:,JL),IRESP,HCOMMENT=YCOMMENT)
- END DO
- ENDIF
-!
-ENDIF
-!
-!-------------------------------------------------------------------------------
-!
-DO JL=1,SIZE(XDG,2)
- IF (JL<10) THEN
- WRITE(YRECFM,FMT='(A4,I1)') 'WSAT',JL
- ELSE
- WRITE(YRECFM,FMT='(A4,I2)') 'WSAT',JL
- ENDIF
- YCOMMENT='soil porosity by layer (m3/m3)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XWSAT(:,JL),IRESP,HCOMMENT=YCOMMENT)
-ENDDO
-!
-DO JL=1,SIZE(XDG,2)
- IF (JL<10) THEN
- WRITE(YRECFM,FMT='(A3,I1)') 'WFC',JL
- ELSE
- WRITE(YRECFM,FMT='(A3,I2)') 'WFC',JL
- ENDIF
- YCOMMENT='field capacity by layer (m3/m3)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XWFC(:,JL),IRESP,HCOMMENT=YCOMMENT)
-ENDDO
-!
-DO JL=1,SIZE(XDG,2)
- IF (JL<10) THEN
- WRITE(YRECFM,FMT='(A5,I1)') 'WWILT',JL
- ELSE
- WRITE(YRECFM,FMT='(A5,I2)') 'WWILT',JL
- ENDIF
- YCOMMENT='wilting point by layer (m3/m3)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XWWILT(:,JL),IRESP,HCOMMENT=YCOMMENT)
-ENDDO
-!
-!-------------------------------------------------------------------------------
-! For Earth System Model
-IF(LFANOCOMPACT.AND..NOT.LPREP)THEN
- CALL END_IO_SURF_n(HPROGRAM)
- IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_PGD_ISBA_N',1,ZHOOK_HANDLE)
- RETURN
-ENDIF
-!
-!-------------------------------------------------------------------------------
-!
-YRECFM='Z0REL'
-YCOMMENT='orography roughness length (M)'
-!
- CALL WRITE_SURF(HPROGRAM,YRECFM,XZ0REL(:),IRESP,HCOMMENT=YCOMMENT)
-!
-!-------------------------------------------------------------------------------
-!
-!* Runoff soil ice depth for each patch
-!
-IF(CHORT=='SGH'.AND.CISBA/='DIF')THEN
- YRECFM='DICE'
- YCOMMENT='soil ice depth for runoff (m)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XD_ICE(:,:),IRESP,HCOMMENT=YCOMMENT)
-ENDIF
-!
-!-------------------------------------------------------------------------------
-!
-!* Fraction of each vegetation type for each patch
-!
-DO JL=1,SIZE(XVEGTYPE_PATCH,2)
- WRITE(YPAS,'(I2)') JL
- YLVLV=ADJUSTL(YPAS(:LEN_TRIM(YPAS)))
- WRITE(YRECFM,FMT='(A9)') 'VEGTY_P'//YLVLV
- YCOMMENT='fraction of each vegetation type for each patch'//' (-)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XVEGTYPE_PATCH(:,JL,:),IRESP,HCOMMENT=YCOMMENT)
-END DO
-!-------------------------------------------------------------------------------
-!
-!* other surface parameters
-!
-YRECFM='RSMIN'
-YCOMMENT='minimum stomatal resistance (SM-1)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XRSMIN(:,:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='GAMMA'
-YCOMMENT='coefficient for RSMIN calculation (-)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XGAMMA(:,:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='CV'
-YCOMMENT='vegetation thermal inertia coefficient (-)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XCV(:,:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='RGL'
-YCOMMENT='maximum solar radiation usable in photosynthesis (-)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XRGL(:,:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='EMIS_ISBA'
-YCOMMENT='surface emissivity (-)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XEMIS(:,:),IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='WRMAX_CF'
-YCOMMENT='coefficient for maximum water interception (-)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XWRMAX_CF(:,:),IRESP,HCOMMENT=YCOMMENT)
-!
-!-------------------------------------------------------------------------------
-!
-IF (LSURF_DIAG_ALBEDO) THEN
-!
-!* Soil albedos
-!
-!
- YRECFM='ALBNIR_S'
- YCOMMENT='soil near-infra-red albedo (-)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XALBNIR_SOIL(:,:),IRESP,HCOMMENT=YCOMMENT)
-!
-!-------------------------------------------------------------------------------
-!
- YRECFM='ALBVIS_S'
- YCOMMENT='soil visible albedo (-)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XALBVIS_SOIL(:,:),IRESP,HCOMMENT=YCOMMENT)
-!
-!-------------------------------------------------------------------------------
-!
- YRECFM='ALBUV_S'
- YCOMMENT='soil UV albedo (-)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XALBUV_SOIL(:,:),IRESP,HCOMMENT=YCOMMENT)
-!
-!-------------------------------------------------------------------------------
-!
-!* albedos
-!
- YRECFM='ALBNIR_ISBA'
- YCOMMENT='total near-infra-red albedo (-)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XALBNIR(:,:),IRESP,HCOMMENT=YCOMMENT)
-!
-!-------------------------------------------------------------------------------
-!
- YRECFM='ALBVIS_ISBA'
- YCOMMENT='total visible albedo (-)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XALBVIS(:,:),IRESP,HCOMMENT=YCOMMENT)
-!
-!-------------------------------------------------------------------------------
-!
- YRECFM='ALBUV_ISBA'
- YCOMMENT='total UV albedo (-)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XALBUV(:,:),IRESP,HCOMMENT=YCOMMENT)
-!
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-!* chemical soil resistances
-!
-IF (CCH_DRY_DEP=='WES89' .AND. NBEQ>0) THEN
- YRECFM='SOILRC_SO2'
- YCOMMENT='bare soil resistance for SO2 (?)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XSOILRC_SO2(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='SOILRC_O3'
- YCOMMENT='bare soil resistance for O3 (?)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XSOILRC_O3(:,:),IRESP,HCOMMENT=YCOMMENT)
-END IF
-!
-!-------------------------------------------------------------------------------
-!
-IF (LAGRIP .AND. (CPHOTO=='LAI' .OR. CPHOTO=='LST' .OR. CPHOTO=='NIT' .OR. CPHOTO=='NCB') ) THEN
-!
-!* seeding and reaping
-!
-!
- YRECFM='TSEED'
- YCOMMENT='date of seeding (-)'
-!
- CALL WRITE_SURF(HPROGRAM,YRECFM,TSEED(:,:),IRESP,HCOMMENT=YCOMMENT)
-!
- YRECFM='TREAP'
- YCOMMENT='date of reaping (-)'
-!
- CALL WRITE_SURF(HPROGRAM,YRECFM,TREAP(:,:),IRESP,HCOMMENT=YCOMMENT)
-!
-!-------------------------------------------------------------------------------
-!
-!* irrigated fraction
-!
- YRECFM='IRRIG'
- YCOMMENT='flag for irrigation (irrigation if >0.) (-)'
-!
- CALL WRITE_SURF(HPROGRAM,YRECFM,XIRRIG(:,:),IRESP,HCOMMENT=YCOMMENT)
-!
-!-------------------------------------------------------------------------------
-!
-!* water supply for irrigation
-!
- YRECFM='WATSUP'
- YCOMMENT='water supply during irrigation process (mm)'
-!
- CALL WRITE_SURF(HPROGRAM,YRECFM,XWATSUP(:,:),IRESP,HCOMMENT=YCOMMENT)
-!
-ENDIF
-!-------------------------------------------------------------------------------
-! End of IO
-!
- CALL END_IO_SURF_n(HPROGRAM)
-IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_PGD_ISBA_N',1,ZHOOK_HANDLE)
-!
-!
-END SUBROUTINE WRITE_DIAG_PGD_ISBA_n
+!SURFEX_LIC Copyright 1994-2014 Meteo-France
+!SURFEX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SURFEX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SURFEX_LIC for details. version 1.
+! #########
+ SUBROUTINE WRITE_DIAG_PGD_ISBA_n(HPROGRAM)
+! #########################################
+!
+!!**** *WRITE_DIAG_PGD_ISBA_n* - writes the ISBA physiographic diagnostic fields
+!!
+!! PURPOSE
+!! -------
+!!
+!!** METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Masson *Meteo France*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 01/2004
+!! Modified 10/2004 by P. Le Moigne: add XZ0REL, XVEGTYPE_PATCH
+!! Modified 11/2005 by P. Le Moigne: limit length of VEGTYPE_PATCH field names
+!! M.Moge 01/2016 using WRITE_SURF_FIELD2D/3D for 2D/3D surfex fields writes
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_SURF_PAR, ONLY : XUNDEF, NUNDEF
+USE MODD_ISBA_n, ONLY : NPATCH, CPHOTO, CHORT, CISBA, &
+ XLAI, XVEG, XZ0,XALBNIR_SOIL,XALBVIS_SOIL,XALBUV_SOIL,&
+ XRSMIN, XGAMMA, XRGL, XCV, XEMIS, XDG, XWRMAX_CF, &
+ XZ0REL, XVEGTYPE_PATCH, XALBNIR, XALBVIS, XALBUV, &
+ XPATCH, XWATSUP, TSEED, TREAP, XIRRIG, XD_ICE, &
+ XROOTFRAC, NWG_LAYER, XDROOT, XDG2, &
+ XWSAT, XWFC, XWWILT, XRUNOFFD, CSOC, XFRACSOC
+USE MODD_AGRI, ONLY : LAGRIP
+!
+USE MODD_DIAG_MISC_ISBA_n,ONLY : LSURF_DIAG_ALBEDO
+!
+USE MODD_IO_SURF_FA, ONLY : LFANOCOMPACT, LPREP
+!
+USE MODD_CH_ISBA_n, ONLY : XSOILRC_SO2, XSOILRC_O3, CCH_DRY_DEP, NBEQ
+USE MODI_INIT_IO_SURF_n
+USE MODI_WRITE_SURF
+USE MODI_WRITE_SURF_FIELD2D
+USE MODI_END_IO_SURF_n
+!
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of arguments
+! -------------------------
+!
+ CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling
+!
+!* 0.2 Declarations of local variables
+! -------------------------------
+!
+REAL, DIMENSION(SIZE(XDG,1),SIZE(XDG,3)) :: ZWORK ! Work array
+!
+INTEGER :: IRESP ! IRESP : return-code if a problem appears
+ CHARACTER(LEN=12) :: YRECFM ! Name of the article to be read
+ CHARACTER(LEN=100):: YCOMMENT ! Comment string
+ CHARACTER(LEN=100):: YCOMMENTUNIT ! Comment string : unit of the datas in the field to write
+ CHARACTER(LEN=2) :: YLVLV, YPAS
+!
+INTEGER :: JJ, JL, JP, ILAYER
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!-------------------------------------------------------------------------------
+!
+! Initialisation for IO
+!
+IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_PGD_ISBA_N',0,ZHOOK_HANDLE)
+ CALL INIT_IO_SURF_n(HPROGRAM,'NATURE','ISBA ','WRITE')
+!
+!-------------------------------------------------------------------------------
+!
+!* Leaf Area Index
+!
+IF (CPHOTO=='NON' .OR. CPHOTO=='AGS' .OR. CPHOTO=='AST') THEN
+ !
+ YRECFM='LAI'
+ YCOMMENT='leaf area index'
+ YCOMMENTUNIT='-'
+ !
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XLAI(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+!* Vegetation fraction
+!
+YRECFM='VEG'
+YCOMMENT='vegetation fraction'
+YCOMMENTUNIT='-'
+!
+CALL WRITE_SURF_FIELD2D(HPROGRAM,XVEG(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+!
+!* Surface roughness length (without snow)
+!
+YRECFM='Z0VEG'
+YCOMMENT='surface roughness length (without snow)'
+YCOMMENTUNIT='M'
+!
+CALL WRITE_SURF_FIELD2D(HPROGRAM,XZ0(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+!
+!-------------------------------------------------------------------------------
+!
+!* Fraction for each patch
+!
+IF(.NOT.LFANOCOMPACT.OR.LPREP)THEN
+ YRECFM='PATCH'
+ YCOMMENT='fraction for each patch'
+ YCOMMENTUNIT='-'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XPATCH(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ENDIF
+!-------------------------------------------------------------------------------
+!
+!* Soil depth for each patch
+!
+DO JL=1,SIZE(XDG,2)
+ IF (JL<10) THEN
+ WRITE(YRECFM,FMT='(A2,I1)') 'DG',JL
+ ELSE
+ WRITE(YRECFM,FMT='(A2,I2)') 'DG',JL
+ ENDIF
+ YCOMMENT='soil depth'
+ YCOMMENTUNIT='M'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XDG(:,JL,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+END DO
+!-------------------------------------------------------------------------------
+!
+IF(CISBA=='DIF')THEN
+!
+!* Root depth
+!
+ YRECFM='DROOT_DIF'
+ YCOMMENT='Root depth in ISBA-DIF'
+!
+ YCOMMENTUNIT='-'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XDROOT(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+!
+ YRECFM='DG2_DIF'
+ YCOMMENT='DG2 depth in ISBA-DIF'
+!
+ YCOMMENTUNIT='-'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XDG2(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+!
+!* Runoff depth
+!
+ YRECFM='RUNOFFD'
+ YCOMMENT='Runoff deph in ISBA-DIF'
+!
+ YCOMMENTUNIT='-'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XRUNOFFD(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+!
+!* Total soil depth for mositure
+!
+ ZWORK(:,:)=XUNDEF
+ DO JP=1,SIZE(XDG,3)
+ DO JJ=1,SIZE(XDG,1)
+ JL=NWG_LAYER(JJ,JP)
+ IF(JL/=NUNDEF)THEN
+ ZWORK(JJ,JP)=XDG(JJ,JL,JP)
+ ENDIF
+ ENDDO
+ ENDDO
+ YRECFM='DTOT_DIF'
+ YCOMMENT='Total soil depth for moisture in ISBA-DIF'
+ YCOMMENTUNIT='-'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,ZWORK(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+!
+!* Root fraction for each patch
+!
+ DO JL=1,SIZE(XROOTFRAC,2)
+ IF (JL<10) THEN
+ WRITE(YRECFM,FMT='(A8,I1)') 'ROOTFRAC',JL
+ ELSE
+ WRITE(YRECFM,FMT='(A8,I2)') 'ROOTFRAC',JL
+ ENDIF
+ YCOMMENT='root fraction by layer'
+ YCOMMENTUNIT='-'
+ ZWORK(:,:)=XUNDEF
+ DO JJ=1,SIZE(XDG,1)
+ WHERE(JL<=NWG_LAYER(JJ,:).AND.NWG_LAYER(JJ,:)/=NUNDEF)
+ ZWORK(JJ,:)=XROOTFRAC(JJ,JL,:)
+ ENDWHERE
+ ENDDO
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,ZWORK(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ END DO
+!
+!* SOC fraction for each layer
+!
+ IF(CSOC=='SGH')THEN
+ DO JL=1,SIZE(XDG,2)
+ IF (JL<10) THEN
+ WRITE(YRECFM,FMT='(A7,I1)') 'FRACSOC',JL
+ ELSE
+ WRITE(YRECFM,FMT='(A7,I2)') 'FRACSOC',JL
+ ENDIF
+ YCOMMENT='SOC fraction by layer (-)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XFRACSOC(:,JL),IRESP,HCOMMENT=YCOMMENT)
+ END DO
+ ENDIF
+!
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+DO JL=1,SIZE(XDG,2)
+ IF (JL<10) THEN
+ WRITE(YRECFM,FMT='(A4,I1)') 'WSAT',JL
+ ELSE
+ WRITE(YRECFM,FMT='(A4,I2)') 'WSAT',JL
+ ENDIF
+ YCOMMENT='soil porosity by layer (m3/m3)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XWSAT(:,JL),IRESP,HCOMMENT=YCOMMENT)
+ENDDO
+!
+DO JL=1,SIZE(XDG,2)
+ IF (JL<10) THEN
+ WRITE(YRECFM,FMT='(A3,I1)') 'WFC',JL
+ ELSE
+ WRITE(YRECFM,FMT='(A3,I2)') 'WFC',JL
+ ENDIF
+ YCOMMENT='field capacity by layer (m3/m3)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XWFC(:,JL),IRESP,HCOMMENT=YCOMMENT)
+ENDDO
+!
+DO JL=1,SIZE(XDG,2)
+ IF (JL<10) THEN
+ WRITE(YRECFM,FMT='(A5,I1)') 'WWILT',JL
+ ELSE
+ WRITE(YRECFM,FMT='(A5,I2)') 'WWILT',JL
+ ENDIF
+ YCOMMENT='wilting point by layer (m3/m3)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XWWILT(:,JL),IRESP,HCOMMENT=YCOMMENT)
+ENDDO
+!
+!-------------------------------------------------------------------------------
+! For Earth System Model
+IF(LFANOCOMPACT.AND..NOT.LPREP)THEN
+ CALL END_IO_SURF_n(HPROGRAM)
+ IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_PGD_ISBA_N',1,ZHOOK_HANDLE)
+ RETURN
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+YRECFM='Z0REL'
+YCOMMENT='orography roughness length (M)'
+!
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XZ0REL(:),IRESP,HCOMMENT=YCOMMENT)
+!
+!-------------------------------------------------------------------------------
+!
+!* Runoff soil ice depth for each patch
+!
+IF(CHORT=='SGH'.AND.CISBA/='DIF')THEN
+ YRECFM='DICE'
+ YCOMMENT='soil ice depth for runoff'
+ YCOMMENTUNIT='m'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XD_ICE(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+!* Fraction of each vegetation type for each patch
+!
+DO JL=1,SIZE(XVEGTYPE_PATCH,2)
+ WRITE(YPAS,'(I2)') JL
+ YLVLV=ADJUSTL(YPAS(:LEN_TRIM(YPAS)))
+ WRITE(YRECFM,FMT='(A9)') 'VEGTY_P'//YLVLV
+ YCOMMENT='fraction of each vegetation type for each patch'
+ YCOMMENTUNIT='-'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XVEGTYPE_PATCH(:,JL,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+END DO
+!-------------------------------------------------------------------------------
+!
+!* other surface parameters
+!
+YRECFM='RSMIN'
+YCOMMENT='minimum stomatal resistance'
+YCOMMENTUNIT='SM-1'
+CALL WRITE_SURF_FIELD2D(HPROGRAM,XRSMIN(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+!
+YRECFM='GAMMA'
+YCOMMENT='coefficient for RSMIN calculation'
+YCOMMENTUNIT='-'
+CALL WRITE_SURF_FIELD2D(HPROGRAM,XGAMMA(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+!
+YRECFM='CV'
+YCOMMENT='vegetation thermal inertia coefficient'
+YCOMMENTUNIT='-'
+CALL WRITE_SURF_FIELD2D(HPROGRAM,XCV(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+!
+YRECFM='RGL'
+YCOMMENT='maximum solar radiation usable in photosynthesis'
+YCOMMENTUNIT='-'
+CALL WRITE_SURF_FIELD2D(HPROGRAM,XRGL(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+!
+YRECFM='EMIS_ISBA'
+YCOMMENT='surface emissivity'
+YCOMMENTUNIT='-'
+CALL WRITE_SURF_FIELD2D(HPROGRAM,XEMIS(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+!
+YRECFM='WRMAX_CF'
+YCOMMENT='coefficient for maximum water interception'
+YCOMMENTUNIT='-'
+CALL WRITE_SURF_FIELD2D(HPROGRAM,XWRMAX_CF(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+!
+!-------------------------------------------------------------------------------
+!
+IF (LSURF_DIAG_ALBEDO) THEN
+!
+!* Soil albedos
+!
+!
+ YRECFM='ALBNIR_S'
+ YCOMMENT='soil near-infra-red albedo'
+ YCOMMENTUNIT='-'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XALBNIR_SOIL(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+!
+!-------------------------------------------------------------------------------
+!
+ YRECFM='ALBVIS_S'
+ YCOMMENT='soil visible albedo'
+ YCOMMENTUNIT='-'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XALBVIS_SOIL(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+!
+!-------------------------------------------------------------------------------
+!
+ YRECFM='ALBUV_S'
+ YCOMMENT='soil UV albedo'
+ YCOMMENTUNIT='-'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XALBUV_SOIL(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+!
+!-------------------------------------------------------------------------------
+!
+!* albedos
+!
+ YRECFM='ALBNIR_ISBA'
+ YCOMMENT='total near-infra-red albedo'
+ YCOMMENTUNIT='-'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XALBNIR(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+!
+!-------------------------------------------------------------------------------
+!
+ YRECFM='ALBVIS_ISBA'
+ YCOMMENT='total visible albedo'
+ YCOMMENTUNIT='-'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XALBVIS(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+!
+!-------------------------------------------------------------------------------
+!
+ YRECFM='ALBUV_ISBA'
+ YCOMMENT='total UV albedo'
+ YCOMMENTUNIT='-'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XALBUV(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+!
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+!* chemical soil resistances
+!
+IF (CCH_DRY_DEP=='WES89' .AND. NBEQ>0) THEN
+ YRECFM='SOILRC_SO2'
+ YCOMMENT='bare soil resistance for SO2'
+ YCOMMENTUNIT='?'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XSOILRC_SO2(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ YRECFM='SOILRC_O3'
+ YCOMMENT='bare soil resistance for O3'
+ YCOMMENTUNIT='?'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XSOILRC_O3(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+END IF
+!
+!-------------------------------------------------------------------------------
+!
+IF (LAGRIP .AND. (CPHOTO=='LAI' .OR. CPHOTO=='LST' .OR. CPHOTO=='NIT' .OR. CPHOTO=='NCB') ) THEN
+!
+!* seeding and reaping
+!
+!
+ YRECFM='TSEED'
+ YCOMMENT='date of seeding (-)'
+!
+ CALL WRITE_SURF(HPROGRAM,YRECFM,TSEED(:,:),IRESP,HCOMMENT=YCOMMENT)
+!
+ YRECFM='TREAP'
+ YCOMMENT='date of reaping (-)'
+!
+ CALL WRITE_SURF(HPROGRAM,YRECFM,TREAP(:,:),IRESP,HCOMMENT=YCOMMENT)
+!
+!-------------------------------------------------------------------------------
+!
+!* irrigated fraction
+!
+ YRECFM='IRRIG'
+ YCOMMENT='flag for irrigation (irrigation if >0.)'
+ YCOMMENTUNIT='-'
+!
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XIRRIG(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+!
+!-------------------------------------------------------------------------------
+!
+!* water supply for irrigation
+!
+ YRECFM='WATSUP'
+ YCOMMENT='water supply during irrigation process'
+ YCOMMENTUNIT='mm'
+!
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XWATSUP(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+!
+ENDIF
+!-------------------------------------------------------------------------------
+! End of IO
+!
+ CALL END_IO_SURF_n(HPROGRAM)
+IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_PGD_ISBA_N',1,ZHOOK_HANDLE)
+!
+!
+END SUBROUTINE WRITE_DIAG_PGD_ISBA_n
diff --git a/src/SURFEX/write_diag_seb_isban.F90 b/src/SURFEX/write_diag_seb_isban.F90
index 10e80a9b1..115e1d113 100644
--- a/src/SURFEX/write_diag_seb_isban.F90
+++ b/src/SURFEX/write_diag_seb_isban.F90
@@ -1,1528 +1,1619 @@
-!SURFEX_LIC Copyright 1994-2014 Meteo-France
-!SURFEX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SURFEX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SURFEX_LIC for details. version 1.
-! #########
- SUBROUTINE WRITE_DIAG_SEB_ISBA_n(HPROGRAM)
-! #################################
-!
-!!**** *WRITE_DIAG_SEB_ISBA* - writes the ISBA diagnostic fields
-!!
-!! PURPOSE
-!! -------
-!!
-!!
-!!** METHOD
-!! ------
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! V. Masson *Meteo France*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 01/2004
-!! B. Decharme 06/2009 key to write (or not) patch result
-!! B. Decharme 08/2009 cumulative radiative budget
-!! B. Decharme 09/2012 : Bug in local variables declaration in PROVAR_TO_DIAG
-!! B. Decharme 09/2012 New diag :
-!! carbon fluxes and reservoirs
-!! soil liquid and ice water content in kg/m2 and m3/m3
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_SURFEX_MPI, ONLY : NWG_SIZE
-!
-USE MODD_SURF_PAR, ONLY : XUNDEF, NUNDEF
-!
-USE MODD_CSTS, ONLY : XRHOLW, XTT, XLMTT
-!
-USE MODD_DIAG_SURF_ATM_n,ONLY : LPROVAR_TO_DIAG, LRESET_BUDGETC
-!
-USE MODD_ISBA_n, ONLY : NPATCH, XPATCH, LFLOOD, CISBA, CHORT, &
- LGLACIER, NGROUND_LAYER, LTEMP_ARP, &
- NTEMPLAYER_ARP, TSNOW, XLE, XDG, XTG, &
- XWG, XWGI, XWR, XICE_STO, XWSAT, XDZG, &
- NWG_LAYER, CPHOTO, CRESPSL, XBIOMASS, &
- XLITTER, XSOILCARB, XLIGNIN_STRUC, &
- NNBIOMASS, NNLITTER, NNSOILCARB, &
- NNLITTLEVS
-!
-USE MODD_AGRI , ONLY : LAGRIP
-!
-USE MODD_DIAG_ISBA_n,ONLY : N2M, LSURF_BUDGET, LRAD_BUDGET, LCOEF, &
- LSURF_VARS,LPATCH_BUDGET, &
- XAVG_RN, XAVG_H, XAVG_LE, XAVG_LEI, XAVG_GFLUX, &
- XAVG_RI, XAVG_CD, XAVG_CH, XAVG_CE, &
- XAVG_T2M, XAVG_Q2M, XAVG_HU2M, &
- XAVG_ZON10M, XAVG_MER10M, XAVG_Z0, XAVG_Z0H, &
- XAVG_QS, XAVG_T2M_MIN, XAVG_T2M_MAX, &
- XAVG_SWD, XAVG_SWU, XAVG_SWBD, XAVG_SWBU, &
- XAVG_LWD, XAVG_LWU, XAVG_FMU, XAVG_FMV, &
- XRN, XH, XGFLUX, XLEI, &
- XRI,XT2M, XQ2M, XHU2M, XZON10M, XMER10M, &
- XZ0_WITH_SNOW, XZ0H_WITH_SNOW, XQS, XWIND10M, &
- XSWD, XSWU, XSWBD, XSWBU, XLWD, XLWU, XFMU, XFMV, &
- XSWDC, XSWUC, XLWDC, XLWUC, XFMUC, XFMVC, &
- XAVG_SWDC, XAVG_SWUC, XAVG_LWDC, XAVG_LWUC, &
- XAVG_FMUC, XAVG_FMVC, XAVG_HU2M_MIN, &
- XAVG_HU2M_MAX, XAVG_WIND10M, XAVG_WIND10M_MAX, &
- XAVG_SFCO2
-!
-USE MODI_INIT_IO_SURF_n
-USE MODI_WRITE_SURF
-USE MODI_END_IO_SURF_n
-USE MODD_DIAG_EVAP_ISBA_n,ONLY : LSURF_EVAP_BUDGET, LSURF_BUDGETC, &
- LWATER_BUDGET, &
- XRNC, XAVG_RNC, XHC, XAVG_HC, &
- XLEC, XAVG_LEC, XGFLUXC, XAVG_GFLUXC, &
- XLEIC, XAVG_LEIC, &
- XLEG, XLEGC, XAVG_LEG, XAVG_LEGC, &
- XLEGI, XLEGIC, XAVG_LEGI, XAVG_LEGIC, &
- XLEV, XLEVC, XAVG_LEV, XAVG_LEVC, &
- XLES, XLESC, XAVG_LES, XAVG_LESC, &
- XLESL, XLESLC, XAVG_LESL, XAVG_LESLC, &
- XLER, XLERC, XAVG_LER, XAVG_LERC, &
- XLETR, XLETRC, XAVG_LETR, XAVG_LETRC, &
- XEVAP, XEVAPC, XAVG_EVAP, XAVG_EVAPC, &
- XDRAIN, XDRAINC, XAVG_DRAIN, XAVG_DRAINC, &
- XRUNOFF, XRUNOFFC, XAVG_RUNOFF, XAVG_RUNOFFC, &
- XHORT, XHORTC, XAVG_HORT, XAVG_HORTC, &
- XDRIP, XDRIPC, XAVG_DRIP, XAVG_DRIPC, &
- XMELT, XMELTC, XAVG_MELT, XAVG_MELTC, &
- XIFLOOD, XIFLOODC, XAVG_IFLOOD, XAVG_IFLOODC, &
- XPFLOOD, XPFLOODC, XAVG_PFLOOD, XAVG_PFLOODC, &
- XLE_FLOOD, XLE_FLOODC, XAVG_LE_FLOOD, &
- XAVG_LE_FLOODC, XLEI_FLOOD, XLEI_FLOODC, &
- XAVG_LEI_FLOOD, XAVG_LEI_FLOODC, &
- XICEFLUXC, XAVG_ICEFLUXC, &
- XRRVEG, XRRVEGC, XAVG_RRVEG, XAVG_RRVEGC, &
- XIRRIG_FLUX, XIRRIG_FLUXC, XAVG_IRRIG_FLUX, &
- XAVG_IRRIG_FLUXC, &
- XGPP,XGPPC,XAVG_GPP,XAVG_GPPC, XRESP_AUTO, &
- XRESPC_AUTO,XAVG_RESP_AUTO,XAVG_RESPC_AUTO, &
- XRESP_ECO,XRESPC_ECO,XAVG_RESP_ECO, &
- XAVG_RESPC_ECO, &
- XDWG, XDWGC, XAVG_DWG, XAVG_DWGC, &
- XDWGI, XDWGIC, XAVG_DWGI, XAVG_DWGIC, &
- XDWR, XDWRC, XAVG_DWR, XAVG_DWRC, &
- XDSWE, XDSWEC, XAVG_DSWE, XAVG_DSWEC, &
- XRAINFALL, XRAINFALLC, XSNOWFALL, XSNOWFALLC, &
- XWATBUD, XWATBUDC, XAVG_WATBUD, XAVG_WATBUDC
-!
-USE MODD_CH_ISBA_n, ONLY : XDEP, CCH_DRY_DEP, LCH_BIO_FLUX, CCH_NAMES, NBEQ, &
- NDSTEQ, LCH_NO_FLUX
-USE MODD_GR_BIOG_n, ONLY : XFISO, XFMONO, XNOFLUX
-USE MODD_DST_n
-USE MODD_DST_SURF
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of arguments
-! -------------------------
-!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling
-!
-!* 0.2 Declarations of local variables
-! -------------------------------
-!
-INTEGER :: IRESP ! IRESP : return-code if a problem appears
- CHARACTER(LEN=12) :: YRECFM ! Name of the article to be write
- CHARACTER(LEN=100):: YCOMMENT ! Comment string
- CHARACTER(LEN=2) :: YNUM
-!
-INTEGER :: JSV, JSW
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-!-------------------------------------------------------------------------------
-!
-! Initialisation for IO
-!
-IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_SEB_ISBA_N',0,ZHOOK_HANDLE)
- CALL INIT_IO_SURF_n(HPROGRAM,'NATURE','ISBA ','WRITE')
-!
-!-------------------------------------------------------------------------------
-!
-!* 2. Richardson number :
-! -----------------
-!
-IF (N2M>=1) THEN
- !
- YRECFM='RI_ISBA'
- YCOMMENT='Richardson number over tile nature'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_RI(:),IRESP,HCOMMENT=YCOMMENT)
- !
-END IF
-!
-!* 3. Energy fluxes :
-! -------------
-!
-IF (LSURF_BUDGET) THEN
- !
- YRECFM='RN_ISBA'
- YCOMMENT='Net radiation over tile nature'//' (W/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_RN(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='H_ISBA'
- YCOMMENT='Sensible heat flux over tile nature'//' (W/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_H(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='LE_ISBA'
- YCOMMENT='total latent heat flux over tile nature'//' (W/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LE(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='LEI_ISBA'
- YCOMMENT='sublimation latent heat flux over tile nature'//' (W/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LEI(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='GFLUX_ISBA'
- YCOMMENT='Ground flux over tile nature'//' (W/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_GFLUX(:),IRESP,HCOMMENT=YCOMMENT)
- !
- IF (LRAD_BUDGET .OR. (LSURF_BUDGETC .AND. .NOT.LRESET_BUDGETC)) THEN
- !
- YRECFM='SWD_ISBA'
- YCOMMENT='short wave downward radiation over tile nature'//' (W/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_SWD(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='SWU_ISBA'
- YCOMMENT='short wave upward radiation over tile nature'//' (W/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_SWU(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='LWD_ISBA'
- YCOMMENT='long wave downward radiation over tile nature'//' (W/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LWD(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='LWU_ISBA'
- YCOMMENT='long wave upward radiation over tile nature'//' (W/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LWU(:),IRESP,HCOMMENT=YCOMMENT)
- !
- DO JSW=1, SIZE(XSWBD,2)
- YNUM=ACHAR(48+JSW)
- !
- YRECFM='SWD_ISBA_'//YNUM
- YCOMMENT='short wave downward radiation over tile nature for spectral band'//YNUM//' (W/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_SWBD(:,JSW),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='SWU_ISBA_'//YNUM
- YCOMMENT='short wave upward radiation over tile nature for spectral band'//YNUM//' (W/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_SWBU(:,JSW),IRESP,HCOMMENT=YCOMMENT)
- !
- ENDDO
- !
- ENDIF
- !
- YRECFM='FMU_ISBA'
- YCOMMENT='u component of wind stress'//' (Pa)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_FMU(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='FMV_ISBA'
- YCOMMENT='v component of wind stress'//' (Pa)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_FMV(:),IRESP,HCOMMENT=YCOMMENT)
- !
-END IF
-!
-!* 4. Specific Energy fluxes :(for each patch)
-! ----------------------------------------
-!
-IF (LSURF_EVAP_BUDGET) THEN
- !
- YRECFM='LEG_ISBA'
- YCOMMENT='bare ground evaporation for tile nature'//' (W/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LEG(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='LEGI_ISBA'
- YCOMMENT='bare ground sublimation for tile nature'//' (W/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LEGI(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='LEV_ISBA'
- YCOMMENT='total vegetation evaporation for tile nature'//' (W/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LEV(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='LES_ISBA'
- YCOMMENT='snow sublimation for tile nature'//' (W/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LES(:),IRESP,HCOMMENT=YCOMMENT)
- !
- IF(TSNOW%SCHEME=='3-L' .OR. TSNOW%SCHEME=='CRO')THEN
- YRECFM='LESL_ISBA'
- YCOMMENT='liquid water evaporation over snow for tile nature'//' (W/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LESL(:),IRESP,HCOMMENT=YCOMMENT)
- ENDIF
- !
- YRECFM='LER_ISBA'
- YCOMMENT='canopy direct evaporation for tile nature'//' (W/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LER(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='LETR_ISBA'
- YCOMMENT='vegetation transpiration for tile nature'//' (W/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LETR(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='EVAP_ISBA'
- YCOMMENT='total evaporative flux for tile nature'//' (Kg/m2/s)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_EVAP(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='DRAIN_ISBA'
- YCOMMENT='drainage for tile nature'//' (Kg/m2/s)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_DRAIN(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='RUNOFF_ISBA'
- YCOMMENT='runoff for tile nature'//' (Kg/m2/s)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_RUNOFF(:),IRESP,HCOMMENT=YCOMMENT)
- !
- IF(CHORT=='SGH'.OR.CISBA=='DIF')THEN
- YRECFM='HORTON_ISBA'
- YCOMMENT='horton runoff for tile nature'//' (Kg/m2/s)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_HORT(:),IRESP,HCOMMENT=YCOMMENT)
- ENDIF
- !
- YRECFM='DRIVEG_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (Kg/m2/s)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_DRIP(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='RRVEG_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (Kg/m2/s)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_RRVEG(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='SNOMLT_ISBA'
- YCOMMENT='snow melting rate'//' (Kg/m2/s)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_MELT(:),IRESP,HCOMMENT=YCOMMENT)
- !
- IF(LAGRIP)THEN
- YRECFM='IRRIG_ISBA'
- YCOMMENT='irrigation rate'//' (Kg/m2/s)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_IRRIG_FLUX(:),IRESP,HCOMMENT=YCOMMENT)
- ENDIF
- !
- IF(LFLOOD)THEN
- !
- YRECFM='IFLOOD_ISBA'
- YCOMMENT='flood soil infiltration (Kg/m2/s)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_IFLOOD(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='PFLOOD_ISBA'
- YCOMMENT='intercepted precipitation by floodplains (Kg/m2/s)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_PFLOOD(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='LEF_ISBA'
- YCOMMENT='total floodplains evaporation (W/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LE_FLOOD(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='LEIF_ISBA'
- YCOMMENT='solid floodplains evaporation (W/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LEI_FLOOD(:),IRESP,HCOMMENT=YCOMMENT)
- !
- ENDIF
- !
- IF(CPHOTO/='NON')THEN
- !
- YRECFM='GPP_ISBA'
- YCOMMENT='gross primary production over tile nature (kgCO2/m2/s)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_GPP(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='R_AUTO_ISBA'
- YCOMMENT='autotrophic respiration over tile nature (kgCO2/m2/s)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_RESP_AUTO(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='R_ECO_ISBA'
- YCOMMENT='ecosystem respiration over tile nature (kgCO2/m2/s)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_RESP_ECO(:),IRESP,HCOMMENT=YCOMMENT)
- !
- ENDIF
- !
- IF(LWATER_BUDGET)THEN
- !
- YRECFM='RAINF_ISBA'
- YCOMMENT='input rainfall rate (Kg/m2/s)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XRAINFALL(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='SNOWF_ISBA'
- YCOMMENT='input snowfall rate (Kg/m2/s)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XSNOWFALL(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='DWG_ISBA'
- YCOMMENT='change in liquid soil moisture (Kg/m2/s)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_DWG(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='DWGI_ISBA'
- YCOMMENT='change in solid soil moisture (Kg/m2/s)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_DWGI(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='DWR_ISBA'
- YCOMMENT='change in water on canopy (Kg/m2/s)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_DWR(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='DSWE_ISBA'
- YCOMMENT='change in snow water equivalent (Kg/m2/s)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_DSWE(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='WATBUD_ISBA'
- YCOMMENT='isba water budget as residue (Kg/m2/s)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_WATBUD(:),IRESP,HCOMMENT=YCOMMENT)
- !
- ENDIF
- !
-ENDIF
-!
-!* 5. Cumulated Energy fluxes
-! -----------------------
-!
-IF (LSURF_BUDGETC) THEN
- !
- YRECFM='LEGC_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LEGC(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='LEGIC_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LEGIC(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='LEVC_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LEVC(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='LESC_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LESC(:),IRESP,HCOMMENT=YCOMMENT)
- !
- IF(TSNOW%SCHEME=='3-L' .OR. TSNOW%SCHEME=='CRO')THEN
- YRECFM='LESLC_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LESLC(:),IRESP,HCOMMENT=YCOMMENT)
- ENDIF
- !
- YRECFM='LERC_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LERC(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='LETRC_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LETRC(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='EVAPC_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (Kg/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_EVAPC(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='DRAINC_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (Kg/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_DRAINC(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='RUNOFFC_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (Kg/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_RUNOFFC(:),IRESP,HCOMMENT=YCOMMENT)
- !
- IF(CHORT=='SGH'.OR.CISBA=='DIF')THEN
- YRECFM='HORTONC_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (Kg/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_HORTC(:),IRESP,HCOMMENT=YCOMMENT)
- ENDIF
- !
- YRECFM='DRIVEGC_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (Kg/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_DRIPC(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='RRVEGC_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (Kg/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_RRVEGC(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='SNOMLTC_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (Kg/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_MELTC(:),IRESP,HCOMMENT=YCOMMENT)
- !
- IF(LAGRIP)THEN
- YRECFM='IRRIGC_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (Kg/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_IRRIG_FLUXC(:),IRESP,HCOMMENT=YCOMMENT)
- ENDIF
- !
- IF(LGLACIER)THEN
- YRECFM='ICE_FC_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (Kg/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_ICEFLUXC(:),IRESP,HCOMMENT=YCOMMENT)
- ENDIF
- !
- IF(LFLOOD)THEN
- !
- YRECFM='IFLOODC_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (Kg/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_IFLOODC(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='PFLOODC_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (Kg/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_PFLOODC(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='LEFC_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LE_FLOODC(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='LEIFC_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LEI_FLOODC(:),IRESP,HCOMMENT=YCOMMENT)
- !
- ENDIF
- !
- YRECFM='RNC_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_RNC(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='HC_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_HC(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='LEC_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LEC(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='LEIC_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LEIC(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='GFLUXC_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_GFLUXC(:),IRESP,HCOMMENT=YCOMMENT)
- !
- IF (LRAD_BUDGET .OR. (LSURF_BUDGETC .AND. .NOT.LRESET_BUDGETC)) THEN
- !
- YRECFM='SWDC_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_SWDC(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='SWUC_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_SWUC(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='LWDC_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LWDC(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='LWUC_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LWUC(:),IRESP,HCOMMENT=YCOMMENT)
- !
- ENDIF
- !
- YRECFM='FMUC_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (Pa.s)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_FMUC(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='FMVC_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (Pa.s)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_FMVC(:),IRESP,HCOMMENT=YCOMMENT)
- !
- IF(CPHOTO/='NON')THEN
- !
- YRECFM='GPPC_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (kgCO2/m2/s)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_GPPC(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='RC_AUTO_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (kgCO2/m2/s)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_RESPC_AUTO(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='RC_ECO_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (kgCO2/m2/s)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_RESPC_ECO(:),IRESP,HCOMMENT=YCOMMENT)
- !
- ENDIF
- !
- IF(LWATER_BUDGET .OR. (LSURF_BUDGETC .AND. .NOT.LRESET_BUDGETC))THEN
- !
- YRECFM='RAINFC_ISBA'
- YCOMMENT='cumulated input rainfall rate (Kg/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XRAINFALLC(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='SNOWFC_ISBA'
- YCOMMENT='cumulated input snowfall rate (Kg/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XSNOWFALLC(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='DWGC_ISBA'
- YCOMMENT='cumulated change in liquid soil moisture (Kg/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_DWGC(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='DWGIC_ISBA'
- YCOMMENT='cumulated change in solid soil moisture (Kg/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_DWGIC(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='DWRC_ISBA'
- YCOMMENT='cumulated change in water on canopy (Kg/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_DWRC(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='DSWEC_ISBA'
- YCOMMENT='cumulated change in snow water equivalent (Kg/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_DSWEC(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='WATBUDC_ISBA'
- YCOMMENT='cumulated isba water budget as residue (Kg/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_WATBUDC(:),IRESP,HCOMMENT=YCOMMENT)
- !
- ENDIF
- !
-ENDIF
-!
-!* 6. parameters at 2 and 10 meters :
-! -------------------------------
-!
-IF (N2M>=1) THEN
- !
- YRECFM='T2M_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (K)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_T2M(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='T2MMIN_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (K)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_T2M_MIN(:),IRESP,HCOMMENT=YCOMMENT)
- XAVG_T2M_MIN(:)=XUNDEF
- !
- YRECFM='T2MMAX_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (K)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_T2M_MAX(:),IRESP,HCOMMENT=YCOMMENT)
- XAVG_T2M_MAX(:)=0.0
- !
- YRECFM='Q2M_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (KG/KG)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_Q2M(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='HU2M_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (-)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_HU2M(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='HU2MMIN_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (-)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_HU2M_MIN(:),IRESP,HCOMMENT=YCOMMENT)
- XAVG_HU2M_MIN(:)=XUNDEF
- !
- YRECFM='HU2MMAX_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (-)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_HU2M_MAX(:),IRESP,HCOMMENT=YCOMMENT)
- XAVG_HU2M_MAX(:)=-XUNDEF
- !
- YRECFM='ZON10M_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (M/S)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_ZON10M(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='MER10M_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (M/S)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_MER10M(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='W10M_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (M/S)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_WIND10M(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='W10MMAX_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (M/S)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_WIND10M_MAX(:),IRESP,HCOMMENT=YCOMMENT)
- XAVG_WIND10M_MAX(:)=0.0
- !
- YRECFM='SFCO2_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (KG/M2/S)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_SFCO2(:),IRESP,HCOMMENT=YCOMMENT)
- !
-END IF
-!----------------------------------------------------------------------------
-!
-!* 7. Transfer coefficients
-! ---------------------
-!
-IF (LCOEF) THEN
- !
- YRECFM='CD_ISBA'
- YCOMMENT='X_Y_'//YRECFM
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_CD(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='CH_ISBA'
- YCOMMENT='X_Y_'//YRECFM
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_CH(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='CE_ISBA'
- YCOMMENT='X_Y_'//YRECFM
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_CE(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='Z0_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (M)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_Z0(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='Z0H_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (M)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_Z0H(:),IRESP,HCOMMENT=YCOMMENT)
- !
-ENDIF
-!
-!----------------------------------------------------------------------------
-!
-!* 8. Surface humidity
-! ----------------
-IF (LSURF_VARS) THEN
- !
- YRECFM='QS_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (KG/KG)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_QS(:),IRESP,HCOMMENT=YCOMMENT)
- !
-ENDIF
-!
-!----------------------------------------------------------------------------
-!
-!* 9. Diag of prognostic fields
-! -------------------------
-!
-IF (LPROVAR_TO_DIAG) CALL PROVAR_TO_DIAG
-!
-!----------------------------------------------------------------------------
-!
-!User want (or not) patch output
-IF(LPATCH_BUDGET.AND.(NPATCH >1))THEN
- !----------------------------------------------------------------------------
- !
- !* 10. Richardson number (for each patch)
- ! -----------------
- !
- IF (N2M>=1) THEN
- !
- YRECFM='RI_P'
- YCOMMENT='X_Y_'//YRECFM
- CALL WRITE_SURF(HPROGRAM,YRECFM,XRI(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- END IF
- !
- !* 11. Energy fluxes :(for each patch)
- ! -------------
- !
- IF (LSURF_BUDGET) THEN
- !
- YRECFM='RN_P'
- YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XRN(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='H_P'
- YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XH(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='LE_P'
- YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XLE(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='LEI_P'
- YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XLEI(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='GFLUX_P'
- YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XGFLUX(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- IF (LRAD_BUDGET .OR. (LSURF_BUDGETC .AND. .NOT.LRESET_BUDGETC)) THEN
- !
- YRECFM='SWD_P'
- YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XSWD(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='SWU_P'
- YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XSWU(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='LWD_P'
- YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XLWD(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='LWU_P'
- YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XLWU(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- DO JSW=1, SIZE(XSWBD,2)
- YNUM=ACHAR(48+JSW)
- !
- YRECFM='SWD_P'//YNUM
- YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XSWBD(:,JSW,:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='SWU_P'//YNUM
- YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XSWBU(:,JSW,:),IRESP,HCOMMENT=YCOMMENT)
- !
- ENDDO
- !
- ENDIF
- !
- YRECFM='FMU_P'
- YCOMMENT='X_Y_'//YRECFM//' (Pa)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XFMU(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='FMV_P'
- YCOMMENT='X_Y_'//YRECFM//' (Pa)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XFMV(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- END IF
- !
- !* 12. Specific Energy fluxes :(for each patch)
- ! ----------------------------------------
- !
- IF (LSURF_EVAP_BUDGET) THEN
- !
- YRECFM='LEG_P'
- YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XLEG(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='LEGI_P'
- YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XLEGI(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='LEV_P'
- YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XLEV(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='LES_P'
- YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XLES(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- IF(TSNOW%SCHEME=='3-L' .OR. TSNOW%SCHEME=='CRO')THEN
- YRECFM='LESL_P'
- YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XLESL(:,:),IRESP,HCOMMENT=YCOMMENT)
- ENDIF
- !
- YRECFM='LER_P'
- YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XLER(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='LETR_P'
- YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XLETR(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='EVAP_P'
- YCOMMENT='X_Y_'//YRECFM//' (Kg/m2/s)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XEVAP(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='DRAIN_P'
- YCOMMENT='X_Y_'//YRECFM//' (Kg/m2/s)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XDRAIN(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='RUNOFF_P'
- YCOMMENT='X_Y_'//YRECFM//' (Kg/m2/s)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XRUNOFF(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- IF(CHORT=='SGH'.OR.CISBA=='DIF')THEN
- YRECFM='HORTON_P'
- YCOMMENT='X_Y_'//YRECFM//' (Kg/m2/s)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XHORT(:,:),IRESP,HCOMMENT=YCOMMENT)
- ENDIF
- !
- YRECFM='DRIVEG_P'
- YCOMMENT='X_Y_'//YRECFM//' (Kg/m2/s)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XDRIP(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='RRVEG_P'
- YCOMMENT='X_Y_'//YRECFM//' (Kg/m2/s)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XRRVEG(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='SNOMLT_P'
- YCOMMENT='X_Y_'//YRECFM//' (Kg/m2/s)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XMELT(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- IF(LAGRIP)THEN
- YRECFM='IRRIG_P'
- YCOMMENT='X_Y_'//YRECFM//' (Kg/m2/s)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XIRRIG_FLUX(:,:),IRESP,HCOMMENT=YCOMMENT)
- ENDIF
- !
- IF(LFLOOD)THEN
- !
- YRECFM='IFLOOD_P'
- YCOMMENT='X_Y_'//YRECFM//' (Kg/m2/s)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XIFLOOD(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='PFLOOD_P'
- YCOMMENT='X_Y_'//YRECFM//' (Kg/m2/s)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XPFLOOD(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='LEF_P'
- YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XLE_FLOOD(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='LEIF_P'
- YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XLEI_FLOOD(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- ENDIF
- !
- IF(CPHOTO/='NON')THEN
- !
- YRECFM='GPP_P'
- YCOMMENT='gross primary production per patch (kgCO2/m2/s)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XGPP(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='R_AUTO_P'
- YCOMMENT='autotrophic respiration per patch (kgCO2/m2/s)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XRESP_AUTO(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='R_ECO_P'
- YCOMMENT='ecosystem respiration per patch (kgCO2/m2/s)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XRESP_ECO(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- ENDIF
- !
- IF(LWATER_BUDGET)THEN
- !
- YRECFM='DWG_P'
- YCOMMENT='change in liquid soil moisture per patch (Kg/m2/s)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XDWG(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='DWGI_P'
- YCOMMENT='change in solid soil moisture per patch (Kg/m2/s)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XDWGI(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='DWR_P'
- YCOMMENT='change in water on canopy per patch (Kg/m2/s)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XDWR(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='DSWE_P'
- YCOMMENT='change in snow water equivalent per patch (Kg/m2/s)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XDSWE(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='WATBUD_P'
- YCOMMENT='isba water budget as residue per patch (Kg/m2/s)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XWATBUD(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- ENDIF
- !
- ENDIF
- !
- !* 13. surface temperature parameters at 2 and 10 meters (for each patch):
- ! -------------------------------------------------------------------
- !
- IF (N2M>=1) THEN
- !
- YRECFM='T2M_P'
- YCOMMENT='X_Y_'//YRECFM//' (K)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XT2M(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='Q2M_P'
- YCOMMENT='X_Y_'//YRECFM//' (KG/KG)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XQ2M(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='HU2M_P'
- YCOMMENT='X_Y_'//YRECFM//' (PERCENT)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XHU2M(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='ZON10M_P'
- YCOMMENT='X_Y_'//YRECFM//' (M/S)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XZON10M(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='MER10M_P'
- YCOMMENT='X_Y_'//YRECFM//' (M/S)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XMER10M(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='W10M_P'
- YCOMMENT='X_Y_'//YRECFM//' (M/S)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XWIND10M(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- END IF
- !
- !* 14. Cumulated Energy fluxes :(for each patch)
- ! -----------------------------------------
- !
- IF (LSURF_BUDGETC) THEN
- !
- YRECFM='LEGC_P'
- YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XLEGC(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='LEGIC_P'
- YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XLEGIC(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='LEVC_P'
- YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XLEVC(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='LESC_P'
- YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XLESC(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- IF(TSNOW%SCHEME=='3-L' .OR. TSNOW%SCHEME=='CRO')THEN
- YRECFM='LESLC_P'
- YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XLESLC(:,:),IRESP,HCOMMENT=YCOMMENT)
- ENDIF
- !
- YRECFM='LERC_P'
- YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XLERC(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='LETRC_P'
- YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XLETRC(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='EVAPC_P'
- YCOMMENT='X_Y_'//YRECFM//' (Kg/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XEVAPC(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='DRAINC_P'
- YCOMMENT='X_Y_'//YRECFM//' (Kg/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XDRAINC(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='RUNOFFC_P'
- YCOMMENT='X_Y_'//YRECFM//' (Kg/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XRUNOFFC(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- IF(CHORT=='SGH'.OR.CISBA=='DIF')THEN
- YRECFM='HORTONC_P'
- YCOMMENT='X_Y_'//YRECFM//' (Kg/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XHORTC(:,:),IRESP,HCOMMENT=YCOMMENT)
- ENDIF
- !
- YRECFM='DRIVEGC_P'
- YCOMMENT='X_Y_'//YRECFM//' (Kg/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XDRIPC(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='RRVEGC_P'
- YCOMMENT='X_Y_'//YRECFM//' (Kg/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XRRVEGC(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='SNOMLTC_P'
- YCOMMENT='X_Y_'//YRECFM//' (Kg/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XMELTC(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- IF(LAGRIP)THEN
- YRECFM='IRRIGC_P'
- YCOMMENT='X_Y_'//YRECFM//' (Kg/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XIRRIG_FLUXC(:,:),IRESP,HCOMMENT=YCOMMENT)
- ENDIF
- !
- IF(LGLACIER)THEN
- YRECFM='ICE_FC_P'
- YCOMMENT='X_Y_'//YRECFM//' (Kg/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XICEFLUXC(:,:),IRESP,HCOMMENT=YCOMMENT)
- ENDIF
- !
- IF(LFLOOD)THEN
- !
- YRECFM='IFLOODC_P'
- YCOMMENT='X_Y_'//YRECFM//' (Kg/m2/s)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XIFLOODC(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='PFLOODC_P'
- YCOMMENT='X_Y_'//YRECFM//' (Kg/m2/s)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XPFLOODC(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='LEFC_P'
- YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XLE_FLOODC(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='LEIFC_P'
- YCOMMENT='X_Y_'//YRECFM//' (W/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XLEI_FLOODC(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- ENDIF
- !
- YRECFM='RNC_P'
- YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XRNC(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='HC_P'
- YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XHC(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='LEC_P'
- YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XLEC(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='LEIC_P'
- YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XLEIC(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='GFLUXC_P'
- YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XGFLUXC(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- IF (LRAD_BUDGET) THEN
- !
- YRECFM='SWDC_P'
- YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XSWDC(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='SWUC_P'
- YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XSWUC(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='LWDC_P'
- YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XLWDC(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='LWUC_P'
- YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XLWUC(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- ENDIF
- !
- YRECFM='FMUC_P'
- YCOMMENT='X_Y_'//YRECFM//' (Pa.s)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XFMUC(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='FMVC_P'
- YCOMMENT='X_Y_'//YRECFM//' (Pa.s)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XFMVC(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- IF(CPHOTO/='NON')THEN
- !
- YRECFM='GPPC_P'
- YCOMMENT='cumulated gross primary production per patch (kgCO2/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XGPPC(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='RC_AUTO_P'
- YCOMMENT='cumulated autotrophic respiration per patch (kgCO2/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XRESPC_AUTO(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='RC_ECO_P'
- YCOMMENT='cumulated ecosystem respiration per patch (kgCO2/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XRESPC_ECO(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- ENDIF
- !
- IF(LWATER_BUDGET .OR. (LSURF_BUDGETC .AND. .NOT.LRESET_BUDGETC))THEN
- !
- YRECFM='DWGC_P'
- YCOMMENT='cumulated change in liquid soil moisture per patch (Kg/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XDWGC(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='DWGIC_P'
- YCOMMENT='cumulated change in solid soil moisture per patch (Kg/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XDWGIC(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='DWRC_P'
- YCOMMENT='cumulated change in water on canopy per patch (Kg/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XDWRC(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='DSWEC_P'
- YCOMMENT='cumulated change in snow water equivalent per patch (Kg/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XDSWEC(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='WATBUDC_P'
- YCOMMENT='cumulated isba water budget as residue per patch (Kg/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XWATBUDC(:,:),IRESP,HCOMMENT=YCOMMENT)
- !
- ENDIF
- !
- ENDIF
- !-------------------------------------------------------------------------------
-ENDIF
-!User want (or not) patch output
-!-------------------------------------------------------------------------------
-!
-!* 15. chemical diagnostics:
-! --------------------
-!
-IF (NBEQ>0 .AND. CCH_DRY_DEP=="WES89 ") THEN
- !
- DO JSV = 1,SIZE(CCH_NAMES,1)
- YRECFM='DV_NAT_'//TRIM(CCH_NAMES(JSV))
- WRITE(YCOMMENT,'(A13,I3.3)')'(m/s) DV_NAT_',JSV
- CALL WRITE_SURF(HPROGRAM,YRECFM,XDEP(:,JSV,:),IRESP,HCOMMENT=YCOMMENT)
- END DO
- !
-ENDIF
-!
-IF (NBEQ>0 .AND. LCH_BIO_FLUX) THEN
- !
- IF (ASSOCIATED(XFISO)) THEN
- YRECFM='FISO'
- WRITE(YCOMMENT,'(A21)')'FISO (molecules/m2/s)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XFISO(:),IRESP,HCOMMENT=YCOMMENT)
- END IF
- !
- IF (ASSOCIATED(XFISO)) THEN
- YRECFM='FMONO'
- WRITE(YCOMMENT,'(A22)')'FMONO (molecules/m2/s)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XFMONO(:),IRESP,HCOMMENT=YCOMMENT)
- END IF
- !
-ENDIF
-!
-IF (LCH_NO_FLUX) THEN
- IF (ASSOCIATED(XNOFLUX)) THEN
- YRECFM='NOFLUX'
- WRITE(YCOMMENT,'(A21)')'NOFLUX (molecules/m2/s)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XNOFLUX(:),IRESP,HCOMMENT=YCOMMENT)
- END IF
-END IF
-!
-IF (NDSTEQ > 0)THEN
- !
- DO JSV = 1,NDSTMDE ! for all dust modes
- WRITE(YRECFM,'(A7,I3.3)')'FLX_DST',JSV
- YCOMMENT='X_Y_'//YRECFM//' (kg/m2/s)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XSFDST(:,JSV,:),IRESP,HCOMMENT=YCOMMENT)
- END DO
- !
-ENDIF
-!
-!-------------------------------------------------------------------------------
-!
-! End of IO
-!
- CALL END_IO_SURF_n(HPROGRAM)
-IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_SEB_ISBA_N',1,ZHOOK_HANDLE)
-!
-CONTAINS
-!
-!-------------------------------------------------------------------------------
-!
-SUBROUTINE PROVAR_TO_DIAG
-!
-REAL, DIMENSION(SIZE(XTG,1)) :: ZPATCH, ZWORK
-REAL, DIMENSION(SIZE(XWG,1),SIZE(XWG,2)) :: ZWG
-REAL, DIMENSION(SIZE(XWG,1),SIZE(XWG,2)) :: ZWGI
-REAL, DIMENSION(SIZE(XWG,1),SIZE(XWG,2)) :: ZMOIST
-REAL, DIMENSION(SIZE(XWG,1),SIZE(XWG,2)) :: ZICE
-REAL, DIMENSION(SIZE(XTG,1),SIZE(XTG,2)) :: ZTG
-REAL, DIMENSION(SIZE(XDG,1),SIZE(XDG,2)) :: ZDG_TOT
-REAL, DIMENSION(SIZE(XDG,1),SIZE(XDG,2),SIZE(XDG,3)) :: ZDG
-!
-REAL, DIMENSION(SIZE(XDG,1),NNBIOMASS) :: ZBIOMASS
-REAL, DIMENSION(SIZE(XDG,1),NNSOILCARB) :: ZSOILCARB
-REAL, DIMENSION(SIZE(XDG,1),NNLITTLEVS) :: ZLIGNIN_STRUC
-REAL, DIMENSION(SIZE(XDG,1),NNLITTER,NNLITTLEVS) :: ZLITTER
-!
- CHARACTER(LEN=8 ) :: YUNIT
- CHARACTER(LEN=4 ) :: YLVL
-INTEGER :: JLAYER, JPATCH, JJ, INI, IWORK, IDEPTH
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_SEB_ISBA_N:PROVAR_TO_DIAG',0,ZHOOK_HANDLE)
-!
-INI=SIZE(XDG,1)
-!
-! * soil temperatures (K)
-!
-IF(LTEMP_ARP)THEN
- IWORK=NTEMPLAYER_ARP
-ELSEIF(CISBA/='DIF')THEN
- IWORK=NGROUND_LAYER-1
-ELSE
- IWORK=NGROUND_LAYER
-ENDIF
-!
-ZTG(:,:)=0.0
-DO JPATCH=1,NPATCH
- DO JLAYER=1,IWORK
- DO JJ=1,INI
- ZTG(JJ,JLAYER) = ZTG(JJ,JLAYER) + XPATCH(JJ,JPATCH) * XTG(JJ,JLAYER,JPATCH)
- ENDDO
- ENDDO
-ENDDO
-!
-DO JLAYER=1,IWORK
- WRITE(YLVL,'(I4)') JLAYER
- YRECFM='TG'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
- YRECFM=YRECFM(:LEN_TRIM(YRECFM))//'_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (K)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,ZTG(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
-END DO
-!
-! * Compute soil liquid and ice water content (kg/m2 and m3/m3)
-!
-ZWG (:,:)=0.0
-ZWGI(:,:)=0.0
-ZDG_TOT(:,:)=0.0
-ZMOIST (:,:)=XUNDEF
-ZICE (:,:)=XUNDEF
-!
-IF(CISBA=='DIF')THEN
- !
- IWORK = NWG_SIZE
- !
- DO JPATCH=1,NPATCH
- DO JLAYER=1,NGROUND_LAYER
- DO JJ=1,INI
-!
-! liquid and ice water content
- IDEPTH=NWG_LAYER(JJ,JPATCH)
- IF(JLAYER<=IDEPTH)THEN
- ZWG (JJ,JLAYER)=ZWG (JJ,JLAYER)+XPATCH(JJ,JPATCH)*XWG (JJ,JLAYER,JPATCH)*XDZG(JJ,JLAYER,JPATCH)
- ZWGI (JJ,JLAYER)=ZWGI (JJ,JLAYER)+XPATCH(JJ,JPATCH)*XWGI(JJ,JLAYER,JPATCH)*XDZG(JJ,JLAYER,JPATCH)
- ZDG_TOT(JJ,JLAYER)=ZDG_TOT(JJ,JLAYER)+XPATCH(JJ,JPATCH)*XDZG(JJ,JLAYER,JPATCH)
- ENDIF
-!
- ENDDO
- ENDDO
- ENDDO
-!
-ELSE
- !
- IWORK = NGROUND_LAYER
- !
- ZDG(:,1,:) = XDG(:,1,:)
- ZDG(:,2,:) = XDG(:,2,:)
- IF(CISBA=='3-L')THEN
- ZDG(:,3,:) = XDG(:,3,:)-XDG(:,2,:)
- ENDIF
-!
- DO JPATCH=1,NPATCH
- DO JLAYER=1,NGROUND_LAYER
- DO JJ=1,INI
- ZWG (JJ,JLAYER)=ZWG (JJ,JLAYER)+XPATCH(JJ,JPATCH)*XWG (JJ,JLAYER,JPATCH)*ZDG(JJ,JLAYER,JPATCH)
- ZWGI (JJ,JLAYER)=ZWGI (JJ,JLAYER)+XPATCH(JJ,JPATCH)*XWGI(JJ,JLAYER,JPATCH)*ZDG(JJ,JLAYER,JPATCH)
- ZDG_TOT(JJ,JLAYER)=ZDG_TOT(JJ,JLAYER)+XPATCH(JJ,JPATCH)*ZDG(JJ,JLAYER,JPATCH)
- ENDDO
- ENDDO
- ENDDO
-!
-ENDIF
-!
-WHERE(ZDG_TOT(:,:)>0.0)
- ZMOIST(:,:)=ZWG (:,:)*XRHOLW
- ZICE (:,:)=ZWGI(:,:)*XRHOLW
- ZWG (:,:)=ZWG (:,:)/ZDG_TOT(:,:)
- ZWGI (:,:)=ZWGI(:,:)/ZDG_TOT(:,:)
-ELSEWHERE
- ZMOIST(:,:)=XUNDEF
- ZICE (:,:)=XUNDEF
- ZWG (:,:)=XUNDEF
- ZWGI (:,:)=XUNDEF
-ENDWHERE
-!
-! * soil liquid water content (m3/m3) and soil moisture (kg/m2)
-!
-YUNIT=' (m3/m3)'
-DO JLAYER=1,IWORK
- WRITE(YLVL,'(I4)') JLAYER
- YRECFM='WG'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
- YRECFM=YRECFM(:LEN_TRIM(YRECFM))//'_ISBA'
- YCOMMENT='X_Y_'//YRECFM//YUNIT
- CALL WRITE_SURF(HPROGRAM,YRECFM,ZWG(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
-END DO
-!
-YUNIT=' (kg/m2)'
-DO JLAYER=1,IWORK
- WRITE(YLVL,'(I4)') JLAYER
- YRECFM='SOILM'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
- YRECFM=YRECFM(:LEN_TRIM(YRECFM))//'_ISBA'
- YCOMMENT='X_Y_'//YRECFM//YUNIT
- CALL WRITE_SURF(HPROGRAM,YRECFM,ZMOIST(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
-END DO
-!
-! * soil ice water content (m3/m3) and soil ice mass (kg/m2)
-!
-IWORK=NGROUND_LAYER
-IF(CISBA/='DIF')THEN
- IWORK=NGROUND_LAYER-1 ! No ice in the FR 3-layers
-ENDIF
-!
-YUNIT=' (m3/m3)'
-DO JLAYER=1,IWORK
- WRITE(YLVL,'(I4)') JLAYER
- YRECFM='WGI'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
- YRECFM=YRECFM(:LEN_TRIM(YRECFM))//'_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (kg/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,ZWGI(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
-END DO
-!
-YUNIT=' (kg/m2)'
-DO JLAYER=1,IWORK
- WRITE(YLVL,'(I4)') JLAYER
- YRECFM='SOILI'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
- YRECFM=YRECFM(:LEN_TRIM(YRECFM))//'_ISBA'
- YCOMMENT='X_Y_'//YRECFM//YUNIT
- CALL WRITE_SURF(HPROGRAM,YRECFM,ZICE(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
-END DO
-!
-! * water intercepted on leaves (kg/m2)
-!
-ZWORK(:)=0.0
-DO JPATCH=1,NPATCH
- ZWORK(:) = ZWORK(:) + XPATCH(:,JPATCH) * XWR(:,JPATCH)
-ENDDO
-!
-YRECFM='WR_ISBA'
-YCOMMENT='X_Y_'//YRECFM//' (kg/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,ZWORK(:),IRESP,HCOMMENT=YCOMMENT)
-!
-! * Glacier ice storage (semi-prognostic) (kg/m2)
-!
-IF(LGLACIER)THEN
- !
- ZWORK(:)=0.0
- DO JPATCH=1,NPATCH
- ZWORK(:) = ZWORK(:) + XPATCH(:,JPATCH) * XICE_STO(:,JPATCH)
- ENDDO
- !
- YRECFM='ICE_STO_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (kg/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,ZWORK(:),IRESP,HCOMMENT=YCOMMENT)
- !
-ENDIF
-!
-! * Snow albedo (-)
-!
-ZPATCH(:) = 0.0
-ZWORK (:) = 0.0
-DO JPATCH=1,NPATCH
- WHERE(TSNOW%ALB(:,JPATCH)/=XUNDEF)
- ZWORK (:) = ZWORK(:) + XPATCH(:,JPATCH) * TSNOW%ALB(:,JPATCH)
- ZPATCH(:) = ZPATCH(:) + XPATCH(:,JPATCH)
- ENDWHERE
-ENDDO
-!
-WHERE(ZPATCH(:)>0.0)
- ZWORK(:) = ZWORK(:) / ZPATCH(:)
-ELSEWHERE
- ZWORK(:) = XUNDEF
-ENDWHERE
-!
-YRECFM='ASNOW_ISBA'
-YCOMMENT='X_Y_'//YRECFM//' (-)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,ZWORK(:),IRESP,HCOMMENT=YCOMMENT)
-!
-IF(TSNOW%SCHEME=='3-L' .OR. TSNOW%SCHEME=='CRO')THEN
- !
- ! * Snow reservoir (kg/m2) by layer
- !
- DO JLAYER = 1,TSNOW%NLAYER
- !
- ZWORK(:)=0.0
- DO JPATCH=1,NPATCH
- ZWORK(:) = ZWORK(:) + XPATCH(:,JPATCH) * TSNOW%WSNOW(:,JLAYER,JPATCH)
- ENDDO
- !
- WRITE(YLVL,'(I4)') JLAYER
- YRECFM='WSNOW_'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
- YRECFM=YRECFM(:LEN_TRIM(YRECFM))//'_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (kg/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,ZWORK(:),IRESP,HCOMMENT=YCOMMENT)
- !
- ENDDO
- !
- ! * Snow depth (m)
- !
- DO JLAYER = 1,TSNOW%NLAYER
- !
- ZWORK(:)=0.0
- DO JPATCH=1,NPATCH
- ZWORK(:) = ZWORK(:) + XPATCH(:,JPATCH) * TSNOW%WSNOW(:,JLAYER,JPATCH)/TSNOW%RHO(:,JLAYER,JPATCH)
- ENDDO
- !
- WRITE(YLVL,'(I4)') JLAYER
- YRECFM='DSNOW_'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
- YRECFM=YRECFM(:LEN_TRIM(YRECFM))//'_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (kg/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,ZWORK(:),IRESP,HCOMMENT=YCOMMENT)
- !
- ENDDO
- !
- ! * Snow temperature (k)
- !
- DO JLAYER = 1,TSNOW%NLAYER
- !
- ZWORK (:) = 0.0
- ZPATCH(:) = 0.0
- DO JPATCH=1,NPATCH
- WHERE(TSNOW%WSNOW(:,JLAYER,JPATCH)>0.)
- ZWORK (:) = ZWORK (:) + XPATCH(:,JPATCH) * TSNOW%TEMP(:,JLAYER,JPATCH)
- ZPATCH(:) = ZPATCH(:) + XPATCH(:,JPATCH)
- ENDWHERE
- ENDDO
- !
- WHERE(ZPATCH(:)>0.0)
- ZWORK(:) = ZWORK(:) / ZPATCH(:)
- ELSEWHERE
- ZWORK(:) = XUNDEF
- ENDWHERE
- !
- WRITE(YLVL,'(I4)') JLAYER
- YRECFM='TSNOW_'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
- YRECFM=YRECFM(:LEN_TRIM(YRECFM))//'_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (K)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,ZWORK(:),IRESP,HCOMMENT=YCOMMENT)
- !
- ENDDO
- !
-ENDIF
-!
-! * Isba-Ags biomass reservoir
-!
-! * Isba-Ags biomass reservoir
-!
-IF(CPHOTO=='NIT'.OR.CPHOTO=='NCB')THEN
-!
- ZBIOMASS(:,:)=0.0
- DO JPATCH=1,NPATCH
- DO JLAYER=1,NNBIOMASS
- DO JJ=1,INI
- ZBIOMASS(JJ,JLAYER) = ZBIOMASS(JJ,JLAYER) + XPATCH(JJ,JPATCH) * XBIOMASS(JJ,JLAYER,JPATCH)
- ENDDO
- ENDDO
- ENDDO
-!
- DO JLAYER = 1,NNBIOMASS
- WRITE(YLVL,'(I4)') JLAYER
- YRECFM='BIOM'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
- YRECFM=YRECFM(:LEN_TRIM(YRECFM))//'_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (kgDM/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,ZBIOMASS(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
- ENDDO
-!
-ENDIF
-!
-! * Isba-CC carbon reservoir
-!
-IF(CRESPSL=='CNT')THEN
-!
- ZLITTER(:,:,:)=0.0
- ZLIGNIN_STRUC(:,:)=0.0
- DO JPATCH=1,NPATCH
- DO JLAYER=1,NNLITTLEVS
- DO JJ=1,INI
- ZLITTER(JJ,1,JLAYER) = ZLITTER(JJ,1,JLAYER) + XPATCH(JJ,JPATCH) * XLITTER(JJ,1,JLAYER,JPATCH)
- ZLITTER(JJ,2,JLAYER) = ZLITTER(JJ,2,JLAYER) + XPATCH(JJ,JPATCH) * XLITTER(JJ,2,JLAYER,JPATCH)
- ZLIGNIN_STRUC(JJ,JLAYER) = ZLIGNIN_STRUC(JJ,JLAYER) + XPATCH(JJ,JPATCH) * XLIGNIN_STRUC(JJ,JLAYER,JPATCH)
- ENDDO
- ENDDO
- ENDDO
-!
- DO JLAYER=1,NNLITTLEVS
- WRITE(YLVL,'(I4)') JLAYER
- YRECFM='LIT1_'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
- YRECFM=YRECFM(:LEN_TRIM(YRECFM))//'_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (gC/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,ZLITTER(:,1,JLAYER),IRESP,HCOMMENT=YCOMMENT)
- WRITE(YLVL,'(I4)') JLAYER
- YRECFM='LIT2_'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
- YRECFM=YRECFM(:LEN_TRIM(YRECFM))//'_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (gC/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,ZLITTER(:,2,JLAYER),IRESP,HCOMMENT=YCOMMENT)
- WRITE(YLVL,'(I4)') JLAYER
- YRECFM='LIGSTR'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
- YRECFM=YRECFM(:LEN_TRIM(YRECFM))//'_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (-)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,ZLIGNIN_STRUC(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
- END DO
-!
- ZSOILCARB(:,:)=0.0
- DO JPATCH=1,NPATCH
- DO JLAYER=1,NNSOILCARB
- DO JJ=1,INI
- ZSOILCARB(JJ,JLAYER) = ZSOILCARB(JJ,JLAYER) + XPATCH(JJ,JPATCH) * XSOILCARB(JJ,JLAYER,JPATCH)
- ENDDO
- ENDDO
- ENDDO
-!
- DO JLAYER = 1,NNSOILCARB
- WRITE(YLVL,'(I4)') JLAYER
- YRECFM='SCARB'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
- YRECFM=YRECFM(:LEN_TRIM(YRECFM))//'_ISBA'
- YCOMMENT='X_Y_'//YRECFM//' (gC/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,ZSOILCARB(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
- ENDDO
-!
-ENDIF
-!
-IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_SEB_ISBA_N:PROVAR_TO_DIAG',1,ZHOOK_HANDLE)
-!
-END SUBROUTINE PROVAR_TO_DIAG
-!
-END SUBROUTINE WRITE_DIAG_SEB_ISBA_n
+!SURFEX_LIC Copyright 1994-2014 Meteo-France
+!SURFEX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SURFEX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SURFEX_LIC for details. version 1.
+! #########
+ SUBROUTINE WRITE_DIAG_SEB_ISBA_n(HPROGRAM)
+! #################################
+!
+!!**** *WRITE_DIAG_SEB_ISBA* - writes the ISBA diagnostic fields
+!!
+!! PURPOSE
+!! -------
+!!
+!!
+!!** METHOD
+!! ------
+!!
+!! REFERENCE
+!! ---------
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Masson *Meteo France*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 01/2004
+!! B. Decharme 06/2009 key to write (or not) patch result
+!! B. Decharme 08/2009 cumulative radiative budget
+!! B. Decharme 09/2012 : Bug in local variables declaration in PROVAR_TO_DIAG
+!! B. Decharme 09/2012 New diag :
+!! carbon fluxes and reservoirs
+!! soil liquid and ice water content in kg/m2 and m3/m3
+!! M.Moge 01/2016 using WRITE_SURF_FIELD2D/3D for 2D/3D surfex fields writes
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_SURFEX_MPI, ONLY : NWG_SIZE
+!
+USE MODD_SURF_PAR, ONLY : XUNDEF, NUNDEF
+!
+USE MODD_CSTS, ONLY : XRHOLW, XTT, XLMTT
+!
+USE MODD_DIAG_SURF_ATM_n,ONLY : LPROVAR_TO_DIAG, LRESET_BUDGETC
+!
+USE MODD_ISBA_n, ONLY : NPATCH, XPATCH, LFLOOD, CISBA, CHORT, &
+ LGLACIER, NGROUND_LAYER, LTEMP_ARP, &
+ NTEMPLAYER_ARP, TSNOW, XLE, XDG, XTG, &
+ XWG, XWGI, XWR, XICE_STO, XWSAT, XDZG, &
+ NWG_LAYER, CPHOTO, CRESPSL, XBIOMASS, &
+ XLITTER, XSOILCARB, XLIGNIN_STRUC, &
+ NNBIOMASS, NNLITTER, NNSOILCARB, &
+ NNLITTLEVS
+!
+USE MODD_AGRI , ONLY : LAGRIP
+!
+USE MODD_DIAG_ISBA_n,ONLY : N2M, LSURF_BUDGET, LRAD_BUDGET, LCOEF, &
+ LSURF_VARS,LPATCH_BUDGET, &
+ XAVG_RN, XAVG_H, XAVG_LE, XAVG_LEI, XAVG_GFLUX, &
+ XAVG_RI, XAVG_CD, XAVG_CH, XAVG_CE, &
+ XAVG_T2M, XAVG_Q2M, XAVG_HU2M, &
+ XAVG_ZON10M, XAVG_MER10M, XAVG_Z0, XAVG_Z0H, &
+ XAVG_QS, XAVG_T2M_MIN, XAVG_T2M_MAX, &
+ XAVG_SWD, XAVG_SWU, XAVG_SWBD, XAVG_SWBU, &
+ XAVG_LWD, XAVG_LWU, XAVG_FMU, XAVG_FMV, &
+ XRN, XH, XGFLUX, XLEI, &
+ XRI,XT2M, XQ2M, XHU2M, XZON10M, XMER10M, &
+ XZ0_WITH_SNOW, XZ0H_WITH_SNOW, XQS, XWIND10M, &
+ XSWD, XSWU, XSWBD, XSWBU, XLWD, XLWU, XFMU, XFMV, &
+ XSWDC, XSWUC, XLWDC, XLWUC, XFMUC, XFMVC, &
+ XAVG_SWDC, XAVG_SWUC, XAVG_LWDC, XAVG_LWUC, &
+ XAVG_FMUC, XAVG_FMVC, XAVG_HU2M_MIN, &
+ XAVG_HU2M_MAX, XAVG_WIND10M, XAVG_WIND10M_MAX, &
+ XAVG_SFCO2
+!
+USE MODI_INIT_IO_SURF_n
+USE MODI_WRITE_SURF
+USE MODI_WRITE_SURF_FIELD2D
+USE MODI_END_IO_SURF_n
+USE MODD_DIAG_EVAP_ISBA_n,ONLY : LSURF_EVAP_BUDGET, LSURF_BUDGETC, &
+ LWATER_BUDGET, &
+ XRNC, XAVG_RNC, XHC, XAVG_HC, &
+ XLEC, XAVG_LEC, XGFLUXC, XAVG_GFLUXC, &
+ XLEIC, XAVG_LEIC, &
+ XLEG, XLEGC, XAVG_LEG, XAVG_LEGC, &
+ XLEGI, XLEGIC, XAVG_LEGI, XAVG_LEGIC, &
+ XLEV, XLEVC, XAVG_LEV, XAVG_LEVC, &
+ XLES, XLESC, XAVG_LES, XAVG_LESC, &
+ XLESL, XLESLC, XAVG_LESL, XAVG_LESLC, &
+ XLER, XLERC, XAVG_LER, XAVG_LERC, &
+ XLETR, XLETRC, XAVG_LETR, XAVG_LETRC, &
+ XEVAP, XEVAPC, XAVG_EVAP, XAVG_EVAPC, &
+ XDRAIN, XDRAINC, XAVG_DRAIN, XAVG_DRAINC, &
+ XRUNOFF, XRUNOFFC, XAVG_RUNOFF, XAVG_RUNOFFC, &
+ XHORT, XHORTC, XAVG_HORT, XAVG_HORTC, &
+ XDRIP, XDRIPC, XAVG_DRIP, XAVG_DRIPC, &
+ XMELT, XMELTC, XAVG_MELT, XAVG_MELTC, &
+ XIFLOOD, XIFLOODC, XAVG_IFLOOD, XAVG_IFLOODC, &
+ XPFLOOD, XPFLOODC, XAVG_PFLOOD, XAVG_PFLOODC, &
+ XLE_FLOOD, XLE_FLOODC, XAVG_LE_FLOOD, &
+ XAVG_LE_FLOODC, XLEI_FLOOD, XLEI_FLOODC, &
+ XAVG_LEI_FLOOD, XAVG_LEI_FLOODC, &
+ XICEFLUXC, XAVG_ICEFLUXC, &
+ XRRVEG, XRRVEGC, XAVG_RRVEG, XAVG_RRVEGC, &
+ XIRRIG_FLUX, XIRRIG_FLUXC, XAVG_IRRIG_FLUX, &
+ XAVG_IRRIG_FLUXC, &
+ XGPP,XGPPC,XAVG_GPP,XAVG_GPPC, XRESP_AUTO, &
+ XRESPC_AUTO,XAVG_RESP_AUTO,XAVG_RESPC_AUTO, &
+ XRESP_ECO,XRESPC_ECO,XAVG_RESP_ECO, &
+ XAVG_RESPC_ECO, &
+ XDWG, XDWGC, XAVG_DWG, XAVG_DWGC, &
+ XDWGI, XDWGIC, XAVG_DWGI, XAVG_DWGIC, &
+ XDWR, XDWRC, XAVG_DWR, XAVG_DWRC, &
+ XDSWE, XDSWEC, XAVG_DSWE, XAVG_DSWEC, &
+ XRAINFALL, XRAINFALLC, XSNOWFALL, XSNOWFALLC, &
+ XWATBUD, XWATBUDC, XAVG_WATBUD, XAVG_WATBUDC
+!
+USE MODD_CH_ISBA_n, ONLY : XDEP, CCH_DRY_DEP, LCH_BIO_FLUX, CCH_NAMES, NBEQ, &
+ NDSTEQ, LCH_NO_FLUX
+USE MODD_GR_BIOG_n, ONLY : XFISO, XFMONO, XNOFLUX
+USE MODD_DST_n
+USE MODD_DST_SURF
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of arguments
+! -------------------------
+!
+ CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling
+!
+!* 0.2 Declarations of local variables
+! -------------------------------
+!
+INTEGER :: IRESP ! IRESP : return-code if a problem appears
+ CHARACTER(LEN=12) :: YRECFM ! Name of the article to be write
+ CHARACTER(LEN=100):: YCOMMENT ! Comment string
+ CHARACTER(LEN=100):: YCOMMENTUNIT ! Comment string : unit of the datas in the field to write
+ CHARACTER(LEN=2) :: YNUM
+!
+INTEGER :: JSV, JSW
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+!-------------------------------------------------------------------------------
+!
+! Initialisation for IO
+!
+IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_SEB_ISBA_N',0,ZHOOK_HANDLE)
+ CALL INIT_IO_SURF_n(HPROGRAM,'NATURE','ISBA ','WRITE')
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. Richardson number :
+! -----------------
+!
+IF (N2M>=1) THEN
+ !
+ YRECFM='RI_ISBA'
+ YCOMMENT='Richardson number over tile nature'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_RI(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+END IF
+!
+!* 3. Energy fluxes :
+! -------------
+!
+IF (LSURF_BUDGET) THEN
+ !
+ YRECFM='RN_ISBA'
+ YCOMMENT='Net radiation over tile nature'//' (W/m2)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_RN(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='H_ISBA'
+ YCOMMENT='Sensible heat flux over tile nature'//' (W/m2)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_H(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='LE_ISBA'
+ YCOMMENT='total latent heat flux over tile nature'//' (W/m2)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LE(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='LEI_ISBA'
+ YCOMMENT='sublimation latent heat flux over tile nature'//' (W/m2)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LEI(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='GFLUX_ISBA'
+ YCOMMENT='Ground flux over tile nature'//' (W/m2)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_GFLUX(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ IF (LRAD_BUDGET .OR. (LSURF_BUDGETC .AND. .NOT.LRESET_BUDGETC)) THEN
+ !
+ YRECFM='SWD_ISBA'
+ YCOMMENT='short wave downward radiation over tile nature'//' (W/m2)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_SWD(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='SWU_ISBA'
+ YCOMMENT='short wave upward radiation over tile nature'//' (W/m2)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_SWU(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='LWD_ISBA'
+ YCOMMENT='long wave downward radiation over tile nature'//' (W/m2)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LWD(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='LWU_ISBA'
+ YCOMMENT='long wave upward radiation over tile nature'//' (W/m2)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LWU(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ DO JSW=1, SIZE(XSWBD,2)
+ YNUM=ACHAR(48+JSW)
+ !
+ YRECFM='SWD_ISBA_'//YNUM
+ YCOMMENT='short wave downward radiation over tile nature for spectral band'//YNUM//' (W/m2)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_SWBD(:,JSW),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='SWU_ISBA_'//YNUM
+ YCOMMENT='short wave upward radiation over tile nature for spectral band'//YNUM//' (W/m2)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_SWBU(:,JSW),IRESP,HCOMMENT=YCOMMENT)
+ !
+ ENDDO
+ !
+ ENDIF
+ !
+ YRECFM='FMU_ISBA'
+ YCOMMENT='u component of wind stress'//' (Pa)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_FMU(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='FMV_ISBA'
+ YCOMMENT='v component of wind stress'//' (Pa)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_FMV(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+END IF
+!
+!* 4. Specific Energy fluxes :(for each patch)
+! ----------------------------------------
+!
+IF (LSURF_EVAP_BUDGET) THEN
+ !
+ YRECFM='LEG_ISBA'
+ YCOMMENT='bare ground evaporation for tile nature'//' (W/m2)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LEG(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='LEGI_ISBA'
+ YCOMMENT='bare ground sublimation for tile nature'//' (W/m2)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LEGI(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='LEV_ISBA'
+ YCOMMENT='total vegetation evaporation for tile nature'//' (W/m2)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LEV(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='LES_ISBA'
+ YCOMMENT='snow sublimation for tile nature'//' (W/m2)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LES(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ IF(TSNOW%SCHEME=='3-L' .OR. TSNOW%SCHEME=='CRO')THEN
+ YRECFM='LESL_ISBA'
+ YCOMMENT='liquid water evaporation over snow for tile nature'//' (W/m2)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LESL(:),IRESP,HCOMMENT=YCOMMENT)
+ ENDIF
+ !
+ YRECFM='LER_ISBA'
+ YCOMMENT='canopy direct evaporation for tile nature'//' (W/m2)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LER(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='LETR_ISBA'
+ YCOMMENT='vegetation transpiration for tile nature'//' (W/m2)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LETR(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='EVAP_ISBA'
+ YCOMMENT='total evaporative flux for tile nature'//' (Kg/m2/s)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_EVAP(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='DRAIN_ISBA'
+ YCOMMENT='drainage for tile nature'//' (Kg/m2/s)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_DRAIN(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='RUNOFF_ISBA'
+ YCOMMENT='runoff for tile nature'//' (Kg/m2/s)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_RUNOFF(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ IF(CHORT=='SGH'.OR.CISBA=='DIF')THEN
+ YRECFM='HORTON_ISBA'
+ YCOMMENT='horton runoff for tile nature'//' (Kg/m2/s)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_HORT(:),IRESP,HCOMMENT=YCOMMENT)
+ ENDIF
+ !
+ YRECFM='DRIVEG_ISBA'
+ YCOMMENT='X_Y_'//YRECFM//' (Kg/m2/s)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_DRIP(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='RRVEG_ISBA'
+ YCOMMENT='X_Y_'//YRECFM//' (Kg/m2/s)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_RRVEG(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='SNOMLT_ISBA'
+ YCOMMENT='snow melting rate'//' (Kg/m2/s)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_MELT(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ IF(LAGRIP)THEN
+ YRECFM='IRRIG_ISBA'
+ YCOMMENT='irrigation rate'//' (Kg/m2/s)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_IRRIG_FLUX(:),IRESP,HCOMMENT=YCOMMENT)
+ ENDIF
+ !
+ IF(LFLOOD)THEN
+ !
+ YRECFM='IFLOOD_ISBA'
+ YCOMMENT='flood soil infiltration (Kg/m2/s)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_IFLOOD(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='PFLOOD_ISBA'
+ YCOMMENT='intercepted precipitation by floodplains (Kg/m2/s)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_PFLOOD(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='LEF_ISBA'
+ YCOMMENT='total floodplains evaporation (W/m2)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LE_FLOOD(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='LEIF_ISBA'
+ YCOMMENT='solid floodplains evaporation (W/m2)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LEI_FLOOD(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ ENDIF
+ !
+ IF(CPHOTO/='NON')THEN
+ !
+ YRECFM='GPP_ISBA'
+ YCOMMENT='gross primary production over tile nature (kgCO2/m2/s)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_GPP(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='R_AUTO_ISBA'
+ YCOMMENT='autotrophic respiration over tile nature (kgCO2/m2/s)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_RESP_AUTO(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='R_ECO_ISBA'
+ YCOMMENT='ecosystem respiration over tile nature (kgCO2/m2/s)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_RESP_ECO(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ ENDIF
+ !
+ IF(LWATER_BUDGET)THEN
+ !
+ YRECFM='RAINF_ISBA'
+ YCOMMENT='input rainfall rate (Kg/m2/s)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XRAINFALL(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='SNOWF_ISBA'
+ YCOMMENT='input snowfall rate (Kg/m2/s)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XSNOWFALL(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='DWG_ISBA'
+ YCOMMENT='change in liquid soil moisture (Kg/m2/s)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_DWG(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='DWGI_ISBA'
+ YCOMMENT='change in solid soil moisture (Kg/m2/s)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_DWGI(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='DWR_ISBA'
+ YCOMMENT='change in water on canopy (Kg/m2/s)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_DWR(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='DSWE_ISBA'
+ YCOMMENT='change in snow water equivalent (Kg/m2/s)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_DSWE(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='WATBUD_ISBA'
+ YCOMMENT='isba water budget as residue (Kg/m2/s)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_WATBUD(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ ENDIF
+ !
+ENDIF
+!
+!* 5. Cumulated Energy fluxes
+! -----------------------
+!
+IF (LSURF_BUDGETC) THEN
+ !
+ YRECFM='LEGC_ISBA'
+ YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LEGC(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='LEGIC_ISBA'
+ YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LEGIC(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='LEVC_ISBA'
+ YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LEVC(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='LESC_ISBA'
+ YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LESC(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ IF(TSNOW%SCHEME=='3-L' .OR. TSNOW%SCHEME=='CRO')THEN
+ YRECFM='LESLC_ISBA'
+ YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LESLC(:),IRESP,HCOMMENT=YCOMMENT)
+ ENDIF
+ !
+ YRECFM='LERC_ISBA'
+ YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LERC(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='LETRC_ISBA'
+ YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LETRC(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='EVAPC_ISBA'
+ YCOMMENT='X_Y_'//YRECFM//' (Kg/m2)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_EVAPC(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='DRAINC_ISBA'
+ YCOMMENT='X_Y_'//YRECFM//' (Kg/m2)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_DRAINC(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='RUNOFFC_ISBA'
+ YCOMMENT='X_Y_'//YRECFM//' (Kg/m2)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_RUNOFFC(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ IF(CHORT=='SGH'.OR.CISBA=='DIF')THEN
+ YRECFM='HORTONC_ISBA'
+ YCOMMENT='X_Y_'//YRECFM//' (Kg/m2)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_HORTC(:),IRESP,HCOMMENT=YCOMMENT)
+ ENDIF
+ !
+ YRECFM='DRIVEGC_ISBA'
+ YCOMMENT='X_Y_'//YRECFM//' (Kg/m2)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_DRIPC(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='RRVEGC_ISBA'
+ YCOMMENT='X_Y_'//YRECFM//' (Kg/m2)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_RRVEGC(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='SNOMLTC_ISBA'
+ YCOMMENT='X_Y_'//YRECFM//' (Kg/m2)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_MELTC(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ IF(LAGRIP)THEN
+ YRECFM='IRRIGC_ISBA'
+ YCOMMENT='X_Y_'//YRECFM//' (Kg/m2)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_IRRIG_FLUXC(:),IRESP,HCOMMENT=YCOMMENT)
+ ENDIF
+ !
+ IF(LGLACIER)THEN
+ YRECFM='ICE_FC_ISBA'
+ YCOMMENT='X_Y_'//YRECFM//' (Kg/m2)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_ICEFLUXC(:),IRESP,HCOMMENT=YCOMMENT)
+ ENDIF
+ !
+ IF(LFLOOD)THEN
+ !
+ YRECFM='IFLOODC_ISBA'
+ YCOMMENT='X_Y_'//YRECFM//' (Kg/m2)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_IFLOODC(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='PFLOODC_ISBA'
+ YCOMMENT='X_Y_'//YRECFM//' (Kg/m2)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_PFLOODC(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='LEFC_ISBA'
+ YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LE_FLOODC(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='LEIFC_ISBA'
+ YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LEI_FLOODC(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ ENDIF
+ !
+ YRECFM='RNC_ISBA'
+ YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_RNC(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='HC_ISBA'
+ YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_HC(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='LEC_ISBA'
+ YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LEC(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='LEIC_ISBA'
+ YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LEIC(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='GFLUXC_ISBA'
+ YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_GFLUXC(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ IF (LRAD_BUDGET .OR. (LSURF_BUDGETC .AND. .NOT.LRESET_BUDGETC)) THEN
+ !
+ YRECFM='SWDC_ISBA'
+ YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_SWDC(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='SWUC_ISBA'
+ YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_SWUC(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='LWDC_ISBA'
+ YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LWDC(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='LWUC_ISBA'
+ YCOMMENT='X_Y_'//YRECFM//' (J/m2)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_LWUC(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ ENDIF
+ !
+ YRECFM='FMUC_ISBA'
+ YCOMMENT='X_Y_'//YRECFM//' (Pa.s)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_FMUC(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='FMVC_ISBA'
+ YCOMMENT='X_Y_'//YRECFM//' (Pa.s)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_FMVC(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ IF(CPHOTO/='NON')THEN
+ !
+ YRECFM='GPPC_ISBA'
+ YCOMMENT='X_Y_'//YRECFM//' (kgCO2/m2/s)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_GPPC(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='RC_AUTO_ISBA'
+ YCOMMENT='X_Y_'//YRECFM//' (kgCO2/m2/s)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_RESPC_AUTO(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='RC_ECO_ISBA'
+ YCOMMENT='X_Y_'//YRECFM//' (kgCO2/m2/s)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_RESPC_ECO(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ ENDIF
+ !
+ IF(LWATER_BUDGET .OR. (LSURF_BUDGETC .AND. .NOT.LRESET_BUDGETC))THEN
+ !
+ YRECFM='RAINFC_ISBA'
+ YCOMMENT='cumulated input rainfall rate (Kg/m2)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XRAINFALLC(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='SNOWFC_ISBA'
+ YCOMMENT='cumulated input snowfall rate (Kg/m2)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XSNOWFALLC(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='DWGC_ISBA'
+ YCOMMENT='cumulated change in liquid soil moisture (Kg/m2)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_DWGC(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='DWGIC_ISBA'
+ YCOMMENT='cumulated change in solid soil moisture (Kg/m2)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_DWGIC(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='DWRC_ISBA'
+ YCOMMENT='cumulated change in water on canopy (Kg/m2)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_DWRC(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='DSWEC_ISBA'
+ YCOMMENT='cumulated change in snow water equivalent (Kg/m2)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_DSWEC(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='WATBUDC_ISBA'
+ YCOMMENT='cumulated isba water budget as residue (Kg/m2)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_WATBUDC(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ ENDIF
+ !
+ENDIF
+!
+!* 6. parameters at 2 and 10 meters :
+! -------------------------------
+!
+IF (N2M>=1) THEN
+ !
+ YRECFM='T2M_ISBA'
+ YCOMMENT='X_Y_'//YRECFM//' (K)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_T2M(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='T2MMIN_ISBA'
+ YCOMMENT='X_Y_'//YRECFM//' (K)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_T2M_MIN(:),IRESP,HCOMMENT=YCOMMENT)
+ XAVG_T2M_MIN(:)=XUNDEF
+ !
+ YRECFM='T2MMAX_ISBA'
+ YCOMMENT='X_Y_'//YRECFM//' (K)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_T2M_MAX(:),IRESP,HCOMMENT=YCOMMENT)
+ XAVG_T2M_MAX(:)=0.0
+ !
+ YRECFM='Q2M_ISBA'
+ YCOMMENT='X_Y_'//YRECFM//' (KG/KG)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_Q2M(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='HU2M_ISBA'
+ YCOMMENT='X_Y_'//YRECFM//' (-)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_HU2M(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='HU2MMIN_ISBA'
+ YCOMMENT='X_Y_'//YRECFM//' (-)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_HU2M_MIN(:),IRESP,HCOMMENT=YCOMMENT)
+ XAVG_HU2M_MIN(:)=XUNDEF
+ !
+ YRECFM='HU2MMAX_ISBA'
+ YCOMMENT='X_Y_'//YRECFM//' (-)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_HU2M_MAX(:),IRESP,HCOMMENT=YCOMMENT)
+ XAVG_HU2M_MAX(:)=-XUNDEF
+ !
+ YRECFM='ZON10M_ISBA'
+ YCOMMENT='X_Y_'//YRECFM//' (M/S)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_ZON10M(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='MER10M_ISBA'
+ YCOMMENT='X_Y_'//YRECFM//' (M/S)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_MER10M(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='W10M_ISBA'
+ YCOMMENT='X_Y_'//YRECFM//' (M/S)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_WIND10M(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='W10MMAX_ISBA'
+ YCOMMENT='X_Y_'//YRECFM//' (M/S)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_WIND10M_MAX(:),IRESP,HCOMMENT=YCOMMENT)
+ XAVG_WIND10M_MAX(:)=0.0
+ !
+ YRECFM='SFCO2_ISBA'
+ YCOMMENT='X_Y_'//YRECFM//' (KG/M2/S)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_SFCO2(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+END IF
+!----------------------------------------------------------------------------
+!
+!* 7. Transfer coefficients
+! ---------------------
+!
+IF (LCOEF) THEN
+ !
+ YRECFM='CD_ISBA'
+ YCOMMENT='X_Y_'//YRECFM
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_CD(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='CH_ISBA'
+ YCOMMENT='X_Y_'//YRECFM
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_CH(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='CE_ISBA'
+ YCOMMENT='X_Y_'//YRECFM
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_CE(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='Z0_ISBA'
+ YCOMMENT='X_Y_'//YRECFM//' (M)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_Z0(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='Z0H_ISBA'
+ YCOMMENT='X_Y_'//YRECFM//' (M)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_Z0H(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ENDIF
+!
+!----------------------------------------------------------------------------
+!
+!* 8. Surface humidity
+! ----------------
+IF (LSURF_VARS) THEN
+ !
+ YRECFM='QS_ISBA'
+ YCOMMENT='X_Y_'//YRECFM//' (KG/KG)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAVG_QS(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ENDIF
+!
+!----------------------------------------------------------------------------
+!
+!* 9. Diag of prognostic fields
+! -------------------------
+!
+IF (LPROVAR_TO_DIAG) CALL PROVAR_TO_DIAG
+!
+!----------------------------------------------------------------------------
+!
+!User want (or not) patch output
+IF(LPATCH_BUDGET.AND.(NPATCH >1))THEN
+ !----------------------------------------------------------------------------
+ !
+ !* 10. Richardson number (for each patch)
+ ! -----------------
+ !
+ IF (N2M>=1) THEN
+ !
+ YRECFM='RI_P'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='-'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XRI(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ END IF
+ !
+ !* 11. Energy fluxes :(for each patch)
+ ! -------------
+ !
+ IF (LSURF_BUDGET) THEN
+ !
+ YRECFM='RN_P'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='W/m2'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XRN(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ YRECFM='H_P'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='W/m2'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XH(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ YRECFM='LE_P'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='W/m2'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XLE(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ YRECFM='LEI_P'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='W/m2'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XLEI(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ YRECFM='GFLUX_P'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='W/m2'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XGFLUX(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ IF (LRAD_BUDGET .OR. (LSURF_BUDGETC .AND. .NOT.LRESET_BUDGETC)) THEN
+ !
+ YRECFM='SWD_P'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='W/m2'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XSWD(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ YRECFM='SWU_P'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='W/m2'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XSWU(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ YRECFM='LWD_P'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='W/m2'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XLWD(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ YRECFM='LWU_P'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='W/m2'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XLWU(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ DO JSW=1, SIZE(XSWBD,2)
+ YNUM=ACHAR(48+JSW)
+ !
+ YRECFM='SWD_P'//YNUM
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='W/m2'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XSWBD(:,JSW,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ YRECFM='SWU_P'//YNUM
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='W/m2'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XSWBU(:,JSW,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ ENDDO
+ !
+ ENDIF
+ !
+ YRECFM='FMU_P'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='Pa'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XFMU(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ YRECFM='FMV_P'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='Pa'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XFMV(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ END IF
+ !
+ !* 12. Specific Energy fluxes :(for each patch)
+ ! ----------------------------------------
+ !
+ IF (LSURF_EVAP_BUDGET) THEN
+ !
+ YRECFM='LEG_P'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='W/m2'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XLEG(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ YRECFM='LEGI_P'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='W/m2'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XLEGI(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ YRECFM='LEV_P'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='W/m2'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XLEV(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ YRECFM='LES_P'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='W/m2'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XLES(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ IF(TSNOW%SCHEME=='3-L' .OR. TSNOW%SCHEME=='CRO')THEN
+ YRECFM='LESL_P'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='W/m2'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XLESL(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ ENDIF
+ !
+ YRECFM='LER_P'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='W/m2'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XLER(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ YRECFM='LETR_P'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='W/m2'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XLETR(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ YRECFM='EVAP_P'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='Kg/m2/s'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XEVAP(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ YRECFM='DRAIN_P'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='Kg/m2/s'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XDRAIN(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ YRECFM='RUNOFF_P'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='Kg/m2/s'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XRUNOFF(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ IF(CHORT=='SGH'.OR.CISBA=='DIF')THEN
+ YRECFM='HORTON_P'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='Kg/m2/s'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XHORT(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ ENDIF
+ !
+ YRECFM='DRIVEG_P'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='Kg/m2/s'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XDRIP(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ YRECFM='RRVEG_P'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='Kg/m2/s'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XRRVEG(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ YRECFM='SNOMLT_P'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='Kg/m2/s'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XMELT(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ IF(LAGRIP)THEN
+ YRECFM='IRRIG_P'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='Kg/m2/s'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XIRRIG_FLUX(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ ENDIF
+ !
+ IF(LFLOOD)THEN
+ !
+ YRECFM='IFLOOD_P'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='Kg/m2/s'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XIFLOOD(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ YRECFM='PFLOOD_P'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='Kg/m2/s'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XPFLOOD(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ YRECFM='LEF_P'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='W/m2'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XLE_FLOOD(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ YRECFM='LEIF_P'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='W/m2'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XLEI_FLOOD(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ ENDIF
+ !
+ IF(CPHOTO/='NON')THEN
+ !
+ YRECFM='GPP_P'
+ YCOMMENT='gross primary production per patch'
+ YCOMMENTUNIT='kgCO2/m2/s'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XGPP(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ YRECFM='R_AUTO_P'
+ YCOMMENT='autotrophic respiration per patch'
+ YCOMMENTUNIT='kgCO2/m2/s'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XRESP_AUTO(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ YRECFM='R_ECO_P'
+ YCOMMENT='ecosystem respiration per patch'
+ YCOMMENTUNIT='kgCO2/m2/s'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XRESP_ECO(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ ENDIF
+ !
+ IF(LWATER_BUDGET)THEN
+ !
+ YRECFM='DWG_P'
+ YCOMMENT='change in liquid soil moisture per patch'
+ YCOMMENTUNIT='Kg/m2/s'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XDWG(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ YRECFM='DWGI_P'
+ YCOMMENT='change in solid soil moisture per patch'
+ YCOMMENTUNIT='Kg/m2/s'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XDWGI(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ YRECFM='DWR_P'
+ YCOMMENT='change in water on canopy per patch'
+ YCOMMENTUNIT='Kg/m2/s'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XDWR(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ YRECFM='DSWE_P'
+ YCOMMENT='change in snow water equivalent per patch'
+ YCOMMENTUNIT='Kg/m2/s'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XDSWE(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ YRECFM='WATBUD_P'
+ YCOMMENT='isba water budget as residue per patch'
+ YCOMMENTUNIT='Kg/m2/s'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XWATBUD(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ ENDIF
+ !
+ ENDIF
+ !
+ !* 13. surface temperature parameters at 2 and 10 meters (for each patch):
+ ! -------------------------------------------------------------------
+ !
+ IF (N2M>=1) THEN
+ !
+ YRECFM='T2M_P'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='K'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XT2M(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ YRECFM='Q2M_P'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='KG/KG'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XQ2M(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ YRECFM='HU2M_P'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='PERCENT'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XHU2M(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ YRECFM='ZON10M_P'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='M/S'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XZON10M(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ YRECFM='MER10M_P'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='M/S'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XMER10M(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ YRECFM='W10M_P'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='M/S'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XWIND10M(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ END IF
+ !
+ !* 14. Cumulated Energy fluxes :(for each patch)
+ ! -----------------------------------------
+ !
+ IF (LSURF_BUDGETC) THEN
+ !
+ YRECFM='LEGC_P'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='J/m2'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XLEGC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ YRECFM='LEGIC_P'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='J/m2'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XLEGIC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ YRECFM='LEVC_P'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='J/m2'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XLEVC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ YRECFM='LESC_P'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='J/m2'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XLESC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ IF(TSNOW%SCHEME=='3-L' .OR. TSNOW%SCHEME=='CRO')THEN
+ YRECFM='LESLC_P'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='J/m2'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XLESLC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ ENDIF
+ !
+ YRECFM='LERC_P'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='J/m2'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XLERC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ YRECFM='LETRC_P'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='J/m2'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XLETRC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ YRECFM='EVAPC_P'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='Kg/m2'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XEVAPC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ YRECFM='DRAINC_P'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='Kg/m2'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XDRAINC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ YRECFM='RUNOFFC_P'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='Kg/m2'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XRUNOFFC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ IF(CHORT=='SGH'.OR.CISBA=='DIF')THEN
+ YRECFM='HORTONC_P'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='Kg/m2'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XHORTC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ ENDIF
+ !
+ YRECFM='DRIVEGC_P'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='Kg/m2'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XDRIPC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ YRECFM='RRVEGC_P'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='Kg/m2'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XRRVEGC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ YRECFM='SNOMLTC_P'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='Kg/m2'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XMELTC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ IF(LAGRIP)THEN
+ YRECFM='IRRIGC_P'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='Kg/m2'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XIRRIG_FLUXC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ ENDIF
+ !
+ IF(LGLACIER)THEN
+ YRECFM='ICE_FC_P'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='Kg/m2'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XICEFLUXC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ ENDIF
+ !
+ IF(LFLOOD)THEN
+ !
+ YRECFM='IFLOODC_P'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='Kg/m2/s'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XIFLOODC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ YRECFM='PFLOODC_P'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='Kg/m2/s'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XPFLOODC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ YRECFM='LEFC_P'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='W/m2'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XLE_FLOODC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ YRECFM='LEIFC_P'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='W/m2'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XLEI_FLOODC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ ENDIF
+ !
+ YRECFM='RNC_P'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='J/m2'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XRNC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ YRECFM='HC_P'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='J/m2'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XHC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ YRECFM='LEC_P'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='J/m2'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XLEC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ YRECFM='LEIC_P'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='J/m2'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XLEIC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ YRECFM='GFLUXC_P'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='J/m2'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XGFLUXC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ IF (LRAD_BUDGET) THEN
+ !
+ YRECFM='SWDC_P'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='J/m2'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XSWDC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ YRECFM='SWUC_P'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='J/m2'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XSWUC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ YRECFM='LWDC_P'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='J/m2'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XLWDC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ YRECFM='LWUC_P'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='J/m2'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XLWUC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ ENDIF
+ !
+ YRECFM='FMUC_P'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='Pa.s'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XFMUC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ YRECFM='FMVC_P'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='Pa.s'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XFMVC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ IF(CPHOTO/='NON')THEN
+ !
+ YRECFM='GPPC_P'
+ YCOMMENT='cumulated gross primary production per patch'
+ YCOMMENTUNIT='kgCO2/m2'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XGPPC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ YRECFM='RC_AUTO_P'
+ YCOMMENT='cumulated autotrophic respiration per patch'
+ YCOMMENTUNIT='kgCO2/m2'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XRESPC_AUTO(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ YRECFM='RC_ECO_P'
+ YCOMMENT='cumulated ecosystem respiration per patch'
+ YCOMMENTUNIT='kgCO2/m2'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XRESPC_ECO(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ ENDIF
+ !
+ IF(LWATER_BUDGET .OR. (LSURF_BUDGETC .AND. .NOT.LRESET_BUDGETC))THEN
+ !
+ YRECFM='DWGC_P'
+ YCOMMENT='cumulated change in liquid soil moisture per patch'
+ YCOMMENTUNIT='Kg/m2'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XDWGC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ YRECFM='DWGIC_P'
+ YCOMMENT='cumulated change in solid soil moisture per patch'
+ YCOMMENTUNIT='Kg/m2'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XDWGIC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ YRECFM='DWRC_P'
+ YCOMMENT='cumulated change in water soil moisture per patch'
+ YCOMMENTUNIT='Kg/m2'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XDWRC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ YRECFM='DSWEC_P'
+ YCOMMENT='cumulated change in snow water equivalent per patch'
+ YCOMMENTUNIT='Kg/m2'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XDSWEC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ YRECFM='WATBUDC_P'
+ YCOMMENT='cumulated isba water budget as residue per patch'
+ YCOMMENTUNIT='Kg/m2'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XWATBUDC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ ENDIF
+ !
+ ENDIF
+ !-------------------------------------------------------------------------------
+ENDIF
+!User want (or not) patch output
+!-------------------------------------------------------------------------------
+!
+!* 15. chemical diagnostics:
+! --------------------
+!
+IF (NBEQ>0 .AND. CCH_DRY_DEP=="WES89 ") THEN
+ !
+ DO JSV = 1,SIZE(CCH_NAMES,1)
+ YRECFM='DV_NAT_'//TRIM(CCH_NAMES(JSV))
+ WRITE(YCOMMENT,'(A13,I3.3)')'DV_NAT_',JSV
+ YCOMMENTUNIT='m/s'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XDEP(:,JSV,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ END DO
+ !
+ENDIF
+!
+IF (NBEQ>0 .AND. LCH_BIO_FLUX) THEN
+ !
+ IF (ASSOCIATED(XFISO)) THEN
+ YRECFM='FISO'
+ WRITE(YCOMMENT,'(A21)')'FISO (molecules/m2/s)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XFISO(:),IRESP,HCOMMENT=YCOMMENT)
+ END IF
+ !
+ IF (ASSOCIATED(XFISO)) THEN
+ YRECFM='FMONO'
+ WRITE(YCOMMENT,'(A22)')'FMONO (molecules/m2/s)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XFMONO(:),IRESP,HCOMMENT=YCOMMENT)
+ END IF
+ !
+ENDIF
+!
+IF (LCH_NO_FLUX) THEN
+ IF (ASSOCIATED(XNOFLUX)) THEN
+ YRECFM='NOFLUX'
+ WRITE(YCOMMENT,'(A21)')'NOFLUX (molecules/m2/s)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XNOFLUX(:),IRESP,HCOMMENT=YCOMMENT)
+ END IF
+END IF
+!
+IF (NDSTEQ > 0)THEN
+ !
+ DO JSV = 1,NDSTMDE ! for all dust modes
+ WRITE(YRECFM,'(A7,I3.3)')'FLX_DST',JSV
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='kg/m2/s'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XSFDST(:,JSV,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ END DO
+ !
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+! End of IO
+!
+ CALL END_IO_SURF_n(HPROGRAM)
+IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_SEB_ISBA_N',1,ZHOOK_HANDLE)
+!
+CONTAINS
+!
+!-------------------------------------------------------------------------------
+!
+SUBROUTINE PROVAR_TO_DIAG
+!
+REAL, DIMENSION(SIZE(XTG,1)) :: ZPATCH, ZWORK
+REAL, DIMENSION(SIZE(XWG,1),SIZE(XWG,2)) :: ZWG
+REAL, DIMENSION(SIZE(XWG,1),SIZE(XWG,2)) :: ZWGI
+REAL, DIMENSION(SIZE(XWG,1),SIZE(XWG,2)) :: ZMOIST
+REAL, DIMENSION(SIZE(XWG,1),SIZE(XWG,2)) :: ZICE
+REAL, DIMENSION(SIZE(XTG,1),SIZE(XTG,2)) :: ZTG
+REAL, DIMENSION(SIZE(XDG,1),SIZE(XDG,2)) :: ZDG_TOT
+REAL, DIMENSION(SIZE(XDG,1),SIZE(XDG,2),SIZE(XDG,3)) :: ZDG
+!
+REAL, DIMENSION(SIZE(XDG,1),NNBIOMASS) :: ZBIOMASS
+REAL, DIMENSION(SIZE(XDG,1),NNSOILCARB) :: ZSOILCARB
+REAL, DIMENSION(SIZE(XDG,1),NNLITTLEVS) :: ZLIGNIN_STRUC
+REAL, DIMENSION(SIZE(XDG,1),NNLITTER,NNLITTLEVS) :: ZLITTER
+!
+ CHARACTER(LEN=8 ) :: YUNIT
+ CHARACTER(LEN=4 ) :: YLVL
+INTEGER :: JLAYER, JPATCH, JJ, INI, IWORK, IDEPTH
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_SEB_ISBA_N:PROVAR_TO_DIAG',0,ZHOOK_HANDLE)
+!
+INI=SIZE(XDG,1)
+!
+! * soil temperatures (K)
+!
+IF(LTEMP_ARP)THEN
+ IWORK=NTEMPLAYER_ARP
+ELSEIF(CISBA/='DIF')THEN
+ IWORK=NGROUND_LAYER-1
+ELSE
+ IWORK=NGROUND_LAYER
+ENDIF
+!
+ZTG(:,:)=0.0
+DO JPATCH=1,NPATCH
+ DO JLAYER=1,IWORK
+ DO JJ=1,INI
+ ZTG(JJ,JLAYER) = ZTG(JJ,JLAYER) + XPATCH(JJ,JPATCH) * XTG(JJ,JLAYER,JPATCH)
+ ENDDO
+ ENDDO
+ENDDO
+!
+DO JLAYER=1,IWORK
+ WRITE(YLVL,'(I4)') JLAYER
+ YRECFM='TG'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
+ YRECFM=YRECFM(:LEN_TRIM(YRECFM))//'_ISBA'
+ YCOMMENT='X_Y_'//YRECFM//' (K)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,ZTG(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
+END DO
+!
+! * Compute soil liquid and ice water content (kg/m2 and m3/m3)
+!
+ZWG (:,:)=0.0
+ZWGI(:,:)=0.0
+ZDG_TOT(:,:)=0.0
+ZMOIST (:,:)=XUNDEF
+ZICE (:,:)=XUNDEF
+!
+IF(CISBA=='DIF')THEN
+ !
+ IWORK = NWG_SIZE
+ !
+ DO JPATCH=1,NPATCH
+ DO JLAYER=1,NGROUND_LAYER
+ DO JJ=1,INI
+!
+! liquid and ice water content
+ IDEPTH=NWG_LAYER(JJ,JPATCH)
+ IF(JLAYER<=IDEPTH)THEN
+ ZWG (JJ,JLAYER)=ZWG (JJ,JLAYER)+XPATCH(JJ,JPATCH)*XWG (JJ,JLAYER,JPATCH)*XDZG(JJ,JLAYER,JPATCH)
+ ZWGI (JJ,JLAYER)=ZWGI (JJ,JLAYER)+XPATCH(JJ,JPATCH)*XWGI(JJ,JLAYER,JPATCH)*XDZG(JJ,JLAYER,JPATCH)
+ ZDG_TOT(JJ,JLAYER)=ZDG_TOT(JJ,JLAYER)+XPATCH(JJ,JPATCH)*XDZG(JJ,JLAYER,JPATCH)
+ ENDIF
+!
+ ENDDO
+ ENDDO
+ ENDDO
+!
+ELSE
+ !
+ IWORK = NGROUND_LAYER
+ !
+ ZDG(:,1,:) = XDG(:,1,:)
+ ZDG(:,2,:) = XDG(:,2,:)
+ IF(CISBA=='3-L')THEN
+ ZDG(:,3,:) = XDG(:,3,:)-XDG(:,2,:)
+ ENDIF
+!
+ DO JPATCH=1,NPATCH
+ DO JLAYER=1,NGROUND_LAYER
+ DO JJ=1,INI
+ ZWG (JJ,JLAYER)=ZWG (JJ,JLAYER)+XPATCH(JJ,JPATCH)*XWG (JJ,JLAYER,JPATCH)*ZDG(JJ,JLAYER,JPATCH)
+ ZWGI (JJ,JLAYER)=ZWGI (JJ,JLAYER)+XPATCH(JJ,JPATCH)*XWGI(JJ,JLAYER,JPATCH)*ZDG(JJ,JLAYER,JPATCH)
+ ZDG_TOT(JJ,JLAYER)=ZDG_TOT(JJ,JLAYER)+XPATCH(JJ,JPATCH)*ZDG(JJ,JLAYER,JPATCH)
+ ENDDO
+ ENDDO
+ ENDDO
+!
+ENDIF
+!
+WHERE(ZDG_TOT(:,:)>0.0)
+ ZMOIST(:,:)=ZWG (:,:)*XRHOLW
+ ZICE (:,:)=ZWGI(:,:)*XRHOLW
+ ZWG (:,:)=ZWG (:,:)/ZDG_TOT(:,:)
+ ZWGI (:,:)=ZWGI(:,:)/ZDG_TOT(:,:)
+ELSEWHERE
+ ZMOIST(:,:)=XUNDEF
+ ZICE (:,:)=XUNDEF
+ ZWG (:,:)=XUNDEF
+ ZWGI (:,:)=XUNDEF
+ENDWHERE
+!
+! * soil liquid water content (m3/m3) and soil moisture (kg/m2)
+!
+YUNIT=' (m3/m3)'
+DO JLAYER=1,IWORK
+ WRITE(YLVL,'(I4)') JLAYER
+ YRECFM='WG'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
+ YRECFM=YRECFM(:LEN_TRIM(YRECFM))//'_ISBA'
+ YCOMMENT='X_Y_'//YRECFM//YUNIT
+ CALL WRITE_SURF(HPROGRAM,YRECFM,ZWG(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
+END DO
+!
+YUNIT=' (kg/m2)'
+DO JLAYER=1,IWORK
+ WRITE(YLVL,'(I4)') JLAYER
+ YRECFM='SOILM'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
+ YRECFM=YRECFM(:LEN_TRIM(YRECFM))//'_ISBA'
+ YCOMMENT='X_Y_'//YRECFM//YUNIT
+ CALL WRITE_SURF(HPROGRAM,YRECFM,ZMOIST(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
+END DO
+!
+! * soil ice water content (m3/m3) and soil ice mass (kg/m2)
+!
+IWORK=NGROUND_LAYER
+IF(CISBA/='DIF')THEN
+ IWORK=NGROUND_LAYER-1 ! No ice in the FR 3-layers
+ENDIF
+!
+YUNIT=' (m3/m3)'
+DO JLAYER=1,IWORK
+ WRITE(YLVL,'(I4)') JLAYER
+ YRECFM='WGI'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
+ YRECFM=YRECFM(:LEN_TRIM(YRECFM))//'_ISBA'
+ YCOMMENT='X_Y_'//YRECFM//' (kg/m2)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,ZWGI(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
+END DO
+!
+YUNIT=' (kg/m2)'
+DO JLAYER=1,IWORK
+ WRITE(YLVL,'(I4)') JLAYER
+ YRECFM='SOILI'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
+ YRECFM=YRECFM(:LEN_TRIM(YRECFM))//'_ISBA'
+ YCOMMENT='X_Y_'//YRECFM//YUNIT
+ CALL WRITE_SURF(HPROGRAM,YRECFM,ZICE(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
+END DO
+!
+! * water intercepted on leaves (kg/m2)
+!
+ZWORK(:)=0.0
+DO JPATCH=1,NPATCH
+ ZWORK(:) = ZWORK(:) + XPATCH(:,JPATCH) * XWR(:,JPATCH)
+ENDDO
+!
+YRECFM='WR_ISBA'
+YCOMMENT='X_Y_'//YRECFM//' (kg/m2)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,ZWORK(:),IRESP,HCOMMENT=YCOMMENT)
+!
+! * Glacier ice storage (semi-prognostic) (kg/m2)
+!
+IF(LGLACIER)THEN
+ !
+ ZWORK(:)=0.0
+ DO JPATCH=1,NPATCH
+ ZWORK(:) = ZWORK(:) + XPATCH(:,JPATCH) * XICE_STO(:,JPATCH)
+ ENDDO
+ !
+ YRECFM='ICE_STO_ISBA'
+ YCOMMENT='X_Y_'//YRECFM//' (kg/m2)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,ZWORK(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ENDIF
+!
+! * Snow albedo (-)
+!
+ZPATCH(:) = 0.0
+ZWORK (:) = 0.0
+DO JPATCH=1,NPATCH
+ WHERE(TSNOW%ALB(:,JPATCH)/=XUNDEF)
+ ZWORK (:) = ZWORK(:) + XPATCH(:,JPATCH) * TSNOW%ALB(:,JPATCH)
+ ZPATCH(:) = ZPATCH(:) + XPATCH(:,JPATCH)
+ ENDWHERE
+ENDDO
+!
+WHERE(ZPATCH(:)>0.0)
+ ZWORK(:) = ZWORK(:) / ZPATCH(:)
+ELSEWHERE
+ ZWORK(:) = XUNDEF
+ENDWHERE
+!
+YRECFM='ASNOW_ISBA'
+YCOMMENT='X_Y_'//YRECFM//' (-)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,ZWORK(:),IRESP,HCOMMENT=YCOMMENT)
+!
+IF(TSNOW%SCHEME=='3-L' .OR. TSNOW%SCHEME=='CRO')THEN
+ !
+ ! * Snow reservoir (kg/m2) by layer
+ !
+ DO JLAYER = 1,TSNOW%NLAYER
+ !
+ ZWORK(:)=0.0
+ DO JPATCH=1,NPATCH
+ ZWORK(:) = ZWORK(:) + XPATCH(:,JPATCH) * TSNOW%WSNOW(:,JLAYER,JPATCH)
+ ENDDO
+ !
+ WRITE(YLVL,'(I4)') JLAYER
+ YRECFM='WSNOW_'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
+ YRECFM=YRECFM(:LEN_TRIM(YRECFM))//'_ISBA'
+ YCOMMENT='X_Y_'//YRECFM//' (kg/m2)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,ZWORK(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ ENDDO
+ !
+ ! * Snow depth (m)
+ !
+ DO JLAYER = 1,TSNOW%NLAYER
+ !
+ ZWORK(:)=0.0
+ DO JPATCH=1,NPATCH
+ ZWORK(:) = ZWORK(:) + XPATCH(:,JPATCH) * TSNOW%WSNOW(:,JLAYER,JPATCH)/TSNOW%RHO(:,JLAYER,JPATCH)
+ ENDDO
+ !
+ WRITE(YLVL,'(I4)') JLAYER
+ YRECFM='DSNOW_'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
+ YRECFM=YRECFM(:LEN_TRIM(YRECFM))//'_ISBA'
+ YCOMMENT='X_Y_'//YRECFM//' (kg/m2)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,ZWORK(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ ENDDO
+ !
+ ! * Snow temperature (k)
+ !
+ DO JLAYER = 1,TSNOW%NLAYER
+ !
+ ZWORK (:) = 0.0
+ ZPATCH(:) = 0.0
+ DO JPATCH=1,NPATCH
+ WHERE(TSNOW%WSNOW(:,JLAYER,JPATCH)>0.)
+ ZWORK (:) = ZWORK (:) + XPATCH(:,JPATCH) * TSNOW%TEMP(:,JLAYER,JPATCH)
+ ZPATCH(:) = ZPATCH(:) + XPATCH(:,JPATCH)
+ ENDWHERE
+ ENDDO
+ !
+ WHERE(ZPATCH(:)>0.0)
+ ZWORK(:) = ZWORK(:) / ZPATCH(:)
+ ELSEWHERE
+ ZWORK(:) = XUNDEF
+ ENDWHERE
+ !
+ WRITE(YLVL,'(I4)') JLAYER
+ YRECFM='TSNOW_'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
+ YRECFM=YRECFM(:LEN_TRIM(YRECFM))//'_ISBA'
+ YCOMMENT='X_Y_'//YRECFM//' (K)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,ZWORK(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ ENDDO
+ !
+ENDIF
+!
+! * Isba-Ags biomass reservoir
+!
+! * Isba-Ags biomass reservoir
+!
+IF(CPHOTO=='NIT'.OR.CPHOTO=='NCB')THEN
+!
+ ZBIOMASS(:,:)=0.0
+ DO JPATCH=1,NPATCH
+ DO JLAYER=1,NNBIOMASS
+ DO JJ=1,INI
+ ZBIOMASS(JJ,JLAYER) = ZBIOMASS(JJ,JLAYER) + XPATCH(JJ,JPATCH) * XBIOMASS(JJ,JLAYER,JPATCH)
+ ENDDO
+ ENDDO
+ ENDDO
+!
+ DO JLAYER = 1,NNBIOMASS
+ WRITE(YLVL,'(I4)') JLAYER
+ YRECFM='BIOM'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
+ YRECFM=YRECFM(:LEN_TRIM(YRECFM))//'_ISBA'
+ YCOMMENT='X_Y_'//YRECFM//' (kgDM/m2)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,ZBIOMASS(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
+ ENDDO
+!
+ENDIF
+!
+! * Isba-CC carbon reservoir
+!
+IF(CRESPSL=='CNT')THEN
+!
+ ZLITTER(:,:,:)=0.0
+ ZLIGNIN_STRUC(:,:)=0.0
+ DO JPATCH=1,NPATCH
+ DO JLAYER=1,NNLITTLEVS
+ DO JJ=1,INI
+ ZLITTER(JJ,1,JLAYER) = ZLITTER(JJ,1,JLAYER) + XPATCH(JJ,JPATCH) * XLITTER(JJ,1,JLAYER,JPATCH)
+ ZLITTER(JJ,2,JLAYER) = ZLITTER(JJ,2,JLAYER) + XPATCH(JJ,JPATCH) * XLITTER(JJ,2,JLAYER,JPATCH)
+ ZLIGNIN_STRUC(JJ,JLAYER) = ZLIGNIN_STRUC(JJ,JLAYER) + XPATCH(JJ,JPATCH) * XLIGNIN_STRUC(JJ,JLAYER,JPATCH)
+ ENDDO
+ ENDDO
+ ENDDO
+!
+ DO JLAYER=1,NNLITTLEVS
+ WRITE(YLVL,'(I4)') JLAYER
+ YRECFM='LIT1_'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
+ YRECFM=YRECFM(:LEN_TRIM(YRECFM))//'_ISBA'
+ YCOMMENT='X_Y_'//YRECFM//' (gC/m2)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,ZLITTER(:,1,JLAYER),IRESP,HCOMMENT=YCOMMENT)
+ WRITE(YLVL,'(I4)') JLAYER
+ YRECFM='LIT2_'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
+ YRECFM=YRECFM(:LEN_TRIM(YRECFM))//'_ISBA'
+ YCOMMENT='X_Y_'//YRECFM//' (gC/m2)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,ZLITTER(:,2,JLAYER),IRESP,HCOMMENT=YCOMMENT)
+ WRITE(YLVL,'(I4)') JLAYER
+ YRECFM='LIGSTR'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
+ YRECFM=YRECFM(:LEN_TRIM(YRECFM))//'_ISBA'
+ YCOMMENT='X_Y_'//YRECFM//' (-)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,ZLIGNIN_STRUC(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
+ END DO
+!
+ ZSOILCARB(:,:)=0.0
+ DO JPATCH=1,NPATCH
+ DO JLAYER=1,NNSOILCARB
+ DO JJ=1,INI
+ ZSOILCARB(JJ,JLAYER) = ZSOILCARB(JJ,JLAYER) + XPATCH(JJ,JPATCH) * XSOILCARB(JJ,JLAYER,JPATCH)
+ ENDDO
+ ENDDO
+ ENDDO
+!
+ DO JLAYER = 1,NNSOILCARB
+ WRITE(YLVL,'(I4)') JLAYER
+ YRECFM='SCARB'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
+ YRECFM=YRECFM(:LEN_TRIM(YRECFM))//'_ISBA'
+ YCOMMENT='X_Y_'//YRECFM//' (gC/m2)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,ZSOILCARB(:,JLAYER),IRESP,HCOMMENT=YCOMMENT)
+ ENDDO
+!
+ENDIF
+!
+IF (LHOOK) CALL DR_HOOK('WRITE_DIAG_SEB_ISBA_N:PROVAR_TO_DIAG',1,ZHOOK_HANDLE)
+!
+END SUBROUTINE PROVAR_TO_DIAG
+!
+END SUBROUTINE WRITE_DIAG_SEB_ISBA_n
diff --git a/src/SURFEX/write_surf_field2d.F90 b/src/SURFEX/write_surf_field2d.F90
new file mode 100644
index 000000000..eff3d83e5
--- /dev/null
+++ b/src/SURFEX/write_surf_field2d.F90
@@ -0,0 +1,134 @@
+!SURFEX_LIC Copyright 1994-2014 Meteo-France
+!SURFEX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SURFEX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SURFEX_LIC for details. version 1.
+! #########
+ SUBROUTINE WRITE_SURF_FIELD2D( HPROGRAM,PFIELD2D,HFIELDNAME,HCOMMENT,HCOMMENTUNIT,HDIR)
+! #####################################
+!
+!!**** *WRITE_SURF_FIELD2D* - writes surfex field in output file using WRITE_SURF,
+!! patch by patch if needed in MESONH
+!! with Z-parallel IO in MESO-NH, we force surfex to write 2D fields
+!! because Z-parallel IO are not supported for 2D SURFEX fields.
+!!
+!!
+!! PURPOSE
+!! -------
+!! writes surfex field in output file using WRITE_SURF,
+!! patch by patch if needed in MESONH
+!! and NB_PROCIO_W > 1
+!! examples of HFIELDNAME : 'TG', 'soil depth from ecoclimap'
+!! with Z-parallel IO in MESO-NH, we force surfex to write 2D fields
+!! because Z-parallel IO are not supported for 2D SURFEX fields.
+!!
+!!** METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!!
+!! AUTHOR
+!! ------
+!! M.Moge *LA - UPS*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 08/01/2016
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_SURF_PAR, ONLY : NUNDEF
+!
+USE MODI_WRITE_SURF
+#ifdef MNH
+USE MODI_GET_NB_PROCIO_WRITE_MNH
+#endif
+!
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of arguments
+! -------------------------
+!
+CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
+REAL, DIMENSION(:,:), INTENT(IN) :: PFIELD2D ! 2D field to be written
+CHARACTER(LEN=12), INTENT(IN) :: HFIELDNAME ! name of the field PFIELD2D. Example : 'X_Y_TG'
+CHARACTER(LEN=100), INTENT(IN) :: HCOMMENT ! Comment string
+CHARACTER(LEN=100), INTENT(IN) :: HCOMMENTUNIT ! unit of the datas in PFIELD2D
+ CHARACTER(LEN=1),OPTIONAL, INTENT(IN) :: HDIR ! type of field :
+! ! 'H' : field with
+! ! horizontal spatial dim.
+! ! '-' : no horizontal dim.
+!
+!* 0.2 Declarations of local variables
+! -------------------------------
+!
+INTEGER :: IRESP ! IRESP : return-code if a problem appears
+INTEGER :: IPATCH ! number of patches in PFIELD2D
+CHARACTER(LEN=16) :: YRECFM ! Name of the article to be read
+CHARACTER(LEN=4 ) :: YPATCH ! current patch
+CHARACTER(LEN=100):: YCOMMENT ! Comment string
+INTEGER :: INB_PROCIO ! number of processes used for Z-parallel IO with MESO-NH
+!
+CHARACTER(LEN=1) :: YDIR
+INTEGER :: JPATCH ! loop counter on patches
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+!------------------------------------------------------------------------------
+!
+!
+IF (LHOOK) CALL DR_HOOK('WRITE_SURF_FIELD2D',0,ZHOOK_HANDLE)
+!
+YDIR = 'H'
+IF (PRESENT(HDIR)) YDIR = HDIR
+!
+IPATCH = SIZE( PFIELD2D, 2 )
+!
+INB_PROCIO = 1
+#ifdef MNH
+IF (HPROGRAM=='MESONH') THEN
+ CALL GET_NB_PROCIO_WRITE_MNH( INB_PROCIO, IRESP )
+ENDIF
+#endif
+!
+IF ( INB_PROCIO > 1 ) THEN
+!
+ DO JPATCH=1,IPATCH
+ WRITE(YPATCH,'(I4.4)') JPATCH
+ YCOMMENT=ADJUSTL(HCOMMENT(:LEN_TRIM(HCOMMENT)))//'patch '//ADJUSTL(YPATCH(:LEN_TRIM(YPATCH)))// &
+ ' ('//ADJUSTL(HCOMMENTUNIT(:LEN_TRIM(HCOMMENTUNIT)))//')'
+ YRECFM=ADJUSTL(HFIELDNAME(:LEN_TRIM(HFIELDNAME)))
+ IF ( IPATCH > 1 ) THEN
+ YRECFM=ADJUSTL(YRECFM(:LEN_TRIM(YRECFM)))//YPATCH
+ ENDIF
+ CALL WRITE_SURF(HPROGRAM,YRECFM,PFIELD2D(:,JPATCH),IRESP,HCOMMENT=YCOMMENT,HDIR=YDIR)
+ ENDDO
+!
+ELSE
+!
+ YCOMMENT=ADJUSTL(HCOMMENT(:LEN_TRIM(HCOMMENT)))// &
+ ' ('//ADJUSTL(HCOMMENTUNIT(:LEN_TRIM(HCOMMENTUNIT)))//')'
+ YRECFM=ADJUSTL(HFIELDNAME(:LEN_TRIM(HFIELDNAME)))
+ CALL WRITE_SURF(HPROGRAM,YRECFM,PFIELD2D(:,:),IRESP,HCOMMENT=YCOMMENT,HDIR=YDIR)
+!
+ENDIF
+!
+IF (LHOOK) CALL DR_HOOK('WRITE_SURF_FIELD2D',1,ZHOOK_HANDLE)
+!
+!-------------------------------------------------------------------------------
+!
+ END SUBROUTINE WRITE_SURF_FIELD2D
\ No newline at end of file
diff --git a/src/SURFEX/write_surf_field3d.F90 b/src/SURFEX/write_surf_field3d.F90
new file mode 100644
index 000000000..c8dd94b0e
--- /dev/null
+++ b/src/SURFEX/write_surf_field3d.F90
@@ -0,0 +1,146 @@
+!SURFEX_LIC Copyright 1994-2014 Meteo-France
+!SURFEX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SURFEX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SURFEX_LIC for details. version 1.
+! #########
+ SUBROUTINE WRITE_SURF_FIELD3D( HPROGRAM,PFIELD3D,KFIRSTLAYER,KLASTLAYER,HFIELDNAME,HCOMMENT,HCOMMENTUNIT,HDIR)
+! #####################################
+!
+!!**** *WRITE_SURF_FIELD3D* - writes surfex field in output file using WRITE_SURF,
+!! layer by layer and patch by patch if needed in MESONH
+!! with Z-parallel IO in MESO-NH, we force surfex to write 2D fields
+!! because Z-parallel IO are not supported for 3D SURFEX fields.
+!!
+!!
+!! PURPOSE
+!! -------
+!! writes surfex field in output file using WRITE_SURF, layer by layer
+!! and patch by patch if needed in MESONH
+!! and NB_PROCIO_W > 1
+!! examples of HFIELDNAME : 'TG', 'soil depth from ecoclimap'
+!! with Z-parallel IO in MESO-NH, we force surfex to write 2D fields
+!! because Z-parallel IO are not supported for 3D SURFEX fields.
+!!
+!!** METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!!
+!! AUTHOR
+!! ------
+!! M.Moge *LA - UPS*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 08/01/2016
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_SURF_PAR, ONLY : NUNDEF
+!
+USE MODI_WRITE_SURF
+#ifdef MNH
+USE MODI_GET_NB_PROCIO_WRITE_MNH
+#endif
+!
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of arguments
+! -------------------------
+!
+CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! calling program
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PFIELD3D ! 3D field to be written
+INTEGER, INTENT(IN) :: KFIRSTLAYER ! first layer of PFIELD3D to be written
+INTEGER, INTENT(IN) :: KLASTLAYER ! last layer of PFIELD3D to be written
+CHARACTER(LEN=12), INTENT(IN) :: HFIELDNAME ! name of the field PFIELD3D. Example : 'X_Y_TG'
+CHARACTER(LEN=100), INTENT(IN) :: HCOMMENT ! Comment string
+CHARACTER(LEN=100), INTENT(IN) :: HCOMMENTUNIT ! unit of the datas in PFIELD3D
+ CHARACTER(LEN=1),OPTIONAL, INTENT(IN) :: HDIR ! type of field :
+! ! 'H' : field with
+! ! horizontal spatial dim.
+! ! '-' : no horizontal dim.
+!
+!* 0.2 Declarations of local variables
+! -------------------------------
+!
+INTEGER :: IRESP ! IRESP : return-code if a problem appears
+INTEGER :: ILAYER ! number of layers in PFIELD3D
+INTEGER :: IPATCH ! number of patches in PFIELD3D
+CHARACTER(LEN=16) :: YRECFM ! Name of the article to be read
+CHARACTER(LEN=4 ) :: YLVL ! current level/layer
+CHARACTER(LEN=4 ) :: YPATCH ! current patch
+CHARACTER(LEN=100):: YCOMMENT ! Comment string
+INTEGER :: INB_PROCIO ! number of processes used for Z-parallel IO with MESO-NH
+!
+CHARACTER(LEN=1) :: YDIR
+INTEGER :: JJ, JLAYER ! loop counter on levels
+INTEGER :: JPATCH ! loop counter on patches
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+!------------------------------------------------------------------------------
+!
+!
+IF (LHOOK) CALL DR_HOOK('WRITE_SURF_FIELD3D',0,ZHOOK_HANDLE)
+!
+YDIR = 'H'
+IF (PRESENT(HDIR)) YDIR = HDIR
+!
+ILAYER = SIZE( PFIELD3D, 2 )
+IPATCH = SIZE( PFIELD3D, 3 )
+!
+INB_PROCIO = 1
+#ifdef MNH
+IF (HPROGRAM=='MESONH') THEN
+ CALL GET_NB_PROCIO_WRITE_MNH( INB_PROCIO, IRESP )
+ENDIF
+#endif
+!
+IF ( INB_PROCIO > 1 ) THEN
+!
+ DO JLAYER=KFIRSTLAYER,KLASTLAYER
+ WRITE(YLVL,'(I4)') JLAYER
+ DO JPATCH=1,IPATCH
+ WRITE(YPATCH,'(I4.4)') JPATCH
+ YCOMMENT=ADJUSTL(HCOMMENT(:LEN_TRIM(HCOMMENT)))//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))//'patch '// &
+ ADJUSTL(YPATCH(:LEN_TRIM(YPATCH)))//' ('//ADJUSTL(HCOMMENTUNIT(:LEN_TRIM(HCOMMENTUNIT)))//')'
+ YRECFM=ADJUSTL(HFIELDNAME(:LEN_TRIM(HFIELDNAME)))//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
+ IF ( IPATCH > 1 ) THEN
+ YRECFM=ADJUSTL(YRECFM(:LEN_TRIM(YRECFM)))//YPATCH
+ ENDIF
+ CALL WRITE_SURF(HPROGRAM,YRECFM,PFIELD3D(:,JLAYER,JPATCH),IRESP,HCOMMENT=YCOMMENT,HDIR=YDIR)
+ ENDDO
+ END DO
+!
+ELSE
+!
+ DO JLAYER=KFIRSTLAYER,KLASTLAYER
+ WRITE(YLVL,'(I4)') JLAYER
+ YCOMMENT=ADJUSTL(HCOMMENT(:LEN_TRIM(HCOMMENT)))//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))// &
+ ' ('//ADJUSTL(HCOMMENTUNIT(:LEN_TRIM(HCOMMENTUNIT)))//')'
+ YRECFM=ADJUSTL(HFIELDNAME(:LEN_TRIM(HFIELDNAME)))//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
+ CALL WRITE_SURF(HPROGRAM,YRECFM,PFIELD3D(:,JLAYER,:),IRESP,HCOMMENT=YCOMMENT,HDIR=YDIR)
+ END DO
+!
+ENDIF
+!
+IF (LHOOK) CALL DR_HOOK('WRITE_SURF_FIELD3D',1,ZHOOK_HANDLE)
+!
+!-------------------------------------------------------------------------------
+!
+ END SUBROUTINE WRITE_SURF_FIELD3D
\ No newline at end of file
diff --git a/src/SURFEX/writesurf_ch_emisn.F90 b/src/SURFEX/writesurf_ch_emisn.F90
index b6fae0d40..d493638d0 100644
--- a/src/SURFEX/writesurf_ch_emisn.F90
+++ b/src/SURFEX/writesurf_ch_emisn.F90
@@ -1,179 +1,183 @@
-!SURFEX_LIC Copyright 1994-2014 Meteo-France
-!SURFEX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SURFEX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SURFEX_LIC for details. version 1.
-! #########
- SUBROUTINE WRITESURF_CH_EMIS_n(HPROGRAM)
-! ##########################################################
-!
-!!**** *WRITESURF_CH_EMIS_n* - routine to write chemistry emission fields
-!!
-!! PURPOSE
-!! -------
-!!
-!! AUTHOR
-!! ------
-!! V. Masson *Meteo France*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 03/2004
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_CH_EMIS_FIELD_n,ONLY : NEMIS_NBR, CEMIS_AREA, CEMIS_NAME, &
- CEMIS_COMMENT, NEMIS_TIME, XEMIS_FIELDS
-USE MODI_WRITE_SURF
-!
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-USE MODI_ABOR1_SFX
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of arguments
-! -------------------------
-!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling
-!
-!* 0.2 Declarations of local variables
-! -------------------------------
-!
-INTEGER :: IRESP ! IRESP : return-code if a problem appears
- ! at the open of the file in LFI routines
-!
- CHARACTER(LEN=12) :: YRECFM ! Name of the article to be written
- CHARACTER(LEN=100):: YCOMMENT ! Comment string
- CHARACTER(LEN=80) :: YNAME ! emitted species name
-!
-INTEGER :: JI,JT ! loop indices
-INTEGER :: JSPEC ! loop index
-LOGICAL :: GFOUND,LOK
- CHARACTER(LEN=40),DIMENSION(NEMIS_NBR) :: YEMISPEC_NAMES
-INTEGER, DIMENSION(NEMIS_NBR) :: INBTIMES
-INTEGER, DIMENSION(NEMIS_NBR) :: IFIRST,ILAST,INEXT
-INTEGER :: INTIMESMAX,ITMP
-INTEGER :: IEMISPEC_NBR
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-
-!-------------------------------------------------------------------------------
-!
-!* 1. Chemical Emission fields :
-! --------------------------
-!
-IF (LHOOK) CALL DR_HOOK('WRITESURF_CH_EMIS_N',0,ZHOOK_HANDLE)
-YRECFM='EMISFILE_NBR'
-YCOMMENT='Total number of 2D emission files.'
- CALL WRITE_SURF(HPROGRAM,YRECFM,NEMIS_NBR,IRESP,HCOMMENT=YCOMMENT)
-!
-! count emitted species
-IEMISPEC_NBR = 0
-DO JI=1,NEMIS_NBR
- YNAME = TRIM(ADJUSTL(CEMIS_NAME(JI)))
- GFOUND = .FALSE.
- DO JSPEC = 1,IEMISPEC_NBR
- IF (YEMISPEC_NAMES(JSPEC) == YNAME) THEN
- GFOUND = .TRUE.
- EXIT
- END IF
- END DO
- IF (.NOT. GFOUND) THEN
- IEMISPEC_NBR = IEMISPEC_NBR+1
- YEMISPEC_NAMES(IEMISPEC_NBR) = YNAME
- INBTIMES(IEMISPEC_NBR) = 1
- IFIRST(IEMISPEC_NBR) = JI
- ILAST(IEMISPEC_NBR) = JI
- INEXT(JI) = 0
- ELSE
- INEXT(ILAST(JSPEC)) = JI
- INEXT(JI) = 0
- ILAST(JSPEC) = JI
- INBTIMES(JSPEC) = INBTIMES(JSPEC)+1
- END IF
-END DO
-!
-YRECFM='EMISPEC_NBR '
-YCOMMENT='Number of emitted chemical species.'
- CALL WRITE_SURF(HPROGRAM,YRECFM,IEMISPEC_NBR,IRESP,HCOMMENT=YCOMMENT)
-!
-IF (IEMISPEC_NBR > 0) THEN
- !
- DO JSPEC = 1,IEMISPEC_NBR
- CALL WRITE_EMIS_SPEC(INBTIMES(JSPEC))
- ENDDO
- !
-ENDIF
-!
-IF (LHOOK) CALL DR_HOOK('WRITESURF_CH_EMIS_N',1,ZHOOK_HANDLE)
-!
-!-------------------------------------------------------------------------------
-CONTAINS
-!
-SUBROUTINE WRITE_EMIS_SPEC(KSIZE)
-!
-INTEGER, INTENT(IN) :: KSIZE
-INTEGER,DIMENSION(KSIZE) :: ITIME
-INTEGER,DIMENSION(KSIZE) :: IINDEX
-REAL,DIMENSION(SIZE(XEMIS_FIELDS,1),KSIZE) :: ZWORK2D
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-IF (LHOOK) CALL DR_HOOK('WRITESURF_CH_EMIS_N:WRITE_EMIS_SPEC',0,ZHOOK_HANDLE)
-!
-JI = IFIRST(JSPEC)
-JT = 0
-! fill the emission times array (ITIME)
-! and the corresponding indices array (IINDEX)
-! for species number JSPEC
-DO WHILE(JI /= 0)
- JT = JT+1
- ITIME(JT) = NEMIS_TIME(JI)
- IINDEX(JT) = JI
- JI = INEXT(JI)
-END DO
-IF (JT /= KSIZE) THEN
- CALL ABOR1_SFX('WRITESURF_CH_EMISN: ABNORMAL ERROR')
-END IF
-! sort indices according to ITIME values
-LOK = .TRUE.
-DO WHILE (LOK)
- LOK = .FALSE.
- DO JI=2,KSIZE
- IF (ITIME(JI-1) > ITIME(JI)) THEN
- LOK = .TRUE.
- ITMP = ITIME(JI-1)
- ITIME(JI-1) = ITIME(JI)
- ITIME(JI) = ITMP
- ITMP = IINDEX(JI-1)
- IINDEX(JI-1) = IINDEX(JI)
- IINDEX(JI) = ITMP
- END IF
- END DO
-END DO
-! Now fill the ZWORK2D array for writing
-ZWORK2D(:,:) = 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
-WRITE(YCOMMENT,'(A3,", emission times number:",I5)') CEMIS_AREA(IINDEX(1)),KSIZE
- CALL WRITE_SURF(HPROGRAM,YRECFM,YEMISPEC_NAMES(JSPEC),IRESP,HCOMMENT=YCOMMENT)
-!
-! Write emission times (ITIME) for species JSPEC
-WRITE(YRECFM,'("EMISTIMES",I3.3)') JSPEC
-YCOMMENT = "Emission times in second"
- CALL WRITE_SURF(HPROGRAM,YRECFM,ITIME(:),IRESP,HCOMMENT=YCOMMENT,HDIR='-')
-!
-! Finally write emission data for species JSPEC
-YRECFM = "E_"//TRIM(YEMISPEC_NAMES(JSPEC))
-YCOMMENT = "Emission data (x,y,t),"//TRIM(CEMIS_COMMENT(IINDEX(1)))
- CALL WRITE_SURF(HPROGRAM,YRECFM,ZWORK2D(:,:),IRESP,HCOMMENT=YCOMMENT)
-!
-IF (LHOOK) CALL DR_HOOK('WRITESURF_CH_EMIS_N:WRITE_EMIS_SPEC',1,ZHOOK_HANDLE)
-!
-END SUBROUTINE WRITE_EMIS_SPEC
-!
-END SUBROUTINE WRITESURF_CH_EMIS_n
+!SURFEX_LIC Copyright 1994-2014 Meteo-France
+!SURFEX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SURFEX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SURFEX_LIC for details. version 1.
+! #########
+ SUBROUTINE WRITESURF_CH_EMIS_n(HPROGRAM)
+! ##########################################################
+!
+!!**** *WRITESURF_CH_EMIS_n* - routine to write chemistry emission fields
+!!
+!! PURPOSE
+!! -------
+!!
+!! AUTHOR
+!! ------
+!! V. Masson *Meteo France*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 03/2004
+!! M.Moge 01/2016 using WRITE_SURF_FIELD2D/3D for 2D/3D surfex fields writes
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CH_EMIS_FIELD_n,ONLY : NEMIS_NBR, CEMIS_AREA, CEMIS_NAME, &
+ CEMIS_COMMENT, NEMIS_TIME, XEMIS_FIELDS
+USE MODI_WRITE_SURF
+USE MODI_WRITE_SURF_FIELD2D
+!
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+USE MODI_ABOR1_SFX
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of arguments
+! -------------------------
+!
+ CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling
+!
+!* 0.2 Declarations of local variables
+! -------------------------------
+!
+INTEGER :: IRESP ! IRESP : return-code if a problem appears
+ ! at the open of the file in LFI routines
+!
+ CHARACTER(LEN=12) :: YRECFM ! Name of the article to be written
+ CHARACTER(LEN=100):: YCOMMENT ! Comment string
+ CHARACTER(LEN=100):: YCOMMENTUNIT ! Comment string : unit of the datas in the field to write
+ CHARACTER(LEN=80) :: YNAME ! emitted species name
+!
+INTEGER :: JI,JT ! loop indices
+INTEGER :: JSPEC ! loop index
+LOGICAL :: GFOUND,LOK
+ CHARACTER(LEN=40),DIMENSION(NEMIS_NBR) :: YEMISPEC_NAMES
+INTEGER, DIMENSION(NEMIS_NBR) :: INBTIMES
+INTEGER, DIMENSION(NEMIS_NBR) :: IFIRST,ILAST,INEXT
+INTEGER :: INTIMESMAX,ITMP
+INTEGER :: IEMISPEC_NBR
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+
+!-------------------------------------------------------------------------------
+!
+!* 1. Chemical Emission fields :
+! --------------------------
+!
+IF (LHOOK) CALL DR_HOOK('WRITESURF_CH_EMIS_N',0,ZHOOK_HANDLE)
+YRECFM='EMISFILE_NBR'
+YCOMMENT='Total number of 2D emission files.'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,NEMIS_NBR,IRESP,HCOMMENT=YCOMMENT)
+!
+! count emitted species
+IEMISPEC_NBR = 0
+DO JI=1,NEMIS_NBR
+ YNAME = TRIM(ADJUSTL(CEMIS_NAME(JI)))
+ GFOUND = .FALSE.
+ DO JSPEC = 1,IEMISPEC_NBR
+ IF (YEMISPEC_NAMES(JSPEC) == YNAME) THEN
+ GFOUND = .TRUE.
+ EXIT
+ END IF
+ END DO
+ IF (.NOT. GFOUND) THEN
+ IEMISPEC_NBR = IEMISPEC_NBR+1
+ YEMISPEC_NAMES(IEMISPEC_NBR) = YNAME
+ INBTIMES(IEMISPEC_NBR) = 1
+ IFIRST(IEMISPEC_NBR) = JI
+ ILAST(IEMISPEC_NBR) = JI
+ INEXT(JI) = 0
+ ELSE
+ INEXT(ILAST(JSPEC)) = JI
+ INEXT(JI) = 0
+ ILAST(JSPEC) = JI
+ INBTIMES(JSPEC) = INBTIMES(JSPEC)+1
+ END IF
+END DO
+!
+YRECFM='EMISPEC_NBR '
+YCOMMENT='Number of emitted chemical species.'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,IEMISPEC_NBR,IRESP,HCOMMENT=YCOMMENT)
+!
+IF (IEMISPEC_NBR > 0) THEN
+ !
+ DO JSPEC = 1,IEMISPEC_NBR
+ CALL WRITE_EMIS_SPEC(INBTIMES(JSPEC))
+ ENDDO
+ !
+ENDIF
+!
+IF (LHOOK) CALL DR_HOOK('WRITESURF_CH_EMIS_N',1,ZHOOK_HANDLE)
+!
+!-------------------------------------------------------------------------------
+CONTAINS
+!
+SUBROUTINE WRITE_EMIS_SPEC(KSIZE)
+!
+INTEGER, INTENT(IN) :: KSIZE
+INTEGER,DIMENSION(KSIZE) :: ITIME
+INTEGER,DIMENSION(KSIZE) :: IINDEX
+REAL,DIMENSION(SIZE(XEMIS_FIELDS,1),KSIZE) :: ZWORK2D
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+IF (LHOOK) CALL DR_HOOK('WRITESURF_CH_EMIS_N:WRITE_EMIS_SPEC',0,ZHOOK_HANDLE)
+!
+JI = IFIRST(JSPEC)
+JT = 0
+! fill the emission times array (ITIME)
+! and the corresponding indices array (IINDEX)
+! for species number JSPEC
+DO WHILE(JI /= 0)
+ JT = JT+1
+ ITIME(JT) = NEMIS_TIME(JI)
+ IINDEX(JT) = JI
+ JI = INEXT(JI)
+END DO
+IF (JT /= KSIZE) THEN
+ CALL ABOR1_SFX('WRITESURF_CH_EMISN: ABNORMAL ERROR')
+END IF
+! sort indices according to ITIME values
+LOK = .TRUE.
+DO WHILE (LOK)
+ LOK = .FALSE.
+ DO JI=2,KSIZE
+ IF (ITIME(JI-1) > ITIME(JI)) THEN
+ LOK = .TRUE.
+ ITMP = ITIME(JI-1)
+ ITIME(JI-1) = ITIME(JI)
+ ITIME(JI) = ITMP
+ ITMP = IINDEX(JI-1)
+ IINDEX(JI-1) = IINDEX(JI)
+ IINDEX(JI) = ITMP
+ END IF
+ END DO
+END DO
+! Now fill the ZWORK2D array for writing
+ZWORK2D(:,:) = 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
+WRITE(YCOMMENT,'(A3,", emission times number:",I5)') CEMIS_AREA(IINDEX(1)),KSIZE
+ CALL WRITE_SURF(HPROGRAM,YRECFM,YEMISPEC_NAMES(JSPEC),IRESP,HCOMMENT=YCOMMENT)
+!
+! Write emission times (ITIME) for species JSPEC
+WRITE(YRECFM,'("EMISTIMES",I3.3)') JSPEC
+YCOMMENT = "Emission times in second"
+ CALL WRITE_SURF(HPROGRAM,YRECFM,ITIME(:),IRESP,HCOMMENT=YCOMMENT,HDIR='-')
+!
+! Finally write emission data for species JSPEC
+YRECFM = "E_"//TRIM(YEMISPEC_NAMES(JSPEC))
+YCOMMENT = "Emission data (x,y,t),"//TRIM(CEMIS_COMMENT(IINDEX(1)))
+YCOMMENTUNIT='-'
+CALL WRITE_SURF_FIELD2D(HPROGRAM,ZWORK2D(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+!
+IF (LHOOK) CALL DR_HOOK('WRITESURF_CH_EMIS_N:WRITE_EMIS_SPEC',1,ZHOOK_HANDLE)
+!
+END SUBROUTINE WRITE_EMIS_SPEC
+!
+END SUBROUTINE WRITESURF_CH_EMIS_n
diff --git a/src/SURFEX/writesurf_gr_snow.F90 b/src/SURFEX/writesurf_gr_snow.F90
index 8f7edd0ea..fb5152515 100644
--- a/src/SURFEX/writesurf_gr_snow.F90
+++ b/src/SURFEX/writesurf_gr_snow.F90
@@ -1,337 +1,244 @@
-!SURFEX_LIC Copyright 1994-2014 Meteo-France
-!SURFEX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SURFEX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SURFEX_LIC for details. version 1.
-! #########
- SUBROUTINE WRITESURF_GR_SNOW(HPROGRAM,HSURFTYPE,HPREFIX,TPSNOW )
-! ##########################################################
-!
-!!**** *WRITESURF_GR_SNOW* - routine to write snow surface fields
-!!
-!! PURPOSE
-!! -------
-! Writes snow surface fields
-!
-!!** METHOD
-!! ------
-!!
-!!
-!!
-!! EXTERNAL
-!! --------
-!!
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!!
-!! AUTHOR
-!! ------
-!! V. Masson * Meteo France *
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 02/2003
-!! A. Bogatchev 09/2005 EBA snow option
-!! M. Moge 09/2015 writing SURFEX fields as 1D fields for each patch for Z-parallel IO with Meso-NH
-!-----------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-!
-USE MODD_SURF_PAR, ONLY : XUNDEF
-USE MODD_TYPE_SNOW
-USE MODD_PREP_SNOW, ONLY : LSNOW_FRAC_TOT
-!
-USE MODI_DETECT_FIELD
-USE MODI_WRITE_SURF
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-!* 0.1 declarations of arguments
-!
- CHARACTER (LEN=6), INTENT(IN) :: HPROGRAM ! program
- CHARACTER (LEN=*), INTENT(IN) :: HSURFTYPE ! generic name used for
- ! snow characteristics
- ! storage in file
- CHARACTER (LEN=3), INTENT(IN) :: HPREFIX ! generic name of prefix for
- ! patch identification
-TYPE(SURF_SNOW), INTENT(IN) :: TPSNOW ! snow characteristics
-!
-!* 0.2 declarations of local variables
-!
-INTEGER :: ISURFTYPE_LEN
-!
- CHARACTER (LEN=100) :: YFMT ! format for writing
- CHARACTER(LEN=12) :: YRECFM ! Name of the article to be read
- CHARACTER(LEN=100) :: YCOMMENT ! Comment string
-INTEGER :: IRESP ! IRESP : return-code if a problem appears
-!
-LOGICAL :: GSNOW ! T --> snow exists somewhere
-!
-INTEGER :: JLAYER ! loop counter
-INTEGER :: JPATCH ! loop counter
-CHARACTER(LEN=4) :: YPATCH ! number of the patch
- CHARACTER(LEN=4) :: YNLAYER ! String depending on the number of layer : less
- !than 10 or more
-!
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!-------------------------------------------------------------------------------
-IF (LHOOK) CALL DR_HOOK('WRITESURF_GR_SNOW',0,ZHOOK_HANDLE)
-!
-!* 1. Initialisation
-! --------------
-
-ISURFTYPE_LEN = LEN_TRIM(HSURFTYPE)
-!
-!
-!* 2. Type of snow scheme
-! -------------------
-!
-WRITE(YFMT,'(A5,I1,A4)') '(A3,A',ISURFTYPE_LEN,',A4)'
-WRITE(YRECFM,YFMT) 'SN_',HSURFTYPE,'_TYP'
-YRECFM=ADJUSTL(HPREFIX//YRECFM)
-YCOMMENT=' '
- CALL WRITE_SURF(HPROGRAM,YRECFM,TPSNOW%SCHEME,IRESP,HCOMMENT=YCOMMENT)
-!
-!
-!* 3. Number of layers
-! ----------------
-!
-WRITE(YFMT,'(A5,I1,A4)') '(A3,A',ISURFTYPE_LEN,',A2)'
-WRITE(YRECFM,YFMT) 'SN_',HSURFTYPE,'_N'
-YRECFM=ADJUSTL(HPREFIX//YRECFM)
-YCOMMENT = '(INTEGER)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,TPSNOW%NLAYER,IRESP,HCOMMENT=YCOMMENT)
-!
-!
-!* 4. Tests to find if there is snow
-! ------------------------------
-!
-IF (TPSNOW%NLAYER>0) THEN
- CALL DETECT_FIELD(HPROGRAM,TPSNOW%WSNOW(:,1,:),GSNOW)
-ELSE
- GSNOW = .FALSE.
-END IF
-!
-WRITE(YFMT,'(A5,I1,A1)') '(A3,A',ISURFTYPE_LEN,')'
-WRITE(YRECFM,YFMT) 'SN_',HSURFTYPE
-YRECFM=ADJUSTL(HPREFIX//YRECFM)
-YCOMMENT = '(LOGICAL)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,GSNOW,IRESP,HCOMMENT=YCOMMENT)
-!
-!
-IF (.NOT. GSNOW) THEN
- IF (LHOOK) CALL DR_HOOK('WRITESURF_GR_SNOW',1,ZHOOK_HANDLE)
- RETURN
-END IF
-!
-!
-!* 5. Additional key
-! ---------------
-!
-YCOMMENT = '(LOGICAL)'
- CALL WRITE_SURF(HPROGRAM,'LSNOW_FRAC_T',LSNOW_FRAC_TOT,IRESP,HCOMMENT=YCOMMENT)
-!
-!
-DO JLAYER = 1,TPSNOW%NLAYER
- !
- YNLAYER='I1.1'
- IF (JLAYER>9) YNLAYER='I2.2'
- !
- IF (TPSNOW%SCHEME=='1-L' .OR. TPSNOW%SCHEME=='D95' .OR. TPSNOW%SCHEME=='EBA' .OR. &
- TPSNOW%SCHEME=='3-L' .OR. TPSNOW%SCHEME=='CRO') THEN
- !
- !* 6. Snow reservoir
- ! --------------
- !
- WRITE(YFMT,'(A5,I1,A6)') '(A4,A',ISURFTYPE_LEN,','//YNLAYER//')'
- WRITE(YRECFM,YFMT) 'WSN_',HSURFTYPE,JLAYER
- YRECFM=ADJUSTL(HPREFIX//YRECFM)
- WRITE(YFMT,'(A6,I1,A9)') '(A10,A',ISURFTYPE_LEN,','//YNLAYER//',A8))'
- WRITE(YCOMMENT,YFMT) 'X_Y_WSNOW_',HSURFTYPE,JLAYER,' (kg/m2)'
-#ifdef MNH_PARALLEL
- DO JPATCH=1,SIZE(TPSNOW%WSNOW,3)
- WRITE(YPATCH,'(I4.4)') SIZE(TPSNOW%WSNOW,3)
- YRECFM=TRIM(YRECFM)//YPATCH
- CALL WRITE_SURF(HPROGRAM,YRECFM,TPSNOW%WSNOW(:,JLAYER,JPATCH),IRESP,HCOMMENT=YCOMMENT)
- END DO
-#else
- CALL WRITE_SURF(HPROGRAM,YRECFM,TPSNOW%WSNOW(:,JLAYER,:),IRESP,HCOMMENT=YCOMMENT)
-#endif
- !
- !* 7. Snow density
- ! ------------
- !
- WRITE(YFMT,'(A5,I1,A6)') '(A4,A',ISURFTYPE_LEN,','//YNLAYER//')'
- WRITE(YRECFM,YFMT) 'RSN_',HSURFTYPE,JLAYER
- YRECFM=ADJUSTL(HPREFIX//YRECFM)
- WRITE(YFMT,'(A6,I1,A9)') '(A10,A',ISURFTYPE_LEN,','//YNLAYER//',A8))'
- WRITE(YCOMMENT,YFMT) 'X_Y_RSNOW_',HSURFTYPE,JLAYER,' (kg/m2)'
-#ifdef MNH_PARALLEL
- DO JPATCH=1,SIZE(TPSNOW%RHO,3)
- WRITE(YPATCH,'(I4.4)') SIZE(TPSNOW%RHO,3)
- YRECFM=TRIM(YRECFM)//YPATCH
- CALL WRITE_SURF(HPROGRAM,YRECFM,TPSNOW%RHO(:,JLAYER,JPATCH),IRESP,HCOMMENT=YCOMMENT)
- END DO
-#else
- CALL WRITE_SURF(HPROGRAM,YRECFM,TPSNOW%RHO(:,JLAYER,:),IRESP,HCOMMENT=YCOMMENT)
-#endif
- !
- END IF
- !
- !* 8. Snow temperature
- ! ----------------
- !
- IF (TPSNOW%SCHEME=='1-L') THEN
- !
- WRITE(YFMT,'(A5,I1,A6)') '(A4,A',ISURFTYPE_LEN,','//YNLAYER//')'
- WRITE(YRECFM,YFMT) 'TSN_',HSURFTYPE,JLAYER
- YRECFM=ADJUSTL(HPREFIX//YRECFM)
- WRITE(YFMT,'(A6,I1,A9)') '(A10,A',ISURFTYPE_LEN,','//YNLAYER//',A8))'
- WRITE(YCOMMENT,YFMT) 'X_Y_TSNOW_',HSURFTYPE,JLAYER,' (kg/m2)'
-#ifdef MNH_PARALLEL
- DO JPATCH=1,SIZE(TPSNOW%T,3)
- WRITE(YPATCH,'(I4.4)') SIZE(TPSNOW%T,3)
- YRECFM=TRIM(YRECFM)//YPATCH
- CALL WRITE_SURF(HPROGRAM,YRECFM,TPSNOW%T(:,JLAYER,JPATCH),IRESP,HCOMMENT=YCOMMENT)
- END DO
-#else
- CALL WRITE_SURF(HPROGRAM,YRECFM,TPSNOW%T(:,JLAYER,:),IRESP,HCOMMENT=YCOMMENT)
-#endif
- !
- END IF
- !
- !* 9. Heat content
- ! ------------
- !
- IF (TPSNOW%SCHEME=='3-L' .OR. TPSNOW%SCHEME=='CRO') THEN
- !
- WRITE(YFMT,'(A5,I1,A6)') '(A4,A',ISURFTYPE_LEN,','//YNLAYER//')'
- WRITE(YRECFM,YFMT) 'HSN_',HSURFTYPE,JLAYER
- YRECFM=ADJUSTL(HPREFIX//YRECFM)
- WRITE(YFMT,'(A6,I1,A9)') '(A10,A',ISURFTYPE_LEN,','//YNLAYER//',A8))'
- WRITE(YCOMMENT,YFMT) 'X_Y_HSNOW_',HSURFTYPE,JLAYER,' (kg/m2)'
-#ifdef MNH_PARALLEL
- DO JPATCH=1,SIZE(TPSNOW%HEAT,3)
- WRITE(YPATCH,'(I4.4)') SIZE(TPSNOW%HEAT,3)
- YRECFM=TRIM(YRECFM)//YPATCH
- CALL WRITE_SURF(HPROGRAM,YRECFM,TPSNOW%HEAT(:,JLAYER,JPATCH),IRESP,HCOMMENT=YCOMMENT)
- END DO
-#else
- CALL WRITE_SURF(HPROGRAM,YRECFM,TPSNOW%HEAT(:,JLAYER,:),IRESP,HCOMMENT=YCOMMENT)
-#endif
- !
- END IF
- !
- IF (TPSNOW%SCHEME=='CRO') THEN
- !
- !* 10. Snow Gran1
- ! ----------
- !
- WRITE(YFMT,'(A5,I1,A6)') '(A4,A',ISURFTYPE_LEN,','//YNLAYER//')'
- WRITE(YRECFM,YFMT) 'SG1_',HSURFTYPE,JLAYER
- YRECFM=ADJUSTL(HPREFIX//YRECFM)
- WRITE(YFMT,'(A6,I1,A9)') '(A11,A',ISURFTYPE_LEN,','//YNLAYER//',A8))'
- WRITE(YCOMMENT,YFMT) 'X_Y_SGRAN1_',HSURFTYPE,JLAYER,' (-)'
-#ifdef MNH_PARALLEL
- DO JPATCH=1,SIZE(TPSNOW%GRAN1,3)
- WRITE(YPATCH,'(I4.4)') SIZE(TPSNOW%GRAN1,3)
- YRECFM=TRIM(YRECFM)//YPATCH
- CALL WRITE_SURF(HPROGRAM,YRECFM,TPSNOW%GRAN1(:,JLAYER,JPATCH),IRESP,HCOMMENT=YCOMMENT)
- END DO
-#else
- CALL WRITE_SURF(HPROGRAM,YRECFM,TPSNOW%GRAN1(:,JLAYER,:),IRESP,HCOMMENT=YCOMMENT)
-#endif
- !
- !* 11. Snow Gran2
- ! ------------
- !
- WRITE(YFMT,'(A5,I1,A6)') '(A4,A',ISURFTYPE_LEN,','//YNLAYER//')'
- WRITE(YRECFM,YFMT) 'SG2_',HSURFTYPE,JLAYER
- YRECFM=ADJUSTL(HPREFIX//YRECFM)
- WRITE(YFMT,'(A6,I1,A9)') '(A11,A',ISURFTYPE_LEN,','//YNLAYER//',A8))'
- WRITE(YCOMMENT,YFMT) 'X_Y_SGRAN2_',HSURFTYPE,JLAYER,' (-)'
-#ifdef MNH_PARALLEL
- DO JPATCH=1,SIZE(TPSNOW%GRAN2,3)
- WRITE(YPATCH,'(I4.4)') SIZE(TPSNOW%GRAN2,3)
- YRECFM=TRIM(YRECFM)//YPATCH
- CALL WRITE_SURF(HPROGRAM,YRECFM,TPSNOW%GRAN2(:,JLAYER,JPATCH),IRESP,HCOMMENT=YCOMMENT)
- END DO
-#else
- CALL WRITE_SURF(HPROGRAM,YRECFM,TPSNOW%GRAN2(:,JLAYER,:),IRESP,HCOMMENT=YCOMMENT)
-#endif
- !
- !* 12. Historical parameter
- ! -------------------
- !
- WRITE(YFMT,'(A5,I1,A6)') '(A4,A',ISURFTYPE_LEN,','//YNLAYER//')'
- WRITE(YRECFM,YFMT) 'SHI_',HSURFTYPE,JLAYER
- YRECFM=ADJUSTL(HPREFIX//YRECFM)
- WRITE(YFMT,'(A6,I1,A9)') '(A10,A',ISURFTYPE_LEN,','//YNLAYER//',A8))'
- WRITE(YCOMMENT,YFMT) 'X_Y_SHIST_',HSURFTYPE,JLAYER,' (-)'
-#ifdef MNH_PARALLEL
- DO JPATCH=1,SIZE(TPSNOW%HIST,3)
- WRITE(YPATCH,'(I4.4)') SIZE(TPSNOW%HIST,3)
- YRECFM=TRIM(YRECFM)//YPATCH
- CALL WRITE_SURF(HPROGRAM,YRECFM,TPSNOW%HIST(:,JLAYER,JPATCH),IRESP,HCOMMENT=YCOMMENT)
- END DO
-#else
- CALL WRITE_SURF(HPROGRAM,YRECFM,TPSNOW%HIST(:,JLAYER,:),IRESP,HCOMMENT=YCOMMENT)
-#endif
- !
- !* 13. Age parameter
- ! ---------------
- !
- WRITE(YFMT,'(A5,I1,A6)') '(A4,A',ISURFTYPE_LEN,','//YNLAYER//')'
- WRITE(YRECFM,YFMT) 'SAG_',HSURFTYPE,JLAYER
- YRECFM=ADJUSTL(HPREFIX//YRECFM)
- WRITE(YFMT,'(A6,I1,A9)') '(A9,A',ISURFTYPE_LEN,','//YNLAYER//',A8))'
- WRITE(YCOMMENT,YFMT) 'X_Y_SAGE_',HSURFTYPE,JLAYER,' (-)'
-#ifdef MNH_PARALLEL
- DO JPATCH=1,SIZE(TPSNOW%AGE,3)
- WRITE(YPATCH,'(I4.4)') SIZE(TPSNOW%AGE,3)
- YRECFM=TRIM(YRECFM)//YPATCH
- CALL WRITE_SURF(HPROGRAM,YRECFM,TPSNOW%AGE(:,JLAYER,JPATCH),IRESP,HCOMMENT=YCOMMENT)
- END DO
-#else
- CALL WRITE_SURF(HPROGRAM,YRECFM,TPSNOW%AGE(:,JLAYER,:),IRESP,HCOMMENT=YCOMMENT)
-#endif
- !
- END IF
- !
-END DO
-!
-!
-!* 14. Albedo
-! ------
-!
-IF (TPSNOW%SCHEME=='D95' .OR. TPSNOW%SCHEME=='EBA' .OR. TPSNOW%SCHEME=='1-L' .OR. &
- TPSNOW%SCHEME=='3-L' .OR. TPSNOW%SCHEME=='CRO') THEN
- !
- WRITE(YFMT,'(A5,I1,A1)') '(A4,A',ISURFTYPE_LEN,')'
- WRITE(YRECFM,YFMT) 'ASN_',HSURFTYPE
- YRECFM=ADJUSTL(HPREFIX//YRECFM)
- WRITE(YFMT,'(A6,I1,A5)') '(A10,A',ISURFTYPE_LEN,',A10)'
- WRITE(YCOMMENT,YFMT) 'X_Y_ASNOW_',HSURFTYPE,' (no unit)'
-#ifdef MNH_PARALLEL
- DO JPATCH=1,SIZE(TPSNOW%ALB,2)
- WRITE(YPATCH,'(I4.4)') SIZE(TPSNOW%ALB,2)
- YRECFM=TRIM(YRECFM)//YPATCH
- CALL WRITE_SURF(HPROGRAM,YRECFM,TPSNOW%ALB(:,JPATCH),IRESP,HCOMMENT=YCOMMENT)
- END DO
-#else
- CALL WRITE_SURF(HPROGRAM,YRECFM,TPSNOW%ALB(:,:),IRESP,HCOMMENT=YCOMMENT)
-#endif
- !
-END IF
-!
-IF (LHOOK) CALL DR_HOOK('WRITESURF_GR_SNOW',1,ZHOOK_HANDLE)
-!
-END SUBROUTINE WRITESURF_GR_SNOW
+!SURFEX_LIC Copyright 1994-2014 Meteo-France
+!SURFEX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SURFEX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SURFEX_LIC for details. version 1.
+! #########
+ SUBROUTINE WRITESURF_GR_SNOW(HPROGRAM,HSURFTYPE,HPREFIX,TPSNOW )
+! ##########################################################
+!
+!!**** *WRITESURF_GR_SNOW* - routine to write snow surface fields
+!!
+!! PURPOSE
+!! -------
+! Writes snow surface fields
+!
+!!** METHOD
+!! ------
+!!
+!!
+!!
+!! EXTERNAL
+!! --------
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Masson * Meteo France *
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 02/2003
+!! A. Bogatchev 09/2005 EBA snow option
+!! M.Moge 01/2016 using WRITE_SURF_FIELD2D/3D for 2D/3D surfex fields writes
+!-----------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+USE MODD_SURF_PAR, ONLY : XUNDEF
+USE MODD_TYPE_SNOW
+USE MODD_PREP_SNOW, ONLY : LSNOW_FRAC_TOT
+!
+USE MODI_DETECT_FIELD
+USE MODI_WRITE_SURF
+USE MODI_WRITE_SURF_FIELD2D
+USE MODI_WRITE_SURF_FIELD3D
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+ CHARACTER (LEN=6), INTENT(IN) :: HPROGRAM ! program
+ CHARACTER (LEN=*), INTENT(IN) :: HSURFTYPE ! generic name used for
+ ! snow characteristics
+ ! storage in file
+ CHARACTER (LEN=3), INTENT(IN) :: HPREFIX ! generic name of prefix for
+ ! patch identification
+TYPE(SURF_SNOW), INTENT(IN) :: TPSNOW ! snow characteristics
+!
+!* 0.2 declarations of local variables
+!
+INTEGER :: ISURFTYPE_LEN
+!
+ CHARACTER (LEN=100) :: YFMT ! format for writing
+ CHARACTER(LEN=12) :: YRECFM ! Name of the article to be read
+ CHARACTER(LEN=100):: YCOMMENT ! Comment string
+ CHARACTER(LEN=100):: YCOMMENTUNIT ! Comment string : unit of the datas in the field to write
+INTEGER :: IRESP ! IRESP : return-code if a problem appears
+!
+LOGICAL :: GSNOW ! T --> snow exists somewhere
+!
+INTEGER :: JLAYER ! loop counter
+CHARACTER(LEN=4) :: YPATCH ! number of the patch
+ CHARACTER(LEN=4) :: YNLAYER ! String depending on the number of layer : less
+ !than 10 or more
+!
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!-------------------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('WRITESURF_GR_SNOW',0,ZHOOK_HANDLE)
+!
+!* 1. Initialisation
+! --------------
+
+ISURFTYPE_LEN = LEN_TRIM(HSURFTYPE)
+!
+!
+!* 2. Type of snow scheme
+! -------------------
+!
+WRITE(YFMT,'(A5,I1,A4)') '(A3,A',ISURFTYPE_LEN,',A4)'
+WRITE(YRECFM,YFMT) 'SN_',HSURFTYPE,'_TYP'
+YRECFM=ADJUSTL(HPREFIX//YRECFM)
+YCOMMENT=' '
+ CALL WRITE_SURF(HPROGRAM,YRECFM,TPSNOW%SCHEME,IRESP,HCOMMENT=YCOMMENT)
+!
+!
+!* 3. Number of layers
+! ----------------
+!
+WRITE(YFMT,'(A5,I1,A4)') '(A3,A',ISURFTYPE_LEN,',A2)'
+WRITE(YRECFM,YFMT) 'SN_',HSURFTYPE,'_N'
+YRECFM=ADJUSTL(HPREFIX//YRECFM)
+YCOMMENT = '(INTEGER)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,TPSNOW%NLAYER,IRESP,HCOMMENT=YCOMMENT)
+!
+!
+!* 4. Tests to find if there is snow
+! ------------------------------
+!
+IF (TPSNOW%NLAYER>0) THEN
+ CALL DETECT_FIELD(HPROGRAM,TPSNOW%WSNOW(:,1,:),GSNOW)
+ELSE
+ GSNOW = .FALSE.
+END IF
+!
+WRITE(YFMT,'(A5,I1,A1)') '(A3,A',ISURFTYPE_LEN,')'
+WRITE(YRECFM,YFMT) 'SN_',HSURFTYPE
+YRECFM=ADJUSTL(HPREFIX//YRECFM)
+YCOMMENT = '(LOGICAL)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,GSNOW,IRESP,HCOMMENT=YCOMMENT)
+!
+!
+IF (.NOT. GSNOW) THEN
+ IF (LHOOK) CALL DR_HOOK('WRITESURF_GR_SNOW',1,ZHOOK_HANDLE)
+ RETURN
+END IF
+!
+!
+!* 5. Additional key
+! ---------------
+!
+YCOMMENT = '(LOGICAL)'
+ CALL WRITE_SURF(HPROGRAM,'LSNOW_FRAC_T',LSNOW_FRAC_TOT,IRESP,HCOMMENT=YCOMMENT)
+!
+!
+IF (TPSNOW%SCHEME=='1-L' .OR. TPSNOW%SCHEME=='D95' .OR. TPSNOW%SCHEME=='EBA' .OR. &
+ TPSNOW%SCHEME=='3-L' .OR. TPSNOW%SCHEME=='CRO') THEN
+ !
+ !
+ !* 6. Snow reservoir
+ ! --------------
+ !
+ YRECFM=ADJUSTL(HPREFIX//'WSN_'//HSURFTYPE)
+ YCOMMENT='X_Y_WSNOW_'//HSURFTYPE
+ YCOMMENTUNIT='kg/m2'
+ CALL WRITE_SURF_FIELD3D(HPROGRAM,TPSNOW%WSNOW,1,TPSNOW%NLAYER,YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ !* 7. Snow density
+ ! ------------
+ !
+ YRECFM=ADJUSTL(HPREFIX//'RSN_'//HSURFTYPE)
+ YCOMMENT='X_Y_RSNOW_'//HSURFTYPE
+ YCOMMENTUNIT='kg/m2'
+ CALL WRITE_SURF_FIELD3D(HPROGRAM,TPSNOW%RHO,1,TPSNOW%NLAYER,YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+END IF
+!
+!* 8. Snow temperature
+! ----------------
+!
+IF (TPSNOW%SCHEME=='1-L') THEN
+ !
+ YRECFM=ADJUSTL(HPREFIX//'TSN_'//HSURFTYPE)
+ YCOMMENT='X_Y_TSNOW_'//HSURFTYPE
+ YCOMMENTUNIT='kg/m2'
+ CALL WRITE_SURF_FIELD3D(HPROGRAM,TPSNOW%T,1,TPSNOW%NLAYER,YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+END IF
+!
+!* 9. Heat content
+! ------------
+!
+IF (TPSNOW%SCHEME=='3-L' .OR. TPSNOW%SCHEME=='CRO') THEN
+ !
+ YRECFM=ADJUSTL(HPREFIX//'HSN_'//HSURFTYPE)
+ YCOMMENT='X_Y_HSNOW_'//HSURFTYPE
+ YCOMMENTUNIT='kg/m2'
+ CALL WRITE_SURF_FIELD3D(HPROGRAM,TPSNOW%HEAT,1,TPSNOW%NLAYER,YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+END IF
+!
+IF (TPSNOW%SCHEME=='CRO') THEN
+ !
+ !
+ !* 10. Snow Gran1
+ ! ----------
+ !
+ YRECFM=ADJUSTL(HPREFIX//'SG1_'//HSURFTYPE)
+ YCOMMENT='X_Y_SGRAN1_'//HSURFTYPE
+ YCOMMENTUNIT='-'
+ CALL WRITE_SURF_FIELD3D(HPROGRAM,TPSNOW%GRAN1,1,TPSNOW%NLAYER,YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ !* 11. Snow Gran2
+ ! ------------
+ !
+ YRECFM=ADJUSTL(HPREFIX//'SG2_'//HSURFTYPE)
+ YCOMMENT='X_Y_SGRAN2_'//HSURFTYPE
+ YCOMMENTUNIT='-'
+ CALL WRITE_SURF_FIELD3D(HPROGRAM,TPSNOW%GRAN2,1,TPSNOW%NLAYER,YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ !* 12. Historical parameter
+ ! -------------------
+ !
+ YRECFM=ADJUSTL(HPREFIX//'SHI_'//HSURFTYPE)
+ YCOMMENT='X_Y_SHIST_'//HSURFTYPE
+ YCOMMENTUNIT='-'
+ CALL WRITE_SURF_FIELD3D(HPROGRAM,TPSNOW%HIST,1,TPSNOW%NLAYER,YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ !* 13. Age parameter
+ ! ---------------
+ !
+ YRECFM=ADJUSTL(HPREFIX//'SAG_'//HSURFTYPE)
+ YCOMMENT='X_Y_SAGE_'//HSURFTYPE
+ YCOMMENTUNIT='-'
+ CALL WRITE_SURF_FIELD3D(HPROGRAM,TPSNOW%AGE,1,TPSNOW%NLAYER,YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+END IF
+!
+!
+!* 14. Albedo
+! ------
+!
+IF (TPSNOW%SCHEME=='D95' .OR. TPSNOW%SCHEME=='EBA' .OR. TPSNOW%SCHEME=='1-L' .OR. &
+ TPSNOW%SCHEME=='3-L' .OR. TPSNOW%SCHEME=='CRO') THEN
+ !
+ YRECFM=ADJUSTL(HPREFIX//'ASN_'//HSURFTYPE)
+ YCOMMENT='X_Y_ASNOW_'//HSURFTYPE
+ YCOMMENTUNIT='no unit'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,TPSNOW%ALB,YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+END IF
+!
+IF (LHOOK) CALL DR_HOOK('WRITESURF_GR_SNOW',1,ZHOOK_HANDLE)
+!
+END SUBROUTINE WRITESURF_GR_SNOW
diff --git a/src/SURFEX/writesurf_isban.F90 b/src/SURFEX/writesurf_isban.F90
index 2225b7c00..06798644d 100644
--- a/src/SURFEX/writesurf_isban.F90
+++ b/src/SURFEX/writesurf_isban.F90
@@ -1,567 +1,378 @@
-!SURFEX_LIC Copyright 1994-2014 Meteo-France
-!SURFEX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SURFEX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SURFEX_LIC for details. version 1.
-! #########
- SUBROUTINE WRITESURF_ISBA_n(HPROGRAM,OLAND_USE)
-! #####################################
-!
-!!**** *WRITESURF_ISBA_n* - writes ISBA prognostic fields
-!!
-!!
-!! PURPOSE
-!! -------
-!!
-!!** METHOD
-!! ------
-!!
-!! EXTERNAL
-!! --------
-!!
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! V. Masson *Meteo France*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 01/2003
-!! P. LeMoigne 12/2004 : correct dimensionning if more than 10 layers in
-!! the soil (diffusion version)
-!! B. Decharme 2008 : Floodplains
-!! B. Decharme 01/2009 : Optional Arpege deep soil temperature write
-!! A.L. Gibelin 03/09 : modifications for CENTURY model
-!! A.L. Gibelin 04/2009 : BIOMASS and RESP_BIOMASS arrays
-!! A.L. Gibelin 06/2009 : Soil carbon variables for CNT option
-!! B. Decharme 07/2011 : land_use semi-prognostic variables
-!! B. Decharme 09/2012 : suppress NWG_LAYER (parallelization problems)
-!! B. Decharme 09/2012 : write some key for prep_read_external
-!! M.Moge 08/2015 writing SURFEX 3D fields one patch at a time for Z-parallel splitting with MNH
-!! except 'FLX_DSTM'
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_SURF_PAR, ONLY : NUNDEF
-!
-USE MODD_ISBA_n, ONLY : NGROUND_LAYER, CISBA, CPHOTO, CRESPSL, CSOC, &
- NNBIOMASS, NNLITTER, NNSOILCARB, NNLITTLEVS, &
- XTG, XWG, XWGI, XWR, XLAI, TSNOW, XTSRAD_NAT,&
- XRESA, XAN, XANFM, XLE, XANDAY, TTIME, &
- XRESP_BIOMASS, XBIOMASS, XPATCH, XDG, &
- XLITTER, XSOILCARB, XLIGNIN_STRUC, LFLOOD, &
- XZ0_FLOOD, LTEMP_ARP, NTEMPLAYER_ARP, &
- LGLACIER, XICE_STO, LSPINUPCARBS, &
- LSPINUPCARBW, NNBYEARSOLD
-!
-USE MODD_ASSIM, ONLY : LASSIM, CASSIM
-!
-USE MODD_CH_ISBA_n, ONLY : NDSTEQ
-USE MODD_DST_n
-USE MODD_DST_SURF
-!
-USE MODI_WRITE_SURF
-USE MODI_WRITESURF_GR_SNOW
-!
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of arguments
-! -------------------------
-!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling
-LOGICAL, INTENT(IN) :: OLAND_USE !
-!
-!* 0.2 Declarations of local variables
-! -------------------------------
-!
-INTEGER :: IRESP ! IRESP : return-code if a problem appears
- CHARACTER(LEN=12) :: YRECFM ! Name of the article to be read
- CHARACTER(LEN=4 ) :: YLVL
- CHARACTER(LEN=5 ) :: YPATCH
- CHARACTER(LEN=100):: YCOMMENT ! Comment string
- CHARACTER(LEN=25) :: YFORM ! Writing format
-!
-INTEGER :: JJ, JLAYER, JP, JNBIOMASS, JNLITTER, JNSOILCARB, JNLITTLEVS ! loop counter on levels
-INTEGER :: JPATCH ! loop counter
-INTEGER :: IWORK ! Work integer
-INTEGER :: JSV
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-!------------------------------------------------------------------------------
-!
-!* 2. Prognostic fields:
-! -----------------
-!
-IF (LHOOK) CALL DR_HOOK('WRITESURF_ISBA_N',0,ZHOOK_HANDLE)
-!* soil temperatures
-!
-IF(LTEMP_ARP)THEN
- IWORK=NTEMPLAYER_ARP
-ELSE
- IWORK=NGROUND_LAYER
-ENDIF
-!
-DO JLAYER=1,IWORK
- YFORM='(A6,I1.1,A4)'
- IF (JLAYER >= 10) YFORM='(A6,I2.2,A4)'
- WRITE(YCOMMENT,FMT=YFORM) 'X_Y_TG',JLAYER,' (K)'
-#ifdef MNH_PARALLEL
- DO JPATCH=1,SIZE(XTG,3)
- IF (JLAYER >= 10) WRITE(YRECFM,FMT='(A2,I2,I4.4)') 'TG',JLAYER,JPATCH
- IF (JLAYER < 10) WRITE(YRECFM,FMT='(A2,I1,I4.4)') 'TG',JLAYER,JPATCH
- CALL WRITE_SURF(HPROGRAM,YRECFM,XTG(:,JLAYER,JPATCH),IRESP,HCOMMENT=YCOMMENT)
- ENDDO
-#else
- WRITE(YLVL,'(I4)') JLAYER
- YRECFM='TG'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
- CALL WRITE_SURF(HPROGRAM,YRECFM,XTG(:,JLAYER,:),IRESP,HCOMMENT=YCOMMENT)
-#endif
-END DO
-!
-!* soil liquid water contents
-!
-DO JLAYER=1,NGROUND_LAYER
- YFORM='(A6,I1.1,A8)'
- IF (JLAYER >= 10) YFORM='(A6,I2.2,A8)'
- WRITE(YCOMMENT,FMT=YFORM) 'X_Y_WG',JLAYER,' (m3/m3)'
-#ifdef MNH_PARALLEL
- DO JPATCH=1,SIZE(XWG,3)
- IF (JLAYER >= 10) WRITE(YRECFM,FMT='(A2,I2,I4.4)') 'WG',JLAYER,JPATCH
- IF (JLAYER < 10) WRITE(YRECFM,FMT='(A2,I1,I4.4)') 'WG',JLAYER,JPATCH
- CALL WRITE_SURF(HPROGRAM,YRECFM,XWG(:,JLAYER,JPATCH),IRESP,HCOMMENT=YCOMMENT)
- ENDDO
-#else
- WRITE(YLVL,'(I4)') JLAYER
- YRECFM='WG'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
- CALL WRITE_SURF(HPROGRAM,YRECFM,XWG(:,JLAYER,:),IRESP,HCOMMENT=YCOMMENT)
-#endif
-END DO
-!
-!* soil ice water contents
-!
-DO JLAYER=1,NGROUND_LAYER
- YFORM='(A7,I1.1,A8)'
- IF (JLAYER >= 10) YFORM='(A7,I2.2,A8)'
- WRITE(YCOMMENT,YFORM) 'X_Y_WGI',JLAYER,' (m3/m3)'
-#ifdef MNH_PARALLEL
- DO JPATCH=1,SIZE(XWGI,3)
- IF (JLAYER >= 10) WRITE(YRECFM,FMT='(A3,I2,I4.4)') 'WGI',JLAYER,JPATCH
- IF (JLAYER < 10) WRITE(YRECFM,FMT='(A3,I1,I4.4)') 'WGI',JLAYER,JPATCH
- CALL WRITE_SURF(HPROGRAM,YRECFM,XWGI(:,JLAYER,JPATCH),IRESP,HCOMMENT=YCOMMENT)
- ENDDO
-#else
- WRITE(YLVL,'(I4)') JLAYER
- YRECFM='WGI'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
- CALL WRITE_SURF(HPROGRAM,YRECFM,XWGI(:,JLAYER,:),IRESP,HCOMMENT=YCOMMENT)
-#endif
-END DO
-!
-!* water intercepted on leaves
-!
-YRECFM='WR'
-YCOMMENT='X_Y_WR (kg/m2)'
-#ifdef MNH_PARALLEL
-DO JPATCH=1,SIZE(XWR,2)
- WRITE(YRECFM,FMT='(A2,I4.4)') 'WR',JPATCH
- CALL WRITE_SURF(HPROGRAM,YRECFM,XWR(:,JPATCH),IRESP,HCOMMENT=YCOMMENT)
-ENDDO
-#else
- CALL WRITE_SURF(HPROGRAM,YRECFM,XWR(:,:),IRESP,HCOMMENT=YCOMMENT)
-#endif
-!
-!* roughness length of Flood water
-!
-IF(LFLOOD)THEN
- YRECFM='Z0_FLOOD'
- YCOMMENT='X_Y_Z0_FLOOD (-)'
-#ifdef MNH_PARALLEL
- DO JPATCH=1,SIZE(XZ0_FLOOD,2)
- WRITE(YRECFM,FMT='(A8,I4.4)') 'Z0_FLOOD',JPATCH
- CALL WRITE_SURF(HPROGRAM,YRECFM,XZ0_FLOOD(:,JPATCH),IRESP,HCOMMENT=YCOMMENT)
- ENDDO
-#else
- CALL WRITE_SURF(HPROGRAM,YRECFM,XZ0_FLOOD(:,:),IRESP,HCOMMENT=YCOMMENT)
-#endif
-ENDIF
-!
-!* Glacier ice storage
-!
-IF(LGLACIER)THEN
- YRECFM='ICE_STO'
- YCOMMENT='X_Y_ICE_STO (kg/m2)'
-#ifdef MNH_PARALLEL
- DO JPATCH=1,SIZE(XICE_STO,2)
- WRITE(YRECFM,FMT='(A7,I4.4)') 'ICE_STO',JPATCH
- CALL WRITE_SURF(HPROGRAM,YRECFM,XICE_STO(:,JPATCH),IRESP,HCOMMENT=YCOMMENT)
- ENDDO
-#else
- CALL WRITE_SURF(HPROGRAM,YRECFM,XICE_STO(:,:),IRESP,HCOMMENT=YCOMMENT)
-#endif
-ENDIF
-!
-!* Leaf Area Index
-!
-IF (CPHOTO/='NON' .AND. CPHOTO/='AGS' .AND. CPHOTO/='AST') THEN
- !
-#ifdef MNH_PARALLEL
- YCOMMENT='X_Y_LAI (m2/m2)'
- DO JPATCH=1,SIZE(XLAI,2)
- IF(LASSIM) THEN
- IF(CASSIM=='PLUS ') THEN
- YRECFM='LAIp'
- WRITE(YRECFM,FMT='(A4,I4.4)') 'LAIp',JPATCH
- ELSEIF(CASSIM=='AVERA') THEN
- YRECFM='LAIa'
- WRITE(YRECFM,FMT='(A4,I4.4)') 'LAIa',JPATCH
- ELSEIF(CASSIM=='2DVAR') THEN
- YRECFM='LAI'
- WRITE(YRECFM,FMT='(A3,I4.4)') 'LAI',JPATCH
- ENDIF
- ELSE
- YRECFM='LAI'
- WRITE(YRECFM,FMT='(A3,I4.4)') 'LAI',JPATCH
- ENDIF
- CALL WRITE_SURF(HPROGRAM,YRECFM,XLAI(:,JPATCH),IRESP,HCOMMENT=YCOMMENT)
- ENDDO
-#else
- IF(LASSIM) THEN
- IF(CASSIM=='PLUS ') THEN
- YRECFM='LAIp'
- ELSEIF(CASSIM=='AVERA') THEN
- YRECFM='LAIa'
- ELSEIF(CASSIM=='2DVAR') THEN
- YRECFM='LAI'
- ENDIF
- ELSE
- YRECFM='LAI'
- ENDIF
- !
- YCOMMENT='X_Y_LAI (m2/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XLAI(:,:),IRESP,HCOMMENT=YCOMMENT)
-#endif
- !
-END IF
-!
-!* snow mantel
-!
- CALL WRITESURF_GR_SNOW(HPROGRAM,'VEG',' ',TSNOW)
-!
-!
-!* key and/or field usefull to make an external prep
-!
-YRECFM = 'GLACIER'
-YCOMMENT='LGLACIER key for external prep'
- CALL WRITE_SURF(HPROGRAM,YRECFM,LGLACIER,IRESP,HCOMMENT=YCOMMENT)
-!
-IF(CISBA=='DIF')THEN
-!
- YRECFM = 'SOC'
- YCOMMENT='SOC key for external prep'
- CALL WRITE_SURF(HPROGRAM,YRECFM,CSOC,IRESP,HCOMMENT=YCOMMENT)
-!
- IF(CSOC=='SGH')THEN
-! Fraction for each patch
- YRECFM='PATCH'
- YCOMMENT='X_Y_PATCH (-) for external prep with SOC'
-#ifdef MNH_PARALLEL
- DO JPATCH=1,SIZE(XPATCH,2)
- WRITE(YRECFM,FMT='(A5,I4.4)') 'PATCH',JPATCH
- CALL WRITE_SURF(HPROGRAM,YRECFM,XPATCH(:,JPATCH),IRESP,HCOMMENT=YCOMMENT)
- ENDDO
-#else
- CALL WRITE_SURF(HPROGRAM,YRECFM,XPATCH(:,:),IRESP,HCOMMENT=YCOMMENT)
-#endif
- ENDIF
-!
-ELSE
-!
- YRECFM = 'TEMPARP'
- YCOMMENT='LTEMP_ARP key for external prep'
- CALL WRITE_SURF(HPROGRAM,YRECFM,LTEMP_ARP,IRESP,HCOMMENT=YCOMMENT)
-!
- IF(LTEMP_ARP)THEN
- YRECFM = 'NTEMPLARP'
- YCOMMENT='NTEMPLAYER_ARP for external prep'
- CALL WRITE_SURF(HPROGRAM,YRECFM,NTEMPLAYER_ARP,IRESP,HCOMMENT=YCOMMENT)
- ENDIF
-!
-ENDIF
-!
-!-------------------------------------------------------------------------------
-!
-!* 4. Semi-prognostic variables
-! -------------------------
-!
-!
-!* patch averaged radiative temperature (K)
-!
-YRECFM='TSRAD_NAT'
-YCOMMENT='X_TSRAD_NAT (K)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XTSRAD_NAT(:),IRESP,HCOMMENT=YCOMMENT)
-!
-!* aerodynamical resistance
-!
-YRECFM='RESA'
-YCOMMENT='X_Y_RESA (s/m)'
-#ifdef MNH_PARALLEL
-DO JPATCH=1,SIZE(XRESA,2)
- WRITE(YRECFM,FMT='(A4,I4.4)') 'RESA',JPATCH
- CALL WRITE_SURF(HPROGRAM,YRECFM,XRESA(:,JPATCH),IRESP,HCOMMENT=YCOMMENT)
-ENDDO
-#else
- CALL WRITE_SURF(HPROGRAM,YRECFM,XRESA(:,:),IRESP,HCOMMENT=YCOMMENT)
-#endif
-!
-!* Land use variables
-!
-IF(OLAND_USE)THEN
-!
- YRECFM='OLD_PATCH'
- YCOMMENT='X_Y_OLD_PATCH (-)'
-#ifdef MNH_PARALLEL
- DO JPATCH=1,SIZE(XPATCH,2)
- WRITE(YRECFM,FMT='(A9,I4.4)') 'OLD_PATCH',JPATCH
- CALL WRITE_SURF(HPROGRAM,YRECFM,XPATCH(:,JPATCH),IRESP,HCOMMENT=YCOMMENT)
- ENDDO
-#else
- CALL WRITE_SURF(HPROGRAM,YRECFM,XPATCH(:,:),IRESP,HCOMMENT=YCOMMENT)
-#endif
-!
- DO JLAYER=1,NGROUND_LAYER
- WRITE(YLVL,'(I4)') JLAYER
- YRECFM='OLD_DG'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
- YFORM='(A6,I1.1,A8)'
- IF (JLAYER >= 10) YFORM='(A6,I2.2,A8)'
- WRITE(YCOMMENT,FMT=YFORM) 'X_Y_OLD_DG',JLAYER,' (m)'
-#ifdef MNH_PARALLEL
- DO JPATCH=1,SIZE(XDG,3)
- IF (JLAYER >= 10) WRITE(YRECFM,FMT='(A6,I2,I4.4)') 'OLD_DG',JLAYER,JPATCH
- IF (JLAYER < 10) WRITE(YRECFM,FMT='(A6,I1,I4.4)') 'OLD_DG',JLAYER,JPATCH
- CALL WRITE_SURF(HPROGRAM,YRECFM,XDG(:,JLAYER,JPATCH),IRESP,HCOMMENT=YCOMMENT)
- ENDDO
-#else
- CALL WRITE_SURF(HPROGRAM,YRECFM,XDG(:,JLAYER,:),IRESP,HCOMMENT=YCOMMENT)
-#endif
- END DO
-!
-ENDIF
-!
-!* ISBA-AGS variables
-!
-IF (CPHOTO/='NON') THEN
- YRECFM='AN'
- YCOMMENT='X_Y_AN (kgCO2/kgair m/s)'
-#ifdef MNH_PARALLEL
- DO JPATCH=1,SIZE(XAN,2)
- WRITE(YRECFM,FMT='(A2,I4.4)') 'AN',JPATCH
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAN(:,JPATCH),IRESP,HCOMMENT=YCOMMENT)
- ENDDO
-#else
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAN(:,:),IRESP,HCOMMENT=YCOMMENT)
-#endif
-!
- YRECFM='ANDAY'
- YCOMMENT='X_Y_ANDAY (kgCO2/m2/day)'
-#ifdef MNH_PARALLEL
- DO JPATCH=1,SIZE(XANDAY,2)
- WRITE(YRECFM,FMT='(A5,I4.4)') 'ANDAY',JPATCH
- CALL WRITE_SURF(HPROGRAM,YRECFM,XANDAY(:,JPATCH),IRESP,HCOMMENT=YCOMMENT)
- ENDDO
-#else
- CALL WRITE_SURF(HPROGRAM,YRECFM,XANDAY(:,:),IRESP,HCOMMENT=YCOMMENT)
-#endif
-!
- YRECFM='ANFM'
- YCOMMENT='X_Y_ANFM (kgCO2/kgair m/s)'
-#ifdef MNH_PARALLEL
- DO JPATCH=1,SIZE(XANFM,2)
- WRITE(YRECFM,FMT='(A4,I4.4)') 'ANFM',JPATCH
- CALL WRITE_SURF(HPROGRAM,YRECFM,XANFM(:,JPATCH),IRESP,HCOMMENT=YCOMMENT)
- ENDDO
-#else
- CALL WRITE_SURF(HPROGRAM,YRECFM,XANFM(:,:),IRESP,HCOMMENT=YCOMMENT)
-#endif
-!
- YRECFM='LE_AGS'
- YCOMMENT='X_Y_LE_AGS (W/m2)'
-#ifdef MNH_PARALLEL
- DO JPATCH=1,SIZE(XLE,2)
- WRITE(YRECFM,FMT='(A6,I4.4)') 'LE_AGS',JPATCH
- CALL WRITE_SURF(HPROGRAM,YRECFM,XLE(:,JPATCH),IRESP,HCOMMENT=YCOMMENT)
- ENDDO
-#else
- CALL WRITE_SURF(HPROGRAM,YRECFM,XLE(:,:),IRESP,HCOMMENT=YCOMMENT)
-#endif
-END IF
-!
-!
-IF (CPHOTO=='NIT' .OR. CPHOTO=='NCB') THEN
- !
- DO JNBIOMASS=1,NNBIOMASS
- YFORM='(A11,I1.1,A10)'
- WRITE(YCOMMENT,FMT=YFORM) 'X_Y_BIOMASS',JNBIOMASS,' (kgDM/m2)'
-#ifdef MNH_PARALLEL
- DO JPATCH=1,SIZE(XLE,2)
- WRITE(YPATCH,'(I1,I4.4)') JNBIOMASS,JPATCH
- YRECFM='LE_AGS'//ADJUSTL(YPATCH(:LEN_TRIM(YPATCH)))
- CALL WRITE_SURF(HPROGRAM,YRECFM,XBIOMASS(:,JNBIOMASS,JPATCH),IRESP,HCOMMENT=YCOMMENT)
- ENDDO
-#else
- WRITE(YLVL,'(I1)') JNBIOMASS
- YRECFM='BIOMA'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
- CALL WRITE_SURF(HPROGRAM,YRECFM,XBIOMASS(:,JNBIOMASS,:),IRESP,HCOMMENT=YCOMMENT)
-#endif
- END DO
- !
- !
- DO JNBIOMASS=2,NNBIOMASS-2
- YFORM='(A16,I1.1,A10)'
- WRITE(YCOMMENT,FMT=YFORM) 'X_Y_RESP_BIOMASS',JNBIOMASS,' (kg/m2/s)'
-#ifdef MNH_PARALLEL
- DO JPATCH=1,SIZE(XLE,2)
- WRITE(YPATCH,'(I1,I4.4)') JNBIOMASS,JPATCH
- YRECFM='RESPI'//ADJUSTL(YPATCH(:LEN_TRIM(YPATCH)))
- CALL WRITE_SURF(HPROGRAM,YRECFM,XRESP_BIOMASS(:,JNBIOMASS,JPATCH),IRESP,HCOMMENT=YCOMMENT)
- ENDDO
-#else
- WRITE(YLVL,'(I1)') JNBIOMASS
- YRECFM='RESPI'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
- CALL WRITE_SURF(HPROGRAM,YRECFM,XRESP_BIOMASS(:,JNBIOMASS,:),IRESP,HCOMMENT=YCOMMENT)
-#endif
- END DO
- !
- IF (CPHOTO=='NIT') THEN
- !
- DO JNBIOMASS=NNBIOMASS-1,NNBIOMASS
- YFORM='(A16,I1.1,A10)'
- WRITE(YCOMMENT,FMT=YFORM) 'X_Y_RESP_BIOMASS',JNBIOMASS,' (kg/m2/s)'
-#ifdef MNH_PARALLEL
- DO JPATCH=1,SIZE(XLE,2)
- WRITE(YPATCH,'(I1,I4.4)') JNBIOMASS,JPATCH
- YRECFM='RESPI'//ADJUSTL(YPATCH(:LEN_TRIM(YPATCH)))
- CALL WRITE_SURF(HPROGRAM,YRECFM,XRESP_BIOMASS(:,JNBIOMASS,JPATCH),IRESP,HCOMMENT=YCOMMENT)
- ENDDO
-#else
- WRITE(YLVL,'(I1)') JNBIOMASS
- YRECFM='RESPI'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
- CALL WRITE_SURF(HPROGRAM,YRECFM,XRESP_BIOMASS(:,JNBIOMASS,:),IRESP,HCOMMENT=YCOMMENT)
-#endif
- END DO
- !
- ENDIF
- !
-END IF
-!
-!* Soil carbon
-!
-YRECFM = 'RESPSL'
-YCOMMENT=YRECFM
- CALL WRITE_SURF(HPROGRAM,YRECFM,CRESPSL,IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='NLITTER'
-YCOMMENT=YRECFM
- CALL WRITE_SURF(HPROGRAM,YRECFM,NNLITTER,IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='NLITTLEVS'
-YCOMMENT=YRECFM
- CALL WRITE_SURF(HPROGRAM,YRECFM,NNLITTLEVS,IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='NSOILCARB'
-YCOMMENT=YRECFM
- CALL WRITE_SURF(HPROGRAM,YRECFM,NNSOILCARB,IRESP,HCOMMENT=YCOMMENT)
-!
-IF(LSPINUPCARBS.OR.LSPINUPCARBW)THEN
- YRECFM='NBYEARSOLD'
- YCOMMENT='yrs'
- CALL WRITE_SURF(HPROGRAM,YRECFM,NNBYEARSOLD,IRESP,HCOMMENT=YCOMMENT)
-ENDIF
-!
-IF (CRESPSL=='CNT') THEN
- !
- DO JNLITTER=1,NNLITTER
- DO JNLITTLEVS=1,NNLITTLEVS
- YFORM='(A10,I1.1,A1,I1.1,A8)'
- WRITE(YCOMMENT,FMT=YFORM) 'X_Y_LITTER',JNLITTER,' ',JNLITTLEVS,' (gC/m2)'
-#ifdef MNH_PARALLEL
- DO JPATCH=1,SIZE(XLE,2)
- WRITE(YPATCH,'(I1,A1,I1,I4.4)') JNLITTER,'_',JNLITTLEVS,JPATCH
- YRECFM='LITTER'//ADJUSTL(YPATCH(:LEN_TRIM(YPATCH)))
- CALL WRITE_SURF(HPROGRAM,YRECFM,XLITTER(:,JNLITTER,JNLITTLEVS,JPATCH),IRESP,HCOMMENT=YCOMMENT)
- ENDDO
-#else
- WRITE(YLVL,'(I1,A1,I1)') JNLITTER,'_',JNLITTLEVS
- YRECFM='LITTER'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
- CALL WRITE_SURF(HPROGRAM,YRECFM,XLITTER(:,JNLITTER,JNLITTLEVS,:),IRESP,HCOMMENT=YCOMMENT)
-#endif
- END DO
- END DO
-
- DO JNSOILCARB=1,NNSOILCARB
- YFORM='(A8,I1.1,A8)'
- WRITE(YCOMMENT,FMT=YFORM) 'X_Y_SOILCARB',JNSOILCARB,' (gC/m2)'
-#ifdef MNH_PARALLEL
- DO JPATCH=1,SIZE(XLE,2)
- WRITE(YPATCH,'(I4,I4.4)') JNSOILCARB,JPATCH
- YRECFM='SOILCARB'//ADJUSTL(YPATCH(:LEN_TRIM(YPATCH)))
- CALL WRITE_SURF(HPROGRAM,YRECFM,XSOILCARB(:,JNSOILCARB,JPATCH),IRESP,HCOMMENT=YCOMMENT)
- ENDDO
-#else
- WRITE(YLVL,'(I4)') JNSOILCARB
- YRECFM='SOILCARB'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
- CALL WRITE_SURF(HPROGRAM,YRECFM,XSOILCARB(:,JNSOILCARB,:),IRESP,HCOMMENT=YCOMMENT)
-#endif
- END DO
-!
- DO JNLITTLEVS=1,NNLITTLEVS
- YFORM='(A12,I1.1,A8)'
- WRITE(YCOMMENT,FMT=YFORM) 'X_Y_LIGNIN_STRUC',JNLITTLEVS,' (-)'
-#ifdef MNH_PARALLEL
- DO JPATCH=1,SIZE(XLE,2)
- WRITE(YPATCH,'(I4,I4.4)') JNLITTLEVS,JPATCH
- YRECFM='LIGNIN_STR'//ADJUSTL(YPATCH(:LEN_TRIM(YPATCH)))
- CALL WRITE_SURF(HPROGRAM,YRECFM,XLIGNIN_STRUC(:,JNLITTLEVS,JPATCH),IRESP,HCOMMENT=YCOMMENT)
- ENDDO
-#else
- WRITE(YLVL,'(I4)') JNLITTLEVS
- YRECFM='LIGNIN_STR'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
- CALL WRITE_SURF(HPROGRAM,YRECFM,XLIGNIN_STRUC(:,JNLITTLEVS,:),IRESP,HCOMMENT=YCOMMENT)
-#endif
- END DO
-!
-ENDIF
-!
-!
-IF (NDSTEQ > 0)THEN
- DO JSV = 1,NDSTMDE ! for all dust modes
- WRITE(YRECFM,'(A8,I3.3)')'FLX_DSTM',JSV
- YCOMMENT='X_Y_'//YRECFM//' (kg/m2)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XSFDSTM(:,JSV,:),IRESP,HCOMMENT=YCOMMENT)
- END DO
-ENDIF
-!
-!-------------------------------------------------------------------------------
-!
-!* 5. Time
-! ----
-!
-YRECFM='DTCUR'
-YCOMMENT='s'
- CALL WRITE_SURF(HPROGRAM,YRECFM,TTIME,IRESP,HCOMMENT=YCOMMENT)
-IF (LHOOK) CALL DR_HOOK('WRITESURF_ISBA_N',1,ZHOOK_HANDLE)
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE WRITESURF_ISBA_n
+!SURFEX_LIC Copyright 1994-2014 Meteo-France
+!SURFEX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SURFEX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SURFEX_LIC for details. version 1.
+! #########
+ SUBROUTINE WRITESURF_ISBA_n(HPROGRAM,OLAND_USE)
+! #####################################
+!
+!!**** *WRITESURF_ISBA_n* - writes ISBA prognostic fields
+!!
+!!
+!! PURPOSE
+!! -------
+!!
+!!** METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Masson *Meteo France*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 01/2003
+!! P. LeMoigne 12/2004 : correct dimensionning if more than 10 layers in
+!! the soil (diffusion version)
+!! B. Decharme 2008 : Floodplains
+!! B. Decharme 01/2009 : Optional Arpege deep soil temperature write
+!! A.L. Gibelin 03/09 : modifications for CENTURY model
+!! A.L. Gibelin 04/2009 : BIOMASS and RESP_BIOMASS arrays
+!! A.L. Gibelin 06/2009 : Soil carbon variables for CNT option
+!! B. Decharme 07/2011 : land_use semi-prognostic variables
+!! B. Decharme 09/2012 : suppress NWG_LAYER (parallelization problems)
+!! B. Decharme 09/2012 : write some key for prep_read_external
+!! M.Moge 01/2016 using WRITE_SURF_FIELD2D/3D for 2D/3D surfex fields writes
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_SURF_PAR, ONLY : NUNDEF
+!
+USE MODD_ISBA_n, ONLY : NGROUND_LAYER, CISBA, CPHOTO, CRESPSL, CSOC, &
+ NNBIOMASS, NNLITTER, NNSOILCARB, NNLITTLEVS, &
+ XTG, XWG, XWGI, XWR, XLAI, TSNOW, XTSRAD_NAT,&
+ XRESA, XAN, XANFM, XLE, XANDAY, TTIME, &
+ XRESP_BIOMASS, XBIOMASS, XPATCH, XDG, &
+ XLITTER, XSOILCARB, XLIGNIN_STRUC, LFLOOD, &
+ XZ0_FLOOD, LTEMP_ARP, NTEMPLAYER_ARP, &
+ LGLACIER, XICE_STO, LSPINUPCARBS, &
+ LSPINUPCARBW, NNBYEARSOLD
+!
+USE MODD_ASSIM, ONLY : LASSIM, CASSIM
+!
+USE MODD_CH_ISBA_n, ONLY : NDSTEQ
+USE MODD_DST_n
+USE MODD_DST_SURF
+!
+USE MODI_WRITE_SURF
+USE MODI_WRITESURF_GR_SNOW
+!
+USE MODI_WRITE_SURF_FIELD3D
+USE MODI_WRITE_SURF_FIELD2D
+!
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of arguments
+! -------------------------
+!
+ CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling
+LOGICAL, INTENT(IN) :: OLAND_USE !
+!
+!* 0.2 Declarations of local variables
+! -------------------------------
+!
+INTEGER :: IRESP ! IRESP : return-code if a problem appears
+ CHARACTER(LEN=12) :: YRECFM ! Name of the article to be read
+ CHARACTER(LEN=4 ) :: YLVL
+ CHARACTER(LEN=5 ) :: YPATCH
+ CHARACTER(LEN=100):: YCOMMENT ! Comment string
+ CHARACTER(LEN=100):: YCOMMENTUNIT ! Comment string : unit of the datas in the field to write
+ CHARACTER(LEN=25) :: YFORM ! Writing format
+!
+INTEGER :: JJ, JLAYER, JP, JNBIOMASS, JNLITTER, JNSOILCARB, JNLITTLEVS ! loop counter on levels
+INTEGER :: IWORK ! Work integer
+INTEGER :: JSV
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+!------------------------------------------------------------------------------
+!
+!* 2. Prognostic fields:
+! -----------------
+!
+IF (LHOOK) CALL DR_HOOK('WRITESURF_ISBA_N',0,ZHOOK_HANDLE)
+!* soil temperatures
+!
+IF(LTEMP_ARP)THEN
+ IWORK=NTEMPLAYER_ARP
+ELSE
+ IWORK=NGROUND_LAYER
+ENDIF
+!
+YRECFM='TG'
+YCOMMENT='X_Y_TG'
+YCOMMENTUNIT='K'
+CALL WRITE_SURF_FIELD3D(HPROGRAM,XTG,1,IWORK,YRECFM,YCOMMENT,YCOMMENTUNIT)
+!
+!* soil liquid water contents
+!
+YRECFM='WG'
+YCOMMENT='X_Y_WG'
+YCOMMENTUNIT='m3/m3'
+CALL WRITE_SURF_FIELD3D(HPROGRAM,XWG,1,NGROUND_LAYER,YRECFM,YCOMMENT,YCOMMENTUNIT)
+!
+!* soil ice water contents
+!
+YRECFM='WGI'
+YCOMMENT='X_Y_WGI'
+YCOMMENTUNIT='m3/m3'
+CALL WRITE_SURF_FIELD3D(HPROGRAM,XWGI,1,NGROUND_LAYER,YRECFM,YCOMMENT,YCOMMENTUNIT)
+!
+!* water intercepted on leaves
+!
+YRECFM='WR'
+YCOMMENT='X_Y_WR'
+YCOMMENTUNIT='kg/m2'
+CALL WRITE_SURF_FIELD2D(HPROGRAM,XWR,YRECFM,YCOMMENT,YCOMMENTUNIT)
+!
+!* roughness length of Flood water
+!
+IF(LFLOOD)THEN
+ YRECFM='Z0_FLOOD'
+ YCOMMENT='X_Y_Z0_FLOOD'
+ YCOMMENTUNIT='-'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XZ0_FLOOD,YRECFM,YCOMMENT,YCOMMENTUNIT)
+ENDIF
+!
+!* Glacier ice storage
+!
+IF(LGLACIER)THEN
+ YRECFM='ICE_STO'
+ YCOMMENT='X_Y_ICE_STO'
+ YCOMMENTUNIT='kg/m2'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XICE_STO,YRECFM,YCOMMENT,YCOMMENTUNIT)
+ENDIF
+!
+!* Leaf Area Index
+!
+IF (CPHOTO/='NON' .AND. CPHOTO/='AGS' .AND. CPHOTO/='AST') THEN
+ !
+ IF(LASSIM) THEN
+ IF(CASSIM=='PLUS ') THEN
+ YRECFM='LAIp'
+ ELSEIF(CASSIM=='AVERA') THEN
+ YRECFM='LAIa'
+ ELSEIF(CASSIM=='2DVAR') THEN
+ YRECFM='LAI'
+ ENDIF
+ ELSE
+ YRECFM='LAI'
+ ENDIF
+ !
+ YCOMMENT='X_Y_LAI'
+ YCOMMENTUNIT='m2/m2'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XLAI,YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+END IF
+!
+!* snow mantel
+!
+ CALL WRITESURF_GR_SNOW(HPROGRAM,'VEG',' ',TSNOW)
+!
+!
+!* key and/or field usefull to make an external prep
+!
+YRECFM = 'GLACIER'
+YCOMMENT='LGLACIER key for external prep'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,LGLACIER,IRESP,HCOMMENT=YCOMMENT)
+!
+IF(CISBA=='DIF')THEN
+!
+ YRECFM = 'SOC'
+ YCOMMENT='SOC key for external prep'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,CSOC,IRESP,HCOMMENT=YCOMMENT)
+!
+ IF(CSOC=='SGH')THEN
+! Fraction for each patch
+ YRECFM='PATCH'
+ YCOMMENT='X_Y_PATCH for external prep with SOC'
+ YCOMMENTUNIT='-'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XPATCH,YRECFM,YCOMMENT,YCOMMENTUNIT)
+ ENDIF
+!
+ELSE
+!
+ YRECFM = 'TEMPARP'
+ YCOMMENT='LTEMP_ARP key for external prep'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,LTEMP_ARP,IRESP,HCOMMENT=YCOMMENT)
+!
+ IF(LTEMP_ARP)THEN
+ YRECFM = 'NTEMPLARP'
+ YCOMMENT='NTEMPLAYER_ARP for external prep'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,NTEMPLAYER_ARP,IRESP,HCOMMENT=YCOMMENT)
+ ENDIF
+!
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+!* 4. Semi-prognostic variables
+! -------------------------
+!
+!
+!* patch averaged radiative temperature (K)
+!
+YRECFM='TSRAD_NAT'
+YCOMMENT='X_TSRAD_NAT (K)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XTSRAD_NAT(:),IRESP,HCOMMENT=YCOMMENT)
+!
+!* aerodynamical resistance
+!
+YRECFM='RESA'
+YCOMMENT='X_Y_RESA (s/m)'
+YCOMMENTUNIT='s/m'
+CALL WRITE_SURF_FIELD2D(HPROGRAM,XRESA,YRECFM,YCOMMENT,YCOMMENTUNIT)
+!#endif
+!
+!* Land use variables
+!
+IF(OLAND_USE)THEN
+!
+ YRECFM='OLD_PATCH'
+ YCOMMENT='X_Y_OLD_PATCH (-)'
+ YCOMMENTUNIT='-'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XPATCH,YRECFM,YCOMMENT,YCOMMENTUNIT)
+!
+ YRECFM='OLD_DG'
+ YCOMMENT='X_Y_OLD_DG'
+ YCOMMENTUNIT='m'
+ CALL WRITE_SURF_FIELD3D(HPROGRAM,XDG,1,NGROUND_LAYER,YRECFM,YCOMMENT,YCOMMENTUNIT)
+!
+ENDIF
+!
+!* ISBA-AGS variables
+!
+IF (CPHOTO/='NON') THEN
+ YRECFM='AN'
+ YCOMMENT='X_Y_AN'
+ YCOMMENTUNIT='kgCO2/kgair m/s'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XAN,YRECFM,YCOMMENT,YCOMMENTUNIT)
+!
+ YRECFM='ANDAY'
+ YCOMMENT='X_Y_ANDAY'
+ YCOMMENTUNIT='kgCO2/m2/day'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XANDAY,YRECFM,YCOMMENT,YCOMMENTUNIT)
+!
+ YRECFM='ANFM'
+ YCOMMENT='X_Y_ANFM'
+ YCOMMENTUNIT='kgCO2/kgair m/s'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XANFM,YRECFM,YCOMMENT,YCOMMENTUNIT)
+!
+ YRECFM='LE_AGS'
+ YCOMMENT='X_Y_LE_AGS'
+ YCOMMENTUNIT='W/m2'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XLE,YRECFM,YCOMMENT,YCOMMENTUNIT)
+END IF
+!
+!
+IF (CPHOTO=='NIT' .OR. CPHOTO=='NCB') THEN
+ !
+YRECFM='BIOMA'
+YCOMMENT='X_Y_BIOMASS'
+YCOMMENTUNIT='kgDM/m2'
+CALL WRITE_SURF_FIELD3D(HPROGRAM,XBIOMASS,1,NNBIOMASS,YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ !
+ YRECFM='RESPI'
+ YCOMMENT='X_Y_RESP_BIOMASS'
+ YCOMMENTUNIT='kg/m2/s'
+ CALL WRITE_SURF_FIELD3D(HPROGRAM,XRESP_BIOMASS,2,NNBIOMASS-2,YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ IF (CPHOTO=='NIT') THEN
+ !
+ YRECFM='RESPI'
+ YCOMMENT='X_Y_RESP_BIOMASS'
+ YCOMMENTUNIT='kg/m2/s'
+ CALL WRITE_SURF_FIELD3D(HPROGRAM,XRESP_BIOMASS,NNBIOMASS-1,NNBIOMASS,YRECFM,YCOMMENT,YCOMMENTUNIT)
+ !
+ ENDIF
+ !
+END IF
+!
+!* Soil carbon
+!
+YRECFM = 'RESPSL'
+YCOMMENT=YRECFM
+ CALL WRITE_SURF(HPROGRAM,YRECFM,CRESPSL,IRESP,HCOMMENT=YCOMMENT)
+!
+YRECFM='NLITTER'
+YCOMMENT=YRECFM
+ CALL WRITE_SURF(HPROGRAM,YRECFM,NNLITTER,IRESP,HCOMMENT=YCOMMENT)
+!
+YRECFM='NLITTLEVS'
+YCOMMENT=YRECFM
+ CALL WRITE_SURF(HPROGRAM,YRECFM,NNLITTLEVS,IRESP,HCOMMENT=YCOMMENT)
+!
+YRECFM='NSOILCARB'
+YCOMMENT=YRECFM
+ CALL WRITE_SURF(HPROGRAM,YRECFM,NNSOILCARB,IRESP,HCOMMENT=YCOMMENT)
+!
+IF(LSPINUPCARBS.OR.LSPINUPCARBW)THEN
+ YRECFM='NBYEARSOLD'
+ YCOMMENT='yrs'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,NNBYEARSOLD,IRESP,HCOMMENT=YCOMMENT)
+ENDIF
+!
+IF (CRESPSL=='CNT') THEN
+ !
+ DO JNLITTER=1,NNLITTER
+ DO JNLITTLEVS=1,NNLITTLEVS
+ YFORM='(A10,I1.1,A1,I1.1)'
+ WRITE(YCOMMENT,FMT=YFORM) 'X_Y_LITTER',JNLITTER,' ',JNLITTLEVS
+ WRITE(YLVL,'(I1,A1,I1)') JNLITTER,'_',JNLITTLEVS
+ YRECFM='LITTER'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))
+ YCOMMENTUNIT='gC/m2'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XLITTER(:,JNLITTER,JNLITTLEVS,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ END DO
+ END DO
+!
+ YRECFM='SOILCARB'
+ YCOMMENT='X_Y_SOILCARB'
+ YCOMMENTUNIT='gC/m2'
+ CALL WRITE_SURF_FIELD3D(HPROGRAM,XSOILCARB,1,NNSOILCARB,YRECFM,YCOMMENT,YCOMMENTUNIT)
+!
+ YRECFM='LIGNIN_STR'
+ YCOMMENT='X_Y_LIGNIN_STRUC'
+ YCOMMENTUNIT='-'
+ CALL WRITE_SURF_FIELD3D(HPROGRAM,XLIGNIN_STRUC,1,NNLITTLEVS,YRECFM,YCOMMENT,YCOMMENTUNIT)
+!
+ENDIF
+!
+!
+IF (NDSTEQ > 0)THEN
+ YRECFM='FLX_DSTM'
+ YCOMMENT='X_Y_FLX_DSTM'
+ YCOMMENTUNIT='kg/m2'
+ CALL WRITE_SURF_FIELD3D(HPROGRAM,XSFDSTM,1,NDSTMDE,YRECFM,YCOMMENT,YCOMMENTUNIT)
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+!* 5. Time
+! ----
+!
+YRECFM='DTCUR'
+YCOMMENT='s'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,TTIME,IRESP,HCOMMENT=YCOMMENT)
+IF (LHOOK) CALL DR_HOOK('WRITESURF_ISBA_N',1,ZHOOK_HANDLE)
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE WRITESURF_ISBA_n
diff --git a/src/SURFEX/writesurf_pgd_isba_parn.F90 b/src/SURFEX/writesurf_pgd_isba_parn.F90
index 576f5a99a..cee2a9701 100644
--- a/src/SURFEX/writesurf_pgd_isba_parn.F90
+++ b/src/SURFEX/writesurf_pgd_isba_parn.F90
@@ -1,489 +1,531 @@
-!SURFEX_LIC Copyright 1994-2014 Meteo-France
-!SURFEX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SURFEX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SURFEX_LIC for details. version 1.
-! #########
- SUBROUTINE WRITESURF_PGD_ISBA_PAR_n(HPROGRAM)
-! ################################################
-!
-!!**** *WRITESURF_PGD_ISBA_PAR_n* - writes ISBA physiographic fields
-!!
-!!
-!! PURPOSE
-!! -------
-!!
-!!** METHOD
-!! ------
-!!
-!! EXTERNAL
-!! --------
-!!
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! V. Masson *Meteo France*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 01/2003
-!! P. Le Moigne 12/2004 : add type of photosynthesis
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_DATA_ISBA_n, ONLY : NTIME, XPAR_VEG, XPAR_LAI,XPAR_RSMIN,XPAR_GAMMA,XPAR_WRMAX_CF, &
- XPAR_RGL,XPAR_CV,XPAR_DG,XPAR_Z0,XPAR_Z0_O_Z0H, &
- XPAR_ALBNIR_VEG,XPAR_ALBVIS_VEG, XPAR_ALBUV_VEG, &
- XPAR_ALBNIR_SOIL,XPAR_ALBVIS_SOIL, XPAR_ALBUV_SOIL, &
- XPAR_EMIS, XPAR_DICE, &
- XPAR_VEGTYPE,XPAR_ROOTFRAC, &
- XPAR_GMES,XPAR_BSLAI,XPAR_LAIMIN,XPAR_SEFOLD,XPAR_GC, &
- XPAR_DMAX, XPAR_F2I, LDATA_STRESS, XPAR_H_TREE,XPAR_RE25,&
- XPAR_CE_NITRO,XPAR_CF_NITRO,XPAR_CNA_NITRO, &
- XPAR_GROUND_DEPTH, XPAR_ROOT_DEPTH, &
- XPAR_ROOT_EXTINCTION, XPAR_ROOT_LIN, &
- LPAR_STRESS, XPAR_IRRIG, XPAR_WATSUP, &
- LDATA_VEGTYPE, LDATA_LAI, LDATA_H_TREE, LDATA_DG, LDATA_ROOTFRAC,&
- LDATA_VEG, LDATA_Z0, LDATA_EMIS, LDATA_DICE, &
- LDATA_RSMIN, LDATA_GAMMA, LDATA_WRMAX_CF, LDATA_RGL, &
- LDATA_CV, LDATA_Z0_O_Z0H, &
- LDATA_ALBNIR_VEG, LDATA_ALBVIS_VEG, LDATA_ALBUV_VEG, &
- LDATA_ALBVIS_SOIL, LDATA_ALBNIR_SOIL, LDATA_ALBUV_SOIL, &
- LDATA_GMES, LDATA_BSLAI, LDATA_SEFOLD, LDATA_GC, LDATA_DMAX, &
- LDATA_RE25, LDATA_LAIMIN, LDATA_F2I, &
- LDATA_CE_NITRO,LDATA_CF_NITRO, LDATA_CNA_NITRO,&
- LDATA_STRESS, LDATA_IRRIG, LDATA_WATSUP, &
- LDATA_GROUND_DEPTH, LDATA_ROOT_DEPTH, &
- LDATA_ROOT_EXTINCTION, LDATA_ROOT_LIN
-
-!
-USE MODI_WRITE_SURF
-!
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of arguments
-! -------------------------
-!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling
-!
-!* 0.2 Declarations of local variables
-! -------------------------------
-!
-INTEGER :: IRESP ! IRESP : return-code if a problem appears
- CHARACTER(LEN=12) :: YRECFM ! Name of the article to be read
- CHARACTER(LEN=100):: YCOMMENT ! Comment string
-INTEGER :: JTIME ! loop index
-INTEGER :: JLAYER ! loop index
-INTEGER :: JPATCH ! loop index
-REAL, DIMENSION(:,:), ALLOCATABLE :: ZWORK
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-!-------------------------------------------------------------------------------
-!
-IF (LHOOK) CALL DR_HOOK('WRITESURF_PGD_ISBA_PAR_N',0,ZHOOK_HANDLE)
-YRECFM='L_VEGTYPE'
-YCOMMENT=YRECFM
- CALL WRITE_SURF(HPROGRAM,YRECFM,LDATA_VEGTYPE,IRESP,HCOMMENT=YCOMMENT)
-IF (LDATA_VEGTYPE) THEN
- YRECFM='D_VEGTYPE'
- YCOMMENT='X_Y_DATA_VEGTYPE'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XPAR_VEGTYPE(:,:),IRESP,HCOMMENT=YCOMMENT)
-ENDIF
-!
-IF (LDATA_LAI .OR. LDATA_VEG .OR. LDATA_Z0 .OR. LDATA_EMIS) THEN
- YRECFM='NDATA_TIME'
- YCOMMENT='(-)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,NTIME,IRESP,HCOMMENT=YCOMMENT)
-ENDIF
-!
-YRECFM='L_VEG'
-YCOMMENT=YRECFM
- CALL WRITE_SURF(HPROGRAM,YRECFM,LDATA_VEG,IRESP,HCOMMENT=YCOMMENT)
-IF (LDATA_VEG) THEN
- DO JTIME=1,NTIME
- WRITE(YRECFM,FMT='(A7,I2.2)') 'D_VEG_T',JTIME
- YCOMMENT='X_Y_D_VEG'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XPAR_VEG(:,JTIME,:),IRESP,HCOMMENT=YCOMMENT)
- END DO
-ENDIF
-!
-YRECFM='L_LAI'
-YCOMMENT=YRECFM
- CALL WRITE_SURF(HPROGRAM,YRECFM,LDATA_LAI,IRESP,HCOMMENT=YCOMMENT)
-IF (LDATA_LAI) THEN
- DO JTIME=1,NTIME
- WRITE(YRECFM,FMT='(A7,I2.2)') 'D_LAI_T',JTIME
- YCOMMENT='X_Y_D_LAI'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XPAR_LAI(:,JTIME,:),IRESP,HCOMMENT=YCOMMENT)
- END DO
-ENDIF
-!
-YRECFM='L_Z0'
-YCOMMENT=YRECFM
- CALL WRITE_SURF(HPROGRAM,YRECFM,LDATA_Z0,IRESP,HCOMMENT=YCOMMENT)
-IF (LDATA_Z0) THEN
- DO JTIME=1,NTIME
- WRITE(YRECFM,FMT='(A6,I2.2)') 'D_Z0_T',JTIME
- YCOMMENT='X_Y_D_Z0'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XPAR_Z0(:,JTIME,:),IRESP,HCOMMENT=YCOMMENT)
- END DO
-ENDIF
-!
-YRECFM='L_EMIS'
-YCOMMENT=YRECFM
- CALL WRITE_SURF(HPROGRAM,YRECFM,LDATA_EMIS,IRESP,HCOMMENT=YCOMMENT)
-IF (LDATA_EMIS) THEN
- DO JTIME=1,NTIME
- WRITE(YRECFM,FMT='(A8,I2.2)') 'D_EMIS_T',JTIME
- YCOMMENT='X_Y_D_EMIS'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XPAR_EMIS(:,JTIME,:),IRESP,HCOMMENT=YCOMMENT)
- END DO
-ENDIF
-!
-YRECFM='L_RSMIN'
-YCOMMENT=YRECFM
- CALL WRITE_SURF(HPROGRAM,YRECFM,LDATA_RSMIN,IRESP,HCOMMENT=YCOMMENT)
-IF (LDATA_RSMIN) THEN
- YRECFM='D_RSMIN'
- YCOMMENT='X_Y_D_RSMIN'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XPAR_RSMIN(:,:),IRESP,HCOMMENT=YCOMMENT)
-ENDIF
-!
-YRECFM='L_GAMMA'
-YCOMMENT=YRECFM
- CALL WRITE_SURF(HPROGRAM,YRECFM,LDATA_GAMMA,IRESP,HCOMMENT=YCOMMENT)
-IF (LDATA_GAMMA) THEN
- YRECFM='D_GAMMA'
- YCOMMENT='X_Y_D_GAMMA'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XPAR_GAMMA(:,:),IRESP,HCOMMENT=YCOMMENT)
-ENDIF
-!
-YRECFM='L_WRMAX_CF'
-YCOMMENT=YRECFM
- CALL WRITE_SURF(HPROGRAM,YRECFM,LDATA_WRMAX_CF,IRESP,HCOMMENT=YCOMMENT)
-IF (LDATA_WRMAX_CF) THEN
- YRECFM='D_WRMAX_CF'
- YCOMMENT='X_Y_D_WRMAX_CF'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XPAR_WRMAX_CF(:,:),IRESP,HCOMMENT=YCOMMENT)
-ENDIF
-!
-YRECFM='L_RGL'
-YCOMMENT=YRECFM
- CALL WRITE_SURF(HPROGRAM,YRECFM,LDATA_RGL,IRESP,HCOMMENT=YCOMMENT)
-IF (LDATA_RGL) THEN
- YRECFM='D_RGL'
- YCOMMENT='X_Y_D_RGL'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XPAR_RGL(:,:),IRESP,HCOMMENT=YCOMMENT)
-ENDIF
-!
-YRECFM='L_CV'
-YCOMMENT=YRECFM
- CALL WRITE_SURF(HPROGRAM,YRECFM,LDATA_CV,IRESP,HCOMMENT=YCOMMENT)
-IF (LDATA_CV) THEN
- YRECFM='D_CV'
- YCOMMENT='X_Y_D_CV'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XPAR_CV(:,:),IRESP,HCOMMENT=YCOMMENT)
-ENDIF
-!
-YRECFM='L_Z0_O_Z0H'
-YCOMMENT=YRECFM
- CALL WRITE_SURF(HPROGRAM,YRECFM,LDATA_Z0_O_Z0H,IRESP,HCOMMENT=YCOMMENT)
-IF (LDATA_Z0_O_Z0H) THEN
- YRECFM='D_Z0_O_Z0H'
- YCOMMENT='X_Y_D_Z0_O_Z0H'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XPAR_Z0_O_Z0H(:,:),IRESP,HCOMMENT=YCOMMENT)
-ENDIF
-!
-YRECFM='L_DG'
-YCOMMENT=YRECFM
- CALL WRITE_SURF(HPROGRAM,YRECFM,LDATA_DG,IRESP,HCOMMENT=YCOMMENT)
-IF (LDATA_DG) THEN
- ALLOCATE(ZWORK(SIZE(XPAR_DG,1),SIZE(XPAR_DG,3)))
- DO JLAYER=1,SIZE(XPAR_DG,2)
- IF (JLAYER<10) WRITE(YRECFM,FMT='(A4,I1.1)') 'D_DG',JLAYER
- IF (JLAYER>=10) WRITE(YRECFM,FMT='(A4,I2.2)') 'D_DG',JLAYER
- YCOMMENT='X_Y_'//YRECFM
- DO JPATCH=1,SIZE(XPAR_DG,3)
- ZWORK(:,JPATCH) = XPAR_DG(:,JLAYER,JPATCH)
- END DO
- CALL WRITE_SURF(HPROGRAM,YRECFM,ZWORK,IRESP,HCOMMENT=YCOMMENT)
- END DO
- DEALLOCATE(ZWORK)
-ENDIF
-!
-YRECFM='L_ROOTFRAC'
-YCOMMENT=YRECFM
- CALL WRITE_SURF(HPROGRAM,YRECFM,LDATA_ROOTFRAC,IRESP,HCOMMENT=YCOMMENT)
-IF (LDATA_ROOTFRAC) THEN
- ALLOCATE(ZWORK(SIZE(XPAR_ROOTFRAC,1),SIZE(XPAR_ROOTFRAC,3)))
- DO JLAYER=1,SIZE(XPAR_ROOTFRAC,2)
- IF (JLAYER<10) WRITE(YRECFM,FMT='(A10,I1.1)') 'D_ROOTFRAC',JLAYER
- IF (JLAYER>=10) WRITE(YRECFM,FMT='(A10,I2.2)') 'D_ROOTFRAC',JLAYER
- YCOMMENT='X_Y_'//YRECFM
- DO JPATCH=1,SIZE(XPAR_ROOTFRAC,3)
- ZWORK(:,JPATCH) = XPAR_ROOTFRAC(:,JLAYER,JPATCH)
- END DO
- CALL WRITE_SURF(HPROGRAM,YRECFM,ZWORK,IRESP,HCOMMENT=YCOMMENT)
- END DO
- DEALLOCATE(ZWORK)
-ENDIF
-!
-YRECFM='L_GROUND_DPT'
-YCOMMENT=YRECFM
- CALL WRITE_SURF(HPROGRAM,YRECFM,LDATA_GROUND_DEPTH,IRESP,HCOMMENT=YCOMMENT)
-IF (LDATA_GROUND_DEPTH) THEN
- YRECFM='D_GROUND_DPT'
- YCOMMENT='X_Y_'//YRECFM
- CALL WRITE_SURF(HPROGRAM,YRECFM,XPAR_GROUND_DEPTH(:,:),IRESP,HCOMMENT=YCOMMENT)
-ENDIF
-!
-YRECFM='L_ROOT_DEPTH'
-YCOMMENT=YRECFM
- CALL WRITE_SURF(HPROGRAM,YRECFM,LDATA_ROOT_DEPTH,IRESP,HCOMMENT=YCOMMENT)
-IF (LDATA_ROOT_DEPTH) THEN
- YRECFM='D_ROOT_DEPTH'
- YCOMMENT='X_Y_'//YRECFM
- CALL WRITE_SURF(HPROGRAM,YRECFM,XPAR_ROOT_DEPTH(:,:),IRESP,HCOMMENT=YCOMMENT)
-ENDIF
-!
-YRECFM='L_ROOT_EXT'
-YCOMMENT=YRECFM
- CALL WRITE_SURF(HPROGRAM,YRECFM,LDATA_ROOT_EXTINCTION,IRESP,HCOMMENT=YCOMMENT)
-IF (LDATA_ROOT_EXTINCTION) THEN
- YRECFM='D_ROOT_EXT'
- YCOMMENT='X_Y_'//YRECFM
- CALL WRITE_SURF(HPROGRAM,YRECFM,XPAR_ROOT_EXTINCTION(:,:),IRESP,HCOMMENT=YCOMMENT)
-ENDIF
-!
-YRECFM='L_ROOT_LIN'
-YCOMMENT=YRECFM
- CALL WRITE_SURF(HPROGRAM,YRECFM,LDATA_ROOT_LIN,IRESP,HCOMMENT=YCOMMENT)
-IF (LDATA_ROOT_LIN) THEN
- YRECFM='D_ROOT_LIN'
- YCOMMENT='X_Y_'//YRECFM
- CALL WRITE_SURF(HPROGRAM,YRECFM,XPAR_ROOT_LIN(:,:),IRESP,HCOMMENT=YCOMMENT)
-ENDIF
-!
-YRECFM='L_DICE'
-YCOMMENT=YRECFM
- CALL WRITE_SURF(HPROGRAM,YRECFM,LDATA_DICE,IRESP,HCOMMENT=YCOMMENT)
-IF (LDATA_DICE) THEN
- YRECFM='D_DICE'
- YCOMMENT='X_Y_'//YRECFM
- CALL WRITE_SURF(HPROGRAM,YRECFM,XPAR_DICE(:,:),IRESP,HCOMMENT=YCOMMENT)
-ENDIF
-!
-YRECFM='L_ALBNIR_VEG'
-YCOMMENT=YRECFM
- CALL WRITE_SURF(HPROGRAM,YRECFM,LDATA_ALBNIR_VEG,IRESP,HCOMMENT=YCOMMENT)
-IF (LDATA_ALBNIR_VEG) THEN
- YRECFM='D_ALBNIR_VEG'
- YCOMMENT='X_Y_'//YRECFM
- CALL WRITE_SURF(HPROGRAM,YRECFM,XPAR_ALBNIR_VEG(:,:),IRESP,HCOMMENT=YCOMMENT)
-ENDIF
-!
-YRECFM='L_ALBVIS_VEG'
-YCOMMENT=YRECFM
- CALL WRITE_SURF(HPROGRAM,YRECFM,LDATA_ALBVIS_VEG,IRESP,HCOMMENT=YCOMMENT)
-IF (LDATA_ALBVIS_VEG) THEN
- YRECFM='D_ALBVIS_VEG'
- YCOMMENT='X_Y_'//YRECFM
- CALL WRITE_SURF(HPROGRAM,YRECFM,XPAR_ALBVIS_VEG(:,:),IRESP,HCOMMENT=YCOMMENT)
-ENDIF
-!
-YRECFM='L_ALBUV_VEG'
-YCOMMENT=YRECFM
- CALL WRITE_SURF(HPROGRAM,YRECFM,LDATA_ALBUV_VEG,IRESP,HCOMMENT=YCOMMENT)
-IF (LDATA_ALBUV_VEG) THEN
- YRECFM='D_ALBUV_VEG'
- YCOMMENT='X_Y_'//YRECFM
- CALL WRITE_SURF(HPROGRAM,YRECFM,XPAR_ALBUV_VEG(:,:),IRESP,HCOMMENT=YCOMMENT)
-ENDIF
-!
-YRECFM='L_ALBNIR_SOI'
-YCOMMENT=YRECFM
- CALL WRITE_SURF(HPROGRAM,YRECFM,LDATA_ALBNIR_SOIL,IRESP,HCOMMENT=YCOMMENT)
-IF (LDATA_ALBNIR_SOIL) THEN
- YRECFM='D_ALBNIR_SOI'
- YCOMMENT='X_Y_'//YRECFM
- CALL WRITE_SURF(HPROGRAM,YRECFM,XPAR_ALBNIR_SOIL(:,:),IRESP,HCOMMENT=YCOMMENT)
-ENDIF
-!
-YRECFM='L_ALBVIS_SOI'
-YCOMMENT=YRECFM
- CALL WRITE_SURF(HPROGRAM,YRECFM,LDATA_ALBVIS_SOIL,IRESP,HCOMMENT=YCOMMENT)
-IF (LDATA_ALBVIS_SOIL) THEN
- YRECFM='D_ALBVIS_SOI'
- YCOMMENT='X_Y_'//YRECFM
- CALL WRITE_SURF(HPROGRAM,YRECFM,XPAR_ALBVIS_SOIL(:,:),IRESP,HCOMMENT=YCOMMENT)
-ENDIF
-!
-YRECFM='L_ALBUV_SOI'
-YCOMMENT=YRECFM
- CALL WRITE_SURF(HPROGRAM,YRECFM,LDATA_ALBUV_SOIL,IRESP,HCOMMENT=YCOMMENT)
-IF (LDATA_ALBUV_SOIL) THEN
- YRECFM='D_ALBUV_SOI'
- YCOMMENT='X_Y_'//YRECFM
- CALL WRITE_SURF(HPROGRAM,YRECFM,XPAR_ALBUV_SOIL(:,:),IRESP,HCOMMENT=YCOMMENT)
-ENDIF
-!
-YRECFM='L_GMES'
-YCOMMENT=YRECFM
- CALL WRITE_SURF(HPROGRAM,YRECFM,LDATA_GMES,IRESP,HCOMMENT=YCOMMENT)
-IF (LDATA_GMES) THEN
- YRECFM='D_GMES'
- YCOMMENT='X_Y_'//YRECFM
- CALL WRITE_SURF(HPROGRAM,YRECFM,XPAR_GMES(:,:),IRESP,HCOMMENT=YCOMMENT)
-ENDIF
-!
-YRECFM='L_BSLAI'
-YCOMMENT=YRECFM
- CALL WRITE_SURF(HPROGRAM,YRECFM,LDATA_BSLAI,IRESP,HCOMMENT=YCOMMENT)
-IF (LDATA_BSLAI) THEN
- YRECFM='D_BSLAI'
- YCOMMENT='X_Y_'//YRECFM
- CALL WRITE_SURF(HPROGRAM,YRECFM,XPAR_BSLAI(:,:),IRESP,HCOMMENT=YCOMMENT)
-ENDIF
-!
-YRECFM='L_LAIMIN'
-YCOMMENT=YRECFM
- CALL WRITE_SURF(HPROGRAM,YRECFM,LDATA_LAIMIN,IRESP,HCOMMENT=YCOMMENT)
-IF (LDATA_LAIMIN) THEN
- YRECFM='D_LAIMIN'
- YCOMMENT='X_Y_'//YRECFM
- CALL WRITE_SURF(HPROGRAM,YRECFM,XPAR_LAIMIN(:,:),IRESP,HCOMMENT=YCOMMENT)
-ENDIF
-!
-YRECFM='L_SEFOLD'
-YCOMMENT=YRECFM
- CALL WRITE_SURF(HPROGRAM,YRECFM,LDATA_SEFOLD,IRESP,HCOMMENT=YCOMMENT)
-IF (LDATA_SEFOLD) THEN
- YRECFM='D_SEFOLD'
- YCOMMENT='X_Y_'//YRECFM
- CALL WRITE_SURF(HPROGRAM,YRECFM,XPAR_SEFOLD(:,:),IRESP,HCOMMENT=YCOMMENT)
-ENDIF
-!
-YRECFM='L_GC'
-YCOMMENT=YRECFM
- CALL WRITE_SURF(HPROGRAM,YRECFM,LDATA_GC,IRESP,HCOMMENT=YCOMMENT)
-IF (LDATA_GC) THEN
- YRECFM='D_GC'
- YCOMMENT='X_Y_'//YRECFM
- CALL WRITE_SURF(HPROGRAM,YRECFM,XPAR_GC(:,:),IRESP,HCOMMENT=YCOMMENT)
-ENDIF
-!
-YRECFM='L_DMAX'
-YCOMMENT=YRECFM
- CALL WRITE_SURF(HPROGRAM,YRECFM,LDATA_DMAX,IRESP,HCOMMENT=YCOMMENT)
-IF (LDATA_DMAX) THEN
- YRECFM='D_DMAX'
- YCOMMENT='X_Y_'//YRECFM
- CALL WRITE_SURF(HPROGRAM,YRECFM,XPAR_DMAX(:,:),IRESP,HCOMMENT=YCOMMENT)
-ENDIF
-!
-YRECFM='L_F2I'
-YCOMMENT=YRECFM
- CALL WRITE_SURF(HPROGRAM,YRECFM,LDATA_F2I,IRESP,HCOMMENT=YCOMMENT)
-IF (LDATA_F2I) THEN
- YRECFM='D_F2I'
- YCOMMENT='X_Y_'//YRECFM
- CALL WRITE_SURF(HPROGRAM,YRECFM,XPAR_F2I(:,:),IRESP,HCOMMENT=YCOMMENT)
-ENDIF
-!
-YRECFM='L_STRESS'
-YCOMMENT=YRECFM
- CALL WRITE_SURF(HPROGRAM,YRECFM,LDATA_STRESS,IRESP,HCOMMENT=YCOMMENT)
-IF (LDATA_STRESS) THEN
- ALLOCATE(ZWORK(SIZE(LPAR_STRESS,1),SIZE(LPAR_STRESS,2)))
- ZWORK=0.
- WHERE(LPAR_STRESS) ZWORK=1.
- YRECFM='D_STRESS'
- YCOMMENT='X_Y_'//YRECFM
- CALL WRITE_SURF(HPROGRAM,YRECFM,ZWORK(:,:),IRESP,HCOMMENT=YCOMMENT)
- DEALLOCATE(ZWORK)
-ENDIF
-!
-YRECFM='L_H_TREE'
-YCOMMENT=YRECFM
- CALL WRITE_SURF(HPROGRAM,YRECFM,LDATA_H_TREE,IRESP,HCOMMENT=YCOMMENT)
-IF (LDATA_H_TREE) THEN
- YRECFM='D_H_TREE'
- YCOMMENT='X_Y_'//YRECFM
- CALL WRITE_SURF(HPROGRAM,YRECFM,XPAR_H_TREE(:,:),IRESP,HCOMMENT=YCOMMENT)
-ENDIF
-!
-YRECFM='L_RE25'
-YCOMMENT=YRECFM
- CALL WRITE_SURF(HPROGRAM,YRECFM,LDATA_RE25,IRESP,HCOMMENT=YCOMMENT)
-IF (LDATA_RE25) THEN
- YRECFM='D_RE25'
- YCOMMENT='X_Y_'//YRECFM
- CALL WRITE_SURF(HPROGRAM,YRECFM,XPAR_RE25(:,:),IRESP,HCOMMENT=YCOMMENT)
-ENDIF
-!
-YRECFM='L_CE_NITRO'
-YCOMMENT=YRECFM
- CALL WRITE_SURF(HPROGRAM,YRECFM,LDATA_CE_NITRO,IRESP,HCOMMENT=YCOMMENT)
-IF (LDATA_CE_NITRO) THEN
- YRECFM='D_CE_NITRO'
- YCOMMENT='X_Y_'//YRECFM
- CALL WRITE_SURF(HPROGRAM,YRECFM,XPAR_CE_NITRO(:,:),IRESP,HCOMMENT=YCOMMENT)
-ENDIF
-!
-YRECFM='L_CF_NITRO'
-YCOMMENT=YRECFM
- CALL WRITE_SURF(HPROGRAM,YRECFM,LDATA_CF_NITRO,IRESP,HCOMMENT=YCOMMENT)
-IF (LDATA_CF_NITRO) THEN
- YRECFM='D_CF_NITRO'
- YCOMMENT='X_Y_'//YRECFM
- CALL WRITE_SURF(HPROGRAM,YRECFM,XPAR_CF_NITRO(:,:),IRESP,HCOMMENT=YCOMMENT)
-ENDIF
-!
-YRECFM='L_CNA_NITRO'
-YCOMMENT=YRECFM
- CALL WRITE_SURF(HPROGRAM,YRECFM,LDATA_CNA_NITRO,IRESP,HCOMMENT=YCOMMENT)
-IF (LDATA_CNA_NITRO) THEN
- YRECFM='D_CNA_NITRO'
- YCOMMENT='X_Y_'//YRECFM
- CALL WRITE_SURF(HPROGRAM,YRECFM,XPAR_CNA_NITRO(:,:),IRESP,HCOMMENT=YCOMMENT)
-ENDIF
-!
-YRECFM='L_IRRIG'
-YCOMMENT=YRECFM
- CALL WRITE_SURF(HPROGRAM,YRECFM,LDATA_IRRIG,IRESP,HCOMMENT=YCOMMENT)
-IF (LDATA_IRRIG) THEN
- DO JTIME=1,NTIME
- WRITE(YRECFM,FMT='(A9,I2.2)') 'D_IRRIG_T',JTIME
- YCOMMENT='X_Y_IRRIG'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XPAR_IRRIG(:,JTIME,:),IRESP,HCOMMENT=YCOMMENT)
- ENDDO
-ENDIF
-!
-YRECFM='L_WATSUP'
-YCOMMENT=YRECFM
- CALL WRITE_SURF(HPROGRAM,YRECFM,LDATA_WATSUP,IRESP,HCOMMENT=YCOMMENT)
-IF (LDATA_WATSUP) THEN
- DO JTIME=1,NTIME
- WRITE(YRECFM,FMT='(A10,I2.2)') 'D_WATSUP_T',JTIME
- YCOMMENT='X_Y_WATSUP'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XPAR_WATSUP(:,JTIME,:),IRESP,HCOMMENT=YCOMMENT)
- ENDDO
-ENDIF
-!
-IF (LHOOK) CALL DR_HOOK('WRITESURF_PGD_ISBA_PAR_N',1,ZHOOK_HANDLE)
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE WRITESURF_PGD_ISBA_PAR_n
+!SURFEX_LIC Copyright 1994-2014 Meteo-France
+!SURFEX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SURFEX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SURFEX_LIC for details. version 1.
+! #########
+ SUBROUTINE WRITESURF_PGD_ISBA_PAR_n(HPROGRAM)
+! ################################################
+!
+!!**** *WRITESURF_PGD_ISBA_PAR_n* - writes ISBA physiographic fields
+!!
+!!
+!! PURPOSE
+!! -------
+!!
+!!** METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Masson *Meteo France*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 01/2003
+!! P. Le Moigne 12/2004 : add type of photosynthesis
+!! M.Moge 01/2016 using WRITE_SURF_FIELD2D/3D for 2D/3D surfex fields writes
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_DATA_ISBA_n, ONLY : NTIME, XPAR_VEG, XPAR_LAI,XPAR_RSMIN,XPAR_GAMMA,XPAR_WRMAX_CF, &
+ XPAR_RGL,XPAR_CV,XPAR_DG,XPAR_Z0,XPAR_Z0_O_Z0H, &
+ XPAR_ALBNIR_VEG,XPAR_ALBVIS_VEG, XPAR_ALBUV_VEG, &
+ XPAR_ALBNIR_SOIL,XPAR_ALBVIS_SOIL, XPAR_ALBUV_SOIL, &
+ XPAR_EMIS, XPAR_DICE, &
+ XPAR_VEGTYPE,XPAR_ROOTFRAC, &
+ XPAR_GMES,XPAR_BSLAI,XPAR_LAIMIN,XPAR_SEFOLD,XPAR_GC, &
+ XPAR_DMAX, XPAR_F2I, LDATA_STRESS, XPAR_H_TREE,XPAR_RE25,&
+ XPAR_CE_NITRO,XPAR_CF_NITRO,XPAR_CNA_NITRO, &
+ XPAR_GROUND_DEPTH, XPAR_ROOT_DEPTH, &
+ XPAR_ROOT_EXTINCTION, XPAR_ROOT_LIN, &
+ LPAR_STRESS, XPAR_IRRIG, XPAR_WATSUP, &
+ LDATA_VEGTYPE, LDATA_LAI, LDATA_H_TREE, LDATA_DG, LDATA_ROOTFRAC,&
+ LDATA_VEG, LDATA_Z0, LDATA_EMIS, LDATA_DICE, &
+ LDATA_RSMIN, LDATA_GAMMA, LDATA_WRMAX_CF, LDATA_RGL, &
+ LDATA_CV, LDATA_Z0_O_Z0H, &
+ LDATA_ALBNIR_VEG, LDATA_ALBVIS_VEG, LDATA_ALBUV_VEG, &
+ LDATA_ALBVIS_SOIL, LDATA_ALBNIR_SOIL, LDATA_ALBUV_SOIL, &
+ LDATA_GMES, LDATA_BSLAI, LDATA_SEFOLD, LDATA_GC, LDATA_DMAX, &
+ LDATA_RE25, LDATA_LAIMIN, LDATA_F2I, &
+ LDATA_CE_NITRO,LDATA_CF_NITRO, LDATA_CNA_NITRO,&
+ LDATA_STRESS, LDATA_IRRIG, LDATA_WATSUP, &
+ LDATA_GROUND_DEPTH, LDATA_ROOT_DEPTH, &
+ LDATA_ROOT_EXTINCTION, LDATA_ROOT_LIN
+
+!
+USE MODI_WRITE_SURF
+USE MODI_WRITE_SURF_FIELD2D
+!
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of arguments
+! -------------------------
+!
+ CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling
+!
+!* 0.2 Declarations of local variables
+! -------------------------------
+!
+INTEGER :: IRESP ! IRESP : return-code if a problem appears
+ CHARACTER(LEN=12) :: YRECFM ! Name of the article to be read
+ CHARACTER(LEN=100):: YCOMMENT ! Comment string
+ CHARACTER(LEN=100):: YCOMMENTUNIT ! Comment string : unit of the datas in the field to write
+INTEGER :: JTIME ! loop index
+INTEGER :: JLAYER ! loop index
+INTEGER :: JPATCH ! loop index
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZWORK
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+!-------------------------------------------------------------------------------
+!
+IF (LHOOK) CALL DR_HOOK('WRITESURF_PGD_ISBA_PAR_N',0,ZHOOK_HANDLE)
+YRECFM='L_VEGTYPE'
+YCOMMENT=YRECFM
+ CALL WRITE_SURF(HPROGRAM,YRECFM,LDATA_VEGTYPE,IRESP,HCOMMENT=YCOMMENT)
+IF (LDATA_VEGTYPE) THEN
+ YRECFM='D_VEGTYPE'
+ YCOMMENT='X_Y_DATA_VEGTYPE'
+ YCOMMENTUNIT='-'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XPAR_VEGTYPE(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ENDIF
+!
+IF (LDATA_LAI .OR. LDATA_VEG .OR. LDATA_Z0 .OR. LDATA_EMIS) THEN
+ YRECFM='NDATA_TIME'
+ YCOMMENT='(-)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,NTIME,IRESP,HCOMMENT=YCOMMENT)
+ENDIF
+!
+YRECFM='L_VEG'
+YCOMMENT=YRECFM
+ CALL WRITE_SURF(HPROGRAM,YRECFM,LDATA_VEG,IRESP,HCOMMENT=YCOMMENT)
+IF (LDATA_VEG) THEN
+ DO JTIME=1,NTIME
+ WRITE(YRECFM,FMT='(A7,I2.2)') 'D_VEG_T',JTIME
+ YCOMMENT='X_Y_D_VEG'
+ YCOMMENTUNIT='-'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XPAR_VEG(:,JTIME,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ END DO
+ENDIF
+!
+YRECFM='L_LAI'
+YCOMMENT=YRECFM
+ CALL WRITE_SURF(HPROGRAM,YRECFM,LDATA_LAI,IRESP,HCOMMENT=YCOMMENT)
+IF (LDATA_LAI) THEN
+ DO JTIME=1,NTIME
+ WRITE(YRECFM,FMT='(A7,I2.2)') 'D_LAI_T',JTIME
+ YCOMMENT='X_Y_D_LAI'
+ YCOMMENTUNIT='-'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XPAR_LAI(:,JTIME,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ END DO
+ENDIF
+!
+YRECFM='L_Z0'
+YCOMMENT=YRECFM
+ CALL WRITE_SURF(HPROGRAM,YRECFM,LDATA_Z0,IRESP,HCOMMENT=YCOMMENT)
+IF (LDATA_Z0) THEN
+ DO JTIME=1,NTIME
+ WRITE(YRECFM,FMT='(A6,I2.2)') 'D_Z0_T',JTIME
+ YCOMMENT='X_Y_D_Z0'
+ YCOMMENTUNIT='-'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XPAR_Z0(:,JTIME,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ END DO
+ENDIF
+!
+YRECFM='L_EMIS'
+YCOMMENT=YRECFM
+ CALL WRITE_SURF(HPROGRAM,YRECFM,LDATA_EMIS,IRESP,HCOMMENT=YCOMMENT)
+IF (LDATA_EMIS) THEN
+ DO JTIME=1,NTIME
+ WRITE(YRECFM,FMT='(A8,I2.2)') 'D_EMIS_T',JTIME
+ YCOMMENT='X_Y_D_EMIS'
+ YCOMMENTUNIT='-'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XPAR_EMIS(:,JTIME,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ END DO
+ENDIF
+!
+YRECFM='L_RSMIN'
+YCOMMENT=YRECFM
+ CALL WRITE_SURF(HPROGRAM,YRECFM,LDATA_RSMIN,IRESP,HCOMMENT=YCOMMENT)
+IF (LDATA_RSMIN) THEN
+ YRECFM='D_RSMIN'
+ YCOMMENT='X_Y_D_RSMIN'
+ YCOMMENTUNIT='-'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XPAR_RSMIN(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ENDIF
+!
+YRECFM='L_GAMMA'
+YCOMMENT=YRECFM
+ CALL WRITE_SURF(HPROGRAM,YRECFM,LDATA_GAMMA,IRESP,HCOMMENT=YCOMMENT)
+IF (LDATA_GAMMA) THEN
+ YRECFM='D_GAMMA'
+ YCOMMENT='X_Y_D_GAMMA'
+ YCOMMENTUNIT='-'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XPAR_GAMMA(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ENDIF
+!
+YRECFM='L_WRMAX_CF'
+YCOMMENT=YRECFM
+ CALL WRITE_SURF(HPROGRAM,YRECFM,LDATA_WRMAX_CF,IRESP,HCOMMENT=YCOMMENT)
+IF (LDATA_WRMAX_CF) THEN
+ YRECFM='D_WRMAX_CF'
+ YCOMMENT='X_Y_D_WRMAX_CF'
+ YCOMMENTUNIT='-'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XPAR_WRMAX_CF(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ENDIF
+!
+YRECFM='L_RGL'
+YCOMMENT=YRECFM
+ CALL WRITE_SURF(HPROGRAM,YRECFM,LDATA_RGL,IRESP,HCOMMENT=YCOMMENT)
+IF (LDATA_RGL) THEN
+ YRECFM='D_RGL'
+ YCOMMENT='X_Y_D_RGL'
+ YCOMMENTUNIT='-'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XPAR_RGL(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ENDIF
+!
+YRECFM='L_CV'
+YCOMMENT=YRECFM
+ CALL WRITE_SURF(HPROGRAM,YRECFM,LDATA_CV,IRESP,HCOMMENT=YCOMMENT)
+IF (LDATA_CV) THEN
+ YRECFM='D_CV'
+ YCOMMENT='X_Y_D_CV'
+ YCOMMENTUNIT='-'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XPAR_CV(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ENDIF
+!
+YRECFM='L_Z0_O_Z0H'
+YCOMMENT=YRECFM
+ CALL WRITE_SURF(HPROGRAM,YRECFM,LDATA_Z0_O_Z0H,IRESP,HCOMMENT=YCOMMENT)
+IF (LDATA_Z0_O_Z0H) THEN
+ YRECFM='D_Z0_O_Z0H'
+ YCOMMENT='X_Y_D_Z0_O_Z0H'
+ YCOMMENTUNIT='-'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XPAR_Z0_O_Z0H(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ENDIF
+!
+YRECFM='L_DG'
+YCOMMENT=YRECFM
+ CALL WRITE_SURF(HPROGRAM,YRECFM,LDATA_DG,IRESP,HCOMMENT=YCOMMENT)
+IF (LDATA_DG) THEN
+ ALLOCATE(ZWORK(SIZE(XPAR_DG,1),SIZE(XPAR_DG,3)))
+ DO JLAYER=1,SIZE(XPAR_DG,2)
+ IF (JLAYER<10) WRITE(YRECFM,FMT='(A4,I1.1)') 'D_DG',JLAYER
+ IF (JLAYER>=10) WRITE(YRECFM,FMT='(A4,I2.2)') 'D_DG',JLAYER
+ YCOMMENT='X_Y_'//YRECFM
+ DO JPATCH=1,SIZE(XPAR_DG,3)
+ ZWORK(:,JPATCH) = XPAR_DG(:,JLAYER,JPATCH)
+ END DO
+ YCOMMENTUNIT='-'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,ZWORK,YRECFM,YCOMMENT,YCOMMENTUNIT)
+ END DO
+ DEALLOCATE(ZWORK)
+ENDIF
+!
+YRECFM='L_ROOTFRAC'
+YCOMMENT=YRECFM
+ CALL WRITE_SURF(HPROGRAM,YRECFM,LDATA_ROOTFRAC,IRESP,HCOMMENT=YCOMMENT)
+IF (LDATA_ROOTFRAC) THEN
+ ALLOCATE(ZWORK(SIZE(XPAR_ROOTFRAC,1),SIZE(XPAR_ROOTFRAC,3)))
+ DO JLAYER=1,SIZE(XPAR_ROOTFRAC,2)
+ IF (JLAYER<10) WRITE(YRECFM,FMT='(A10,I1.1)') 'D_ROOTFRAC',JLAYER
+ IF (JLAYER>=10) WRITE(YRECFM,FMT='(A10,I2.2)') 'D_ROOTFRAC',JLAYER
+ YCOMMENT='X_Y_'//YRECFM
+ DO JPATCH=1,SIZE(XPAR_ROOTFRAC,3)
+ ZWORK(:,JPATCH) = XPAR_ROOTFRAC(:,JLAYER,JPATCH)
+ END DO
+ YCOMMENTUNIT='-'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,ZWORK,YRECFM,YCOMMENT,YCOMMENTUNIT)
+ END DO
+ DEALLOCATE(ZWORK)
+ENDIF
+!
+YRECFM='L_GROUND_DPT'
+YCOMMENT=YRECFM
+ CALL WRITE_SURF(HPROGRAM,YRECFM,LDATA_GROUND_DEPTH,IRESP,HCOMMENT=YCOMMENT)
+IF (LDATA_GROUND_DEPTH) THEN
+ YRECFM='D_GROUND_DPT'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='-'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XPAR_GROUND_DEPTH(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ENDIF
+!
+YRECFM='L_ROOT_DEPTH'
+YCOMMENT=YRECFM
+ CALL WRITE_SURF(HPROGRAM,YRECFM,LDATA_ROOT_DEPTH,IRESP,HCOMMENT=YCOMMENT)
+IF (LDATA_ROOT_DEPTH) THEN
+ YRECFM='D_ROOT_DEPTH'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='-'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XPAR_ROOT_DEPTH(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ENDIF
+!
+YRECFM='L_ROOT_EXT'
+YCOMMENT=YRECFM
+ CALL WRITE_SURF(HPROGRAM,YRECFM,LDATA_ROOT_EXTINCTION,IRESP,HCOMMENT=YCOMMENT)
+IF (LDATA_ROOT_EXTINCTION) THEN
+ YRECFM='D_ROOT_EXT'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='-'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XPAR_ROOT_EXTINCTION(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ENDIF
+!
+YRECFM='L_ROOT_LIN'
+YCOMMENT=YRECFM
+ CALL WRITE_SURF(HPROGRAM,YRECFM,LDATA_ROOT_LIN,IRESP,HCOMMENT=YCOMMENT)
+IF (LDATA_ROOT_LIN) THEN
+ YRECFM='D_ROOT_LIN'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='-'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XPAR_ROOT_LIN(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ENDIF
+!
+YRECFM='L_DICE'
+YCOMMENT=YRECFM
+ CALL WRITE_SURF(HPROGRAM,YRECFM,LDATA_DICE,IRESP,HCOMMENT=YCOMMENT)
+IF (LDATA_DICE) THEN
+ YRECFM='D_DICE'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='-'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XPAR_DICE(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ENDIF
+!
+YRECFM='L_ALBNIR_VEG'
+YCOMMENT=YRECFM
+ CALL WRITE_SURF(HPROGRAM,YRECFM,LDATA_ALBNIR_VEG,IRESP,HCOMMENT=YCOMMENT)
+IF (LDATA_ALBNIR_VEG) THEN
+ YRECFM='D_ALBNIR_VEG'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='-'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XPAR_ALBNIR_VEG(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ENDIF
+!
+YRECFM='L_ALBVIS_VEG'
+YCOMMENT=YRECFM
+ CALL WRITE_SURF(HPROGRAM,YRECFM,LDATA_ALBVIS_VEG,IRESP,HCOMMENT=YCOMMENT)
+IF (LDATA_ALBVIS_VEG) THEN
+ YRECFM='D_ALBVIS_VEG'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='-'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XPAR_ALBVIS_VEG(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ENDIF
+!
+YRECFM='L_ALBUV_VEG'
+YCOMMENT=YRECFM
+ CALL WRITE_SURF(HPROGRAM,YRECFM,LDATA_ALBUV_VEG,IRESP,HCOMMENT=YCOMMENT)
+IF (LDATA_ALBUV_VEG) THEN
+ YRECFM='D_ALBUV_VEG'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='-'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XPAR_ALBUV_VEG(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ENDIF
+!
+YRECFM='L_ALBNIR_SOI'
+YCOMMENT=YRECFM
+ CALL WRITE_SURF(HPROGRAM,YRECFM,LDATA_ALBNIR_SOIL,IRESP,HCOMMENT=YCOMMENT)
+IF (LDATA_ALBNIR_SOIL) THEN
+ YRECFM='D_ALBNIR_SOI'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='-'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XPAR_ALBNIR_SOIL(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ENDIF
+!
+YRECFM='L_ALBVIS_SOI'
+YCOMMENT=YRECFM
+ CALL WRITE_SURF(HPROGRAM,YRECFM,LDATA_ALBVIS_SOIL,IRESP,HCOMMENT=YCOMMENT)
+IF (LDATA_ALBVIS_SOIL) THEN
+ YRECFM='D_ALBVIS_SOI'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='-'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XPAR_ALBVIS_SOIL(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ENDIF
+!
+YRECFM='L_ALBUV_SOI'
+YCOMMENT=YRECFM
+ CALL WRITE_SURF(HPROGRAM,YRECFM,LDATA_ALBUV_SOIL,IRESP,HCOMMENT=YCOMMENT)
+IF (LDATA_ALBUV_SOIL) THEN
+ YRECFM='D_ALBUV_SOI'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='-'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XPAR_ALBUV_SOIL(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ENDIF
+!
+YRECFM='L_GMES'
+YCOMMENT=YRECFM
+ CALL WRITE_SURF(HPROGRAM,YRECFM,LDATA_GMES,IRESP,HCOMMENT=YCOMMENT)
+IF (LDATA_GMES) THEN
+ YRECFM='D_GMES'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='-'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XPAR_GMES(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ENDIF
+!
+YRECFM='L_BSLAI'
+YCOMMENT=YRECFM
+ CALL WRITE_SURF(HPROGRAM,YRECFM,LDATA_BSLAI,IRESP,HCOMMENT=YCOMMENT)
+IF (LDATA_BSLAI) THEN
+ YRECFM='D_BSLAI'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='-'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XPAR_BSLAI(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ENDIF
+!
+YRECFM='L_LAIMIN'
+YCOMMENT=YRECFM
+ CALL WRITE_SURF(HPROGRAM,YRECFM,LDATA_LAIMIN,IRESP,HCOMMENT=YCOMMENT)
+IF (LDATA_LAIMIN) THEN
+ YRECFM='D_LAIMIN'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='-'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XPAR_LAIMIN(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ENDIF
+!
+YRECFM='L_SEFOLD'
+YCOMMENT=YRECFM
+ CALL WRITE_SURF(HPROGRAM,YRECFM,LDATA_SEFOLD,IRESP,HCOMMENT=YCOMMENT)
+IF (LDATA_SEFOLD) THEN
+ YRECFM='D_SEFOLD'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='-'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XPAR_SEFOLD(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ENDIF
+!
+YRECFM='L_GC'
+YCOMMENT=YRECFM
+ CALL WRITE_SURF(HPROGRAM,YRECFM,LDATA_GC,IRESP,HCOMMENT=YCOMMENT)
+IF (LDATA_GC) THEN
+ YRECFM='D_GC'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='-'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XPAR_GC(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ENDIF
+!
+YRECFM='L_DMAX'
+YCOMMENT=YRECFM
+ CALL WRITE_SURF(HPROGRAM,YRECFM,LDATA_DMAX,IRESP,HCOMMENT=YCOMMENT)
+IF (LDATA_DMAX) THEN
+ YRECFM='D_DMAX'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='-'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XPAR_DMAX(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ENDIF
+!
+YRECFM='L_F2I'
+YCOMMENT=YRECFM
+ CALL WRITE_SURF(HPROGRAM,YRECFM,LDATA_F2I,IRESP,HCOMMENT=YCOMMENT)
+IF (LDATA_F2I) THEN
+ YRECFM='D_F2I'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='-'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XPAR_F2I(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ENDIF
+!
+YRECFM='L_STRESS'
+YCOMMENT=YRECFM
+ CALL WRITE_SURF(HPROGRAM,YRECFM,LDATA_STRESS,IRESP,HCOMMENT=YCOMMENT)
+IF (LDATA_STRESS) THEN
+ ALLOCATE(ZWORK(SIZE(LPAR_STRESS,1),SIZE(LPAR_STRESS,2)))
+ ZWORK=0.
+ WHERE(LPAR_STRESS) ZWORK=1.
+ YRECFM='D_STRESS'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='-'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,ZWORK(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ DEALLOCATE(ZWORK)
+ENDIF
+!
+YRECFM='L_H_TREE'
+YCOMMENT=YRECFM
+ CALL WRITE_SURF(HPROGRAM,YRECFM,LDATA_H_TREE,IRESP,HCOMMENT=YCOMMENT)
+IF (LDATA_H_TREE) THEN
+ YRECFM='D_H_TREE'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='-'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XPAR_H_TREE(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ENDIF
+!
+YRECFM='L_RE25'
+YCOMMENT=YRECFM
+ CALL WRITE_SURF(HPROGRAM,YRECFM,LDATA_RE25,IRESP,HCOMMENT=YCOMMENT)
+IF (LDATA_RE25) THEN
+ YRECFM='D_RE25'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='-'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XPAR_RE25(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ENDIF
+!
+YRECFM='L_CE_NITRO'
+YCOMMENT=YRECFM
+ CALL WRITE_SURF(HPROGRAM,YRECFM,LDATA_CE_NITRO,IRESP,HCOMMENT=YCOMMENT)
+IF (LDATA_CE_NITRO) THEN
+ YRECFM='D_CE_NITRO'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='-'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XPAR_CE_NITRO(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ENDIF
+!
+YRECFM='L_CF_NITRO'
+YCOMMENT=YRECFM
+ CALL WRITE_SURF(HPROGRAM,YRECFM,LDATA_CF_NITRO,IRESP,HCOMMENT=YCOMMENT)
+IF (LDATA_CF_NITRO) THEN
+ YRECFM='D_CF_NITRO'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='-'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XPAR_CF_NITRO(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ENDIF
+!
+YRECFM='L_CNA_NITRO'
+YCOMMENT=YRECFM
+ CALL WRITE_SURF(HPROGRAM,YRECFM,LDATA_CNA_NITRO,IRESP,HCOMMENT=YCOMMENT)
+IF (LDATA_CNA_NITRO) THEN
+ YRECFM='D_CNA_NITRO'
+ YCOMMENT='X_Y_'//YRECFM
+ YCOMMENTUNIT='-'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XPAR_CNA_NITRO(:,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ENDIF
+!
+YRECFM='L_IRRIG'
+YCOMMENT=YRECFM
+ CALL WRITE_SURF(HPROGRAM,YRECFM,LDATA_IRRIG,IRESP,HCOMMENT=YCOMMENT)
+IF (LDATA_IRRIG) THEN
+ DO JTIME=1,NTIME
+ WRITE(YRECFM,FMT='(A9,I2.2)') 'D_IRRIG_T',JTIME
+ YCOMMENT='X_Y_IRRIG'
+ YCOMMENTUNIT='-'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XPAR_IRRIG(:,JTIME,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ ENDDO
+ENDIF
+!
+YRECFM='L_WATSUP'
+YCOMMENT=YRECFM
+ CALL WRITE_SURF(HPROGRAM,YRECFM,LDATA_WATSUP,IRESP,HCOMMENT=YCOMMENT)
+IF (LDATA_WATSUP) THEN
+ DO JTIME=1,NTIME
+ WRITE(YRECFM,FMT='(A10,I2.2)') 'D_WATSUP_T',JTIME
+ YCOMMENT='X_Y_WATSUP'
+ YCOMMENTUNIT='-'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XPAR_WATSUP(:,JTIME,:),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ ENDDO
+ENDIF
+!
+IF (LHOOK) CALL DR_HOOK('WRITESURF_PGD_ISBA_PAR_N',1,ZHOOK_HANDLE)
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE WRITESURF_PGD_ISBA_PAR_n
diff --git a/src/SURFEX/writesurf_pgd_isban.F90 b/src/SURFEX/writesurf_pgd_isban.F90
index 206c50391..ae1609204 100644
--- a/src/SURFEX/writesurf_pgd_isban.F90
+++ b/src/SURFEX/writesurf_pgd_isban.F90
@@ -1,359 +1,356 @@
-!SURFEX_LIC Copyright 1994-2014 Meteo-France
-!SURFEX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SURFEX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SURFEX_LIC for details. version 1.
-! #########
- SUBROUTINE WRITESURF_PGD_ISBA_n(HPROGRAM)
-! ################################################
-!
-!!**** *WRITESURF_PGD_ISBA_n* - writes ISBA physiographic fields
-!!
-!!
-!! PURPOSE
-!! -------
-!!
-!!** METHOD
-!! ------
-!!
-!! EXTERNAL
-!! --------
-!!
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!!
-!! REFERENCE
-!! ---------
-!!
-!!
-!! AUTHOR
-!! ------
-!! V. Masson *Meteo France*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 01/2003
-!! P. Le Moigne 12/2004 : add type of photosynthesis
-!! B. Decharme 06/2009 : add topographic index statistics
-!! A.L. Gibelin 04/2009 : dimension NBIOMASS for ISBA-A-gs
-!! B. Decharme 07/2011 : delete argument HWRITE
-!! M. Moge 02/2015 parallelization using WRITE_LCOVER
-!! M. Moge 08/2015 writing ECO_DG fields as 2D fields with WRITE_SURF
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_SURF_ATM_n, ONLY : CNATURE
-USE MODD_ISBA_n, ONLY : NPATCH, NGROUND_LAYER, NNBIOMASS, CISBA,&
- CPEDOTF, CPHOTO, LTR_ML, XRM_PATCH, &
- XCLAY, XSAND, XSOC, &
- XAOSIP, XAOSIM, XAOSJP, XAOSJM, &
- XHO2IP, XHO2IM, XHO2JP, XHO2JM, &
- XSSO_SLOPE, &
- XRUNOFFB, XWDRAIN, &
- XTI_MIN, XTI_MAX, XTI_MEAN, XTI_STD, &
- XTI_SKEW, XZS,XCOVER, &
- XZ0EFFJPDIR, &
- LCOVER, LECOCLIMAP, LCTI, LSOCP, LNOF, &
- XSOILGRID, XPH, XFERT, LPERM, XPERM, &
- XDG, NWG_LAYER
-!
-USE MODD_ISBA_GRID_n, ONLY : XLAT, XLON, XMESH_SIZE, CGRID, XGRID_PAR
-!
-USE MODI_WRITE_SURF
-USE MODI_WRITE_GRID
-USE MODI_WRITESURF_PGD_ISBA_PAR_n
-USE MODI_WRITESURF_PGD_TSZ0_PAR_n
-!
-USE MODI_WRITE_LCOVER
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of arguments
-! -------------------------
-!
- CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling
-!
-!* 0.2 Declarations of local variables
-! -------------------------------
-!
-INTEGER :: IRESP ! IRESP : return-code if a problem appears
- CHARACTER(LEN=12) :: YRECFM ! Name of the article to be read
- CHARACTER(LEN=100):: YCOMMENT ! Comment string
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!
-INTEGER :: JL ! loop counter
-INTEGER :: JPATCH ! loop counter
-!
-!-------------------------------------------------------------------------------
-!
-!
-!* soil scheme option
-!
-IF (LHOOK) CALL DR_HOOK('WRITESURF_PGD_ISBA_N',0,ZHOOK_HANDLE)
-YRECFM='ISBA'
-YCOMMENT=YRECFM
- CALL WRITE_SURF(HPROGRAM,YRECFM,CISBA,IRESP,HCOMMENT=YCOMMENT)
-!
-!* Pedo-transfert function
-!
-YRECFM='PEDOTF'
-YCOMMENT=YRECFM
- CALL WRITE_SURF(HPROGRAM,YRECFM,CPEDOTF,IRESP,HCOMMENT=YCOMMENT)
-!
-!* type of photosynthesis
-!
-YRECFM='PHOTO'
-YCOMMENT=YRECFM
- CALL WRITE_SURF(HPROGRAM,YRECFM,CPHOTO,IRESP,HCOMMENT=YCOMMENT)
-!
-!* new radiative transfert
-!
-YRECFM='TR_ML'
-YCOMMENT=YRECFM
- CALL WRITE_SURF(HPROGRAM,YRECFM,LTR_ML,IRESP,HCOMMENT=YCOMMENT)
-!
-!* threshold to remove little fractions of patches
-!
-YRECFM='RM_PATCH'
-YCOMMENT=YRECFM
- CALL WRITE_SURF(HPROGRAM,YRECFM,XRM_PATCH,IRESP,HCOMMENT=YCOMMENT)
-
-!* number of soil layers
-!
-YRECFM='GROUND_LAYER'
-YCOMMENT=YRECFM
- CALL WRITE_SURF(HPROGRAM,YRECFM,NGROUND_LAYER,IRESP,HCOMMENT=YCOMMENT)
-!
-!* Reference grid for DIF
-!
-IF(CISBA=='DIF') THEN
- YRECFM='SOILGRID'
- YCOMMENT=YRECFM
- CALL WRITE_SURF(HPROGRAM,YRECFM,XSOILGRID,IRESP,HCOMMENT=YCOMMENT,HDIR='-')
-ENDIF
-!
-!* number of biomass pools
-!
-YRECFM='NBIOMASS'
-YCOMMENT=YRECFM
- CALL WRITE_SURF(HPROGRAM,YRECFM,NNBIOMASS,IRESP,HCOMMENT=YCOMMENT)
-!
-!* number of tiles
-!
-YRECFM='PATCH_NUMBER'
-YCOMMENT=YRECFM
- CALL WRITE_SURF(HPROGRAM,YRECFM,NPATCH,IRESP,HCOMMENT=YCOMMENT)
-!
-!* flag indicating if fields are computed from ecoclimap or not
-!
-YRECFM='ECOCLIMAP'
-YCOMMENT=YRECFM
- CALL WRITE_SURF(HPROGRAM,YRECFM,LECOCLIMAP,IRESP,HCOMMENT=YCOMMENT)
-!
-!
-!* 2. Physiographic data fields:
-! -------------------------
-!
-!* cover classes
-!
-CALL WRITE_LCOVER(HPROGRAM,LCOVER)
-!
-YCOMMENT='COVER FIELDS'
- CALL WRITE_SURF(HPROGRAM,'COVER',XCOVER(:,:),LCOVER,IRESP,HCOMMENT=YCOMMENT)
-!
-!* orography
-!
-YRECFM='ZS'
-YCOMMENT='ZS'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XZS(:),IRESP,HCOMMENT=YCOMMENT)
-!
-!* latitude, longitude
-!
- CALL WRITE_GRID(HPROGRAM,CGRID,XGRID_PAR,XLAT,XLON,XMESH_SIZE,IRESP,XZ0EFFJPDIR)
-!
-!
-!* clay fraction
-!
-!
-YRECFM='CLAY'
-YCOMMENT='X_Y_CLAY'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XCLAY(:,1),IRESP,HCOMMENT=YCOMMENT)
-!
-!* sand fraction
-!
-YRECFM='SAND'
-YCOMMENT='X_Y_SAND'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XSAND(:,1),IRESP,HCOMMENT=YCOMMENT)
-!
-!* soil organic carbon
-!
-YRECFM='SOCP'
-YCOMMENT=''
- CALL WRITE_SURF(HPROGRAM,YRECFM,LSOCP,IRESP,HCOMMENT=YCOMMENT)
-!
-IF(LSOCP)THEN
- !
- YCOMMENT='X_Y_SOC'
- YRECFM='SOC_TOP'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XSOC(:,1),IRESP,HCOMMENT=YCOMMENT)
- YRECFM='SOC_SUB'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XSOC(:,2),IRESP,HCOMMENT=YCOMMENT)
- !
-ENDIF
-!
-!* permafrost distribution
-!
-YRECFM='PERMAFROST'
-YCOMMENT=''
- CALL WRITE_SURF(HPROGRAM,YRECFM,LPERM,IRESP,HCOMMENT=YCOMMENT)
-!
-IF(LPERM)THEN
- YCOMMENT='X_Y_PERM'
- YRECFM='PERM'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XPERM(:),IRESP,HCOMMENT=YCOMMENT)
-ENDIF
-!
-!SOILNOX
-!
-YRECFM='NO'
-YCOMMENT=''
- CALL WRITE_SURF(HPROGRAM,YRECFM,LNOF,IRESP,HCOMMENT=YCOMMENT)
-!
-IF (LNOF) THEN
- !
- YRECFM='PH'
- YCOMMENT='X_Y_PH'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XPH(:),IRESP,HCOMMENT=YCOMMENT)
- !
- YRECFM='FERT'
- YCOMMENT='X_Y_FERT'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XFERT(:),IRESP,HCOMMENT=YCOMMENT)
- !
-ENDIF
-!
-!* subgrid-scale orography parameters to compute dynamical roughness length
-!
-YRECFM='AOSIP'
-YCOMMENT='X_Y_AOSIP'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAOSIP,IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='AOSIM'
-YCOMMENT='X_Y_AOSIM'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAOSIM,IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='AOSJP'
-YCOMMENT='X_Y_AOSJP'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAOSJP,IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='AOSJM'
-YCOMMENT='X_Y_AOSJM'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XAOSJM,IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='HO2IP'
-YCOMMENT='X_Y_HO2IP'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XHO2IP,IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='HO2IM'
-YCOMMENT='X_Y_HO2IM'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XHO2IM,IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='HO2JP'
-YCOMMENT='X_Y_HO2JP'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XHO2JP,IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='HO2JM'
-YCOMMENT='X_Y_HO2JM'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XHO2JM,IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='SSO_SLOPE'
-YCOMMENT='X_Y_SSO_SLOPE (-)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XSSO_SLOPE,IRESP,HCOMMENT=YCOMMENT)
-!
-!* orographic runoff coefficient
-!
-YRECFM='RUNOFFB'
-YCOMMENT='X_Y_RUNOFFB'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XRUNOFFB,IRESP,HCOMMENT=YCOMMENT)
-!
-!* subgrid drainage coefficient
-!
-YRECFM='WDRAIN'
-YCOMMENT='X_Y_WDRAIN'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XWDRAIN,IRESP,HCOMMENT=YCOMMENT)
-!
-!* topographic index statistics
-!
-YRECFM='CTI'
-YCOMMENT=''
- CALL WRITE_SURF(HPROGRAM,YRECFM,LCTI,IRESP,HCOMMENT=YCOMMENT)
-!
-IF(LCTI)THEN
-!
-YRECFM='TI_MIN'
-YCOMMENT='X_Y_TI_MIN'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XTI_MIN,IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='TI_MAX'
-YCOMMENT='X_Y_TI_MAX'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XTI_MAX,IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='TI_MEAN'
-YCOMMENT='X_Y_TI_MEAN'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XTI_MEAN,IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='TI_STD'
-YCOMMENT='X_Y_TI_STD'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XTI_STD,IRESP,HCOMMENT=YCOMMENT)
-!
-YRECFM='TI_SKEW'
-YCOMMENT='X_Y_TI_SKEW'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XTI_SKEW,IRESP,HCOMMENT=YCOMMENT)
-!
-ENDIF
-!
-!-------------------------------------------------------------------------------
-!
-!* 3. ISBA diagnostic PGD fields stored in PGD file for improved efficiency in PREP step
-! ----------------------------------------------------------------------------------
-!
-IF (LECOCLIMAP .AND. ASSOCIATED(XDG)) THEN
- ! note XDG is not associated only in the zoom_pgd step. This is not a
- ! problem because an initialization of the model is redone just after.
- ! In all other cases, the fileds are associated and initialized.
-!
-!* Soil depth for each patch
-!
-DO JPATCH = 1,SIZE(XDG,3)
- DO JL=1,SIZE(XDG,2)
- IF (JL<10) THEN
- WRITE(YRECFM,FMT='(A6,I1,I4.4)') 'ECO_DG',JL,JPATCH
- ELSE
- WRITE(YRECFM,FMT='(A6,I2,I4.4)') 'ECO_DG',JL,JPATCH
- ENDIF
- YCOMMENT='soil depth from ecoclimap'//' (M)'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XDG(:,JL,JPATCH),IRESP,HCOMMENT=YCOMMENT)
- END DO
-END DO
-!* Total soil depth for moisture
-!
- IF (CISBA=='DIF') THEN
- YRECFM='ECO_WG_L'
- YCOMMENT='Number of soil layers for moisture in ISBA-DIF'
- CALL WRITE_SURF(HPROGRAM,YRECFM,FLOAT(NWG_LAYER(:,:)),IRESP,HCOMMENT=YCOMMENT)
- END IF
-END IF
-!
-!-------------------------------------------------------------------------------
- CALL WRITESURF_PGD_ISBA_PAR_n(HPROGRAM)
-IF (CNATURE=='TSZ0') CALL WRITESURF_PGD_TSZ0_PAR_n(HPROGRAM)
-!
-IF (LHOOK) CALL DR_HOOK('WRITESURF_PGD_ISBA_N',1,ZHOOK_HANDLE)
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE WRITESURF_PGD_ISBA_n
+!SURFEX_LIC Copyright 1994-2014 Meteo-France
+!SURFEX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SURFEX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SURFEX_LIC for details. version 1.
+! #########
+ SUBROUTINE WRITESURF_PGD_ISBA_n(HPROGRAM)
+! ################################################
+!
+!!**** *WRITESURF_PGD_ISBA_n* - writes ISBA physiographic fields
+!!
+!!
+!! PURPOSE
+!! -------
+!!
+!!** METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!!
+!! AUTHOR
+!! ------
+!! V. Masson *Meteo France*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 01/2003
+!! P. Le Moigne 12/2004 : add type of photosynthesis
+!! B. Decharme 06/2009 : add topographic index statistics
+!! A.L. Gibelin 04/2009 : dimension NBIOMASS for ISBA-A-gs
+!! B. Decharme 07/2011 : delete argument HWRITE
+!! M. Moge 02/2015 parallelization using WRITE_LCOVER
+!! M.Moge 01/2016 using WRITE_SURF_FIELD2D/3D for 2D/3D surfex fields writes
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_SURF_ATM_n, ONLY : CNATURE
+USE MODD_ISBA_n, ONLY : NPATCH, NGROUND_LAYER, NNBIOMASS, CISBA,&
+ CPEDOTF, CPHOTO, LTR_ML, XRM_PATCH, &
+ XCLAY, XSAND, XSOC, &
+ XAOSIP, XAOSIM, XAOSJP, XAOSJM, &
+ XHO2IP, XHO2IM, XHO2JP, XHO2JM, &
+ XSSO_SLOPE, &
+ XRUNOFFB, XWDRAIN, &
+ XTI_MIN, XTI_MAX, XTI_MEAN, XTI_STD, &
+ XTI_SKEW, XZS,XCOVER, &
+ XZ0EFFJPDIR, &
+ LCOVER, LECOCLIMAP, LCTI, LSOCP, LNOF, &
+ XSOILGRID, XPH, XFERT, LPERM, XPERM, &
+ XDG, NWG_LAYER
+!
+USE MODD_ISBA_GRID_n, ONLY : XLAT, XLON, XMESH_SIZE, CGRID, XGRID_PAR
+!
+USE MODI_WRITE_SURF
+USE MODI_WRITE_GRID
+USE MODI_WRITESURF_PGD_ISBA_PAR_n
+USE MODI_WRITESURF_PGD_TSZ0_PAR_n
+!
+USE MODI_WRITE_SURF_FIELD2D
+USE MODI_WRITE_SURF_FIELD3D
+!
+USE MODI_WRITE_LCOVER
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of arguments
+! -------------------------
+!
+ CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling
+!
+!* 0.2 Declarations of local variables
+! -------------------------------
+!
+INTEGER :: IRESP ! IRESP : return-code if a problem appears
+ CHARACTER(LEN=12) :: YRECFM ! Name of the article to be read
+ CHARACTER(LEN=100):: YCOMMENT ! Comment string
+ CHARACTER(LEN=100):: YCOMMENTUNIT ! Comment string : unit of the datas in the field to write
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+INTEGER :: JL ! loop counter
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* soil scheme option
+!
+IF (LHOOK) CALL DR_HOOK('WRITESURF_PGD_ISBA_N',0,ZHOOK_HANDLE)
+YRECFM='ISBA'
+YCOMMENT=YRECFM
+ CALL WRITE_SURF(HPROGRAM,YRECFM,CISBA,IRESP,HCOMMENT=YCOMMENT)
+!
+!* Pedo-transfert function
+!
+YRECFM='PEDOTF'
+YCOMMENT=YRECFM
+ CALL WRITE_SURF(HPROGRAM,YRECFM,CPEDOTF,IRESP,HCOMMENT=YCOMMENT)
+!
+!* type of photosynthesis
+!
+YRECFM='PHOTO'
+YCOMMENT=YRECFM
+ CALL WRITE_SURF(HPROGRAM,YRECFM,CPHOTO,IRESP,HCOMMENT=YCOMMENT)
+!
+!* new radiative transfert
+!
+YRECFM='TR_ML'
+YCOMMENT=YRECFM
+ CALL WRITE_SURF(HPROGRAM,YRECFM,LTR_ML,IRESP,HCOMMENT=YCOMMENT)
+!
+!* threshold to remove little fractions of patches
+!
+YRECFM='RM_PATCH'
+YCOMMENT=YRECFM
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XRM_PATCH,IRESP,HCOMMENT=YCOMMENT)
+
+!* number of soil layers
+!
+YRECFM='GROUND_LAYER'
+YCOMMENT=YRECFM
+ CALL WRITE_SURF(HPROGRAM,YRECFM,NGROUND_LAYER,IRESP,HCOMMENT=YCOMMENT)
+!
+!* Reference grid for DIF
+!
+IF(CISBA=='DIF') THEN
+ YRECFM='SOILGRID'
+ YCOMMENT=YRECFM
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XSOILGRID,IRESP,HCOMMENT=YCOMMENT,HDIR='-')
+ENDIF
+!
+!* number of biomass pools
+!
+YRECFM='NBIOMASS'
+YCOMMENT=YRECFM
+ CALL WRITE_SURF(HPROGRAM,YRECFM,NNBIOMASS,IRESP,HCOMMENT=YCOMMENT)
+!
+!* number of tiles
+!
+YRECFM='PATCH_NUMBER'
+YCOMMENT=YRECFM
+ CALL WRITE_SURF(HPROGRAM,YRECFM,NPATCH,IRESP,HCOMMENT=YCOMMENT)
+!
+!* flag indicating if fields are computed from ecoclimap or not
+!
+YRECFM='ECOCLIMAP'
+YCOMMENT=YRECFM
+ CALL WRITE_SURF(HPROGRAM,YRECFM,LECOCLIMAP,IRESP,HCOMMENT=YCOMMENT)
+!
+!
+!* 2. Physiographic data fields:
+! -------------------------
+!
+!* cover classes
+!
+CALL WRITE_LCOVER(HPROGRAM,LCOVER)
+!
+YCOMMENT='COVER FIELDS'
+ CALL WRITE_SURF(HPROGRAM,'COVER',XCOVER(:,:),LCOVER,IRESP,HCOMMENT=YCOMMENT)
+!
+!* orography
+!
+YRECFM='ZS'
+YCOMMENT='ZS'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XZS(:),IRESP,HCOMMENT=YCOMMENT)
+!
+!* latitude, longitude
+!
+ CALL WRITE_GRID(HPROGRAM,CGRID,XGRID_PAR,XLAT,XLON,XMESH_SIZE,IRESP,XZ0EFFJPDIR)
+!
+!
+!* clay fraction
+!
+!
+YRECFM='CLAY'
+YCOMMENT='X_Y_CLAY'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XCLAY(:,1),IRESP,HCOMMENT=YCOMMENT)
+!
+!* sand fraction
+!
+YRECFM='SAND'
+YCOMMENT='X_Y_SAND'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XSAND(:,1),IRESP,HCOMMENT=YCOMMENT)
+!
+!* soil organic carbon
+!
+YRECFM='SOCP'
+YCOMMENT=''
+ CALL WRITE_SURF(HPROGRAM,YRECFM,LSOCP,IRESP,HCOMMENT=YCOMMENT)
+!
+IF(LSOCP)THEN
+ !
+ YCOMMENT='X_Y_SOC'
+ YRECFM='SOC_TOP'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XSOC(:,1),IRESP,HCOMMENT=YCOMMENT)
+ YRECFM='SOC_SUB'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XSOC(:,2),IRESP,HCOMMENT=YCOMMENT)
+ !
+ENDIF
+!
+!* permafrost distribution
+!
+YRECFM='PERMAFROST'
+YCOMMENT=''
+ CALL WRITE_SURF(HPROGRAM,YRECFM,LPERM,IRESP,HCOMMENT=YCOMMENT)
+!
+IF(LPERM)THEN
+ YCOMMENT='X_Y_PERM'
+ YRECFM='PERM'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XPERM(:),IRESP,HCOMMENT=YCOMMENT)
+ENDIF
+!
+!SOILNOX
+!
+YRECFM='NO'
+YCOMMENT=''
+ CALL WRITE_SURF(HPROGRAM,YRECFM,LNOF,IRESP,HCOMMENT=YCOMMENT)
+!
+IF (LNOF) THEN
+ !
+ YRECFM='PH'
+ YCOMMENT='X_Y_PH'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XPH(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='FERT'
+ YCOMMENT='X_Y_FERT'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XFERT(:),IRESP,HCOMMENT=YCOMMENT)
+ !
+ENDIF
+!
+!* subgrid-scale orography parameters to compute dynamical roughness length
+!
+YRECFM='AOSIP'
+YCOMMENT='X_Y_AOSIP'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAOSIP,IRESP,HCOMMENT=YCOMMENT)
+!
+YRECFM='AOSIM'
+YCOMMENT='X_Y_AOSIM'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAOSIM,IRESP,HCOMMENT=YCOMMENT)
+!
+YRECFM='AOSJP'
+YCOMMENT='X_Y_AOSJP'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAOSJP,IRESP,HCOMMENT=YCOMMENT)
+!
+YRECFM='AOSJM'
+YCOMMENT='X_Y_AOSJM'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XAOSJM,IRESP,HCOMMENT=YCOMMENT)
+!
+YRECFM='HO2IP'
+YCOMMENT='X_Y_HO2IP'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XHO2IP,IRESP,HCOMMENT=YCOMMENT)
+!
+YRECFM='HO2IM'
+YCOMMENT='X_Y_HO2IM'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XHO2IM,IRESP,HCOMMENT=YCOMMENT)
+!
+YRECFM='HO2JP'
+YCOMMENT='X_Y_HO2JP'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XHO2JP,IRESP,HCOMMENT=YCOMMENT)
+!
+YRECFM='HO2JM'
+YCOMMENT='X_Y_HO2JM'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XHO2JM,IRESP,HCOMMENT=YCOMMENT)
+!
+YRECFM='SSO_SLOPE'
+YCOMMENT='X_Y_SSO_SLOPE (-)'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XSSO_SLOPE,IRESP,HCOMMENT=YCOMMENT)
+!
+!* orographic runoff coefficient
+!
+YRECFM='RUNOFFB'
+YCOMMENT='X_Y_RUNOFFB'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XRUNOFFB,IRESP,HCOMMENT=YCOMMENT)
+!
+!* subgrid drainage coefficient
+!
+YRECFM='WDRAIN'
+YCOMMENT='X_Y_WDRAIN'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XWDRAIN,IRESP,HCOMMENT=YCOMMENT)
+!
+!* topographic index statistics
+!
+YRECFM='CTI'
+YCOMMENT=''
+ CALL WRITE_SURF(HPROGRAM,YRECFM,LCTI,IRESP,HCOMMENT=YCOMMENT)
+!
+IF(LCTI)THEN
+!
+YRECFM='TI_MIN'
+YCOMMENT='X_Y_TI_MIN'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XTI_MIN,IRESP,HCOMMENT=YCOMMENT)
+!
+YRECFM='TI_MAX'
+YCOMMENT='X_Y_TI_MAX'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XTI_MAX,IRESP,HCOMMENT=YCOMMENT)
+!
+YRECFM='TI_MEAN'
+YCOMMENT='X_Y_TI_MEAN'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XTI_MEAN,IRESP,HCOMMENT=YCOMMENT)
+!
+YRECFM='TI_STD'
+YCOMMENT='X_Y_TI_STD'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XTI_STD,IRESP,HCOMMENT=YCOMMENT)
+!
+YRECFM='TI_SKEW'
+YCOMMENT='X_Y_TI_SKEW'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XTI_SKEW,IRESP,HCOMMENT=YCOMMENT)
+!
+ENDIF
+!
+!-------------------------------------------------------------------------------
+!
+!* 3. ISBA diagnostic PGD fields stored in PGD file for improved efficiency in PREP step
+! ----------------------------------------------------------------------------------
+!
+IF (LECOCLIMAP .AND. ASSOCIATED(XDG)) THEN
+ ! note XDG is not associated only in the zoom_pgd step. This is not a
+ ! problem because an initialization of the model is redone just after.
+ ! In all other cases, the fileds are associated and initialized.
+!
+!* Soil depth for each patch
+!
+YRECFM='ECO_DG'
+YCOMMENT='soil depth from ecoclimap'
+YCOMMENTUNIT='M'
+CALL WRITE_SURF_FIELD3D(HPROGRAM,XDG,1,SIZE(XDG,2),YRECFM,YCOMMENT,YCOMMENTUNIT)
+!* Total soil depth for moisture
+!
+ IF (CISBA=='DIF') THEN
+ YRECFM='ECO_WG_L'
+ YCOMMENT='Number of soil layers for moisture in ISBA-DIF'
+ YCOMMENTUNIT='-'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,FLOAT(NWG_LAYER(:,:)),YRECFM,YCOMMENT,YCOMMENTUNIT)
+ END IF
+END IF
+!
+!-------------------------------------------------------------------------------
+ CALL WRITESURF_PGD_ISBA_PAR_n(HPROGRAM)
+IF (CNATURE=='TSZ0') CALL WRITESURF_PGD_TSZ0_PAR_n(HPROGRAM)
+!
+IF (LHOOK) CALL DR_HOOK('WRITESURF_PGD_ISBA_N',1,ZHOOK_HANDLE)
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE WRITESURF_PGD_ISBA_n
diff --git a/src/SURFEX/writesurf_snapn.F90 b/src/SURFEX/writesurf_snapn.F90
index 24b6f285b..c68f61b83 100644
--- a/src/SURFEX/writesurf_snapn.F90
+++ b/src/SURFEX/writesurf_snapn.F90
@@ -1,81 +1,85 @@
-!SURFEX_LIC Copyright 1994-2014 Meteo-France
-!SURFEX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
-!SURFEX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
-!SURFEX_LIC for details. version 1.
-! #########
- SUBROUTINE WRITESURF_SNAP_n(HPROGRAM)
-! #######################################################################
-!
-!-----------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-!
-USE MODI_GET_LUOUT
-USE MODI_WRITE_SURF
-!
-USE MODD_CH_SNAP_n
-!
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-USE MODI_ABOR1_SFX
-!
-IMPLICIT NONE
-!
- CHARACTER(LEN=6) :: HPROGRAM
-!
-!* 0.2 declarations of local variables
-!
-INTEGER :: IRESP ! I/O error code
- CHARACTER (LEN=16) :: YRECFM ! article name
- CHARACTER (LEN=100) :: YCOMMENT ! comment
-INTEGER :: ILUOUT ! Unit number for prints
-INTEGER :: JSPEC ! Loop index for emission species
-INTEGER :: JSNAP ! Loop index for SNAP categories
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!-------------------------------------------------------------------------------
-IF (LHOOK) CALL DR_HOOK('WRITESURF_SNAP_n',0,ZHOOK_HANDLE)
- CALL GET_LUOUT(HPROGRAM,ILUOUT)
-!
-!-------------------------------------------------------------------------------
-!
-YRECFM='EMISPEC_NBR'
- CALL WRITE_SURF(HPROGRAM,YRECFM,NEMIS_NBR,IRESP,YCOMMENT)
-YRECFM='SNAP_NBR'
- CALL WRITE_SURF(HPROGRAM,YRECFM,NEMIS_SNAP,IRESP,YCOMMENT)
-YRECFM='SNAP_TIME'
- CALL WRITE_SURF(HPROGRAM,YRECFM,CSNAP_TIME_REF,IRESP,YCOMMENT)
-!
-IF (CSNAP_TIME_REF=='LEGAL') THEN
- YRECFM='LEGALTIME'
- CALL WRITE_SURF(HPROGRAM,YRECFM,XDELTA_LEGAL_TIME(:),IRESP,YCOMMENT)
-END IF
-!-------------------------------------------------------------------------------
-!
-DO JSPEC=1,NEMIS_NBR
-! Writes the name of species
- WRITE(YRECFM,'("EMISNAME",I3.3)') JSPEC
- YCOMMENT = CEMIS_COMMENT(JSPEC)
- CALL WRITE_SURF(HPROGRAM,YRECFM,CEMIS_NAME(JSPEC),IRESP,YCOMMENT)
-!
-! Writes the temporal profiles of all snaps
- YRECFM = "E_"//TRIM(CEMIS_NAME(JSPEC))//"_M"
- CALL WRITE_SURF(HPROGRAM,YRECFM,XSNAP_MONTHLY(:,:,JSPEC),IRESP,YCOMMENT,HDIR='-')
- YRECFM = "E_"//TRIM(CEMIS_NAME(JSPEC))//"_D"
- CALL WRITE_SURF(HPROGRAM,YRECFM,XSNAP_DAILY(:,:,JSPEC),IRESP,YCOMMENT,HDIR='-')
- YRECFM = "E_"//TRIM(CEMIS_NAME(JSPEC))//"_H"
- CALL WRITE_SURF(HPROGRAM,YRECFM,XSNAP_HOURLY(:,:,JSPEC),IRESP,YCOMMENT,HDIR='-')
-! Writes the potential emission of species for each snap
- DO JSNAP=1,NEMIS_SNAP
- WRITE(YRECFM,'("SNAP",I2.2,"_",A3)') JSNAP,CEMIS_NAME(JSPEC)
- CALL WRITE_SURF(HPROGRAM,YRECFM,XEMIS_FIELDS_SNAP(:,JSNAP,JSPEC),IRESP,YCOMMENT)
- END DO
-!
-END DO
-!
-!-------------------------------------------------------------------------------
-IF (LHOOK) CALL DR_HOOK('WRITESURF_SNAP_n',1,ZHOOK_HANDLE)
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE WRITESURF_SNAP_n
+
+!! MODIFICATIONS
+!! M.Moge 01/2016 using WRITE_SURF_FIELD2D/3D for 2D/3D surfex fields writes
+! #########
+ SUBROUTINE WRITESURF_SNAP_n(HPROGRAM)
+! #######################################################################
+!
+!-----------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!
+USE MODI_GET_LUOUT
+USE MODI_WRITE_SURF
+USE MODI_WRITE_SURF_FIELD2D
+!
+USE MODD_CH_SNAP_n
+!
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+USE MODI_ABOR1_SFX
+!
+IMPLICIT NONE
+!
+ CHARACTER(LEN=6) :: HPROGRAM
+!
+!* 0.2 declarations of local variables
+!
+INTEGER :: IRESP ! I/O error code
+ CHARACTER (LEN=16) :: YRECFM ! article name
+ CHARACTER (LEN=100) :: YCOMMENT ! comment
+ CHARACTER(LEN=100):: YCOMMENTUNIT ! Comment string : unit of the datas in the field to write
+INTEGER :: ILUOUT ! Unit number for prints
+INTEGER :: JSPEC ! Loop index for emission species
+INTEGER :: JSNAP ! Loop index for SNAP categories
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!-------------------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('WRITESURF_SNAP_n',0,ZHOOK_HANDLE)
+ CALL GET_LUOUT(HPROGRAM,ILUOUT)
+!
+!-------------------------------------------------------------------------------
+!
+YRECFM='EMISPEC_NBR'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,NEMIS_NBR,IRESP,YCOMMENT)
+YRECFM='SNAP_NBR'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,NEMIS_SNAP,IRESP,YCOMMENT)
+YRECFM='SNAP_TIME'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,CSNAP_TIME_REF,IRESP,YCOMMENT)
+!
+IF (CSNAP_TIME_REF=='LEGAL') THEN
+ YRECFM='LEGALTIME'
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XDELTA_LEGAL_TIME(:),IRESP,YCOMMENT)
+END IF
+!-------------------------------------------------------------------------------
+!
+DO JSPEC=1,NEMIS_NBR
+! Writes the name of species
+ WRITE(YRECFM,'("EMISNAME",I3.3)') JSPEC
+ YCOMMENT = CEMIS_COMMENT(JSPEC)
+ CALL WRITE_SURF(HPROGRAM,YRECFM,CEMIS_NAME(JSPEC),IRESP,YCOMMENT)
+!
+! Writes the temporal profiles of all snaps
+ YRECFM = "E_"//TRIM(CEMIS_NAME(JSPEC))//"_M"
+ YCOMMENTUNIT='-'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XSNAP_MONTHLY(:,:,JSPEC),YRECFM,YCOMMENT,YCOMMENTUNIT,HDIR='-')
+ YRECFM = "E_"//TRIM(CEMIS_NAME(JSPEC))//"_D"
+ YCOMMENTUNIT='-'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XSNAP_DAILY(:,:,JSPEC),YRECFM,YCOMMENT,YCOMMENTUNIT,HDIR='-')
+ YRECFM = "E_"//TRIM(CEMIS_NAME(JSPEC))//"_H"
+ YCOMMENTUNIT='-'
+ CALL WRITE_SURF_FIELD2D(HPROGRAM,XSNAP_HOURLY(:,:,JSPEC),YRECFM,YCOMMENT,YCOMMENTUNIT,HDIR='-')
+! Writes the potential emission of species for each snap
+ DO JSNAP=1,NEMIS_SNAP
+ WRITE(YRECFM,'("SNAP",I2.2,"_",A3)') JSNAP,CEMIS_NAME(JSPEC)
+ CALL WRITE_SURF(HPROGRAM,YRECFM,XEMIS_FIELDS_SNAP(:,JSNAP,JSPEC),IRESP,YCOMMENT)
+ END DO
+!
+END DO
+!
+!-------------------------------------------------------------------------------
+IF (LHOOK) CALL DR_HOOK('WRITESURF_SNAP_n',1,ZHOOK_HANDLE)
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE WRITESURF_SNAP_n
--
GitLab