Gaelle 18/01/2016: modif for PREPLL from M.Moge
authorGaelle Tanguy <gaelle.tanguy@meteo.fr>
Mon, 18 Jan 2016 09:18:35 +0000 (09:18 +0000)
committerPhilippe WAUTELET <philippe.wautelet@aero.obs-mip.fr>
Thu, 19 May 2016 14:44:49 +0000 (16:44 +0200)
29 files changed:
src/MNH/fill_sonfieldn.f90
src/MNH/fill_zsmtn.f90
src/MNH/open_nestpgd_files.f90
src/SURFEX/build_emisstabn.F90
src/SURFEX/ch_emission_fluxn.F90
src/SURFEX/ch_init_snapn.F90
src/SURFEX/mode_read_extern.F90
src/SURFEX/prep_isba_extern.F90
src/SURFEX/prep_teb_extern.F90
src/SURFEX/prep_teb_garden_extern.F90
src/SURFEX/prep_teb_greenroof_extern.F90
src/SURFEX/read_gr_snow.F90
src/SURFEX/read_isban.F90
src/SURFEX/read_pgd_isba_parn.F90
src/SURFEX/read_surf_field2d.F90 [new file with mode: 0644]
src/SURFEX/read_surf_field3d.F90 [new file with mode: 0644]
src/SURFEX/read_surf_isba_parn.F90
src/SURFEX/regular_grid_spawn.F90
src/SURFEX/write_diag_misc_isban.F90
src/SURFEX/write_diag_pgd_isban.F90
src/SURFEX/write_diag_seb_isban.F90
src/SURFEX/write_surf_field2d.F90 [new file with mode: 0644]
src/SURFEX/write_surf_field3d.F90 [new file with mode: 0644]
src/SURFEX/writesurf_ch_emisn.F90
src/SURFEX/writesurf_gr_snow.F90
src/SURFEX/writesurf_isban.F90
src/SURFEX/writesurf_pgd_isba_parn.F90
src/SURFEX/writesurf_pgd_isban.F90
src/SURFEX/writesurf_snapn.F90

index aba16ef..c4163bd 100644 (file)
-!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\r
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence\r
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt  \r
+!MNH_LIC for details. version 1.\r
+!-----------------------------------------------------------------\r
+!--------------- special set of characters for RCS information\r
+!-----------------------------------------------------------------\r
+! $Source$ $Revision$\r
+!-----------------------------------------------------------------\r
+!     ##########################\r
+      MODULE MODI_FILL_SONFIELD_n\r
+!     ##########################\r
+!\r
+INTERFACE \r
+!\r
+      SUBROUTINE FILL_SONFIELD_n(KMI,YFIELD,PNESTFIELD,KLSON)\r
+!\r
+INTEGER ,                 INTENT(IN)     :: KMI    ! son model number\r
+CHARACTER(LEN=6),         INTENT(IN)     :: YFIELD ! name of the field to nest\r
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT)  :: PNESTFIELD\r
+INTEGER,                  INTENT(IN)     :: KLSON  ! rank of son model in PNESTFIELD\r
+!\r
+END SUBROUTINE FILL_SONFIELD_n\r
+END INTERFACE\r
+!\r
+END MODULE MODI_FILL_SONFIELD_n\r
+!\r
+!\r
+!\r
+!     ##################################################\r
+      SUBROUTINE FILL_SONFIELD_n(KMI,YFIELD,PNESTFIELD,KLSON)\r
+!     ##################################################\r
+!\r
+!!****  *FILL_SONFIELD_n* - fill the working array for nesting of pgd files\r
+!!                          with        son model index= _n\r
+!!\r
+!!    PURPOSE\r
+!!    -------\r
+!\r
+!!**  METHOD\r
+!!    ------\r
+!!\r
+!!    EXTERNAL\r
+!!    --------\r
+!!       \r
+!!    IMPLICIT ARGUMENTS\r
+!!    ------------------ \r
+!!\r
+!!    REFERENCE\r
+!!    ---------\r
+!!      Book2 of the documentation\r
+!!      \r
+!!\r
+!!    AUTHOR\r
+!!    ------\r
+!!     V. Masson       * Meteo France *\r
+!!\r
+!!    MODIFICATIONS\r
+!!    -------------\r
+!!      Original        27/09/96\r
+!!   J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1 \r
+!!        M.Moge        01/2016 bug fix for parallel execution\r
+!-------------------------------------------------------------------------------\r
+!\r
+!*       0.    DECLARATIONS\r
+!\r
+USE MODD_GRID_n\r
+USE MODD_NESTING\r
+USE MODD_PARAMETERS\r
+USE MODE_SPLITTING_ll, ONLY : SPLIT2, DEF_SPLITTING2\r
+USE MODD_VAR_ll, ONLY : NPROC, IP, YSPLITTING, NMNH_COMM_WORLD\r
+USE MODD_STRUCTURE_ll, ONLY : ZONE_ll\r
+!\r
+USE MODE_MODELN_HANDLER\r
+!\r
+!USE MODE_TOOLS_ll, ONLY : GET_OR_ll\r
+!USE MODE_LS_ll\r
+!USE MODD_LSFIELD_n, ONLY : SET_LSFIELD_1WAY_ll\r
+USE MODE_ll\r
+!\r
+IMPLICIT NONE\r
+!\r
+!*       0.1   declarations of arguments\r
+!\r
+INTEGER ,                 INTENT(IN)     :: KMI    ! son model number\r
+CHARACTER(LEN=6),         INTENT(IN)     :: YFIELD ! name of the field to nest\r
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT)  :: PNESTFIELD\r
+INTEGER,                  INTENT(IN)     :: KLSON  ! rank of son model in PNESTFIELD\r
+!\r
+!\r
+!*       0.2   declarations of local variables\r
+!\r
+INTEGER :: IIB1,IIE1,IJB1,IJE1 ! limits of physical domain of KDAD model\r
+INTEGER :: JI1,JJ1             ! loop counters   in domain of KDAD model\r
+!\r
+INTEGER :: JI2INF, JI2SUP      ! limits of a grid mesh of domain of KDAD model\r
+INTEGER :: JJ2INF,JJ2SUP       ! relatively to son domain\r
+INTEGER :: IMI                 ! current model index\r
+INTEGER :: JLAYER              ! loop counter\r
+INTEGER :: IINFO_ll\r
+INTEGER :: IXSIZE, IYSIZE  ! sizes of global son domain in father grid\r
+INTEGER :: IXSIZE_F, IYSIZE_F  ! sizes of global father domain\r
+TYPE(ZONE_ll), DIMENSION(:), ALLOCATABLE :: TZSPLITTING\r
+INTEGER :: IXOR, IYOR  ! origin of local subdomain\r
+INTEGER :: IXOR_C, IYOR_C, IXEND_C, IYEND_C  ! origin and end of local physical son subdomain in father grid\r
+REAL, DIMENSION(:,:), ALLOCATABLE  :: ZSUM\r
+REAL, DIMENSION(:,:), ALLOCATABLE  :: ZSUM_C\r
+INTEGER :: IDIMX_C, IDIMY_C ! size of extended local son subdomain in father grid obtained with GET_CHILD_DIM_ll\r
+INTEGER :: IXDOMAINS, IYDOMAINS               ! number of subdomains in X and Y directions\r
+LOGICAL :: GPREM                              ! needed for DEF_SPLITTING2, true if NPROC is a prime number\r
+!-------------------------------------------------------------------------------\r
+!\r
+!*       1.    initializations\r
+!              ---------------\r
+!\r
+IMI = GET_CURRENT_MODEL_INDEX()\r
+CALL GET_OR_ll( YSPLITTING, IXOR, IYOR )\r
+CALL GOTO_MODEL(KMI)\r
+CALL GO_TOMODEL_ll(KMI, IINFO_ll)\r
+!\r
+IF (KLSON/=1) THEN\r
+  ! get sizes of global son domain in father grid\r
+  IXSIZE = NXEND_ALL(KMI) - NXOR_ALL (KMI) + 1 - 2*JPHEXT ! - 1\r
+  IYSIZE = NYEND_ALL(KMI) - NYOR_ALL (KMI) + 1 - 2*JPHEXT ! - 1\r
+  ! get splitting of current model KMI in father grid\r
+  IXSIZE_F = NXEND_ALL(NDAD(KMI)) - NXOR_ALL (NDAD(KMI))  + 1 - 2*JPHEXT\r
+  IYSIZE_F = NYEND_ALL(NDAD(KMI)) - NYOR_ALL (NDAD(KMI))  + 1 - 2*JPHEXT\r
+  ALLOCATE(TZSPLITTING(NPROC))\r
+! we want the same domain partitioning for the child domain and for the father domain\r
+  CALL DEF_SPLITTING2(IXDOMAINS,IYDOMAINS,IXSIZE_F,IYSIZE_F,NPROC,GPREM)\r
+  CALL SPLIT2 ( IXSIZE, IYSIZE, 1, NPROC, TZSPLITTING, YSPLITTING, IXDOMAINS, IYDOMAINS )\r
+  IIB1 = JPHEXT + 1\r
+  IIE1 = TZSPLITTING(IP)%NXEND - TZSPLITTING(IP)%NXOR + JPHEXT + 1\r
+  IJB1 = JPHEXT + 1\r
+  IJE1 = TZSPLITTING(IP)%NYEND - TZSPLITTING(IP)%NYOR + JPHEXT + 1\r
+!  IIB1 = NXOR_ALL(KMI) + TZSPLITTING(IP)%NXOR - JPHEXT\r
+!  IIE1 = NXOR_ALL(KMI) + TZSPLITTING(IP)%NXEND - JPHEXT\r
+!  IJB1 = NYOR_ALL(KMI) + TZSPLITTING(IP)%NYOR - JPHEXT\r
+!  IJE1 = NYOR_ALL(KMI) + TZSPLITTING(IP)%NYEND - JPHEXT\r
+ENDIF\r
+!\r
+!* correct only if JPHEXT = 1\r
+!\r
+!JUAN A REVOIR TODO_JPHEXT !!!\r
+! <<<<<<< fill_sonfieldn.f90\r
+!IIB1 = NXOR_ALL (KMI)+1\r
+!IIE1 = NXEND_ALL(KMI)-1\r
+!IJB1 = NYOR_ALL (KMI)+1\r
+!IJE1 = NYEND_ALL(KMI)-1\r
+! =======\r
+!IIB1 = NXOR_ALL (KMI)+JPHEXT\r
+!IIE1 = NXEND_ALL(KMI)-JPHEXT\r
+!IJB1 = NYOR_ALL (KMI)+JPHEXT\r
+!IJE1 = NYEND_ALL(KMI)-JPHEXT\r
+! >>>>>>> 1.2.4.1.18.2.2.1\r
+!\r
+DO JLAYER=1,SIZE(PNESTFIELD,4)\r
+  PNESTFIELD(:,:,KLSON,JLAYER) = XUNDEF\r
+END DO\r
+!\r
+!-------------------------------------------------------------------------------\r
+IF (KLSON==1) THEN\r
+!\r
+!*       2.    case KLSON=1 : father itself\r
+!              ----------------------------\r
+!\r
+      SELECT CASE(YFIELD)\r
+        CASE ('ZS    ')\r
+          PNESTFIELD(:,:,KLSON,1) = XZS(:,:)\r
+         CASE ('ZSMT  ')   ! smooth topography for SLEVE coordinate\r
+          PNESTFIELD(:,:,KLSON,1) = XZSMT(:,:)\r
+        CASE DEFAULT\r
+          CALL GOTO_MODEL(IMI)\r
+          CALL GO_TOMODEL_ll(IMI, IINFO_ll)\r
+      END SELECT\r
+!\r
+!-------------------------------------------------------------------------------\r
+ELSE\r
+!\r
+!*       3.    case KLSON>1 : one son\r
+!              ----------------------\r
+!\r
+!  ALLOCATE( ZSUM(SIZE(PNESTFIELD,1), SIZE(PNESTFIELD,2)) )\r
+  ALLOCATE( ZSUM(SIZE(XZS,1), SIZE(XZS,2)) )\r
+  !\r
+  CALL GOTO_MODEL( NDAD(KMI) )\r
+  CALL GO_TOMODEL_ll( NDAD(KMI), IINFO_ll )\r
+  CALL GET_CHILD_DIM_ll(KMI, IDIMX_C, IDIMY_C, IINFO_ll)\r
+  CALL GOTO_MODEL( KMI )\r
+  CALL GO_TOMODEL_ll( KMI, IINFO_ll )\r
+  ALLOCATE( ZSUM_C(IDIMX_C, IDIMY_C) )\r
+  !\r
+  DO JI1 = IIB1,IIE1\r
+    DO JJ1 = IJB1,IJE1\r
+      JI2INF= (JI1-IIB1)  *NDXRATIO_ALL(KMI)+1+JPHEXT\r
+      JI2SUP= (JI1-IIB1+1)*NDXRATIO_ALL(KMI)  +JPHEXT\r
+      JJ2INF= (JJ1-IJB1)  *NDYRATIO_ALL(KMI)+1+JPHEXT\r
+      JJ2SUP= (JJ1-IJB1+1)*NDYRATIO_ALL(KMI)  +JPHEXT\r
+\r
+      SELECT CASE(YFIELD)\r
+         CASE ('ZS    ')\r
+           ZSUM_C(1+JPHEXT+(JI1-IIB1+1),1+JPHEXT+(JJ1-IJB1+1)) = SUM ( XZS(JI2INF:JI2SUP,JJ2INF:JJ2SUP ) )&\r
+                                     / ( NDXRATIO_ALL(KMI)*NDYRATIO_ALL(KMI) )\r
+         CASE ('ZSMT  ')  ! smooth topography for SLEVE coordinate\r
+           ZSUM_C(1+JPHEXT+(JI1-IIB1+1),1+JPHEXT+(JJ1-IJB1+1)) = SUM ( XZSMT(JI2INF:JI2SUP,JJ2INF:JJ2SUP ) )&\r
+                                     / ( NDXRATIO_ALL(KMI)*NDYRATIO_ALL(KMI) )\r
+        CASE DEFAULT\r
+          CALL GOTO_MODEL(IMI)\r
+          CALL GO_TOMODEL_ll(IMI, IINFO_ll)\r
+          RETURN\r
+      END SELECT\r
+\r
+    END DO\r
+  END DO\r
+  !switch to father model to set the LSFIELD and do the communications with LS_FEEDBACK_ll\r
+CALL GET_FEEDBACK_COORD_ll(IXOR_C,IYOR_C,IXEND_C,IYEND_C,IINFO_ll) ! physical domain's origin and end\r
+  CALL SET_LSFIELD_2WAY_ll(PNESTFIELD(IXOR_C:IXEND_C,IYOR_C:IYEND_C,KLSON,1), ZSUM_C)\r
+  CALL LS_FEEDBACK_ll(IINFO_ll)\r
+  CALL UNSET_LSFIELD_1WAY_ll()\r
+!\r
+!-------------------------------------------------------------------------------\r
+END IF\r
+!\r
+CALL GOTO_MODEL(IMI)\r
+CALL GO_TOMODEL_ll(IMI, IINFO_ll)\r
+!-------------------------------------------------------------------------------\r
+!\r
+END SUBROUTINE FILL_SONFIELD_n\r
index fadde4e..5bb8ae9 100644 (file)
-!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\r
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence\r
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt  \r
+!MNH_LIC for details. version 1.\r
+!-----------------------------------------------------------------\r
+!--------------- special set of characters for RCS information\r
+!-----------------------------------------------------------------\r
+! $Source$ $Revision$\r
+! masdev4_7 BUG1 2007/06/15 17:47:17\r
+!-----------------------------------------------------------------\r
+!     ######################\r
+      MODULE MODI_FILL_ZSMTn\r
+!     ######################\r
+!\r
+INTERFACE \r
+!\r
+      SUBROUTINE FILL_ZSMT_n(HFIELD,PFIELD,KSON)\r
+!\r
+CHARACTER(LEN=6),         INTENT(IN) :: HFIELD ! name of the field to nest\r
+REAL, DIMENSION(:,:), INTENT(INOUT)  :: PFIELD\r
+INTEGER,                  INTENT(IN) :: KSON   ! son model index\r
+!\r
+END SUBROUTINE FILL_ZSMT_n\r
+!\r
+END INTERFACE\r
+!\r
+END MODULE MODI_FILL_ZSMTn\r
+!\r
+!\r
+!\r
+!     ##########################################\r
+      SUBROUTINE FILL_ZSMT_n(HFIELD,PFIELD,KSON)\r
+!     ##########################################\r
+!\r
+!!****  *FILL_ZSMT_n* - fill the working array for nesting of pgd files\r
+!!                          with KSON model index\r
+!!\r
+!!    PURPOSE\r
+!!    -------\r
+!\r
+!!**  METHOD\r
+!!    ------\r
+!!\r
+!!    EXTERNAL\r
+!!    --------\r
+!!       \r
+!!    IMPLICIT ARGUMENTS\r
+!!    ------------------ \r
+!!\r
+!!    REFERENCE\r
+!!    ---------\r
+!!      Book2 of the documentation\r
+!!      \r
+!!\r
+!!    AUTHOR\r
+!!    ------\r
+!!     V. Masson       * Meteo France *\r
+!!\r
+!!    MODIFICATIONS\r
+!!    -------------\r
+!!      Original        12/01/05\r
+!!      Modification    20/05/06 Remove Clark and Farley interpolation\r
+!!        M.Moge        01/2016 bug fix for parallel execution\r
+!-------------------------------------------------------------------------------\r
+!\r
+!*       0.    DECLARATIONS\r
+!\r
+USE MODD_GRID_n,  ONLY : XZSMT\r
+USE MODD_LUNIT_n, ONLY : CLUOUT\r
+USE MODD_LBC_n,   ONLY : CLBCX,CLBCY\r
+USE MODD_NESTING\r
+USE MODD_PARAMETERS\r
+!\r
+USE MODI_INI_BIKHARDT_n\r
+USE MODI_SPAWN_ZS\r
+USE MODE_MODELN_HANDLER\r
+!\r
+USE MODE_SPLITTING_ll, ONLY : SPLIT2, DEF_SPLITTING2\r
+USE MODD_VAR_ll, ONLY : NPROC, IP, YSPLITTING, NMNH_COMM_WORLD\r
+USE MODD_STRUCTURE_ll, ONLY : ZONE_ll\r
+!\r
+IMPLICIT NONE\r
+!\r
+!*       0.1   declarations of arguments\r
+!\r
+CHARACTER(LEN=6),     INTENT(IN)     :: HFIELD ! name of the field to fill\r
+REAL, DIMENSION(:,:), INTENT(INOUT)  :: PFIELD\r
+INTEGER,              INTENT(IN) :: KSON   ! son model index\r
+!\r
+!*       0.2   declarations of local variables\r
+!-------------------------------------------------------------------------------\r
+INTEGER :: IMI ! current model index (DAD index)\r
+!\r
+! Dummy pointers needed to correct an ifort Bug\r
+CHARACTER(LEN=4), DIMENSION(:), POINTER :: DPTR_CLBCX,DPTR_CLBCY\r
+REAL, DIMENSION(:,:),  POINTER          :: DPTR_XZSMT\r
+INTEGER :: IINFO_ll\r
+INTEGER :: IXSIZE, IYSIZE        ! sizes of global son domain in father grid\r
+INTEGER :: IXSIZE_F, IYSIZE_F    ! sizes of global father domain\r
+TYPE(ZONE_ll), DIMENSION(:), ALLOCATABLE :: TZSPLITTING\r
+INTEGER :: IXOR,IXEND,IYOR,IYEND ! limits of extended  domain of KSON model in its father's grid\r
+INTEGER :: IDIMX, IDIMY  ! dimensions of extended son subdomain in father's grid + one point in each direction\r
+INTEGER :: IXDOMAINS, IYDOMAINS               ! number of subdomains in X and Y directions\r
+LOGICAL :: GPREM                              ! needed for DEF_SPLITTING2, true if NPROC is a prime number\r
+!\r
+!*       1.    initializations\r
+!              ---------------\r
+!\r
+IMI = GET_CURRENT_MODEL_INDEX()\r
+CALL GOTO_MODEL(KSON)\r
+CALL GO_TOMODEL_ll(KSON, IINFO_ll)\r
+!\r
+! get sizes of global son domain in father grid\r
+IXSIZE = NXEND_ALL(KSON) - NXOR_ALL (KSON) + 1 - 2*JPHEXT\r
+IYSIZE = NYEND_ALL(KSON) - NYOR_ALL (KSON) + 1 - 2*JPHEXT\r
+! get splitting of current model KMI in father grid\r
+IXSIZE_F = NXEND_ALL(NDAD(KSON)) - NXOR_ALL (NDAD(KSON)) + 1 - 2*JPHEXT\r
+IYSIZE_F = NYEND_ALL(NDAD(KSON)) - NYOR_ALL (NDAD(KSON)) + 1 - 2*JPHEXT\r
+ALLOCATE(TZSPLITTING(NPROC))\r
+! we want the same domain partitioning for the child domain and for the father domain\r
+CALL DEF_SPLITTING2(IXDOMAINS,IYDOMAINS,IXSIZE_F,IYSIZE_F,NPROC,GPREM)\r
+CALL SPLIT2 ( IXSIZE, IYSIZE, 1, NPROC, TZSPLITTING, YSPLITTING, IXDOMAINS, IYDOMAINS )\r
+! get coords of extended domain of KSON in its father's grid\r
+IXOR  = NXOR_ALL(KSON) + TZSPLITTING(IP)%NXOR  -1 - JPHEXT \r
+IXEND = NXOR_ALL(KSON) + TZSPLITTING(IP)%NXEND -1 + JPHEXT \r
+IYOR  = NYOR_ALL(KSON) + TZSPLITTING(IP)%NYOR  -1 - JPHEXT \r
+IYEND = NYOR_ALL(KSON) + TZSPLITTING(IP)%NYEND -1 + JPHEXT\r
+!\r
+!IDIMX = IXEND - IXOR - 1\r
+!IDIMY = IYEND - IYOR - 1\r
+IDIMX = IXEND - IXOR + 1 +2*1 ! + 2*JPHEXT\r
+IDIMY = IYEND - IYOR + 1 +2*1 ! + 2*JPHEXT\r
+!\r
+CALL INI_BIKHARDT_n(NDXRATIO_ALL(KSON),NDYRATIO_ALL(KSON),KSON)\r
+!\r
+!-------------------------------------------------------------------------------\r
+!\r
+!*       2.    interpolation of dad field\r
+!              --------------------------\r
+!\r
+DPTR_CLBCX=>CLBCX\r
+DPTR_CLBCY=>CLBCY\r
+DPTR_XZSMT=>XZSMT\r
+CALL SPAWN_ZS(NXOR_ALL(KSON),NXEND_ALL(KSON),NYOR_ALL(KSON),NYEND_ALL(KSON), &\r
+              NDXRATIO_ALL(KSON),NDYRATIO_ALL(KSON),IDIMX,IDIMY,DPTR_CLBCX,DPTR_CLBCY,         &\r
+              CLUOUT,PFIELD,DPTR_XZSMT,HFIELD                             )\r
+!-------------------------------------------------------------------------------\r
+!\r
+CALL GOTO_MODEL(IMI)\r
+CALL GO_TOMODEL_ll(IMI, IINFO_ll)\r
+!\r
+END SUBROUTINE FILL_ZSMT_n\r
index f369feb..70cf5af 100644 (file)
-!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\r
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence\r
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt  \r
+!MNH_LIC for details. version 1.\r
+!-----------------------------------------------------------------\r
+!--------------- special set of characters for RCS information\r
+!-----------------------------------------------------------------\r
+! $Source$ $Revision$\r
+!-----------------------------------------------------------------\r
+!#############################\r
+MODULE MODI_OPEN_NESTPGD_FILES\r
+!#############################\r
+!\r
+INTERFACE\r
+      SUBROUTINE OPEN_NESTPGD_FILES(HPGD,HNESTPGD)\r
+!\r
+CHARACTER(LEN=28), DIMENSION(:), INTENT(OUT) :: HPGD     ! name of the input  pgd files\r
+CHARACTER(LEN=28), DIMENSION(:), INTENT(OUT) :: HNESTPGD ! name of the output pgd files\r
+END SUBROUTINE OPEN_NESTPGD_FILES\r
+END INTERFACE\r
+END MODULE MODI_OPEN_NESTPGD_FILES\r
+!     ############################################\r
+      SUBROUTINE OPEN_NESTPGD_FILES(HPGD,HNESTPGD)\r
+!     ############################################\r
+!\r
+!!****  *OPEN_NESTPGD_FILES* - openning of the files used in PREP_NEST_PGD\r
+!!                         \r
+!!\r
+!!    PURPOSE\r
+!!    -------\r
+!!\r
+!!**  METHOD\r
+!!    ------\r
+!!\r
+!!    CAUTION:\r
+!!    This routine supposes the name of the namelist file is 'PRE_NEST_PGD1.nam'.\r
+!!\r
+!!    EXTERNAL\r
+!!    --------\r
+!!\r
+!!    Routine FMOPEN\r
+!!\r
+!!    IMPLICIT ARGUMENTS\r
+!!    ------------------\r
+!!\r
+!!      Module MODD_LUNIT     :  contains logical unit names for all models\r
+!!         CLUOUT0  : name of output-listing\r
+!!\r
+!!    REFERENCE\r
+!!    ---------\r
+!!\r
+!!      Book 2\r
+!!\r
+!!    AUTHOR\r
+!!    ------\r
+!!     \r
+!!      V.Masson  Meteo-France\r
+!!\r
+!!    MODIFICATIONS\r
+!!    -------------\r
+!!      Original     26/09/96\r
+!!                   30/07/97 (Masson) group MODI_OPEN_LUOUTn\r
+!!                   15/10/01 (I.Mallet) allow namelists in different orders\r
+!!                   07/06/2010 (J.escobar from Ivan Ristic) bug PGI\r
+!!                   30/12/2012 (S.Bielli) Add NAM_NCOUT for netcdf output\r
+!!    J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1 \r
+!!                   11/2015 (M.Moge) disable the creation of files on multiple \r
+!!                                 Z-levels when using parallel IO for PREP_PGD\r
+!!                   01/2016 (M.Moge) Bug fix : open the output file using Z-parallel IO\r
+!-------------------------------------------------------------------------------\r
+!\r
+!*       0.    DECLARATIONS\r
+!              ------------\r
+!\r
+USE MODD_LUNIT\r
+USE MODD_CONF\r
+USE MODD_NESTING\r
+USE MODD_PARAMETERS\r
+!\r
+USE MODI_OPEN_LUOUTn\r
+!\r
+USE MODE_IO_ll\r
+USE MODE_FM\r
+USE MODE_POS\r
+!\r
+USE MODE_MODELN_HANDLER\r
+!\r
+#ifdef MNH_NCWRIT\r
+USE MODN_NCOUT\r
+#endif\r
+USE MODN_CONFIO\r
+!\r
+USE MODD_PARAMETERS, ONLY : JPHEXT  \r
+USE MODD_CONF, ONLY       : NHALO_CONF_MNH => NHALO\r
+!\r
+USE  MODN_CONFZ\r
+!\r
+IMPLICIT NONE\r
+!\r
+!*       0.1   Declaration of arguments\r
+!              ------------------------\r
+!\r
+CHARACTER(LEN=28), DIMENSION(:), INTENT(OUT) :: HPGD     ! name of the input  pgd files\r
+CHARACTER(LEN=28), DIMENSION(:), INTENT(OUT) :: HNESTPGD ! name of the output pgd files\r
+!\r
+!*       0.2   Declaration of local variables\r
+!              ------------------------------\r
+!\r
+INTEGER :: IRESP      ! return-code if problems eraised\r
+INTEGER :: ILUOUT0    ! logical unit for listing file\r
+INTEGER :: ININAR     ! number of articles initially present in a FM file\r
+LOGICAL :: GFOUND     ! Return code when searching namelist\r
+!\r
+CHARACTER(LEN=28) :: HPRE_NEST_PGD ! name of namelist file\r
+INTEGER           :: IPRE_NEST_PGD ! logical unit of namelist file\r
+!\r
+CHARACTER(LEN=28)                        :: YPGD      ! name of the pgd file for each model\r
+CHARACTER(LEN=28)                        :: YLUOUT    ! name of output listing file for each model\r
+CHARACTER(LEN=2)                         :: YNEST     ! to define the output pgd file names\r
+CHARACTER(LEN=28)                        :: YPGD1, YPGD2, YPGD3, YPGD4, &\r
+                                            YPGD5, YPGD6, YPGD7, YPGD8\r
+!                                                     ! name of all pgd files\r
+!                                                     ! in the namelist\r
+INTEGER                        :: IDAD    ! father of one model\r
+INTEGER                        :: JPGD    ! loop counter\r
+LOGICAL                        :: GADD    !\r
+CHARACTER(LEN=21), DIMENSION(JPMODELMAX) :: YSHORTPGD \r
+INTEGER                                  :: NHALO_MNH\r
+!\r
+INTEGER :: ILUNAM,ILUOUT              ! Logical unit number for the EXSPA file\r
+!\r
+!*       0.3   Declaration of namelists\r
+!              ------------------------\r
+!\r
+NAMELIST/NAM_PGD1/ YPGD1\r
+NAMELIST/NAM_PGD2/ YPGD2, IDAD\r
+NAMELIST/NAM_PGD3/ YPGD3, IDAD\r
+NAMELIST/NAM_PGD4/ YPGD4, IDAD\r
+NAMELIST/NAM_PGD5/ YPGD5, IDAD\r
+NAMELIST/NAM_PGD6/ YPGD6, IDAD\r
+NAMELIST/NAM_PGD7/ YPGD7, IDAD\r
+NAMELIST/NAM_PGD8/ YPGD8, IDAD\r
+NAMELIST/NAM_NEST_PGD/ YNEST\r
+NAMELIST/NAM_CONF_NEST/JPHEXT, NHALO_MNH\r
+!-------------------------------------------------------------------------------\r
+!\r
+!*       1.    SET DEFAULT NAMES\r
+!              -----------------\r
+!\r
+DO JPGD=1,JPMODELMAX\r
+  HPGD    (JPGD)='                           '\r
+  HNESTPGD(JPGD)='                           '\r
+END DO\r
+!\r
+HPRE_NEST_PGD='PRE_NEST_PGD1.nam'\r
+CLUOUT0='OUTPUT_LISTING0'\r
+!\r
+!-------------------------------------------------------------------------------\r
+!\r
+!*       2.    OPENNING OF CLUOUT0\r
+!              -------------------\r
+!\r
+CALL OPEN_ll(UNIT=ILUOUT0,FILE=CLUOUT0,IOSTAT=IRESP,FORM='FORMATTED',ACTION='WRITE', &\r
+     MODE=GLOBAL)\r
+!\r
+!-------------------------------------------------------------------------------\r
+!\r
+!*       3.    OPENNING OF PRE_NEST_PGD1.nam\r
+!              -----------------------------\r
+!\r
+CALL OPEN_ll(UNIT=IPRE_NEST_PGD,FILE=HPRE_NEST_PGD,IOSTAT=IRESP,FORM='FORMATTED',ACTION='READ', &\r
+     MODE=GLOBAL)\r
+!reading of NAM_CONFZ\r
+CALL FMLOOK_ll(HPRE_NEST_PGD,HPRE_NEST_PGD,ILUOUT,IRESP)\r
+CALL POSNAM(IPRE_NEST_PGD,'NAM_CONFZ',GFOUND)\r
+IF (GFOUND) READ(UNIT=IPRE_NEST_PGD,NML=NAM_CONFZ)\r
+!\r
+!JUAN\r
+CALL POSNAM(IPRE_NEST_PGD,'NAM_CONF_NEST',GFOUND)\r
+IF (GFOUND) THEN\r
+   NHALO_MNH = NHALO_CONF_MNH\r
+   READ(UNIT=IPRE_NEST_PGD,NML=NAM_CONF_NEST)\r
+   NHALO_CONF_MNH = NHALO_MNH\r
+END IF\r
+!JUAN\r
+!\r
+!-------------------------------------------------------------------------------\r
+!\r
+!*       4.    READING OF THE OTHER FILE NAMES\r
+!              -------------------------------\r
+!\r
+YPGD1='                            '\r
+YPGD2='                            '\r
+YPGD3='                            '\r
+YPGD4='                            '\r
+YPGD5='                            '\r
+YPGD6='                            '\r
+YPGD7='                            '\r
+YPGD8='                            '\r
+NDAD(:)=0\r
+GADD=.TRUE.\r
+!\r
+DO JPGD=1,JPMODELMAX\r
+  IDAD=0\r
+  IF (JPGD==1) THEN\r
+    CALL POSNAM(IPRE_NEST_PGD,'NAM_PGD1',GFOUND)\r
+    IF (GFOUND) READ(UNIT=IPRE_NEST_PGD,NML=NAM_PGD1)\r
+  END IF\r
+  IF (JPGD==2) THEN\r
+    CALL POSNAM(IPRE_NEST_PGD,'NAM_PGD2',GFOUND)\r
+    IF (GFOUND) READ(UNIT=IPRE_NEST_PGD,NML=NAM_PGD2)\r
+  END IF\r
+  IF (JPGD==3) THEN\r
+    CALL POSNAM(IPRE_NEST_PGD,'NAM_PGD3',GFOUND)\r
+    IF (GFOUND) READ(UNIT=IPRE_NEST_PGD,NML=NAM_PGD3)\r
+  END IF\r
+  IF (JPGD==4) THEN\r
+    CALL POSNAM(IPRE_NEST_PGD,'NAM_PGD4',GFOUND)\r
+    IF (GFOUND) READ(UNIT=IPRE_NEST_PGD,NML=NAM_PGD4)\r
+  END IF\r
+  IF (JPGD==5) THEN\r
+    CALL POSNAM(IPRE_NEST_PGD,'NAM_PGD5',GFOUND)\r
+    IF (GFOUND) READ(UNIT=IPRE_NEST_PGD,NML=NAM_PGD5)\r
+  END IF\r
+  IF (JPGD==6) THEN\r
+    CALL POSNAM(IPRE_NEST_PGD,'NAM_PGD6',GFOUND)\r
+    IF (GFOUND) READ(UNIT=IPRE_NEST_PGD,NML=NAM_PGD6)\r
+  END IF\r
+  IF (JPGD==7) THEN\r
+    CALL POSNAM(IPRE_NEST_PGD,'NAM_PGD7',GFOUND)\r
+    IF (GFOUND) READ(UNIT=IPRE_NEST_PGD,NML=NAM_PGD7)\r
+  END IF\r
+  IF (JPGD==8) THEN\r
+    CALL POSNAM(IPRE_NEST_PGD,'NAM_PGD8',GFOUND)\r
+    IF (GFOUND) READ(UNIT=IPRE_NEST_PGD,NML=NAM_PGD8)\r
+  END IF\r
+  !\r
+  IF (JPGD==1) YPGD=YPGD1\r
+  IF (JPGD==2) YPGD=YPGD2\r
+  IF (JPGD==3) YPGD=YPGD3\r
+  IF (JPGD==4) YPGD=YPGD4\r
+  IF (JPGD==5) YPGD=YPGD5\r
+  IF (JPGD==6) YPGD=YPGD6\r
+  IF (JPGD==7) YPGD=YPGD7\r
+  IF (JPGD==8) YPGD=YPGD8\r
+  !\r
+  IF (LEN_TRIM(YPGD) == 0) THEN\r
+    IF (JPGD==1) THEN\r
+      WRITE(ILUOUT0,*) 'No pgd file was present for model 1 in namelist NAM_PGD1'\r
+!callabortstop\r
+      CALL CLOSE_ll(CLUOUT0,IOSTAT=IRESP)\r
+      CALL ABORT\r
+      STOP\r
+    ELSE\r
+      GADD=.FALSE.\r
+      CYCLE\r
+    END IF\r
+  END IF\r
+  !\r
+  IF ( (IDAD<1 .OR. IDAD>JPMODELMAX) .AND. (JPGD>1) ) THEN\r
+      WRITE(ILUOUT0,*) 'No father indicated for model ',JPGD,' in namelist NAM_PGD',JPGD\r
+!callabortstop\r
+      CALL CLOSE_ll(CLUOUT0,IOSTAT=IRESP)\r
+      CALL ABORT\r
+      STOP\r
+  END IF\r
+  !\r
+  IF (GADD) THEN\r
+    NMODEL=JPGD\r
+    !\r
+    IF (IDAD>=JPGD) THEN\r
+      WRITE(ILUOUT0,*) 'pgd files are not correctly ordered:'\r
+      WRITE(ILUOUT0,*) ' in namelist NAM_PGD',JPGD,' was found IDAD= ', IDAD\r
+!callabortstop\r
+      CALL CLOSE_ll(CLUOUT0,IOSTAT=IRESP)\r
+      CALL ABORT\r
+      STOP\r
+    END IF\r
+    !\r
+    NDAD(JPGD)=IDAD\r
+    HPGD(JPGD)=YPGD\r
+  END IF\r
+END DO\r
+!\r
+!-------------------------------------------------------------------------------\r
+!\r
+!*       5.    NAMES OF OUTPUT PGD FILES\r
+!              -------------------------\r
+!\r
+CALL POSNAM(IPRE_NEST_PGD,'NAM_NEST_PGD',GFOUND,ILUOUT0)\r
+IF (GFOUND) READ(UNIT=IPRE_NEST_PGD,NML=NAM_NEST_PGD)\r
+HNESTPGD(:) = '                            '\r
+!\r
+YSHORTPGD(:)=HPGD(:)\r
+DO JPGD=1,NMODEL\r
+  HNESTPGD(JPGD) = ADJUSTR( YSHORTPGD(JPGD))//'.nest'//ADJUSTL(YNEST)\r
+  HNESTPGD(JPGD) = ADJUSTL(HNESTPGD(JPGD))\r
+END DO\r
+#ifdef MNH_NCWRIT\r
+CALL POSNAM(IPRE_NEST_PGD,'NAM_NCOUT',GFOUND,ILUOUT0)\r
+IF (GFOUND) READ(UNIT=IPRE_NEST_PGD,NML=NAM_NCOUT)\r
+#endif\r
+!\r
+CALL POSNAM(IPRE_NEST_PGD,'NAM_CONFIO',GFOUND,ILUOUT0)\r
+IF (GFOUND) READ(UNIT=IPRE_NEST_PGD,NML=NAM_CONFIO)\r
+CALL SET_CONFIO_ll(LCDF4, LLFIOUT, LLFIREAD)\r
+!\r
+!-------------------------------------------------------------------------------\r
+CALL CLOSE_ll(HPRE_NEST_PGD)\r
+!-------------------------------------------------------------------------------\r
+!\r
+!*       6.    OPENING OF INPUT AND OUTPUT PGD FILES\r
+!              -------------------------------------\r
+!\r
+DO JPGD=1,NMODEL\r
+  CALL FMOPEN_ll(HPGD(JPGD),'READ',CLUOUT0,0,2,NVERB,ININAR,IRESP,OPARALLELIO=.FALSE.)\r
+  CALL FMOPEN_ll(HNESTPGD(JPGD),'WRITE',CLUOUT0,0,1,NVERB,ININAR,IRESP)\r
+END DO\r
+!\r
+!-------------------------------------------------------------------------------\r
+!\r
+!*       7.    OPENING OF OUPUT LISTING FILES FOR ALL MODELS\r
+!              ----------------------------------------------\r
+!\r
+DO JPGD=1,NMODEL\r
+  CALL GOTO_MODEL(JPGD)\r
+  WRITE(YLUOUT,'("OUTPUT_LISTING",I0)') JPGD\r
+  CALL OPEN_LUOUT_n(YLUOUT)\r
+END DO\r
+!\r
+!-------------------------------------------------------------------------------\r
+!\r
+END SUBROUTINE OPEN_NESTPGD_FILES\r
index 3d00972..02cb7a6 100644 (file)
-!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
+!     #########\r
+       SUBROUTINE BUILD_EMISSTAB_n(HPROGRAM,KCH,HEMIS_GR_NAME, KNBTIMES,&\r
+              KEMIS_GR_TIME,KOFFNDX,TPEMISS,KSIZE,KLUOUT, KVERB,PRHODREF)  \r
+!!    #####################################################################\r
+!!\r
+!!*** *BUILD_EMISSTAB*\r
+!!\r
+!!    PURPOSE\r
+!!    -------\r
+!!\r
+!!**  METHOD\r
+!!    ------\r
+!!\r
+!!    AUTHOR\r
+!!    ------\r
+!!    D. Gazen\r
+!!\r
+!!    MODIFICATIONS\r
+!!    -------------\r
+!!    Original 01/02/00\r
+!!    C. Mari  30/10/00  call of MODD_TYPE_EFUTIL and MODD_CST\r
+!!    D.Gazen  01/12/03  change emissions handling for surf. externalization!!\r
+!!    P.Tulet  01/01/04  change conversion for externalization (flux unit is\r
+!!                        molec./m2/s)\r
+!!    M.Leriche  04/14   apply conversion factor if lead = f\r
+!!    M.Moge    01/2016  using READ_SURF_FIELD2D for 2D surfex fields reads\r
+!!\r
+!!    EXTERNAL\r
+!!    --------\r
+USE MODI_CH_OPEN_INPUTB\r
+USE MODI_READ_SURF_FIELD2D\r
+!!\r
+!!    IMPLICIT ARGUMENTS\r
+!!    ------------------\r
+USE MODD_TYPE_EFUTIL, ONLY : EMISSVAR_T\r
+USE MODD_CSTS,        ONLY : NDAYSEC, XMD, XAVOGADRO\r
+USE MODD_CH_SURF_n,   ONLY : XCONVERSION\r
+!------------------------------------------------------------------------------\r
+!\r
+!*       0.   DECLARATIONS\r
+!        -----------------\r
+!\r
+USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK\r
+USE PARKIND1  ,ONLY : JPRB\r
+!\r
+USE MODI_ABOR1_SFX\r
+!\r
+IMPLICIT NONE\r
+!\r
+!*       0.1  declaration of arguments\r
+!\r
+ CHARACTER(LEN=6),                INTENT(IN) :: HPROGRAM   ! Program name\r
+INTEGER,                         INTENT(IN) :: KCH\r
+ CHARACTER(LEN=*),DIMENSION(:),   INTENT(IN) :: HEMIS_GR_NAME ! Offline species name\r
+INTEGER, DIMENSION(:),           INTENT(IN) :: KNBTIMES ! nb of emis times array\r
+INTEGER, DIMENSION(:),           INTENT(IN) :: KEMIS_GR_TIME\r
+INTEGER, DIMENSION(:),           INTENT(IN) :: KOFFNDX ! index of offline species\r
+TYPE(EMISSVAR_T),DIMENSION(:),   INTENT(OUT):: TPEMISS ! emission struct array to fill\r
+INTEGER,                         INTENT(IN) :: KSIZE   ! size X*Y (1D) of physical domain\r
+INTEGER,                         INTENT(IN) :: KLUOUT  ! output listing channel\r
+INTEGER,                         INTENT(IN) :: KVERB   ! verbose level\r
+REAL, DIMENSION(:),              INTENT(IN) :: PRHODREF ! dry density for ref. state\r
+!\r
+!\r
+!*       0.2  declaration of local variables\r
+!\r
+ CHARACTER(LEN=3):: YUNIT       ! unit of the flux\r
+INTEGER         :: INBTS       ! Number of emis times for a species\r
+INTEGER         :: IRESP       ! I/O return value\r
+INTEGER         :: IIND1, IIND2\r
+INTEGER         :: JSPEC       ! loop index\r
+INTEGER         :: ITIME       ! loop index\r
+INTEGER         :: IWS_DEFAULT ! Default Memory window size for emission reading\r
+ CHARACTER (LEN=16):: YRECFM    ! LFI article name\r
+REAL(KIND=JPRB) :: ZHOOK_HANDLE\r
+\r
+!\r
+!------------------------------------------------------------------------------\r
+!\r
+!*    EXECUTABLE STATEMENTS\r
+!     ---------------------\r
+!\r
+\r
+IF (LHOOK) CALL DR_HOOK('BUILD_EMISSTAB_N',0,ZHOOK_HANDLE)\r
+IF (KVERB >= 5) THEN\r
+  WRITE(KLUOUT,*) '********     SUBROUTINE (CHIMIE): BUILD_EMISSTAB_n     ********'\r
+END IF\r
+!\r
+!*       1.   READ DATA \r
+!        --------------\r
+!\r
+ CALL CH_OPEN_INPUTB("EMISUNIT", KCH, KLUOUT)\r
+!\r
+! read unit identifier\r
+READ(KCH,'(A3)') YUNIT\r
+!\r
+!\r
+!*       2.   MAP DATA ONTO PROGNOSTIC VARIABLES\r
+!        ---------------------------------------\r
+!\r
+ALLOCATE (XCONVERSION(SIZE(PRHODREF,1)))\r
+! determine the conversion factor\r
+  XCONVERSION(:) = 1.\r
+SELECT CASE (YUNIT)\r
+CASE ('MIX') ! flux given ppp*m/s,  conversion to molec/m2/s\r
+! where 1 molecule/cm2/s = (224.14/6.022136E23) ppp*m/s\r
+  XCONVERSION(:) = XAVOGADRO * PRHODREF(:) / XMD\r
+CASE ('CON') ! flux given in molecules/cm2/s, conversion to molec/m2/s \r
+  XCONVERSION(:) =  1E4\r
+CASE ('MOL') ! flux given in microMol/m2/day, conversion to molec/m2/s  \r
+! where 1 microMol/m2/day = (22.414/86.400)*1E-12 ppp*m/s\r
+  !XCONVERSION(:) = (22.414/86.400)*1E-12 * XAVOGADRO * PRHODREF(:) / XMD\r
+  XCONVERSION(:) = 1E-6 * XAVOGADRO / 86400.\r
+\r
+CASE DEFAULT\r
+  CALL ABOR1_SFX('CH_BUILDEMISSN: UNKNOWN CONVERSION FACTOR')\r
+END SELECT\r
+!\r
+! Read Window size default value >= 2\r
+IWS_DEFAULT = 5 ! Should be set by namelist\r
+IF (IWS_DEFAULT < 2) IWS_DEFAULT = 2\r
+!\r
+IIND1 = 0\r
+IIND2 = 0\r
+DO JSPEC=1,SIZE(TPEMISS) ! loop on offline emission species\r
+!\r
+  INBTS = KNBTIMES(JSPEC)\r
+!\r
+! Fill %CNAME\r
+  TPEMISS(JSPEC)%CNAME = HEMIS_GR_NAME(KOFFNDX(JSPEC))\r
+! Allocate and Fill %NETIMES \r
+  ALLOCATE(TPEMISS(JSPEC)%NETIMES(INBTS))\r
+  IIND1 = IIND2+1\r
+  IIND2 = IIND2+INBTS\r
+  TPEMISS(JSPEC)%NETIMES(:) = KEMIS_GR_TIME(IIND1:IIND2)\r
+! \r
+! Update %NWS, %NDX, %NTX, %LREAD, %XEMISDATA\r
+  IF (INBTS <= IWS_DEFAULT) THEN\r
+! Number of times smaller than read window size allowed\r
+! Read emis data once and for all\r
+    TPEMISS(JSPEC)%NWS = INBTS\r
+    TPEMISS(JSPEC)%NDX = 1\r
+    TPEMISS(JSPEC)%NTX = 1\r
+    TPEMISS(JSPEC)%LREAD = .FALSE. ! to prevent future reading\r
+    ALLOCATE(TPEMISS(JSPEC)%XEMISDATA(KSIZE,INBTS))\r
+! Read file for emission data\r
+    YRECFM='E_'//TRIM(TPEMISS(JSPEC)%CNAME)\r
+    CALL READ_SURF_FIELD2D(HPROGRAM,TPEMISS(JSPEC)%XEMISDATA(:,:),YRECFM)\r
+!\r
+! Correction : Replace 999. with 0. value in the Emission FLUX\r
+! and apply conversion\r
+    WHERE(TPEMISS(JSPEC)%XEMISDATA(:,:) == 999.)\r
+      TPEMISS(JSPEC)%XEMISDATA(:,:) = 0. \r
+    END WHERE\r
+    WHERE(TPEMISS(JSPEC)%XEMISDATA(:,:) == 1.E20)\r
+      TPEMISS(JSPEC)%XEMISDATA(:,:) = 0. \r
+    END WHERE\r
+      DO ITIME=1,INBTS\r
+      ! XCONVERSION IS APPLIED IN CH_EMISSION_FLUXN ONLY FOR LREAD = T\r
+        TPEMISS(JSPEC)%XEMISDATA(:,ITIME) = TPEMISS(JSPEC)%XEMISDATA(:,ITIME) * XCONVERSION(:)\r
+        !TPEMISS(JSPEC)%XEMISDATA(:,ITIME) = TPEMISS(JSPEC)%XEMISDATA(:,ITIME)\r
+      END DO\r
+  ELSE\r
+! Read window size is smaller than number of emission times\r
+    TPEMISS(JSPEC)%NWS = IWS_DEFAULT\r
+    TPEMISS(JSPEC)%NDX = IWS_DEFAULT\r
+    TPEMISS(JSPEC)%NTX = 0\r
+    TPEMISS(JSPEC)%LREAD = .TRUE.\r
+    ALLOCATE(TPEMISS(JSPEC)%XEMISDATA(KSIZE,IWS_DEFAULT))\r
+  END IF\r
\r
+  IF (INBTS == 1) THEN\r
+    TPEMISS(JSPEC)%XFWORK=>TPEMISS(JSPEC)%XEMISDATA(:,1)\r
+  ELSE\r
+    ALLOCATE(TPEMISS(JSPEC)%XFWORK(KSIZE))\r
+  END IF\r
+! Compute index for periodic case\r
+  TPEMISS(JSPEC)%NPX = MAXVAL(MINLOC(TPEMISS(JSPEC)%NETIMES(:)+&\r
+         (1+(TPEMISS(JSPEC)%NETIMES(INBTS)-&\r
+         TPEMISS(JSPEC)%NETIMES(:))/NDAYSEC)*NDAYSEC))  \r
+!\r
+! Some di###ay\r
+  IF (KVERB >= 6) THEN\r
+    WRITE(KLUOUT,*) '====== Species ',TRIM(TPEMISS(JSPEC)%CNAME), ' ======'\r
+    WRITE(KLUOUT,*) '  Emission Times :' ,TPEMISS(JSPEC)%NETIMES\r
+    WRITE(KLUOUT,*) '  Current time index :' ,TPEMISS(JSPEC)%NTX\r
+    WRITE(KLUOUT,*) '  Current data index :' ,TPEMISS(JSPEC)%NDX\r
+    WRITE(KLUOUT,*) '  Periodic index = ',TPEMISS(JSPEC)%NPX,&\r
+            ' at time :',TPEMISS(JSPEC)%NETIMES(TPEMISS(JSPEC)%NPX)  \r
+    WRITE(KLUOUT,*) '  Read window size :', TPEMISS(JSPEC)%NWS\r
+    IF (TPEMISS(JSPEC)%LREAD) THEN\r
+      WRITE(KLUOUT,*) ' -> Data must be read during simulation.'\r
+    ELSE\r
+      WRITE(KLUOUT,*) ' -> Data already in memory.'\r
+    END IF\r
+  END IF\r
+END DO\r
+\r
+IF (KVERB >= 5) THEN\r
+  WRITE(KLUOUT,*) '******** END SUBROUTINE (CHIMIE) : BUILD_EMISSTAB_n     ********'\r
+END IF\r
+IF (LHOOK) CALL DR_HOOK('BUILD_EMISSTAB_N',1,ZHOOK_HANDLE)\r
+\r
+END SUBROUTINE BUILD_EMISSTAB_n\r
index 7bb844b..93b3576 100644 (file)
-!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
+!     #########\r
+      SUBROUTINE CH_EMISSION_FLUX_n(HPROGRAM,PSIMTIME,PSFSV, PRHOA, PTSTEP, KNBTS_MAX)\r
+!     ######################################################################\r
+!!\r
+!!***  *CH_EMISSION_FLUX_n* - \r
+!!\r
+!!    PURPOSE\r
+!!    -------\r
+!!      Return a time-dependent emission flux based on tabulated values\r
+!!\r
+!!**  METHOD\r
+!!    ------\r
+!!\r
+!!    AUTHOR\r
+!!    ------\r
+!!    D. Gazen\r
+!!\r
+!!    MODIFICATIONS\r
+!!    -------------\r
+!!    Original 08/02/00\r
+!!    C. Mari  30/10/00 call to MODD_TYPE_EFUTIL and MODD_CST\r
+!!    D.Gazen  01/12/03  change emissions handling for surf. externalization\r
+!!    P.Tulet  01/01/04  change emission conversion factor\r
+!!    P.Tulet  01/01/05  add dust, orilam\r
+!!    M.Leriche    2015  suppress ZDEPOT\r
+!!    M.Moge    01/2016  using READ_SURF_FIELD2D for 2D surfex fields reads\r
+!!\r
+!!    EXTERNAL\r
+!!    --------\r
+!!\r
+!!\r
+!!    IMPLICIT ARGUMENTS\r
+!!    ------------------\r
+USE MODD_SV_n,             ONLY: CSV,NSV_CHSBEG,NSV_CHSEND, NSV_AERBEG,  NSV_AEREND\r
+USE MODD_TYPE_EFUTIL,      ONLY: EMISSVAR_T, PRONOSVAR_T\r
+USE MODD_CSTS,             ONLY: NDAYSEC\r
+USE MODD_CH_EMIS_FIELD_n,  ONLY: TSEMISS, TSPRONOSLIST, XTIME_SIMUL\r
+USE MODD_CH_SURF_n,        ONLY: XCONVERSION\r
+!\r
+USE MODI_READ_SURF_FIELD2D\r
+USE MODI_INIT_IO_SURF_n\r
+USE MODI_END_IO_SURF_n\r
+USE MODI_GET_LUOUT\r
+!UPG*AERO1\r
+USE MODD_CHS_AEROSOL, ONLY: LCH_AERO_FLUX\r
+USE MODI_CH_AER_EMISSION\r
+!UPG*AERO1\r
+!!\r
+!------------------------------------------------------------------------------\r
+!\r
+!*       0.   DECLARATIONS\r
+!        -----------------\r
+!\r
+USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK\r
+USE PARKIND1  ,ONLY : JPRB\r
+!\r
+USE MODI_ABOR1_SFX\r
+!\r
+IMPLICIT NONE\r
+!\r
+!*       0.1  declaration of arguments\r
+!\r
+CHARACTER(LEN=6),   INTENT(IN)  :: HPROGRAM    ! program calling surf. schemes\r
+REAL,               INTENT(IN)  :: PSIMTIME    ! time of simulation in sec UTC\r
+                                               ! (counting from midnight of\r
+                                               ! the current day)\r
+REAL,DIMENSION(:,:),  INTENT(INOUT) :: PSFSV   ! emission flux in ppp*m/s\r
+REAL, DIMENSION(:),   INTENT(IN)    :: PRHOA     ! air density (kg/m3)\r
+REAL,                 INTENT(IN)    :: PTSTEP    ! atmospheric time-step                 (s)\r
+INTEGER,              INTENT(IN)    :: KNBTS_MAX !max size of TEMISS%NETIMES\r
+\r
+!\r
+!*       0.2  declaration of local variables\r
+!\r
+INTEGER       :: IVERB   ! verbosity level\r
+INTEGER       :: KSIZE1D ! 1D size = X*Y physical domain \r
+INTEGER       :: JI      ! loop control\r
+REAL          :: ZALPHA  ! interpolation weight\r
+!\r
+INTEGER :: INBTS       ! Number of emission times for a species\r
+INTEGER :: ITIM1,ITIM2 ! first/last time for interpolation\r
+INTEGER :: INDX1,INDX2 ! first/next index for data interpolation\r
+INTEGER :: ISIMTIME, ITPERIOD\r
+CHARACTER (LEN=16)  :: YRECFM          ! LFI article name\r
+TYPE(PRONOSVAR_T),POINTER :: CURPRONOS !Current pronostic variable\r
+!\r
+!*       0.3  declaration of saved local variables\r
+!\r
+CHARACTER(LEN=6), DIMENSION(:), POINTER :: CNAMES\r
+REAL,DIMENSION(SIZE(PSFSV,1),KNBTS_MAX)     :: ZWORK ! temporary array for reading data\r
+REAL,DIMENSION(SIZE(PSFSV,1),SIZE(PSFSV,2)) :: ZEMIS ! interpolated in time emission flux\r
+REAL,DIMENSION(SIZE(PSFSV,1))               :: ZFCO  ! CO flux\r
+INTEGER                          :: INEQ  ! number of chemical var\r
+                                          !(=NEQ (chimie gaz) + NSV_AER (chimie aerosol)\r
+INTEGER                          :: IWS   ! window size\r
+INTEGER                          :: IRESP ! return code for I/O\r
+INTEGER                          :: ILUOUT ! Outputlisting unit\r
+LOGICAL                          :: LIOINIT ! True if I/O init done\r
+INTEGER                          :: JW\r
+INTEGER                          :: ITIME\r
+LOGICAL                          :: GCO = .FALSE. ! switch if CO emission are available\r
+REAL(KIND=JPRB) :: ZHOOK_HANDLE\r
+!\r
+!------------------------------------------------------------------------------\r
+!\r
+!*    EXECUTABLE STATEMENTS\r
+!     ---------------------\r
+!\r
+IF (LHOOK) CALL DR_HOOK('CH_EMISSION_FLUX_N',0,ZHOOK_HANDLE)\r
+CALL GET_LUOUT(HPROGRAM,ILUOUT)\r
+LIOINIT = .FALSE.\r
+IVERB   = 5\r
+KSIZE1D = SIZE(PSFSV,1)\r
+INEQ    = SIZE(PSFSV,2)\r
+!\r
+!------------------------------------------------------------------------------\r
+!\r
+!*    3.  INTERPOLATE SURFACE FLUXES IN TIME IF NEEDED\r
+!     ------------------------------------------------\r
+!\r
+IF (XTIME_SIMUL == 0.) THEN\r
+   XTIME_SIMUL = PSIMTIME\r
+ELSE\r
+   XTIME_SIMUL = XTIME_SIMUL + PTSTEP\r
+END IF\r
+\r
+IF (IVERB >= 5) WRITE(ILUOUT,*) '******** CH_EMISSION_FLUX  ********'\r
+DO JI=1,SIZE(TSEMISS)\r
+! Simulation time (counting from midnight) is saved\r
+  ISIMTIME = XTIME_SIMUL\r
+!\r
+  INBTS = SIZE(TSEMISS(JI)%NETIMES) ! \r
+  IWS   = TSEMISS(JI)%NWS           ! Window Size for I/O\r
+  INDX1 = TSEMISS(JI)%NDX           ! Current data index\r
+!\r
+  IF (INBTS == 1) THEN\r
+!   Time Constant Flux\r
+!   XFWORK already points on data (see build_emisstabn.F90)\r
+    IF (IVERB >= 6) THEN\r
+      WRITE(ILUOUT,*) 'NO interpolation for ',TRIM(TSEMISS(JI)%CNAME)\r
+      IF (IVERB >= 10 ) WRITE(ILUOUT,*) TSEMISS(JI)%XFWORK\r
+    END IF\r
+  ELSE\r
+    IF (IVERB >= 6) THEN\r
+      WRITE(ILUOUT,*) 'Interpolation (T =',ISIMTIME,') : ',TSEMISS(JI)%CNAME\r
+    END IF\r
+    IF (ISIMTIME < TSEMISS(JI)%NETIMES(1)) THEN\r
+!     Tsim < T(1)=Tmin should not happen but who knows ?\r
+      TSEMISS(JI)%NTX = 1\r
+    ELSE\r
+!     Check for periodicity when ISIMTIME is beyond last emission time\r
+!     and probably correct ISIMTIME\r
+      IF (ISIMTIME > TSEMISS(JI)%NETIMES(INBTS)) THEN \r
+!       Tsim > T(INBTS)=Tmax\r
+        ITPERIOD = (1+(TSEMISS(JI)%NETIMES(INBTS)-&\r
+                TSEMISS(JI)%NETIMES(TSEMISS(JI)%NPX))/NDAYSEC)*NDAYSEC  \r
+        ISIMTIME = MODULO(ISIMTIME-TSEMISS(JI)%NETIMES(TSEMISS(JI)%NPX),ITPERIOD)+&\r
+                TSEMISS(JI)%NETIMES(TSEMISS(JI)%NPX)  \r
+        IF (IVERB >= 6) THEN\r
+          WRITE(ILUOUT,*) '  ITPERIOD = ', ITPERIOD\r
+          WRITE(ILUOUT,*) '  ISIMTIME modifie = ', ISIMTIME\r
+        END IF\r
+        IF (TSEMISS(JI)%NTX == INBTS .AND. ISIMTIME<TSEMISS(JI)%NETIMES(INBTS)) THEN\r
+!         Update time index NTX \r
+          TSEMISS(JI)%NTX = TSEMISS(JI)%NPX\r
+!         Increment data index NDX : NDX correction will occur later\r
+!                                    to assure 1 <= NDX <= IWS\r
+          INDX1 = INDX1 + 1\r
+        END IF\r
+      END IF\r
+!\r
+!     search NTX such that : ETIMES(NTX) < ISIMTIME <= ETIMES(NTX+1)\r
+!     and make NDX follow NTX : NDX correction will occur later\r
+!                               to assure 1 <= NDX <= IWS\r
+      DO WHILE (TSEMISS(JI)%NTX < INBTS)\r
+        IF (ISIMTIME >= TSEMISS(JI)%NETIMES(TSEMISS(JI)%NTX+1)) THEN\r
+          TSEMISS(JI)%NTX = TSEMISS(JI)%NTX + 1\r
+          INDX1 = INDX1 + 1\r
+          INDX2 = INDX1 + 1\r
+        ELSE\r
+          EXIT\r
+        END IF\r
+      END DO\r
+    END IF\r
+!\r
+!   Check availability of data within memory Window (XEMISDATA(:,1:IWS))\r
+    IF (INDX1 >= IWS) THEN\r
+!\r
+!     Data index reached the memory window limits\r
+!\r
+      IF (TSEMISS(JI)%LREAD) THEN \r
+!\r
+!       File must be read to update XEMISDATA array for this species \r
+!\r
+        IF (.NOT. LIOINIT) THEN\r
+!         Must be done once before reading\r
+          CALL INIT_IO_SURF_n(HPROGRAM,'FULL  ','SURF  ','READ ')\r
+          IF (IVERB >= 6) WRITE(ILUOUT,*) 'INIT des I/O DONE.'\r
+          LIOINIT=.TRUE.\r
+        END IF\r
+        YRECFM='E_'//TRIM(TSEMISS(JI)%CNAME)\r
+        IF (IVERB >= 6)&\r
+               WRITE (ILUOUT,*) 'READ emission :',TRIM(YRECFM),&\r
+               ', SIZE(ZWORK)=',SIZE(ZWORK,1),INBTS \r
+        CALL READ_SURF_FIELD2D(HPROGRAM,ZWORK(:,1:INBTS),YRECFM)\r
+!\r
+! Correction : Replace 999. with 0. value in the Emission FLUX\r
+        WHERE(ZWORK(:,1:INBTS) == 999.)\r
+          ZWORK(:,1:INBTS) = 0. \r
+        END WHERE\r
+        WHERE(ZWORK(:,1:INBTS) == 1.E20)\r
+          ZWORK(:,1:INBTS) = 0. \r
+        END WHERE\r
+        DO ITIME=1,INBTS\r
+        ZWORK(:,ITIME) = ZWORK(:,ITIME)*XCONVERSION(:)\r
+        END DO\r
+!\r
+!       \r
+        IF ((TSEMISS(JI)%NTX+IWS-1) > INBTS) THEN\r
+!\r
+!         ===== Periodic CASE =====\r
+!\r
+          IF (IVERB >= 6)&\r
+                 WRITE (ILUOUT,*) 'Periodic CASE : NPX =',TSEMISS(JI)%NPX  \r
+          IF (IWS <  (INBTS-TSEMISS(JI)%NPX+1)) THEN\r
+!           Window size is smaller then number of periodical times\r
+!\r
+!           example : IWS=5, NPX=2, INBTS=11, NTX=9\r
+!                               NTX       NPX\r
+!                                |         |\r
+!           time index :      ...9 10 11 # 2 3 4...11 #\r
+!       old data index :[1 2 3 4 5] \r
+!       new data index :        [1  2  3   4 5]\r
+!                                |  \r
+!                               NDX    \r
+!\r
+            TSEMISS(JI)%XEMISDATA(:,1:INBTS-TSEMISS(JI)%NTX+1) = &\r
+                   ZWORK(:,TSEMISS(JI)%NTX:INBTS)  \r
+!\r
+            IF (IVERB >= 6) THEN\r
+              WRITE(ILUOUT,*) 'Window SIZE smaller than INBTS !'\r
+              WRITE(ILUOUT,*) 'Window index, Time index'\r
+              DO JW=1,INBTS-TSEMISS(JI)%NTX+1\r
+                WRITE(ILUOUT,*) JW,TSEMISS(JI)%NTX+JW-1\r
+              END DO\r
+            END IF\r
+!\r
+            TSEMISS(JI)%XEMISDATA(:,INBTS-TSEMISS(JI)%NTX+2:IWS) = &\r
+                   ZWORK(:,TSEMISS(JI)%NPX:TSEMISS(JI)%NPX+IWS-INBTS+TSEMISS(JI)%NTX-2)  \r
+!\r
+            IF (IVERB >= 6) THEN\r
+              DO JW=INBTS-TSEMISS(JI)%NTX+2,IWS\r
+                WRITE(ILUOUT,*) JW,TSEMISS(JI)%NPX+JW-(INBTS-TSEMISS(JI)%NTX+2)\r
+              END DO\r
+            END IF\r
+            INDX1 = 1\r
+            INDX2 = 2\r
+          ELSE\r
+!           Window size may get smaller AND it will be the last reading\r
+!\r
+!           example : IWS=6, NPX=7, INBTS=11, NTX=9\r
+!\r
+!                         NTX       NPX NTX\r
+!                          |         |   |\r
+!           time index: ...9 10 11 # 7 8 9 10 11 #\r
+!       old data index: ...6]\r
+!       new data index:             [1 2 3  4  5]\r
+!                                        |\r
+!                                       NDX=NTX-NPX+1\r
+!\r
+            IWS = INBTS-TSEMISS(JI)%NPX+1\r
+            TSEMISS(JI)%NWS = IWS\r
+            TSEMISS(JI)%XEMISDATA(:,1:IWS) = ZWORK(:,TSEMISS(JI)%NPX:INBTS)\r
+            IF (IVERB >= 6) THEN\r
+              WRITE(ILUOUT,*) 'Window SIZE equal or greater than INBTS !'\r
+              WRITE(ILUOUT,*) 'Window index, Time index'\r
+              DO JW=1,IWS\r
+                WRITE(ILUOUT,*) JW,TSEMISS(JI)%NPX+JW-1\r
+              END DO\r
+            END IF\r
+            INDX1 = TSEMISS(JI)%NTX-TSEMISS(JI)%NPX+1\r
+            INDX2 = MOD((INDX1+1),IWS)\r
+            TSEMISS(JI)%LREAD = .FALSE. ! no more reading\r
+          END IF\r
+        ELSE\r
+!\r
+!         ===== NON periodic (normal) CASE =====\r
+!\r
+! example : with IWS=5, the window moves forward\r
+!                             NTX\r
+!                              | \r
+!         time index : 1 2 3 4 5 6 7 8 9 10 11 ... INBTS # \r
+!     old data index :[1 2 3 4 5] \r
+!     new data index :        [1 2 3 4 5] \r
+!                              |\r
+!                             NDX\r
+!\r
+          TSEMISS(JI)%XEMISDATA(:,1:IWS) = ZWORK(:,TSEMISS(JI)%NTX:TSEMISS(JI)%NTX+IWS-1)\r
+          IF (IVERB >= 6) THEN\r
+            WRITE(ILUOUT,*) 'Window index, Time index'\r
+            DO JW=1,IWS\r
+              WRITE(ILUOUT,*) JW,TSEMISS(JI)%NTX+JW-1\r
+            END DO\r
+          END IF\r
+          INDX1 = 1\r
+          INDX2 = 2\r
+        END IF\r
+      ELSE\r
+!       Data is already in memory because window size is sufficient \r
+!       to hold INBTS emission times => simply update NDX according to NTX\r
+!       \r
+        IF (IWS==INBTS) THEN \r
+!\r
+!         'Window size' = 'Nb emis times' at INIT (ch_init_emission)\r
+!         so NDX must be set equal to NTX (the window does not move)\r
+! example :\r
+!                         NPX    NTX\r
+!                          |      | \r
+!         time index :  1  2  3  ... INBTS\r
+!         data index : [1  2  3  ... INBTS]\r
+!                                 |\r
+!                                NDX\r
+\r
+          INDX1 = TSEMISS(JI)%NTX\r
+          INDX2 = INDX1+1\r
+          IF (INDX2 > IWS) INDX2=TSEMISS(JI)%NPX\r
+        ELSE\r
+!          \r
+!         Windows size changed during periodic case\r
+!         NDX must be equal to NTX - NPX + 1\r
+!         (the window does not move)\r
+! example :\r
+!                                NTX\r
+!                                 | \r
+!         time index : NPX NPX+1 NPX+2 ... INBTS\r
+!         data index : [1    2    3    ...   IWS]\r
+!                                 |\r
+!                                NDX\r
+          INDX1 = TSEMISS(JI)%NTX-TSEMISS(JI)%NPX+1\r
+          INDX2 = MOD((INDX1+1),IWS)\r
+        END IF\r
+      END IF\r
+    ELSE ! (INDX1 < IWS)\r
+      INDX2 = INDX1+1\r
+    END IF\r
+!\r
+!   Don't forget to update NDX with new value INDX1\r
+    TSEMISS(JI)%NDX = INDX1\r
+!\r
+!   Compute both times for interpolation\r
+    IF (TSEMISS(JI)%NTX < INBTS) THEN \r
+      ITIM1 = TSEMISS(JI)%NETIMES(TSEMISS(JI)%NTX)\r
+      ITIM2 = TSEMISS(JI)%NETIMES(TSEMISS(JI)%NTX+1)\r
+    ELSE\r
+      ITIM1 = TSEMISS(JI)%NETIMES(INBTS)\r
+      ITIM2 = TSEMISS(JI)%NETIMES(TSEMISS(JI)%NPX)+ITPERIOD\r
+    END IF\r
+!\r
+! Interpolate variables in time -> update XFWORK\r
+!\r
+!\r
+!  time       :  ITIM1...Tsim...ITIM2\r
+!                  |              |  \r
+!  data index :  INDX1          INDX2\r
+!\r
+!\r
+    ZALPHA = (REAL(ISIMTIME) - ITIM1) / (ITIM2-ITIM1)\r
+    TSEMISS(JI)%XFWORK(:) = ZALPHA*TSEMISS(JI)%XEMISDATA(:,INDX2) +&\r
+            (1.-ZALPHA)*TSEMISS(JI)%XEMISDATA(:,INDX1)  \r
+    IF (IVERB >= 6) THEN\r
+      WRITE(ILUOUT,*) '  Current time INDEX : ',TSEMISS(JI)%NTX\r
+      WRITE(ILUOUT,*) '  TIME : ',ISIMTIME, ' (',ITIM1,',',ITIM2,')'\r
+      WRITE(ILUOUT,*) '  Window size : ',TSEMISS(JI)%NWS\r
+      WRITE(ILUOUT,*) '  Current data INDEX : ',INDX1,INDX2\r
+      IF (IVERB >= 10) WRITE(ILUOUT,*) '  FLUX : ',TSEMISS(JI)%XFWORK\r
+    END IF\r
+  END IF\r
+END DO\r
+! \r
+! Agregation : flux computation\r
+!\r
+ZEMIS(:,:) = 0.\r
+!\r
+! Point on head of Pronostic variable list\r
+! to cover the entire list.\r
+IF (NSV_AEREND > 0) THEN\r
+CNAMES=>CSV(NSV_CHSBEG:NSV_AEREND)\r
+ELSE\r
+CNAMES=>CSV(NSV_CHSBEG:NSV_CHSEND)\r
+END IF\r
+CURPRONOS=>TSPRONOSLIST\r
+DO WHILE(ASSOCIATED(CURPRONOS))\r
+  IF (CURPRONOS%NAMINDEX > INEQ) THEN\r
+    WRITE(ILUOUT,*) 'FATAL ERROR in CH_EMISSION_FLUXN : SIZE(ZEMIS,2) =',&\r
+           INEQ,', INDEX bugge =',CURPRONOS%NAMINDEX  \r
+    CALL ABOR1_SFX('CH_EMISSION_FLUXN: FATAL ERROR')\r
+  END IF\r
+  \r
+  ZEMIS(:,CURPRONOS%NAMINDEX) = 0.\r
+!\r
+! Loop on the number of agreg. coeff.\r
+  DO JI=1,CURPRONOS%NBCOEFF\r
+!   Compute agregated flux    \r
+    ZEMIS(:,CURPRONOS%NAMINDEX) = ZEMIS(:,CURPRONOS%NAMINDEX)+&\r
+            CURPRONOS%XCOEFF(JI)*TSEMISS(CURPRONOS%NEFINDEX(JI))%XFWORK(:)  \r
+  END DO\r
+\r
+  IF (IVERB >= 6) THEN\r
+    WRITE(ILUOUT,*) 'Agregation for ',CNAMES(CURPRONOS%NAMINDEX)\r
+    IF (IVERB >= 10) WRITE(ILUOUT,*) 'ZEMIS = ',ZEMIS(:,CURPRONOS%NAMINDEX)\r
+  END IF\r
+  IF ((CNAMES(CURPRONOS%NAMINDEX) == "CO") .AND. ANY(ZEMIS(:,CURPRONOS%NAMINDEX).GT.0.)) THEN\r
+  ZFCO(:) = ZEMIS(:,CURPRONOS%NAMINDEX)\r
+  GCO = .TRUE.\r
+  END IF\r
+\r
+  CURPRONOS=>CURPRONOS%NEXT\r
+!\r
+END DO\r
+!\r
+IF ((LCH_AERO_FLUX).AND.(NSV_AERBEG > 0)) THEN\r
+  IF (GCO) THEN\r
+    CALL CH_AER_EMISSION(ZEMIS, PRHOA, CSV, NSV_CHSBEG, PFCO=ZFCO)\r
+  ELSE\r
+    CALL CH_AER_EMISSION(ZEMIS, PRHOA, CSV, NSV_CHSBEG)\r
+  ENDIF\r
+END IF\r
+!\r
+PSFSV(:,:) = PSFSV(:,:) + ZEMIS(:,:)\r
+!\r
+IF (LIOINIT) CALL END_IO_SURF_n(HPROGRAM)\r
+!\r
+IF (IVERB >= 6) WRITE(ILUOUT,*) '******** END CH_EMISSION_FLUX  ********'\r
+IF (LHOOK) CALL DR_HOOK('CH_EMISSION_FLUX_N',1,ZHOOK_HANDLE)\r
+!\r
+END SUBROUTINE CH_EMISSION_FLUX_n\r
index 6519222..fe4ecaa 100644 (file)
-!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
+!     #########\r
+      SUBROUTINE CH_INIT_SNAP_n(HPROGRAM,KLU,HINIT,KCH,PRHOA)\r
+!     #######################################\r
+!\r
+!!****  *CH_INIT_EMIISION_TEMP_n* - routine to initialize chemical emissions data structure\r
+!!\r
+!!    PURPOSE\r
+!!    -------\r
+!       Allocates and initialize emission surface fields\r
+!       by reading their value in initial file.\r
+!\r
+!!**  METHOD\r
+!!    ------\r
+!!    \r
+!!    \r
+!!    AUTHOR\r
+!!    ------\r
+!!     S.QUEGUINER \r
+!!\r
+!!    MODIFICATIONS\r
+!!    -------------\r
+!!      Original        11/2011\r
+!!        M.Moge    01/2016  using READ_SURF_FIELD2D for 2D surfex fields reads\r
+!!-----------------------------------------------------------------------------\r
+!\r
+!*       0.    DECLARATIONS\r
+!\r
+USE MODD_CSTS,       ONLY : XAVOGADRO, XMD\r
+USE MODD_CH_SNAP_n\r
+USE MODI_GET_LUOUT\r
+USE MODI_READ_SURF\r
+USE MODI_READ_SURF_FIELD2D\r
+USE MODI_ABOR1_SFX\r
+USE MODI_CH_CONVERSION_FACTOR\r
+USE MODI_BUILD_PRONOSLIST_n\r
+USE MODI_CH_OPEN_INPUTB\r
+!\r
+USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK\r
+USE PARKIND1  ,ONLY : JPRB\r
+!\r
+!\r
+IMPLICIT NONE\r
+!\r
+!*       0.1   declarations of arguments\r
+!\r
+ CHARACTER(LEN=6),  INTENT(IN)  :: HPROGRAM ! Program name\r
+INTEGER,           INTENT(IN)  :: KLU      ! number of points\r
+ CHARACTER(LEN=3),  INTENT(IN)  :: HINIT    ! Flag to know if one initializes:\r
+!                                          ! 'ALL' : all variables for a run\r
+!                                          ! 'PRE' : only variables to build \r
+!                                          !         an initial file\r
+INTEGER,           INTENT(IN)  :: KCH      ! logical unit of input chemistry file\r
+REAL, DIMENSION(:),INTENT(IN)  :: PRHOA    ! air density\r
+!\r
+!*       0.2   declarations of local variables\r
+!\r
+INTEGER             :: IRESP                 !   File \r
+INTEGER             :: ILUOUT                ! output listing logical unit\r
+ CHARACTER (LEN=16)  :: YRECFM                ! management\r
+ CHARACTER (LEN=100) :: YCOMMENT              ! variables\r
+INTEGER             :: JSPEC                 ! Loop index for chemical species\r
+INTEGER             :: JSNAP                 ! Loop index for SNAP categories\r
+!\r
+ CHARACTER(LEN=40)   :: YSPEC_NAME            ! species name\r
+!\r
+INTEGER             :: IVERSION       ! version of surfex file being read\r
+INTEGER             :: IBUG           ! version of SURFEX bugfix\r
+REAL(KIND=JPRB) :: ZHOOK_HANDLE\r
+!-------------------------------------------------------------------------------\r
+IF (LHOOK) CALL DR_HOOK('CH_INIT_SNAP_N',0,ZHOOK_HANDLE)\r
+ CALL GET_LUOUT(HPROGRAM,ILUOUT)\r
+!\r
+!* ascendant compatibility\r
+YRECFM='VERSION'\r
+ CALL READ_SURF(HPROGRAM,YRECFM,IVERSION,IRESP)\r
+YRECFM='BUG'\r
+ CALL READ_SURF(HPROGRAM,YRECFM,IBUG,IRESP)\r
+!\r
+!*      1.     Chemical Emission snap configuration\r
+!              ------------------------------------\r
+!\r
+! Read the number of emission species and snaps\r
+IF (IVERSION>7 .OR. (IVERSION==7 .AND. IBUG>=3) ) THEN\r
+  CALL READ_SURF(HPROGRAM,'EMISPEC_NBR',NEMIS_NBR,IRESP)\r
+  CALL READ_SURF(HPROGRAM,'SNAP_NBR',NEMIS_SNAP,IRESP)\r
+  CALL READ_SURF(HPROGRAM,'SNAP_TIME',CSNAP_TIME_REF,IRESP)\r
+ELSE\r
+  CALL ABOR1_SFX('CH_INIT_SNAPN: NO SNAP EMISSIONS IN SURFEX FILE: FILE TOO OLD')\r
+END IF\r
+!\r
+! Number of instants for each temporal profile.\r
+! For the time being, they are constant (even for the diurnal cycle)\r
+!\r
+NSNAP_M=12 ! 12 months\r
+NSNAP_D=7  !  7 day a week\r
+NSNAP_H=24 ! 24 hours a day (=> temporal resolution = 1 hour)\r
+!\r
+!\r
+!*      2.     Chemical Emission fields\r
+!              ------------------------\r
+!\r
+ALLOCATE(CEMIS_NAME       (               NEMIS_NBR))\r
+ALLOCATE(CEMIS_COMMENT    (               NEMIS_NBR))\r
+ALLOCATE(XEMIS_FIELDS_SNAP(KLU,NEMIS_SNAP,NEMIS_NBR))\r
+ALLOCATE(XEMIS_FIELDS     (KLU,           NEMIS_NBR))\r
+LEMIS_FIELDS = .FALSE.\r
+!\r
+ALLOCATE(XSNAP_MONTHLY(NSNAP_M,NEMIS_SNAP,NEMIS_NBR))\r
+ALLOCATE(XSNAP_DAILY  (NSNAP_D,NEMIS_SNAP,NEMIS_NBR))\r
+ALLOCATE(XSNAP_HOURLY (NSNAP_H,NEMIS_SNAP,NEMIS_NBR))\r
+!\r
+IF (CSNAP_TIME_REF=='LEGAL') THEN\r
+  ALLOCATE(XDELTA_LEGAL_TIME(KLU))\r
+  YRECFM='LEGALTIME'\r
+  CALL READ_SURF(HPROGRAM,YRECFM,XDELTA_LEGAL_TIME(:),IRESP,YCOMMENT)\r
+END IF\r
+!\r
+DO JSPEC = 1,NEMIS_NBR ! Loop on the number of species\r
+!\r
+! Read the species name\r
+  WRITE(YRECFM,'("EMISNAME",I3.3)') JSPEC\r
+  CALL READ_SURF(HPROGRAM,YRECFM,YSPEC_NAME,IRESP,YCOMMENT)\r
+  CEMIS_COMMENT(JSPEC)=YCOMMENT\r
+  IF (IRESP/=0) THEN\r
+    CALL ABOR1_SFX('CH_INIT_SNAPN: PROBLEM WHEN READING NAME OF EMITTED CHEMICAL SPECIES')\r
+  END IF\r
+  WRITE(ILUOUT,*) ' Emission ',JSPEC,' : ',TRIM(YSPEC_NAME)\r
+  CEMIS_NAME(JSPEC) = YSPEC_NAME(1:12)\r
+! \r
+! Read  the potential emission of species for each snap\r
+  DO JSNAP=1,NEMIS_SNAP\r
+    WRITE(YRECFM,'("SNAP",I2.2,"_",A3)') JSNAP,CEMIS_NAME(JSPEC)\r
+    CALL READ_SURF(HPROGRAM,YRECFM,XEMIS_FIELDS_SNAP(:,JSNAP,JSPEC),IRESP,YCOMMENT)\r
+  END DO\r
+!\r
+! Read the temporal profiles of all snaps\r
+  YRECFM = "E_"//TRIM(CEMIS_NAME(JSPEC))//"_M"\r
+  YRECFM = 'ICE_STO'\r
+  CALL READ_SURF_FIELD2D(HPROGRAM,XSNAP_MONTHLY(:,:,JSPEC),YRECFM,YCOMMENT,HDIR='-')\r
+  YRECFM = "E_"//TRIM(CEMIS_NAME(JSPEC))//"_D"\r
+  CALL READ_SURF_FIELD2D(HPROGRAM,XSNAP_DAILY(:,:,JSPEC),YRECFM,YCOMMENT,HDIR='-')\r
+  YRECFM = "E_"//TRIM(CEMIS_NAME(JSPEC))//"_H"\r
+  CALL READ_SURF_FIELD2D(HPROGRAM,XSNAP_HOURLY(:,:,JSPEC),YRECFM,YCOMMENT,HDIR='-')\r
+END DO\r
+!\r
+!*      3.     Conversion factor\r
+!              -----------------\r
+!\r
+IF (HINIT=='ALL') THEN\r
+  CALL CH_OPEN_INPUTB("EMISUNIT", KCH, ILUOUT)\r
+!\r
+! read unit identifier\r
+  READ(KCH,'(A3)') CCONVERSION\r
+!\r
+  ALLOCATE (XCONVERSION(KLU))\r
+! determine the conversion factor\r
+  CALL CH_CONVERSION_FACTOR(CCONVERSION,PRHOA)\r
+!\r
+!*      4.     List of emissions to be aggregated into atm. chemical species\r
+!              -------------------------------------------------------------\r
+!\r
+  CALL BUILD_PRONOSLIST_n(NEMIS_NBR,CEMIS_NAME,TSPRONOSLIST,KCH,ILUOUT,6)\r
+!\r
+!-------------------------------------------------------------------------------\r
+END IF\r
+!\r
+IF (LHOOK) CALL DR_HOOK('CH_INIT_SNAP_N',1,ZHOOK_HANDLE)\r
+!-------------------------------------------------------------------------------\r
+!\r
+END SUBROUTINE CH_INIT_SNAP_n\r
index b5417c8..2384cc4 100644 (file)
-!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 \r
+!SURFEX_LIC This is part of the SURFEX software governed by the CeCILL-C  licence\r
+!SURFEX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt\r
+!SURFEX_LIC for details. version 1.\r
+! Modifications :\r
+! P.Marguinaud : 11-09-2012 : shorten field name\r
+! G.Delautier : 24-06-2015 : bug for arome compressed files\r
+! M.Moge    01/2016  using READ_SURF_FIELD2D/3D for 2D/3D surfex fields reads\r
+!     #####################\r
+MODULE MODE_READ_EXTERN\r
+!     #####################\r
+!-------------------------------------------------------------------\r
+!\r
+USE MODI_READ_LECOCLIMAP\r
+!\r
+USE MODI_PUT_ON_ALL_VEGTYPES\r
+USE MODI_OLD_NAME\r
+!\r
+USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK\r
+USE PARKIND1  ,ONLY : JPRB\r
+!\r
+CONTAINS\r
+!\r
+!---------------------------------------------------------------------------------------\r
+!\r
+!     #######################\r
+      SUBROUTINE READ_EXTERN_DEPTH(HPROGRAM,KLUOUT,HISBA,HNAT,HFIELD,KNI,KLAYER, &\r
+                                   KPATCH,PSOILGRID,PDEPTH,KVERSION  )\r
+!     #######################\r
+!\r
+USE MODD_SURF_PAR,       ONLY : NUNDEF, XUNDEF\r
+USE MODD_DATA_COVER_PAR, ONLY : JPCOVER, NVEGTYPE\r
+!\r
+USE MODI_READ_SURF_ISBA_PAR_n\r
+USE MODI_READ_SURF_FIELD3D\r
+USE MODI_READ_SURF_FIELD2D\r
+USE MODI_READ_SURF\r
+USE MODI_CONVERT_COVER_ISBA\r
+USE MODI_GARDEN_SOIL_DEPTH\r
+\r
+!\r
+IMPLICIT NONE\r
+!\r
+!* dummy arguments\r
+!  ---------------\r
+!\r
+ CHARACTER(LEN=6),     INTENT(IN)    :: HPROGRAM  ! type of input file\r
+INTEGER,              INTENT(IN)    :: KLUOUT    ! logical unit of output listing\r
+ CHARACTER(LEN=3),     INTENT(IN)    :: HISBA     ! type of ISBA soil scheme\r
+ CHARACTER(LEN=3),     INTENT(IN)    :: HNAT      ! type of surface (nature, gardens)\r
+ CHARACTER(LEN=7),     INTENT(IN)    :: HFIELD    ! field name\r
+INTEGER,              INTENT(IN)    :: KNI       ! number of points\r
+INTEGER,           INTENT(INOUT)    :: KLAYER    ! number of layers\r
+INTEGER,              INTENT(IN)    :: KPATCH    ! number of patch\r
+INTEGER,              INTENT(IN)    :: KVERSION  ! surface version\r
+REAL, DIMENSION(:),   INTENT(IN)    :: PSOILGRID\r
+REAL, DIMENSION(:,:,:), POINTER     :: PDEPTH    ! middle depth of each layer\r
+!\r
+!* local variables\r
+!  ---------------\r
+!\r
+ CHARACTER(LEN=12) :: YRECFM         ! Name of the article to be read\r
+ CHARACTER(LEN=16) :: YRECFM2\r
+ CHARACTER(LEN=100):: YCOMMENT       ! Comment string\r
+INTEGER           :: IRESP          ! reading return code\r
+INTEGER           :: ILAYER         ! number of soil layers\r
+INTEGER           :: JLAYER         ! loop counter\r
+INTEGER           :: JPATCH         ! loop counter\r
+INTEGER           :: JJ\r
+INTEGER           :: IVERSION\r
+INTEGER           :: IBUGFIX\r
+!\r
+LOGICAL, DIMENSION(JPCOVER)          :: GCOVER ! flag to read the covers\r
+REAL,    DIMENSION(:,:), ALLOCATABLE :: ZCOVER ! cover fractions\r
+REAL,    DIMENSION(:,:), ALLOCATABLE :: ZGROUND_DEPTH ! cover fractions\r
+INTEGER, DIMENSION(:,:), ALLOCATABLE :: IWG_LAYER\r
+REAL,  DIMENSION(:,:,:), ALLOCATABLE :: ZD     ! depth of each inter-layer\r
+REAL,  DIMENSION(:,:,:), ALLOCATABLE :: ZDG    ! depth of each inter-layer\r
+REAL,  DIMENSION(:,:,:), ALLOCATABLE :: ZDEPTH ! middle of each layer for each patch\r
+REAL,  DIMENSION(:,:),   ALLOCATABLE :: ZWORK  ! work array\r
+REAL,  DIMENSION(KNI)                :: ZHVEG  ! high vegetation fraction\r
+REAL,  DIMENSION(KNI)                :: ZLVEG  ! low  vegetation fraction\r
+REAL,  DIMENSION(KNI)                :: ZNVEG  ! no   vegetation fraction\r
+ CHARACTER(LEN=4)                     :: YHVEG  ! type of high vegetation\r
+ CHARACTER(LEN=4)                     :: YLVEG  ! type of low  vegetation\r
+ CHARACTER(LEN=4)                     :: YNVEG  ! type of no   vegetation\r
+LOGICAL                              :: GECOCLIMAP ! T if ecoclimap is used\r
+LOGICAL                              :: GPAR_GARDEN! T if garden data are used\r
+LOGICAL                              :: GDATA_DG\r
+LOGICAL                              :: GDATA_GROUND_DEPTH\r
+INTEGER                              :: IHYDRO_LAYER\r
+REAL(KIND=JPRB) :: ZHOOK_HANDLE\r
+!\r
+!\r
+!------------------------------------------------------------------------------\r
+!\r
+IF (LHOOK) CALL DR_HOOK('MODE_READ_EXTERN:READ_EXTERN_DEPTH',0,ZHOOK_HANDLE)\r
+!\r
+IF (HNAT=='NAT') THEN\r
+  CALL READ_LECOCLIMAP(HPROGRAM,GECOCLIMAP)\r
+ELSE\r
+  CALL READ_SURF(HPROGRAM,'PAR_GARDEN',GPAR_GARDEN,IRESP)\r
+  GECOCLIMAP = .NOT. GPAR_GARDEN\r
+END IF\r
+!\r
+!\r
+YRECFM='VERSION'\r
+ CALL READ_SURF(HPROGRAM,YRECFM,IVERSION,IRESP)\r
+!\r
+YRECFM='BUG'\r
+ CALL READ_SURF(HPROGRAM,YRECFM,IBUGFIX,IRESP)\r
+!\r
+!------------------------------------------------------------------------------\r
+!\r
+ALLOCATE(ZDG   (KNI,KLAYER,KPATCH))\r
+ALLOCATE(IWG_LAYER   (KNI,KPATCH))\r
+IWG_LAYER(:,:) = NUNDEF\r
+IHYDRO_LAYER = KLAYER\r
+!\r
+IF (GECOCLIMAP) THEN\r
+\r
+ IF (IVERSION<7 .OR. IVERSION==7 .AND. IBUGFIX<=3) THEN\r
+  !\r
+  !* reading of the cover to obtain the depth of inter-layers\r
+  !\r
+  CALL OLD_NAME(HPROGRAM,'COVER_LIST      ',YRECFM)\r
+  CALL READ_SURF(HPROGRAM,YRECFM,GCOVER(:),IRESP,HDIR='-')\r
+  !\r
+  ALLOCATE(ZCOVER(KNI,JPCOVER))\r
+  YRECFM='COVER'\r
+  CALL READ_SURF(HPROGRAM,YRECFM,ZCOVER(:,:),GCOVER(:),IRESP,HDIR='A')  \r
+  !\r
+  !* computes soil layers\r
+  !  \r
+  CALL CONVERT_COVER_ISBA(HISBA,NUNDEF,ZCOVER,'   ',HNAT,PSOILGRID=PSOILGRID,PDG=ZDG,KWG_LAYER=IWG_LAYER)\r
+  !\r
+  DEALLOCATE(ZCOVER)\r
+ ELSE\r
+print*, '-----------------------------------------------'\r
+print*, '-----------------------------------------------'\r
+print*, '-----------------------------------------------'\r
+print*, '-----------------------------------------------'\r
+print*, 'MODE_READ_EXTERN : ==> ON NE LIT PAS LES COVERS'\r
+print*, '-----------------------------------------------'\r
+print*, '-----------------------------------------------'\r
+print*, '-----------------------------------------------'\r
+print*, '-----------------------------------------------'\r
+  IF (HNAT=='NAT') THEN\r
+    YRECFM='ECO_DG'\r
+  ELSE\r
+    YRECFM='GD_ECO_DG'\r
+  END IF\r
+  CALL READ_SURF_FIELD3D(HPROGRAM,ZDG,1,SIZE(ZDG,2),YRECFM,HDIR='A')\r
+  !\r
+  IF (HISBA=='DIF') THEN\r
+    YRECFM='ECO_WG_L'\r
+    IF (HNAT=='GRD') YRECFM='GD_ECO_WG_L'\r
+    ALLOCATE(ZWORK(KNI,KPATCH)) \r
+    CALL READ_SURF_FIELD2D(HPROGRAM,ZWORK(:,:),YRECFM,HDIR='A')\r
+    WHERE (ZWORK==XUNDEF) ZWORK=NUNDEF\r
+    IWG_LAYER=NINT(ZWORK)\r
+    DEALLOCATE(ZWORK)\r
+  END IF\r
+ END IF\r
+  !\r
+  IF (HISBA=='DIF') IHYDRO_LAYER = MAXVAL(IWG_LAYER(:,:),IWG_LAYER(:,:)/=NUNDEF)\r
+ENDIF\r
+\r
+!-------------------------------------------------------------------\r
+IF (HNAT=='NAT' .AND. (IVERSION>=7 .OR. .NOT.GECOCLIMAP)) THEN\r
+  !\r
+  !* directly read soil layers in the file for nature ISBA soil layers\r
+  !\r
+  GDATA_DG = .TRUE.\r
+  IF (IVERSION>=7) THEN\r
+    YRECFM='L_DG'\r
+    YCOMMENT=YRECFM\r
+    CALL READ_SURF(HPROGRAM,YRECFM,GDATA_DG,IRESP,HCOMMENT=YCOMMENT)\r
+  ENDIF\r
+  !\r
+  IF (GDATA_DG) THEN\r
+    !\r
+    ALLOCATE(ZWORK(KNI,KPATCH))\r
+    DO JLAYER=1,KLAYER\r
+      IF (JLAYER<10)  WRITE(YRECFM,FMT='(A4,I1.1)') 'D_DG',JLAYER\r
+      IF (JLAYER>=10) WRITE(YRECFM,FMT='(A4,I2.2)') 'D_DG',JLAYER\r
+      CALL READ_SURF_ISBA_PAR_n(HPROGRAM,YRECFM,KLUOUT,KNI,ZWORK,IRESP,IVERSION,HDIR='A')\r
+      DO JPATCH=1,KPATCH\r
+        ZDG(:,JLAYER,JPATCH) = ZWORK(:,JPATCH)\r
+      END DO\r
+    END DO\r
+    DEALLOCATE(ZWORK)\r
+    !\r
+  ENDIF\r
+  !\r
+    GDATA_GROUND_DEPTH=.FALSE.\r
+  IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=2) THEN\r
+    !\r
+    YRECFM2='L_GROUND_DEPTH'\r
+    IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) YRECFM2='L_GROUND_DPT'\r
+    YCOMMENT=YRECFM2\r
+    CALL READ_SURF(HPROGRAM,YRECFM2,GDATA_GROUND_DEPTH,IRESP,HCOMMENT=YCOMMENT)\r
+    !\r
+    IF (GDATA_GROUND_DEPTH) THEN\r
+      !\r
+      YRECFM2='D_GROUND_DETPH'\r
+      IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) YRECFM2='D_GROUND_DPT'\r
+      ALLOCATE(ZGROUND_DEPTH(KNI,KPATCH))\r
+      CALL READ_SURF_ISBA_PAR_n(HPROGRAM,YRECFM2,KLUOUT,KNI,ZGROUND_DEPTH(:,:),IRESP,IVERSION,HDIR='A')\r
+      !\r
+      DO JPATCH=1,KPATCH\r
+        DO JJ=1,KNI\r
+          DO JLAYER=1,KLAYER\r
+            IF ( ZDG(JJ,JLAYER,JPATCH) <= ZGROUND_DEPTH(JJ,JPATCH) .AND. ZGROUND_DEPTH(JJ,JPATCH) < XUNDEF ) &\r
+                IWG_LAYER(JJ,JPATCH) = JLAYER\r
+          ENDDO\r
+        ENDDO\r
+      ENDDO\r
+      DEALLOCATE(ZGROUND_DEPTH)\r
+      !\r
+      IF (HISBA=='DIF') IHYDRO_LAYER = MAXVAL(IWG_LAYER(:,:),IWG_LAYER(:,:)/=NUNDEF)\r
+      !\r
+    ENDIF\r
+    !\r
+  ENDIF\r
+  !\r
+ELSE IF (HNAT=='GRD' .AND. .NOT.GECOCLIMAP) THEN\r
+  !\r
+  !* computes soil layers from vegetation fractions read in the file\r
+  !\r
+  CALL READ_SURF(HPROGRAM,'D_TYPE_HVEG',YHVEG,IRESP)\r
+  CALL READ_SURF(HPROGRAM,'D_TYPE_LVEG',YLVEG,IRESP)\r
+  CALL READ_SURF(HPROGRAM,'D_TYPE_NVEG',YNVEG,IRESP)\r
+  CALL READ_SURF(HPROGRAM,'D_FRAC_HVEG',ZHVEG,IRESP,HDIR='A')\r
+  CALL READ_SURF(HPROGRAM,'D_FRAC_LVEG',ZLVEG,IRESP,HDIR='A')\r
+  CALL READ_SURF(HPROGRAM,'D_FRAC_NVEG',ZNVEG,IRESP,HDIR='A')\r
+  ! Ground layers\r
+  CALL GARDEN_SOIL_DEPTH(YNVEG,YLVEG,YHVEG,ZNVEG,ZLVEG,ZHVEG,ZDG)\r
+  !\r
+END IF\r
+!\r
+DEALLOCATE(IWG_LAYER)\r
+!\r
+IF (HFIELD=='WG    ' .OR. HFIELD=='WGI   ' .OR. HFIELD=='TWN_WG  ' .OR. HFIELD=='TWN_WGI ' .OR. &\r
+      HFIELD=='GD_WG  ' .OR. HFIELD=='GD_WGI ') THEN\r
+  KLAYER = IHYDRO_LAYER\r
+ENDIF\r
+!\r
+!-------------------------------------------------------------------\r
+!\r
+!* In force-restore ISBA, adds a layer at bottom of surface layer and a layer\r
+!  between root and deep layers.\r
+!\r
+IF (HISBA=='2-L' .OR. HISBA=='3-L') THEN\r
+  ILAYER = KLAYER + 1\r
+  IF (HISBA=='3-L') ILAYER = ILAYER + 1\r
+  ALLOCATE(ZD    (KNI,ILAYER,KPATCH))\r
+  DO JPATCH=1,KPATCH\r
+    ! for interpolations, middle of surface layer must be at least at 1cm\r
+    ZD(:,1,JPATCH) = MIN(3.*ZDG(:,1,JPATCH),MAX(ZDG(:,1,JPATCH),0.02))\r
+    ! new layer below surface layer. This layer will be at root depth layer humidity\r
+    ZD(:,2,JPATCH) = MIN(4.*ZDG(:,1,JPATCH),0.5*(ZDG(:,1,JPATCH)+ZDG(:,2,JPATCH)))\r
+    ! root layer\r
+    ZD(:,3,JPATCH) = ZDG(:,2,JPATCH)\r
+    IF (HISBA=='3-L') THEN\r
+      ! between root and deep layers. This layer will have deep soil humidity.\r
+      WHERE (ZDG(:,2,JPATCH)<ZDG(:,3,JPATCH))\r
+        ZD(:,4,JPATCH) = 0.75 * ZDG(:,2,JPATCH) + 0.25 * ZDG(:,3,JPATCH)\r
+      ELSEWHERE\r
+        ZD(:,4,JPATCH) = ZDG(:,3,JPATCH)\r
+      END WHERE\r
+      ! deep layer\r
+      ZD(:,5,JPATCH) = ZDG(:,3,JPATCH)\r
+    END IF\r
+  END DO\r
+ELSE\r
+  ILAYER = KLAYER\r
+  ALLOCATE(ZD    (KNI,ILAYER,KPATCH))\r
+  ZD(:,:,:) = ZDG(:,1:KLAYER,:)\r
+END IF\r
+!\r
+DEALLOCATE(ZDG)\r
+!\r
+!-------------------------------------------------------------------\r
+!* recovers middle layer depth (from the surface)\r
+ALLOCATE(ZDEPTH    (KNI,ILAYER,KPATCH))\r
+ZDEPTH = XUNDEF\r
+DO JPATCH=1,KPATCH\r
+  WHERE(ZD(:,1,JPATCH)/=XUNDEF) &\r
+    ZDEPTH    (:,1,JPATCH)=ZD(:,1,JPATCH)/2.  \r
+  DO JLAYER=2,ILAYER\r
+    WHERE(ZD(:,1,JPATCH)/=XUNDEF) &\r
+      ZDEPTH    (:,JLAYER,JPATCH) = (ZD(:,JLAYER-1,JPATCH) + ZD(:,JLAYER,JPATCH))/2.  \r
+  END DO\r
+END DO\r
+DEALLOCATE(ZD)\r
+!-------------------------------------------------------------------\r
+!\r
+ALLOCATE(PDEPTH    (KNI,ILAYER,NVEGTYPE))\r
+ CALL PUT_ON_ALL_VEGTYPES(KNI,ILAYER,KPATCH,NVEGTYPE,ZDEPTH,PDEPTH)\r
+DEALLOCATE(ZDEPTH)\r
+\r
+IF (LHOOK) CALL DR_HOOK('MODE_READ_EXTERN:READ_EXTERN_DEPTH',1,ZHOOK_HANDLE)\r
+!-------------------------------------------------------------------\r
+!\r
+END SUBROUTINE READ_EXTERN_DEPTH\r
+!\r
+!\r
+!-------------------------------------------------------------------\r
+!---------------------------------------------------------------------------------------\r
+!\r
+!     #######################\r
+      SUBROUTINE READ_EXTERN_ISBA(HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE,&\r
+                                  KLUOUT,KNI,HFIELD,HNAME,PFIELD,PDEPTH)\r
+!     #######################\r
+!\r
+USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE\r
+USE MODD_SURF_PAR,       ONLY : XUNDEF\r
+USE MODD_ISBA_PAR,    ONLY : XOPTIMGRID\r
+!\r
+USE MODI_OPEN_AUX_IO_SURF\r
+USE MODI_CLOSE_AUX_IO_SURF\r
+USE MODI_READ_SURF\r
+USE MODI_READ_SURF_FIELD3D\r
+USE MODE_SOIL\r
+!\r
+IMPLICIT NONE\r
+!\r
+!* dummy arguments\r
+!  ---------------\r
+!\r
+ CHARACTER(LEN=28),  INTENT(IN)  :: HFILE     ! name of file\r
+ CHARACTER(LEN=6),   INTENT(IN)  :: HFILETYPE ! type of input file\r
+ CHARACTER(LEN=28),  INTENT(IN)  :: HFILEPGD     ! name of file\r
+ CHARACTER(LEN=6),   INTENT(IN)  :: HFILEPGDTYPE ! type of input file\r
+INTEGER,              INTENT(IN)    :: KLUOUT    ! logical unit of output listing\r
+INTEGER,              INTENT(IN)    :: KNI       ! number of points\r
+ CHARACTER(LEN=7),     INTENT(IN)    :: HFIELD    ! field name\r
+ CHARACTER(LEN=*),     INTENT(IN)    :: HNAME     ! field name in the file\r
+REAL, DIMENSION(:,:,:), POINTER       :: PFIELD    ! field to initialize\r
+REAL, DIMENSION(:,:,:), POINTER       :: PDEPTH    ! middle depth of each layer\r
+!\r
+!\r
+!* local variables\r
+!  ---------------\r
+!\r
+ CHARACTER(LEN=12) :: YRECFM         ! Name of the article to be read\r
+ CHARACTER(LEN=4)  :: YLVL\r
+#ifdef MNH_PARALLEL\r
+ CHARACTER(LEN=8)  :: YPATCH\r
+#endif\r
+ CHARACTER(LEN=3)  :: YISBA          ! type of ISBA soil scheme\r
+ CHARACTER(LEN=3)  :: YNAT           ! type of surface (nature, garden)\r
+ CHARACTER(LEN=4)  :: YPEDOTF        ! type of pedo-transfert function\r
+INTEGER           :: IRESP          ! reading return code\r
+INTEGER           :: ILAYER         ! number of layers\r
+INTEGER           :: JLAYER         ! loop counter\r
+INTEGER           :: IPATCH         ! number of patch\r
+INTEGER           :: JPATCH         ! loop counter\r
+INTEGER           :: JVEGTYPE       ! loop counter\r
+LOGICAL           :: GTEB           ! TEB field\r
+!\r
+REAL,  DIMENSION(:,:,:), ALLOCATABLE :: ZFIELD ! field read, one level, all patches\r
+REAL,  DIMENSION(:,:),   ALLOCATABLE :: ZWORK  ! field read, one level, all patches\r
+!\r
+REAL,  DIMENSION(:,:,:), ALLOCATABLE :: ZVAR      ! profile of physical variable\r
+REAL,  DIMENSION(:),   ALLOCATABLE   :: ZCLAY     ! clay fraction\r
+REAL,  DIMENSION(:),   ALLOCATABLE   :: ZSAND     ! sand fraction\r
+REAL,  DIMENSION(:),   ALLOCATABLE   :: ZWWILT    ! wilting point\r
+REAL,  DIMENSION(:),   ALLOCATABLE   :: ZWFC      ! field capacity\r
+REAL,  DIMENSION(:),   ALLOCATABLE   :: ZWSAT     ! saturation\r
+REAL,  DIMENSION(:),   ALLOCATABLE   :: ZSOILGRID\r
+REAL,  DIMENSION(:),   ALLOCATABLE   :: ZNAT      ! natural surface fraction \r
+!\r
+INTEGER :: IVERSION   ! surface version\r
+INTEGER :: IBUGFIX\r
+!\r
+REAL(KIND=JPRB) :: ZHOOK_HANDLE\r
+!-------------------------------------------------------------------------------\r
+IF (LHOOK) CALL DR_HOOK('MODE_READ_EXTERN:READ_EXTERN_ISBA',0,ZHOOK_HANDLE)\r
+WRITE  (KLUOUT,*) ' | Reading ',HFIELD,' in externalized file'\r
+!\r
+GTEB = (HNAME(1:3)=='TWN' .OR. HNAME(1:3)=='GD_' .OR. HNAME(1:3)=='GR_' &\r
+        .OR. HNAME(4:6)=='GD_' .OR. HNAME(4:6)=='GR_')\r
+!\r
+!------------------------------------------------------------------------------\r
+!\r
+IF (GTEB) THEN\r
+  CALL OPEN_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE,'TOWN  ')\r
+ELSE\r
+  CALL OPEN_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE,'NATURE')\r
+ENDIF\r
+!\r
+YRECFM='VERSION'\r
+ CALL READ_SURF(HFILEPGDTYPE,YRECFM,IVERSION,IRESP)\r
+!\r
+YRECFM='BUG'\r
+ CALL READ_SURF(HFILEPGDTYPE,YRECFM,IBUGFIX,IRESP)\r
+!\r
+!* Read number of soil layers\r
+!\r
+YRECFM='GROUND_LAYER'\r
+IF (GTEB) THEN \r
+  YRECFM='TWN_LAYER'\r
+  IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) YRECFM='GD_LAYER'\r
+ENDIF\r
+ CALL READ_SURF(HFILEPGDTYPE,YRECFM,ILAYER,IRESP)\r
+!\r
+!* number of tiles\r
+!\r
+IPATCH=1\r
+IF (.NOT. GTEB) THEN\r
+  YRECFM='PATCH_NUMBER'\r
+  CALL READ_SURF(HFILEPGDTYPE,YRECFM,IPATCH,IRESP)\r
+END IF\r
+!\r
+!* soil scheme\r
+!\r
+YRECFM='ISBA'\r
+IF (GTEB) THEN \r
+  YRECFM='TWN_ISBA'\r
+  IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) YRECFM='GD_ISBA'\r
+ENDIF\r
+ CALL READ_SURF(HFILEPGDTYPE,YRECFM,YISBA,IRESP)\r
+!\r
+IF (IVERSION>=7) THEN\r
+  !\r
+  !* Pedo-transfert function\r
+  !\r
+  YRECFM='PEDOTF'\r
+  IF (GTEB) THEN \r
+    YRECFM='TWN_PEDOTF'\r
+    IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) YRECFM='GD_PEDOTF'\r
+  ENDIF\r
+  CALL READ_SURF(HFILEPGDTYPE,YRECFM,YPEDOTF,IRESP)\r
+  !\r
+ELSE\r
+  YPEDOTF = 'CH78'\r
+ENDIF\r
+!\r
+!Only Brook and Corey with Force-Restore scheme\r
+IF(YISBA/='DIF')THEN\r
+  YPEDOTF='CH78'\r
+ENDIF\r
+!\r
+!-------------------------------------------------------------------------------\r
+!\r
+! *.  Read clay fraction\r
+!     ------------------\r
+!\r
+ALLOCATE(ZCLAY(KNI))\r
+YRECFM='CLAY'\r
+IF (GTEB) THEN \r
+  YRECFM='TWN_CLAY'\r
+  IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) YRECFM='GD_CLAY'\r
+ENDIF\r
+ CALL READ_SURF(HFILEPGDTYPE,YRECFM,ZCLAY(:),IRESP,HDIR='A')\r
+!\r
+!-------------------------------------------------------------------------------\r
+!\r
+! *.  Read sand fraction\r
+!     ------------------\r
+!\r
+ALLOCATE(ZSAND(KNI))\r
+YRECFM='SAND'\r
+IF (GTEB) THEN \r
+  YRECFM='TWN_SAND'\r
+  IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) YRECFM='GD_SAND'\r
+ENDIF\r
+ CALL READ_SURF(HFILEPGDTYPE,YRECFM,ZSAND(:),IRESP,HDIR='A')\r
+!\r
+!-------------------------------------------------------------------------------\r
+!\r
+! *.  Read soil grid\r
+!     --------------\r
+!\r
+!* Reference grid for DIF\r
+!\r
+IF(YISBA=='DIF') THEN\r
+  ALLOCATE(ZSOILGRID(ILAYER))\r
+  ZSOILGRID=XUNDEF\r
+  IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=2) THEN\r
+    YRECFM='SOILGRID'\r
+    IF (GTEB) THEN \r
+      YRECFM='TWN_SOILGRID'\r
+      IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) YRECFM='GD_SOILGRID'\r
+    ENDIF\r
+    CALL READ_SURF(HFILEPGDTYPE,YRECFM,ZSOILGRID,IRESP,HDIR='-')\r
+  ELSE\r
+    ZSOILGRID(1:ILAYER) = XOPTIMGRID(1:ILAYER)\r
+  ENDIF\r
+ELSE\r
+  ALLOCATE(ZSOILGRID(0))\r
+ENDIF\r
+!\r
+IF ((HFIELD=='TG    ') .AND. (YISBA=='2-L' .OR. YISBA=='3-L')) THEN\r
+  ALLOCATE(PDEPTH    (KNI,ILAYER,NVEGTYPE))\r
+  DO JVEGTYPE=1,NVEGTYPE\r
+    PDEPTH(:,1,JVEGTYPE) = 0.\r
+    PDEPTH(:,2,JVEGTYPE) = 0.2\r
+    IF (ILAYER==3) PDEPTH(:,3,JVEGTYPE) = 3.\r
+  END DO\r
+ELSE\r
+  YNAT='NAT'\r
+  IF (GTEB) YNAT='GRD'\r
+  CALL READ_EXTERN_DEPTH(HFILEPGDTYPE,KLUOUT,YISBA,YNAT,HFIELD,KNI,ILAYER,IPATCH,&\r
+                         ZSOILGRID,PDEPTH,IVERSION)\r
+END IF\r
+!\r
+DEALLOCATE(ZSOILGRID)\r
+!\r
+! *.  Read fraction of nature\r
+!     --------------\r
+!\r
+ALLOCATE(ZNAT(KNI))\r
+IF (IVERSION>=7) THEN\r
+  CALL READ_SURF(HFILEPGDTYPE,'FRAC_NATURE',ZNAT,IRESP,HDIR='A')\r
+ELSE\r
+  ZNAT=1.0  \r
+ENDIF\r
+\r
+!\r
+ CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)\r
+!\r
+!* Allocate soil variable profile\r
+!  ------------------------------\r
+!\r
+!\r
+ALLOCATE(ZVAR(KNI,ILAYER,IPATCH))\r
+ALLOCATE(ZWORK(KNI,IPATCH))\r
+ZWORK(:,:) = XUNDEF\r
+!\r
+! *.  Read soil variable profile\r
+!     --------------------------\r
+!\r
+IF (GTEB) THEN\r
+  CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,'TOWN  ')\r
+ELSE\r
+  CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,'NATURE')\r
+ENDIF\r
+!\r
+  YRECFM=TRIM(HNAME)\r
+  CALL READ_SURF_FIELD3D(HFILETYPE,ZVAR,1,ILAYER,YRECFM,HDIR='A')\r
+!\r
+ CALL CLOSE_AUX_IO_SURF(HFILE,HFILETYPE)\r
+!\r
+DEALLOCATE(ZWORK)\r
+!\r
+!\r
+! *.  Compute relative humidity from units kg/m^2 (SWI)\r
+!     ------------------------------------------------\r
+!\r
+!* In case of force-restore ISBA, adds one layer at bottom of surface layer\r
+IF ((HFIELD=='WG    ' .OR. HFIELD=='WGI   ') .AND. (YISBA=='2-L' .OR. YISBA=='3-L')) THEN\r
+  ALLOCATE(ZFIELD(KNI,ILAYER,IPATCH))\r
+  ZFIELD(:,:,:) = ZVAR(:,:,:)\r
+  DEALLOCATE(ZVAR)\r
+  !\r
+  ILAYER = ILAYER + 1\r
+  IF ( YISBA=='3-L' ) ILAYER = ILAYER + 1\r
+  ALLOCATE(ZVAR(KNI,ILAYER,IPATCH))\r
+  DO JPATCH=1,IPATCH\r
+    ZVAR(:,1,JPATCH)=ZFIELD(:,1,JPATCH)\r
+    ZVAR(:,2,JPATCH)=ZFIELD(:,2,JPATCH)  ! new layer at root layer humidity but below surface layer\r
+    ZVAR(:,3,JPATCH)=ZFIELD(:,2,JPATCH)\r
+    IF ( YISBA=='3-L' ) THEN\r
+      ZVAR(:,4,JPATCH)=ZFIELD(:,3,JPATCH)\r
+      ZVAR(:,5,JPATCH)=ZFIELD(:,3,JPATCH)\r
+    END IF\r
+  END DO\r
+  DEALLOCATE(ZFIELD)\r
+END IF\r
+!\r
+ALLOCATE(ZFIELD(KNI,ILAYER,IPATCH))\r
+ZFIELD = ZVAR\r
+!\r
+IF (HFIELD=='WG    ' .OR. HFIELD=='WGI   ') THEN\r
+  !\r
+  ! Compute ISBA model constants\r
+  !\r
+  ALLOCATE (ZWFC  (KNI))\r
+  ALLOCATE (ZWWILT(KNI))\r
+  ALLOCATE (ZWSAT (KNI))\r
+  !\r
+  ZWSAT (:) = WSAT_FUNC (ZCLAY(:),ZSAND(:),YPEDOTF)\r
+  ZWWILT(:) = WWILT_FUNC(ZCLAY(:),ZSAND(:),YPEDOTF)\r
+  ZWFC  (:) = WFC_FUNC  (ZCLAY(:),ZSAND(:),YPEDOTF)\r
+  !\r
+  DEALLOCATE (ZSAND)\r
+  DEALLOCATE (ZCLAY)\r
+\r
+  ZFIELD(:,:,:) = XUNDEF\r
+  !\r
+  IF (HFIELD=='WG    ') THEN\r
+    DO JPATCH=1,IPATCH\r
+      DO JLAYER=1,ILAYER\r
+        WHERE(ZNAT(:)>0.0 .AND. ZVAR(:,JLAYER,JPATCH)/=XUNDEF)\r
+          ZVAR(:,JLAYER,JPATCH) = MAX(MIN(ZVAR(:,JLAYER,JPATCH),ZWSAT(:)),0.)\r
+          !\r
+          ZFIELD(:,JLAYER,JPATCH) = (ZVAR(:,JLAYER,JPATCH) - ZWWILT(:)) / (ZWFC(:) - ZWWILT(:))\r
+        END WHERE\r
+      END DO\r
+    END DO\r
+  ELSE IF (HFIELD=='WGI   ') THEN\r
+    DO JPATCH=1,IPATCH\r
+      DO JLAYER=1,ILAYER\r
+        WHERE(ZNAT(:)>0.0 .AND. ZVAR(:,JLAYER,JPATCH)/=XUNDEF)\r
+          ZFIELD(:,JLAYER,JPATCH) = ZVAR(:,JLAYER,JPATCH) / ZWSAT(:)  \r
+        END WHERE \r
+      END DO\r
+    END DO\r
+  END IF\r
+!\r
+  DEALLOCATE (ZNAT)\r
+  DEALLOCATE (ZWSAT)\r
+  DEALLOCATE (ZWWILT)\r
+  DEALLOCATE (ZWFC)\r
+!\r
+!\r
+END IF\r
+!\r
+DEALLOCATE(ZVAR)\r
+!-------------------------------------------------------------------------------\r
+!\r
+! *.  Set the field on all vegtypes\r
+!     -----------------------------\r
+!\r
+ALLOCATE(PFIELD(KNI,ILAYER,NVEGTYPE))\r
+ CALL PUT_ON_ALL_VEGTYPES(KNI,ILAYER,IPATCH,NVEGTYPE,ZFIELD,PFIELD)\r
+DEALLOCATE(ZFIELD)\r
+IF (LHOOK) CALL DR_HOOK('MODE_READ_EXTERN:READ_EXTERN_ISBA',1,ZHOOK_HANDLE)\r
+!\r
+!------------------------------------------------------------------------------\r
+!\r
+END SUBROUTINE READ_EXTERN_ISBA\r
+!\r
+!------------------------------------------------------------------------------\r
+!\r
+END MODULE MODE_READ_EXTERN                       \r
index e71125a..710e8c0 100644 (file)
-!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 \r
+!SURFEX_LIC This is part of the SURFEX software governed by the CeCILL-C  licence\r
+!SURFEX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt\r
+!SURFEX_LIC for details. version 1.\r
+!     #########\r
+SUBROUTINE PREP_ISBA_EXTERN(HPROGRAM,HSURF,HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE,KLUOUT,PFIELD)\r
+!     #################################################################################\r
+!\r
+!!****  *PREP_ISBA_EXTERN* - initializes ISBA fields from operational GRIB\r
+!!\r
+!!    PURPOSE\r
+!!    -------\r
+!\r
+!!**  METHOD\r
+!!    ------\r
+!!\r
+!!    REFERENCE\r
+!!    ---------\r
+!!      \r
+!!\r
+!!    AUTHOR\r
+!!    ------\r
+!!     V. Masson \r
+!!\r
+!!    MODIFICATIONS\r
+!!    -------------\r
+!!      Original    01/2004\r
+!!        M.Moge    01/2016  using READ_SURF_FIELD2D for 2D surfex fields reads\r
+!!------------------------------------------------------------------\r
+!\r
+\r
+!\r
+USE MODE_READ_EXTERN\r
+!\r
+USE MODD_TYPE_DATE_SURF\r
+!\r
+USE MODI_PREP_GRID_EXTERN\r
+USE MODI_READ_SURF\r
+USE MODI_INTERP_GRID\r
+USE MODI_OPEN_AUX_IO_SURF\r
+USE MODI_CLOSE_AUX_IO_SURF\r
+!\r
+USE MODD_PREP,           ONLY : CINGRID_TYPE, CINTERP_TYPE\r
+USE MODD_PREP_ISBA,      ONLY : XGRID_SOIL, XWR_DEF\r
+USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE\r
+USE MODD_SURF_PAR,       ONLY : XUNDEF\r
+!\r
+USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK\r
+USE PARKIND1  ,ONLY : JPRB\r
+!\r
+USE MODI_PUT_ON_ALL_VEGTYPES\r
+!\r
+USE MODI_READ_SURF_FIELD2D\r
+!\r
+IMPLICIT NONE\r
+!\r
+!*      0.1    declarations of arguments\r
+!\r
+ CHARACTER(LEN=6),   INTENT(IN)  :: HPROGRAM  ! program calling surf. schemes\r
+ CHARACTER(LEN=7),   INTENT(IN)  :: HSURF     ! type of field\r
+ CHARACTER(LEN=28),  INTENT(IN)  :: HFILE     ! name of file\r
+ CHARACTER(LEN=6),   INTENT(IN)  :: HFILETYPE ! type of input file\r
+ CHARACTER(LEN=28),  INTENT(IN)  :: HFILEPGD     ! name of file\r
+ CHARACTER(LEN=6),   INTENT(IN)  :: HFILEPGDTYPE ! type of input file\r
+INTEGER,            INTENT(IN)  :: KLUOUT    ! logical unit of output listing\r
+REAL,DIMENSION(:,:,:), POINTER  :: PFIELD    ! field to interpolate horizontally (on final soil grid)\r
+!\r
+!*      0.2    declarations of local variables\r
+!\r
+ CHARACTER(LEN=12) :: YRECFM         ! Name of the article to be read\r
+INTEGER           :: IRESP          ! reading return code\r
+INTEGER           :: INI            ! total 1D dimension\r
+INTEGER           :: IPATCH         ! number of patch\r
+!\r
+REAL, DIMENSION(:,:,:), POINTER     :: ZFIELD         ! field read on initial MNH vertical soil grid, all patches\r
+REAL, DIMENSION(:,:),   POINTER     :: ZFIELD1        ! field read on initial MNH vertical soil grid, one patch\r
+REAL, DIMENSION(:,:,:), POINTER     :: ZD             ! depth of field in the soil\r
+REAL, DIMENSION(:,:), POINTER     :: ZD1            ! depth of field in the soil, one patch\r
+REAL, DIMENSION(:,:), ALLOCATABLE   :: ZOUT         !\r
+INTEGER                             :: JVEGTYPE        ! loop counter for patch\r
+REAL(KIND=JPRB) :: ZHOOK_HANDLE\r
+!\r
+!------------------------------------------------------------------------------\r
+!\r
+!*      1.     Preparation of IO for reading in the file\r
+!              -----------------------------------------\r
+!\r
+!* Note that all points are read, even those without physical meaning.\r
+!  These points will not be used during the horizontal interpolation step.\r
+!  Their value must be defined as XUNDEF.\r
+!\r
+IF (LHOOK) CALL DR_HOOK('PREP_ISBA_EXTERN',0,ZHOOK_HANDLE)\r
+!\r
+!------------------------------------------------------------------------------\r
+!\r
+!*      2.     Reading of grid\r
+!              ---------------\r
+!\r
+ CALL OPEN_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE,'NATURE')\r
+!\r
+ CALL PREP_GRID_EXTERN(HFILEPGDTYPE,KLUOUT,CINGRID_TYPE,CINTERP_TYPE,INI)\r
+!\r
+!---------------------------------------------------------------------------------------\r
+!\r
+!*      3.     Transformation into physical quantity to be interpolated\r
+!              --------------------------------------------------------\r
+!\r
+SELECT CASE(HSURF)\r
+!\r
+!*     3.      Orography\r
+!              ---------\r
+!\r
+  CASE('ZS     ')\r
+    ALLOCATE(PFIELD(INI,1,1))\r
+    YRECFM='ZS'\r
+    CALL READ_SURF(HFILEPGDTYPE,YRECFM,PFIELD(:,1,1),IRESP,HDIR='A')\r
+    CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)\r
+!\r
+!--------------------------------------------------------------------------\r
+!\r
+!\r
+!*      3.1    Profile of temperature, water or ice in the soil\r
+!\r
+  CASE('TG    ','WG    ','WGI   ')\r
+     CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)\r
+!* reading of the profile and its depth definition\r
+     CALL READ_EXTERN_ISBA(HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE,&\r
+                           KLUOUT,INI,HSURF,HSURF,ZFIELD,ZD)\r
+! \r
+     ALLOCATE(ZFIELD1(SIZE(ZFIELD,1),SIZE(ZFIELD,2)))\r
+     ALLOCATE(ZD1(SIZE(ZFIELD,1),SIZE(ZFIELD,2)))\r
+     ALLOCATE(ZOUT(SIZE(ZFIELD,1),SIZE(XGRID_SOIL)))\r
+     ALLOCATE(PFIELD(SIZE(ZFIELD,1),SIZE(XGRID_SOIL),SIZE(ZFIELD,3)))\r
+!\r
+     DO JVEGTYPE=1,SIZE(ZFIELD,3)\r
+        ZFIELD1(:,:)=ZFIELD(:,:,JVEGTYPE)\r
+        ZD1(:,:)=ZD(:,:,JVEGTYPE)\r
+        CALL INTERP_GRID(ZD1,ZFIELD1,XGRID_SOIL,ZOUT)\r
+        PFIELD(:,:,JVEGTYPE)=ZOUT(:,:)\r
+     END DO\r
+   \r
+!\r
+     DEALLOCATE(ZFIELD)\r
+     DEALLOCATE(ZOUT)\r
+     DEALLOCATE(ZFIELD1)\r
+     DEALLOCATE(ZD)\r
+!\r
+!--------------------------------------------------------------------------\r
+!\r
+!*      3.4    Water content intercepted on leaves, LAI\r
+!\r
+  CASE('WR     ')\r
+     ALLOCATE(PFIELD(INI,1,NVEGTYPE))\r
+     !* number of tiles\r
+     YRECFM='PATCH_NUMBER'\r
+     CALL READ_SURF(HFILEPGDTYPE,YRECFM,IPATCH,IRESP)\r
+     CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)\r
+     ALLOCATE(ZFIELD(INI,1,IPATCH))\r
+     YRECFM = 'WR'\r
+     CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,'NATURE')\r
+     CALL READ_SURF_FIELD2D(HFILETYPE,ZFIELD(:,1,:),YRECFM,HDIR='A')\r
+     CALL CLOSE_AUX_IO_SURF(HFILE,HFILETYPE)\r
+     CALL PUT_ON_ALL_VEGTYPES(INI,1,IPATCH,NVEGTYPE,ZFIELD,PFIELD)\r
+     DEALLOCATE(ZFIELD)\r
+!\r
+  CASE('LAI    ')\r
+     CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)\r
+     ALLOCATE(PFIELD(INI,1,NVEGTYPE))\r
+     PFIELD(:,:,:) = XUNDEF\r
+!\r
+END SELECT\r
+!\r
+!\r
+!---------------------------------------------------------------------------\r
+!\r
+!*      6.     End of IO\r
+!              ---------\r
+!\r
+IF (LHOOK) CALL DR_HOOK('PREP_ISBA_EXTERN',1,ZHOOK_HANDLE)\r
+!\r
+!---------------------------------------------------------------------------\r
+!---------------------------------------------------------------------------\r
+END SUBROUTINE PREP_ISBA_EXTERN\r
index b998d60..74c1ed9 100644 (file)
-!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 \r
+!SURFEX_LIC This is part of the SURFEX software governed by the CeCILL-C  licence\r
+!SURFEX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt\r
+!SURFEX_LIC for details. version 1.\r
+!!\r
+!!    MODIFICATIONS\r
+!!    -------------\r
+!!      M.Moge    01/2016  using READ_SURF_FIELD2D/3D for 2D/3D surfex fields reads\r
+!     #########\r
+SUBROUTINE PREP_TEB_EXTERN(HPROGRAM,HSURF,HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE,KLUOUT,PFIELD)\r
+!     #################################################################################\r
+!\r
+USE MODD_TYPE_DATE_SURF\r
+!\r
+USE MODI_PREP_GRID_EXTERN\r
+USE MODI_READ_SURF\r
+USE MODI_GET_TEB_DEPTHS\r
+USE MODI_INTERP_GRID\r
+USE MODI_OPEN_AUX_IO_SURF\r
+USE MODI_CLOSE_AUX_IO_SURF\r
+USE MODI_TOWN_PRESENCE\r
+USE MODI_READ_TEB_PATCH\r
+USE MODI_GET_CURRENT_TEB_PATCH\r
+USE MODI_READ_SURF_FIELD2D\r
+!\r
+USE MODD_PREP,       ONLY : CINGRID_TYPE, CINTERP_TYPE\r
+USE MODD_PREP_TEB,   ONLY : XGRID_ROAD, XGRID_WALL, XGRID_ROOF, &\r
+                            XGRID_FLOOR, XWS_ROOF, XWS_ROAD, &\r
+                            XTI_BLD_DEF, XWS_ROOF_DEF, XWS_ROAD_DEF, XHUI_BLD_DEF\r
+USE MODD_DATA_COVER_PAR, ONLY : JPCOVER\r
+USE MODD_SURF_PAR, ONLY: XUNDEF\r
+!\r
+USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK\r
+USE PARKIND1  ,ONLY : JPRB\r
+!\r
+IMPLICIT NONE\r
+!\r
+!*      0.1    declarations of arguments\r
+!\r
+ CHARACTER(LEN=6),   INTENT(IN)  :: HPROGRAM  ! program calling surf. schemes\r
+ CHARACTER(LEN=7),   INTENT(IN)  :: HSURF     ! type of field\r
+ CHARACTER(LEN=28),  INTENT(IN)  :: HFILE     ! name of file\r
+ CHARACTER(LEN=6),   INTENT(IN)  :: HFILETYPE ! type of input file\r
+ CHARACTER(LEN=28),  INTENT(IN)  :: HFILEPGD     ! name of file\r
+ CHARACTER(LEN=6),   INTENT(IN)  :: HFILEPGDTYPE ! type of input file\r
+INTEGER,            INTENT(IN)  :: KLUOUT    ! logical unit of output listing\r
+REAL,DIMENSION(:,:), POINTER    :: PFIELD    ! field to interpolate horizontally\r
+!\r
+!*      0.2    declarations of local variables\r
+!\r
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZFIELD         ! field read\r
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZDEPTH         ! depth of each layer\r
+REAL, DIMENSION(:),   ALLOCATABLE :: ZDEPTH_TOT     ! total depth of surface\r
+!\r
+REAL, DIMENSION(:,:),   ALLOCATABLE :: ZD  ! intermediate array\r
+!\r
+ CHARACTER(LEN=12) :: YRECFM         ! Name of the article to be read\r
+INTEGER           :: IRESP          ! reading return code\r
+INTEGER           :: ILAYER         ! number of layers\r
+INTEGER           :: JLAYER         ! loop counter\r
+INTEGER           :: IVERSION       ! SURFEX version\r
+INTEGER           :: IBUGFIX        ! SURFEX bug version\r
+LOGICAL           :: GOLD_NAME      ! old name flag for temperatures\r
+ CHARACTER(LEN=4)  :: YWALL_OPT      ! option of walls\r
+ CHARACTER(LEN=6)  :: YSURF          ! Surface type\r
+ CHARACTER(LEN=3)  :: YBEM ! key of the building energy model DEF for DEFault (Masson et al. 2002) ,\r
+                          ! BEM for Building Energy Model (Bueno et al. 2012)\r
+!\r
+INTEGER           :: INI            ! total 1D dimension\r
+!\r
+LOGICAL                              :: GTEB      ! flag if TEB fields are present\r
+INTEGER                              :: IPATCH    ! number of soil temperature patches\r
+INTEGER                              :: ITEB_PATCH! number of TEB patches in file\r
+INTEGER                              :: ICURRENT_PATCH! current TEB patch to be initialized\r
+ CHARACTER(LEN=3)                     :: YPATCH    ! indentificator for TEB patch\r
+REAL(KIND=JPRB) :: ZHOOK_HANDLE\r
+!-------------------------------------------------------------------------------------\r
+!\r
+!*      1.     Preparation of IO for reading in the file\r
+!              -----------------------------------------\r
+!\r
+!* Note that all points are read, even those without physical meaning.\r
+!  These points will not be used during the horizontal interpolation step.\r
+!  Their value must be defined as XUNDEF.\r
+!\r
+IF (LHOOK) CALL DR_HOOK('PREP_TEB_EXTERN',0,ZHOOK_HANDLE)\r
+!\r
+ CALL OPEN_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE,'TOWN  ')\r
+!\r
+!* reading of version of the file being read\r
+ CALL READ_SURF(HFILEPGDTYPE,'VERSION',IVERSION,IRESP)\r
+ CALL READ_SURF(HFILEPGDTYPE,'BUG',IBUGFIX,IRESP)\r
+GOLD_NAME=(IVERSION<7 .OR. (IVERSION==7 .AND. IBUGFIX<3))\r
+!\r
+IF (.NOT.GOLD_NAME) THEN\r
+   YRECFM='BEM'\r
+   CALL READ_SURF(HFILEPGDTYPE,YRECFM,YBEM,IRESP)\r
+ELSE\r
+   YBEM='DEF'\r
+ENDIF\r
+!-------------------------------------------------------------------------------------\r
+!\r
+!*      2.     Reading of grid\r
+!              ---------------\r
+!\r
+!* reads the grid\r
+ CALL PREP_GRID_EXTERN(HFILEPGDTYPE,KLUOUT,CINGRID_TYPE,CINTERP_TYPE,INI)\r
+!\r
+!\r
+!* reads if TEB fields exist in the input file\r
+ CALL TOWN_PRESENCE(HFILEPGDTYPE,GTEB)\r
+!\r
+!---------------------------------------------------------------------------------------\r
+!\r
+!*     3.      Orography\r
+!              ---------\r
+!\r
+IF (HSURF=='ZS     ') THEN\r
+  !\r
+  ALLOCATE(PFIELD(INI,1))\r
+  YRECFM='ZS'\r
+  CALL READ_SURF(HFILEPGDTYPE,YRECFM,PFIELD(:,1),IRESP,HDIR='A')\r
+  CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)\r
+  !\r
+  !---------------------------------------------------------------------------------------\r
+ELSE\r
+!---------------------------------------------------------------------------------------\r
+!\r
+!*     4.     TEB fields are read\r
+!             -------------------\r
+!\r
+  IF (GTEB) THEN\r
+!\r
+    CALL READ_TEB_PATCH(HFILEPGDTYPE,ITEB_PATCH)\r
+    CALL GET_CURRENT_TEB_PATCH(ICURRENT_PATCH)\r
+    YPATCH='   '\r
+    IF (ITEB_PATCH>1) THEN\r
+      WRITE(YPATCH,FMT='(A,I1,A)') 'T',MIN(ICURRENT_PATCH,ITEB_PATCH),'_'\r
+    END IF\r
+!---------------------------------------------------------------------------------------\r
+    SELECT CASE(HSURF)\r
+!---------------------------------------------------------------------------------------\r
+!\r
+!*     4.1    Profile of temperatures in roads, roofs or walls\r
+!             ------------------------------------------------\r
+!\r
+    CASE('T_ROAD','T_ROOF','T_WALLA','T_WALLB','T_FLOOR','T_MASS')\r
+      YSURF=HSURF(1:6)\r
+      !* reading of number of layers\r
+      IF (YSURF=='T_ROAD') YRECFM='ROAD_LAYER'\r
+      IF (YSURF=='T_ROOF') YRECFM='ROOF_LAYER'\r
+      IF (YSURF=='T_WALL') YRECFM='WALL_LAYER'\r
+      IF (YSURF=='T_FLOO' .OR. YSURF=='T_MASS') THEN \r
+        IF (YBEM=='DEF') THEN\r
+          YRECFM='ROAD_LAYER'\r
+        ELSE\r
+          YRECFM='FLOOR_LAYER'\r
+        END IF\r
+      END IF\r
+      CALL READ_SURF(HFILEPGDTYPE,YRECFM,ILAYER,IRESP)\r
+      !\r
+      ALLOCATE(ZD(INI,ILAYER))\r
+      IF (YSURF=='T_ROAD') CALL GET_TEB_DEPTHS(HFILEPGDTYPE,PD_ROAD=ZD)\r
+      IF (YSURF=='T_ROOF') CALL GET_TEB_DEPTHS(HFILEPGDTYPE,PD_ROOF=ZD)\r
+      IF (YSURF=='T_WALL') CALL GET_TEB_DEPTHS(HFILEPGDTYPE,PD_WALL=ZD)\r
+      IF (YSURF=='T_MASS') CALL GET_TEB_DEPTHS(HFILEPGDTYPE,PD_FLOOR=ZD)\r
+      IF (YSURF=='T_FLOO') CALL GET_TEB_DEPTHS(HFILEPGDTYPE,PD_FLOOR=ZD)\r
+      !\r
+      CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)\r
+      CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,'TOWN  ')\r
+      !\r
+      !* reading option for road orientation\r
+      YWALL_OPT = 'UNIF'\r
+      IF (YSURF =='T_WALL' .AND. .NOT. GOLD_NAME) THEN\r
+        CALL READ_SURF(HFILETYPE,'WALL_OPT',YWALL_OPT,IRESP)\r
+      END IF\r
+      !\r
+      !* reading of the profile\r
+      ALLOCATE(ZFIELD(INI,ILAYER))\r
+      DO JLAYER=1,ILAYER\r
+        IF (GOLD_NAME) THEN\r
+          WRITE(YRECFM,'(A6,I1.1)') HSURF(1:6),JLAYER\r
+        ELSE\r
+          WRITE(YRECFM,'(A1,A4,I1.1)') HSURF(1:1),HSURF(3:6),JLAYER\r
+          IF (YSURF =='T_WALL' .AND. YWALL_OPT/='UNIF') &\r
+            WRITE(YRECFM,'(A1,A5,I1.1)') HSURF(1:1),HSURF(3:7),JLAYER\r
+          IF ((HSURF=='T_FLOOR' .OR. HSURF=='T_MASS') .AND. YBEM=='DEF') THEN\r
+            IF (HSURF=='T_FLOOR' .AND. JLAYER>1) THEN \r
+              WRITE(YRECFM,'(A5,I1.1)') 'TROAD',JLAYER\r
+            ELSE\r
+              WRITE(YRECFM,'(A6)') 'TI_BLD'\r
+            ENDIF\r
+          END IF\r
+        END IF\r
+        YRECFM=YPATCH//YRECFM\r
+        YRECFM=ADJUSTL(YRECFM)\r
+        CALL READ_SURF(HFILETYPE,YRECFM,ZFIELD(:,JLAYER),IRESP,HDIR='A')\r
+      END DO\r
+      CALL CLOSE_AUX_IO_SURF(HFILE,HFILETYPE)\r
+      !\r
+      !* recovers middle layer depth (from the surface)\r
+      ALLOCATE(ZDEPTH    (INI,ILAYER))\r
+      ALLOCATE(ZDEPTH_TOT(INI))\r
+      ZDEPTH    (:,1)=ZD(:,1)/2.\r
+      ZDEPTH_TOT(:)  =ZD(:,1)\r
+      DO JLAYER=2,ILAYER\r
+        ZDEPTH    (:,JLAYER) = ZDEPTH_TOT(:) + ZD(:,JLAYER)/2.\r
+        ZDEPTH_TOT(:) = ZDEPTH_TOT(:) + ZD(:,JLAYER)\r
+      END DO\r
+      !\r
+      !* in case of wall or roof, normalizes by total wall or roof thickness\r
+      IF (YSURF=='T_ROOF' .OR. YSURF=='T_WALL' .OR. HSURF == 'T_FLOOR' .OR. HSURF == 'T_MASS') THEN\r
+        DO JLAYER=1,ILAYER\r
+          ZDEPTH(:,JLAYER) = ZDEPTH(:,JLAYER) / ZDEPTH_TOT(:)\r
+        END DO\r
+      END IF\r
+      !\r
+      !* interpolation on the fine vertical grid\r
+      IF (YSURF=='T_ROAD') THEN\r
+        ALLOCATE(PFIELD(SIZE(ZFIELD,1),SIZE(XGRID_ROAD)))\r
+        CALL INTERP_GRID(ZDEPTH,ZFIELD,XGRID_ROAD,PFIELD)\r
+      ELSEIF (YSURF=='T_ROOF') THEN\r
+        ALLOCATE(PFIELD(SIZE(ZFIELD,1),SIZE(XGRID_ROOF)))\r
+        CALL INTERP_GRID(ZDEPTH,ZFIELD,XGRID_ROOF,PFIELD)\r
+      ELSEIF (YSURF=='T_WALL') THEN\r
+        ALLOCATE(PFIELD(SIZE(ZFIELD,1),SIZE(XGRID_WALL)))\r
+        CALL INTERP_GRID(ZDEPTH,ZFIELD,XGRID_WALL,PFIELD)\r
+      ELSEIF (YSURF=='T_FLOO' .OR. YSURF=='T_MASS') THEN\r
+        ALLOCATE(PFIELD(SIZE(ZFIELD,1),SIZE(XGRID_FLOOR)))\r
+        CALL INTERP_GRID(ZDEPTH,ZFIELD,XGRID_FLOOR,PFIELD)\r
+      END IF\r
+      !\r
+      !* end\r
+      DEALLOCATE(ZD)\r
+      DEALLOCATE(ZFIELD)\r
+      DEALLOCATE(ZDEPTH)\r
+      DEALLOCATE(ZDEPTH_TOT)\r
+!---------------------------------------------------------------------------------------\r
+!\r
+!*      4.2    Internal moisture\r
+!              ---------------\r
+!\r
+    CASE('QI_BLD ')\r
+      ALLOCATE(PFIELD(INI,1))\r
+      IF (YBEM=='BEM') THEN\r
+        YRECFM='QI_BLD'\r
+        YRECFM=YPATCH//YRECFM\r
+        YRECFM=ADJUSTL(YRECFM)\r
+        CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)\r
+        CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,'TOWN  ')\r
+        CALL READ_SURF(HFILETYPE,YRECFM,PFIELD(:,1),IRESP,HDIR='A')\r
+        CALL CLOSE_AUX_IO_SURF(HFILE,HFILETYPE)\r
+      ELSE\r
+        PFIELD(:,1) = XUNDEF\r
+      ENDIF\r
+!\r
+!---------------------------------------------------------------------------------------\r
+!\r
+!*      4.2    Other variables\r
+!              ---------------\r
+!\r
+    CASE DEFAULT\r
+      ALLOCATE(PFIELD(INI,1))\r
+      YRECFM=HSURF\r
+      IF (HSURF=='T_CAN  ') THEN\r
+        YRECFM='TCANYON'\r
+        IF (GOLD_NAME) YRECFM='T_CANYON'\r
+      ELSEIF (HSURF=='Q_CAN  ') THEN\r
+        YRECFM='QCANYON'\r
+        IF (GOLD_NAME) YRECFM='Q_CANYON'\r
+      ELSEIF (HSURF=='T_WIN2 ' .OR. HSURF=='T_WIN1') THEN\r
+        IF (YBEM=='BEM') THEN\r
+          YRECFM=HSURF\r
+        ELSE\r
+          YRECFM='TI_BLD'\r
+        ENDIF\r
+      ENDIF\r
+      YRECFM=YPATCH//YRECFM\r
+      YRECFM=ADJUSTL(YRECFM)\r
+      CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)\r
+      CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,'TOWN  ')\r
+      CALL READ_SURF(HFILETYPE,YRECFM,PFIELD(:,1),IRESP,HDIR='A')\r
+      CALL CLOSE_AUX_IO_SURF(HFILE,HFILETYPE)\r
+!\r
+!---------------------------------------------------------------------------------------\r
+    END SELECT\r
+!---------------------------------------------------------------------------------------\r
+!\r
+!*     5.     Subtitutes if TEB fields do not exist\r
+!             -------------------------------------\r
+!\r
+  ELSE\r
+\r
+    CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)\r
+\r
+    SELECT CASE(HSURF)\r
+\r
+    !* temperature profiles\r
+    CASE('T_ROAD','T_ROOF','T_WALL','T_WIN1','T_FLOOR','T_CAN','TI_ROAD')\r
+      YSURF=HSURF(1:6)\r
+      !* reading of the soil surface temperature\r
+      CALL OPEN_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE,'NATURE')\r
+      CALL READ_SURF(HFILEPGDTYPE,'PATCH_NUMBER',IPATCH,IRESP)\r
+      CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)\r
+      ALLOCATE(ZFIELD(INI,IPATCH))\r
+      CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,'NATURE')\r
+      IF (YSURF=='T_FLOO' .OR. YSURF=='T_CAN ' .OR. YSURF=='TI_ROA') THEN\r
+        YRECFM='TG2'\r
+        CALL READ_SURF_FIELD2D(HFILETYPE,ZFIELD(:,:),YRECFM,HDIR='A')\r
+      ELSE\r
+        YRECFM='TG1'\r
+        CALL READ_SURF_FIELD2D(HFILETYPE,ZFIELD(:,:),YRECFM,HDIR='A')\r
+      ENDIF\r
+      CALL CLOSE_AUX_IO_SURF(HFILE,HFILETYPE)\r
+      !* fills the whole temperature profile by this soil temperature\r
+      IF (YSURF=='T_ROAD') ILAYER=SIZE(XGRID_ROAD)\r
+      IF (YSURF=='T_ROOF') ILAYER=SIZE(XGRID_ROOF)\r
+      IF (YSURF=='T_WALL') ILAYER=SIZE(XGRID_WALL)\r
+      IF (YSURF=='T_FLOO') ILAYER=SIZE(XGRID_FLOOR)\r
+      IF (YSURF=='T_WIN1' .OR. YSURF=='T_CAN ' .OR. YSURF=='TI_ROA') ILAYER=1\r
+      ALLOCATE(PFIELD(INI,ILAYER))\r
+      IF (YSURF=='T_FLOO') THEN\r
+        !* sets the temperature equal to this deep soil temperature\r
+        PFIELD(:,1) = XTI_BLD_DEF\r
+      ELSE\r
+        PFIELD(:,1) = ZFIELD(:,1)\r
+      ENDIF\r
+      DO JLAYER=2,ILAYER\r
+        PFIELD(:,JLAYER) = ZFIELD(:,1)\r
+      END DO\r
+      DEALLOCATE(ZFIELD)\r
+\r
+    CASE('T_MASS','TI_BLD','T_WIN2')\r
+      YSURF=HSURF(1:6)\r
+      IF (YSURF=='T_MASS') ILAYER = SIZE(XGRID_FLOOR)\r
+      IF (YSURF=='TI_BLD'.OR.YSURF=='T_WIN2') ILAYER=1\r
+      ALLOCATE(PFIELD(INI, ILAYER))\r
+      PFIELD(:,:) = XTI_BLD_DEF\r
\r
+    !* building moisture\r
+    CASE('QI_BLD ')\r
+      ALLOCATE(PFIELD(INI,1))\r
+      PFIELD(:,1) = XUNDEF\r
+\r
+    !* water reservoirs\r
+    CASE('WS_ROOF','WS_ROAD')\r
+      ALLOCATE(PFIELD(INI,1))\r
+      IF (HSURF=='WS_ROOF') PFIELD = XWS_ROOF_DEF\r
+      IF (HSURF=='WS_ROAD') PFIELD = XWS_ROAD_DEF\r
+\r
+   !* other fields\r
+    CASE DEFAULT\r
+      ALLOCATE(PFIELD(INI,1))\r
+      PFIELD = 0.\r
+\r
+    END SELECT\r
+\r
+  END IF\r
+!-------------------------------------------------------------------------------------\r
+END IF\r
+!-------------------------------------------------------------------------------------\r
+!\r
+!*      6.     End of IO\r
+!              ---------\r
+!\r
+IF (LHOOK) CALL DR_HOOK('PREP_TEB_EXTERN',1,ZHOOK_HANDLE)\r
+!\r
+!---------------------------------------------------------------------------------------\r
+!\r
+END SUBROUTINE PREP_TEB_EXTERN\r
index 772ce57..3b1bc61 100644 (file)
-!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 \r
+!SURFEX_LIC This is part of the SURFEX software governed by the CeCILL-C  licence\r
+!SURFEX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt\r
+!SURFEX_LIC for details. version 1.\r
+!     #########\r
+SUBROUTINE PREP_TEB_GARDEN_EXTERN(HPROGRAM,HSURF,HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE,KLUOUT,PFIELD)\r
+!     #################################################################################\r
+!\r
+!!****  *PREP_TEB_GARDEN_EXTERN* - initializes ISBA fields from operational GRIB\r
+!!\r
+!!    PURPOSE\r
+!!    -------\r
+!\r
+!!**  METHOD\r
+!!    ------\r
+!!\r
+!!    REFERENCE\r
+!!    ---------\r
+!!      \r
+!!\r
+!!    AUTHOR\r
+!!    ------\r
+!!     V. Masson \r
+!!\r
+!!    MODIFICATIONS\r
+!!    -------------\r
+!!      Original    01/2004\r
+!!      M.Moge    01/2016  using READ_SURF_FIELD2D/3D for 2D/3D surfex fields reads\r
+!!------------------------------------------------------------------\r
+!\r
+\r
+!\r
+USE MODE_READ_EXTERN\r
+!\r
+USE MODD_TYPE_DATE_SURF\r
+!\r
+USE MODI_PREP_GRID_EXTERN\r
+USE MODI_READ_SURF\r
+USE MODI_INTERP_GRID\r
+USE MODI_OPEN_AUX_IO_SURF\r
+USE MODI_CLOSE_AUX_IO_SURF\r
+USE MODI_READ_TEB_PATCH\r
+USE MODI_GET_CURRENT_TEB_PATCH\r
+USE MODI_TOWN_PRESENCE\r
+!\r
+USE MODD_PREP,           ONLY : CINGRID_TYPE, CINTERP_TYPE\r
+USE MODD_PREP_TEB_GARDEN,ONLY : XGRID_SOIL, XWR_DEF\r
+USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE\r
+USE MODD_SURF_PAR,       ONLY : XUNDEF\r
+!\r
+USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK\r
+USE PARKIND1  ,ONLY : JPRB\r
+!\r
+USE MODI_PUT_ON_ALL_VEGTYPES\r
+!\r
+USE MODI_READ_SURF_FIELD2D\r
+!\r
+IMPLICIT NONE\r
+!\r
+!*      0.1    declarations of arguments\r
+!\r
+ CHARACTER(LEN=6),   INTENT(IN)  :: HPROGRAM  ! program calling surf. schemes\r
+ CHARACTER(LEN=7),   INTENT(IN)  :: HSURF     ! type of field\r
+ CHARACTER(LEN=28),  INTENT(IN)  :: HFILE     ! name of file\r
+ CHARACTER(LEN=6),   INTENT(IN)  :: HFILETYPE ! type of input file\r
+ CHARACTER(LEN=28),  INTENT(IN)  :: HFILEPGD     ! name of file\r
+ CHARACTER(LEN=6),   INTENT(IN)  :: HFILEPGDTYPE ! type of input file\r
+INTEGER,            INTENT(IN)  :: KLUOUT    ! logical unit of output listing\r
+REAL,DIMENSION(:,:,:), POINTER  :: PFIELD    ! field to interpolate horizontally (on final soil grid)\r
+!\r
+!*      0.2    declarations of local variables\r
+!\r
+ CHARACTER(LEN=12) :: YRECFM        ! Name of the article to be read\r
+INTEGER           :: IRESP          ! reading return code\r
+INTEGER           :: INI            ! total 1D dimension\r
+INTEGER           :: IPATCH         ! number of patch\r
+!\r
+REAL, DIMENSION(:,:,:), POINTER     :: ZFIELD         ! field read on initial MNH vertical soil grid, all patches\r
+REAL, DIMENSION(:,:),   POINTER     :: ZFIELD1        ! field read on initial MNH vertical soil grid, one patch\r
+REAL, DIMENSION(:,:,:), POINTER     :: ZD             ! depth of field in the soil\r
+REAL, DIMENSION(:,:), POINTER       :: ZD1            ! depth of field in the soil, one patch\r
+REAL, DIMENSION(:,:), ALLOCATABLE   :: ZOUT           !\r
+INTEGER                             :: JPATCH         ! loop counter for patch\r
+INTEGER                             :: ITEB_PATCH     ! number of TEB patches in file\r
+INTEGER                             :: ICURRENT_PATCH ! current TEB patch to be initialized\r
+INTEGER                             :: IVERSION       ! SURFEX version\r
+INTEGER                             :: IBUGFIX        ! SURFEX bug version\r
+LOGICAL                             :: GOLD_NAME      ! old name flag for temperatures\r
+ CHARACTER(LEN=12)                   :: YSURF     ! type of field\r
+ CHARACTER(LEN=3)                    :: YPATCH    ! indentificator for TEB patch\r
+ CHARACTER(LEN=4)                    :: YPATCH2   ! number of the patch\r
+LOGICAL                         :: GTEB      ! flag if TEB fields are present\r
+LOGICAL                         :: GGARDEN   ! T if gardens are present in the file\r
+REAL(KIND=JPRB) :: ZHOOK_HANDLE\r
+!\r
+!------------------------------------------------------------------------------\r
+!\r
+!*      1.     Preparation of IO for reading in the file\r
+!              -----------------------------------------\r
+!\r
+!* Note that all points are read, even those without physical meaning.\r
+!  These points will not be used during the horizontal interpolation step.\r
+!  Their value must be defined as XUNDEF.\r
+!\r
+IF (LHOOK) CALL DR_HOOK('PREP_TEB_GARDEN_EXTERN',0,ZHOOK_HANDLE)\r
+!\r
+!------------------------------------------------------------------------------\r
+!\r
+!*      2.     Reading of grid\r
+!              ---------------\r
+!\r
+ CALL OPEN_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE,'TOWN  ')\r
+!\r
+!* reading of version of the file being read\r
+ CALL READ_SURF(HFILEPGDTYPE,'VERSION',IVERSION,IRESP)\r
+ CALL READ_SURF(HFILEPGDTYPE,'BUG',IBUGFIX,IRESP)\r
+GOLD_NAME=(IVERSION<7 .OR. (IVERSION==7 .AND. IBUGFIX<3))\r
+!\r
+ CALL PREP_GRID_EXTERN(HFILEPGDTYPE,KLUOUT,CINGRID_TYPE,CINTERP_TYPE,INI)\r
+!\r
+!* reads if TEB fields exist in the input file\r
+ CALL TOWN_PRESENCE(HFILEPGDTYPE,GTEB)\r
+!\r
+IF (GTEB) THEN\r
+  CALL READ_TEB_PATCH(HFILEPGDTYPE,ITEB_PATCH)\r
+  CALL GET_CURRENT_TEB_PATCH(ICURRENT_PATCH)\r
+  YPATCH='   '\r
+  IF (ITEB_PATCH>1) THEN\r
+    WRITE(YPATCH,FMT='(A,I1,A)') 'T',MIN(ICURRENT_PATCH,ITEB_PATCH),'_'\r
+  END IF\r
+END IF\r
+!\r
+!---------------------------------------------------------------------------------------\r
+!\r
+!*      3.     Transformation into physical quantity to be interpolated\r
+!              --------------------------------------------------------\r
+!\r
+SELECT CASE(HSURF)\r
+!\r
+!*     3.      Orography\r
+!              ---------\r
+!\r
+  CASE('ZS     ')\r
+    ALLOCATE(PFIELD(INI,1,1))\r
+    YRECFM='ZS'\r
+    CALL READ_SURF(HFILEPGDTYPE,YRECFM,PFIELD(:,1,1),IRESP,HDIR='A')\r
+    CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)\r
+!\r
+!--------------------------------------------------------------------------\r
+!\r
+!\r
+!*      3.1    Profile of temperature, water or ice in the soil\r
+!\r
+  CASE('TG    ','WG    ','WGI   ')\r
+!* choice if one reads garden fields (if present) or ISBA fields\r
+    GGARDEN = .FALSE.\r
+    IF (GTEB) CALL READ_SURF(HFILEPGDTYPE,'GARDEN',GGARDEN,IRESP)\r
+    CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)\r
+    IF (GGARDEN) THEN\r
+      YSURF = 'GD_'//HSURF(1:3)\r
+      IF (GOLD_NAME) YSURF = 'TWN_'//HSURF(1:3)\r
+      YSURF = YPATCH//YSURF\r
+    ELSE\r
+      YSURF = HSURF\r
+    END IF\r
+    YSURF=ADJUSTL(YSURF)  \r
+!* reading of the profile and its depth definition\r
+     CALL READ_EXTERN_ISBA(HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE,KLUOUT,INI,&\r
+                HSURF,YSURF,ZFIELD,ZD)\r
+! \r
+     ALLOCATE(ZFIELD1(SIZE(ZFIELD,1),SIZE(ZFIELD,2)))\r
+     ALLOCATE(ZD1(SIZE(ZFIELD,1),SIZE(ZFIELD,2)))\r
+     ALLOCATE(ZOUT(SIZE(ZFIELD,1),SIZE(XGRID_SOIL)))\r
+     ALLOCATE(PFIELD(SIZE(ZFIELD,1),SIZE(XGRID_SOIL),SIZE(ZFIELD,3)))\r
+!\r
+     DO JPATCH=1,SIZE(ZFIELD,3)\r
+        ZFIELD1(:,:)=ZFIELD(:,:,JPATCH)\r
+        ZD1(:,:)=ZD(:,:,JPATCH)\r
+        CALL INTERP_GRID(ZD1,ZFIELD1,XGRID_SOIL,ZOUT)\r
+        PFIELD(:,:,JPATCH)=ZOUT(:,:)\r
+     END DO\r
+!\r
+     DEALLOCATE(ZFIELD)\r
+     DEALLOCATE(ZOUT)\r
+     DEALLOCATE(ZFIELD1)\r
+     DEALLOCATE(ZD)\r
+!\r
+!--------------------------------------------------------------------------\r
+!\r
+!*      3.4    Water content intercepted on leaves, LAI\r
+!\r
+  CASE('WR     ')\r
+     ALLOCATE(PFIELD(INI,1,NVEGTYPE))\r
+     !* choice if one reads garden fields (if present) or ISBA fields    \r
+     GGARDEN = .FALSE.\r
+     IF (GTEB) CALL READ_SURF(HFILEPGDTYPE,'GARDEN',GGARDEN,IRESP)\r
+     CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)\r
+     IF (GGARDEN) THEN\r
+       IPATCH = 1    \r
+       YRECFM = 'GD_WR'\r
+       IF (GOLD_NAME) YRECFM = 'TWN_WR'\r
+       YRECFM = YPATCH//YRECFM\r
+       CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,'TOWN  ')\r
+     ELSE            \r
+       YRECFM = 'PATCH_NUMBER'\r
+       CALL OPEN_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE,'NATURE')\r
+       CALL READ_SURF(HFILEPGDTYPE,YRECFM,IPATCH,IRESP)\r
+       CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)\r
+       CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,'NATURE')\r
+       YRECFM = 'WR'\r
+     END IF\r
+     YRECFM=ADJUSTL(YRECFM)\r
+     \r
+     ALLOCATE(ZFIELD(INI,1,IPATCH))\r
+     CALL READ_SURF_FIELD2D(HFILETYPE,ZFIELD(:,1,:),YRECFM,HDIR='A')\r
+     CALL CLOSE_AUX_IO_SURF(HFILE,HFILETYPE)\r
+     CALL PUT_ON_ALL_VEGTYPES(INI,1,1,NVEGTYPE,ZFIELD,PFIELD)\r
+     DEALLOCATE(ZFIELD)\r
+!\r
+  CASE('LAI    ')\r
+     CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)\r
+     ALLOCATE(PFIELD(INI,1,NVEGTYPE))\r
+     PFIELD(:,:,:) = XUNDEF\r
+!\r
+END SELECT\r
+!\r
+!\r
+!---------------------------------------------------------------------------\r
+!\r
+!*      6.     End of IO\r
+!              ---------\r
+!\r
+IF (LHOOK) CALL DR_HOOK('PREP_TEB_GARDEN_EXTERN',1,ZHOOK_HANDLE)\r
+!\r
+!---------------------------------------------------------------------------\r
+!---------------------------------------------------------------------------\r
+END SUBROUTINE PREP_TEB_GARDEN_EXTERN\r
index 1267762..54420b6 100644 (file)
-!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 \r
+!SURFEX_LIC This is part of the SURFEX software governed by the CeCILL-C  licence\r
+!SURFEX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt\r
+!SURFEX_LIC for details. version 1.\r
+!     #########\r
+SUBROUTINE PREP_TEB_GREENROOF_EXTERN(HPROGRAM,HSURF,HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE,KLUOUT,PFIELD)\r
+!     #################################################################################\r
+!\r
+!!****  *PREP_TEB_GREENROOF_EXTERN* - initializes ISBA fields from operational GRIB\r
+!!\r
+!!    PURPOSE\r
+!!    -------\r
+!\r
+!!**  METHOD\r
+!!    ------\r
+!!    Based on "prep_teb_garden_extern"\r
+!!\r
+!!    REFERENCE\r
+!!    ---------\r
+!!      \r
+!!\r
+!!    AUTHOR\r
+!!    ------\r
+!!    A. Lemonsu & C. de Munck \r
+!!\r
+!!    MODIFICATIONS\r
+!!    -------------\r
+!!      Original    07/2011\r
+!!      M.Moge    01/2016  using READ_SURF_FIELD2D/3D for 2D/3D surfex fields reads\r
+!!------------------------------------------------------------------\r
+!\r
+\r
+!\r
+USE MODE_READ_EXTERN\r
+!\r
+USE MODD_TYPE_DATE_SURF\r
+!\r
+USE MODI_PREP_GRID_EXTERN\r
+USE MODI_READ_SURF\r
+USE MODI_INTERP_GRID\r
+USE MODI_OPEN_AUX_IO_SURF\r
+USE MODI_CLOSE_AUX_IO_SURF\r
+USE MODI_READ_TEB_PATCH\r
+USE MODI_GET_CURRENT_TEB_PATCH\r
+USE MODI_TOWN_PRESENCE\r
+!\r
+USE MODD_PREP,               ONLY : CINGRID_TYPE, CINTERP_TYPE\r
+USE MODD_PREP_TEB_GREENROOF, ONLY : XGRID_SOIL, XWR_DEF\r
+USE MODD_DATA_COVER_PAR,     ONLY : NVEGTYPE\r
+USE MODD_SURF_PAR,           ONLY : XUNDEF\r
+!\r
+USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK\r
+USE PARKIND1  ,ONLY : JPRB\r
+!\r
+USE MODI_PUT_ON_ALL_VEGTYPES\r
+!\r
+USE MODI_READ_SURF_FIELD2D\r
+!\r
+IMPLICIT NONE\r
+!\r
+!*      0.1    declarations of arguments\r
+!\r
+ CHARACTER(LEN=6),   INTENT(IN)  :: HPROGRAM  ! program calling surf. schemes\r
+ CHARACTER(LEN=7),   INTENT(IN)  :: HSURF     ! type of field\r
+ CHARACTER(LEN=28),  INTENT(IN)  :: HFILE     ! name of file\r
+ CHARACTER(LEN=6),   INTENT(IN)  :: HFILETYPE ! type of input file\r
+ CHARACTER(LEN=28),  INTENT(IN)  :: HFILEPGD     ! name of file\r
+ CHARACTER(LEN=6),   INTENT(IN)  :: HFILEPGDTYPE ! type of input file\r
+INTEGER,            INTENT(IN)  :: KLUOUT    ! logical unit of output listing\r
+REAL,DIMENSION(:,:,:), POINTER  :: PFIELD    ! field to interpolate horizontally (on final soil grid)\r
+!\r
+!*      0.2    declarations of local variables\r
+!\r
+ CHARACTER(LEN=12) :: YRECFM         ! Name of the article to be read\r
+INTEGER           :: IRESP          ! reading return code\r
+INTEGER           :: INI            ! total 1D dimension\r
+INTEGER           :: IPATCH         ! number of patch\r
+!\r
+REAL, DIMENSION(:,:,:), POINTER     :: ZFIELD         ! field read on initial MNH vertical soil grid, all patches\r
+REAL, DIMENSION(:,:),   POINTER     :: ZFIELD1        ! field read on initial MNH vertical soil grid, one patch\r
+REAL, DIMENSION(:,:,:), POINTER     :: ZD             ! depth of field in the soil\r
+REAL, DIMENSION(:,:), POINTER       :: ZD1            ! depth of field in the soil, one patch\r
+REAL, DIMENSION(:,:), ALLOCATABLE   :: ZOUT           !\r
+LOGICAL                             :: GTEB           ! flag if TEB fields are present\r
+INTEGER                             :: JPATCH         ! loop counter for patch\r
+ CHARACTER(LEN=12)                   :: YSURF          ! type of field\r
+INTEGER                             :: ITEB_PATCH     ! number of TEB patches in file\r
+INTEGER                             :: ICURRENT_PATCH ! current TEB patch to be initialized\r
+INTEGER                             :: IVERSION       ! SURFEX version\r
+INTEGER                             :: IBUGFIX        ! SURFEX bug version\r
+LOGICAL                             :: GOLD_NAME      ! old name flag for temperatures\r
+ CHARACTER(LEN=3)                    :: YPATCH         ! indentificator for TEB patch\r
+ CHARACTER(LEN=4)                    :: YPATCH2   ! number of the patch\r
+LOGICAL                             :: GGREENROOF     ! T if gardens are present in the file\r
+!\r
+REAL(KIND=JPRB) :: ZHOOK_HANDLE\r
+!\r
+!------------------------------------------------------------------------------\r
+!\r
+!*      1.     Preparation of IO for reading in the file\r
+!              -----------------------------------------\r
+!\r
+!* Note that all points are read, even those without physical meaning.\r
+!  These points will not be used during the horizontal interpolation step.\r
+!  Their value must be defined as XUNDEF.\r
+!\r
+IF (LHOOK) CALL DR_HOOK('PREP_TEB_GREENROOF_EXTERN',0,ZHOOK_HANDLE)\r
+ CALL OPEN_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE,'TOWN  ')\r
+!\r
+!* reading of version of the file being read\r
+ CALL READ_SURF(HFILEPGDTYPE,'VERSION',IVERSION,IRESP)\r
+ CALL READ_SURF(HFILEPGDTYPE,'BUG',IBUGFIX,IRESP)\r
+GOLD_NAME=(IVERSION<7 .OR. (IVERSION==7 .AND. IBUGFIX<3))\r
+!\r
+!------------------------------------------------------------------------------\r
+!\r
+!*      2.     Reading of grid\r
+!              ---------------\r
+!\r
+ CALL PREP_GRID_EXTERN(HFILEPGDTYPE,KLUOUT,CINGRID_TYPE,CINTERP_TYPE,INI)\r
+!\r
+!* reads if TEB fields exist in the input file\r
+ CALL TOWN_PRESENCE(HFILEPGDTYPE,GTEB)\r
+!\r
+IF (GTEB) THEN\r
+  CALL READ_TEB_PATCH(HFILEPGDTYPE,ITEB_PATCH)\r
+  CALL GET_CURRENT_TEB_PATCH(ICURRENT_PATCH)\r
+  YPATCH='   '\r
+  IF (ITEB_PATCH>1) THEN\r
+    WRITE(YPATCH,FMT='(A,I1,A)') 'T',MIN(ICURRENT_PATCH,ITEB_PATCH),'_'\r
+  END IF\r
+END IF\r
+!\r
+! A FAIRE : VERIFIER QUE LES MODIFS DES PATCH/GTEB/GGREENROOF SONT CORRECTES\r
+!---------------------------------------------------------------------------------------\r
+!\r
+!*      3.     Transformation into physical quantity to be interpolated\r
+!              --------------------------------------------------------\r
+!\r
+SELECT CASE(HSURF)\r
+!\r
+!*     3.      Orography\r
+!              ---------\r
+!\r
+  CASE('ZS     ')\r
+    ALLOCATE(PFIELD(INI,1,1))\r
+    YRECFM='ZS'\r
+    CALL READ_SURF(HFILEPGDTYPE,YRECFM,PFIELD(:,1,1),IRESP,HDIR='A')\r
+    CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)\r
+!\r
+!--------------------------------------------------------------------------\r
+!\r
+!\r
+!*      3.1    Profile of temperature, water or ice in the soil\r
+!\r
+  CASE('TG    ','WG    ','WGI   ')\r
+!* choice if one reads garden fields (if present) or ISBA fields\r
+     GGREENROOF = .FALSE.\r
+     IF (GTEB) CALL READ_SURF(HFILEPGDTYPE,'LGREENROOF',GGREENROOF,IRESP)\r
+     CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)\r
+     IF (GGREENROOF) THEN\r
+        YSURF = 'GR_'//HSURF(1:3)  \r
+        YSURF=YPATCH//YSURF      \r
+     ELSE\r
+       YSURF = HSURF\r
+     END IF\r
+     YSURF=ADJUSTL(YSURF)\r
+!* reading of the profile and its depth definition\r
+     CALL READ_EXTERN_ISBA(HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE,KLUOUT,INI,&\r
+        HSURF,YSURF,ZFIELD,ZD)\r
+! \r
+     ALLOCATE(ZFIELD1(SIZE(ZFIELD,1),SIZE(ZFIELD,2)))\r
+     ALLOCATE(ZD1(SIZE(ZFIELD,1),SIZE(ZFIELD,2)))\r
+     ALLOCATE(ZOUT(SIZE(ZFIELD,1),SIZE(XGRID_SOIL)))\r
+     ALLOCATE(PFIELD(SIZE(ZFIELD,1),SIZE(XGRID_SOIL),SIZE(ZFIELD,3)))\r
+!\r
+     DO JPATCH=1,SIZE(ZFIELD,3)\r
+        ZFIELD1(:,:)=ZFIELD(:,:,JPATCH)\r
+        ZD1(:,:)=ZD(:,:,JPATCH)\r
+        CALL INTERP_GRID(ZD1,ZFIELD1,XGRID_SOIL,ZOUT)\r
+        PFIELD(:,:,JPATCH)=ZOUT(:,:)\r
+     END DO\r
+!\r
+     DEALLOCATE(ZFIELD)\r
+     DEALLOCATE(ZOUT)\r
+     DEALLOCATE(ZFIELD1)\r
+     DEALLOCATE(ZD)\r
+!\r
+!--------------------------------------------------------------------------\r
+!\r
+!*      3.4    Water content intercepted on leaves, LAI\r
+!\r
+  CASE('WR     ')\r
+     ALLOCATE(PFIELD(INI,1,NVEGTYPE))\r
+     !* choice if one reads garden fields (if present) or ISBA fields\r
+     GGREENROOF = .FALSE.\r
+     IF (GTEB) CALL READ_SURF(HFILEPGDTYPE,'LGREENROOF',GGREENROOF,IRESP)\r
+     CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)\r
+     IF (GGREENROOF) THEN\r
+       IPATCH = 1             \r
+       YRECFM = 'GD_WR'\r
+       YRECFM=YPATCH//YRECFM\r
+       CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,'TOWN  ')\r
+     ELSE\r
+       YRECFM = 'PATCH_NUMBER'\r
+       CALL OPEN_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE,'NATURE')\r
+       CALL READ_SURF(HFILEPGDTYPE,YRECFM,IPATCH,IRESP)\r
+       CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)\r
+       CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,'NATURE')\r
+       YRECFM = 'WR'\r
+     END IF\r
+     YRECFM=ADJUSTL(YRECFM)\r
+     ALLOCATE(ZFIELD(INI,1,IPATCH))\r
+     CALL READ_SURF_FIELD2D(HFILETYPE,ZFIELD(:,1,:),YRECFM,HDIR='A')\r
+     CALL CLOSE_AUX_IO_SURF(HFILE,HFILETYPE)\r
+     CALL PUT_ON_ALL_VEGTYPES(INI,1,1,NVEGTYPE,ZFIELD,PFIELD)\r
+     DEALLOCATE(ZFIELD)\r
+!\r
+  CASE('LAI    ')\r
+     CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE)\r
+     ALLOCATE(PFIELD(INI,1,NVEGTYPE))\r
+     PFIELD(:,:,:) = XUNDEF\r
+!\r
+END SELECT\r
+!\r
+!\r
+!---------------------------------------------------------------------------\r
+!\r
+!*      6.     End of IO\r
+!              ---------\r
+!\r
+IF (LHOOK) CALL DR_HOOK('PREP_TEB_GREENROOF_EXTERN',1,ZHOOK_HANDLE)\r
+!\r
+!---------------------------------------------------------------------------\r
+!---------------------------------------------------------------------------\r
+END SUBROUTINE PREP_TEB_GREENROOF_EXTERN\r
index 7e7a976..d6afdea 100644 (file)
-!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 \r
+!SURFEX_LIC This is part of the SURFEX software governed by the CeCILL-C  licence\r
+!SURFEX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt\r
+!SURFEX_LIC for details. version 1.\r
+!     #########\r
+      SUBROUTINE READ_GR_SNOW(HPROGRAM,HSURFTYPE,HPREFIX,     &\r
+                              KLU,KPATCH,TPSNOW,HDIR)  \r
+!     ##########################################################\r
+!\r
+!!****  *READ_GR_SNOW* - routine to read snow surface fields\r
+!!\r
+!!    PURPOSE\r
+!!    -------\r
+!       Initialize snow surface fields.\r
+!\r
+!!**  METHOD\r
+!!    ------\r
+!!    \r
+!!    \r
+!!\r
+!!    EXTERNAL\r
+!!    --------\r
+!!      \r
+!!       \r
+!!    IMPLICIT ARGUMENTS\r
+!!    ------------------ \r
+!!\r
+!!    REFERENCE\r
+!!    ---------\r
+!!      \r
+!!      \r
+!!\r
+!!    AUTHOR\r
+!!    ------\r
+!!     V. Masson       * Meteo France *\r
+!!\r
+!!    MODIFICATIONS\r
+!!    -------------\r
+!!      Original       20/01/99\r
+!       F.solmon       06/00 adaptation for patch\r
+!       V.Masson       01/03 new version of ISBA\r
+!       B. Decharme    2008  If no WSNOW, WSNOW = XUNDEF\r
+!!      M.Moge    01/2016  using READ_SURF_FIELD2D/3D for 2D/3D surfex fields reads\r
+!-----------------------------------------------------------------------------\r
+!\r
+!*       0.    DECLARATIONS\r
+!\r
+USE MODD_TYPE_SNOW\r
+!\r
+USE MODI_READ_SURF\r
+USE MODI_READ_SURF_FIELD2D\r
+USE MODI_READ_SURF_FIELD3D\r
+!\r
+USE MODI_ALLOCATE_GR_SNOW\r
+!\r
+USE MODD_SURF_PAR, ONLY : XUNDEF\r
+USE MODD_PREP_SNOW, ONLY : LSNOW_FRAC_TOT\r
+!\r
+USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK\r
+USE PARKIND1  ,ONLY : JPRB\r
+!\r
+IMPLICIT NONE\r
+!\r
+!*       0.1   declarations of arguments\r
+!\r
+ CHARACTER(LEN=6),   INTENT(IN)           :: HPROGRAM  ! calling program\r
+ CHARACTER (LEN=*),  INTENT(IN)           :: HSURFTYPE ! generic name used for\r
+                                                      ! snow characteristics\r
+                                                      ! storage in file\r
+ CHARACTER (LEN=3),  INTENT(IN)           :: HPREFIX   ! generic name for patch\r
+!                                                     ! identification                      \r
+INTEGER,            INTENT(IN)           :: KLU       ! horizontal size of snow var.\r
+INTEGER,            INTENT(IN)           :: KPATCH    ! number of tiles\r
+TYPE(SURF_SNOW)                          :: TPSNOW    ! snow characteristics\r
+ CHARACTER (LEN=1),  INTENT(IN), OPTIONAL :: HDIR      ! type of reading\r
+!                                                     ! HDIR = 'A' : entire field on All processors\r
+!                                                     ! HDIR = 'H' : distribution on each processor\r
+!\r
+!*       0.2   declarations of local variables\r
+!\r
+INTEGER             :: IRESP               ! Error code after redding\r
+ CHARACTER(LEN=12)   :: YRECFM              ! Name of the article to be read\r
+ CHARACTER(LEN=16)   :: YRECFM2 \r
+!\r
+ CHARACTER (LEN=100) :: YFMT                ! format for writing\r
+INTEGER             :: ISURFTYPE_LEN       ! \r
+LOGICAL             :: GSNOW               ! snow written in the file\r
+INTEGER             :: JLAYER              ! loop counter\r
+CHARACTER(LEN=4)    :: YPATCH              ! number of the patch\r
+REAL, DIMENSION(:,:),ALLOCATABLE  :: ZWORK ! 2D array to write data in file\r
+ CHARACTER(LEN=1)    :: YDIR                ! type of reading\r
+ CHARACTER(LEN=4)    :: YNLAYER     !Format depending on the number of layers\r
+INTEGER             :: IVERSION, IBUGFIX\r
+REAL(KIND=JPRB) :: ZHOOK_HANDLE\r
+!-------------------------------------------------------------------------------\r
+!\r
+IF (LHOOK) CALL DR_HOOK('READ_GR_SNOW',0,ZHOOK_HANDLE)\r
+YDIR = 'H'\r
+IF (PRESENT(HDIR)) YDIR = HDIR\r
+!\r
+!-------------------------------------------------------------------------------\r
+ CALL READ_SURF(HPROGRAM,'VERSION',IVERSION,IRESP)\r
+ CALL READ_SURF(HPROGRAM,'BUG',IBUGFIX,IRESP)\r
+!-------------------------------------------------------------------------------\r
+!\r
+!*       1.    Type of snow scheme\r
+!              -------------------\r
+!\r
+ISURFTYPE_LEN=LEN_TRIM(HSURFTYPE)\r
+IF (IVERSION <=2 .OR. (IVERSION==3 .AND. IBUGFIX<=4)) THEN\r
+  WRITE(YFMT,'(A5,I1,A4)')     '(A5,A',ISURFTYPE_LEN,',A5)'\r
+  WRITE(YRECFM2,YFMT) 'SNOW_',HSURFTYPE,'_TYPE'\r
+ELSE\r
+  IF (IVERSION<7 .OR. IVERSION==7 .AND. IBUGFIX<3) THEN\r
+    WRITE(YFMT,'(A5,I1,A4)')     '(A3,A',ISURFTYPE_LEN,',A5)'\r
+    WRITE(YRECFM2,YFMT) 'SN_',HSURFTYPE,'_TYPE'\r
+  ELSE\r
+    WRITE(YFMT,'(A5,I1,A4)')     '(A3,A',ISURFTYPE_LEN,',A4)'\r
+    WRITE(YRECFM2,YFMT) 'SN_',HSURFTYPE,'_TYP'\r
+    YRECFM2=ADJUSTL(HPREFIX//YRECFM2)\r
+  ENDIF\r
+END IF\r
+!\r
+ CALL READ_SURF(HPROGRAM,YRECFM2,TPSNOW%SCHEME,IRESP)\r
+!\r
+!*       2.    Snow levels\r
+!              -----------\r
+!\r
+!\r
+IF (IVERSION <=2 .OR. (IVERSION==3 .AND. IBUGFIX<=4)) THEN\r
+  WRITE(YFMT,'(A5,I1,A4)')     '(A5,A',ISURFTYPE_LEN,',A6)'\r
+  WRITE(YRECFM2,YFMT) 'SNOW_',HSURFTYPE,'_LAYER'\r
+ELSE\r
+  WRITE(YFMT,'(A5,I1,A4)')     '(A3,A',ISURFTYPE_LEN,',A2)'\r
+  WRITE(YRECFM2,YFMT) 'SN_',HSURFTYPE,'_N'\r
+  IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) YRECFM2=ADJUSTL(HPREFIX//YRECFM2)\r
+END IF\r
+!\r
+ CALL READ_SURF(HPROGRAM,YRECFM2,TPSNOW%NLAYER,IRESP)\r
+!\r
+!*       2.    Presence of snow fields in the file\r
+!              -----------------------------------\r
+!\r
+IF (IVERSION >6 .OR. (IVERSION==6 .AND. IBUGFIX>=1)) THEN\r
+  WRITE(YFMT,'(A5,I1,A1)')     '(A3,A',ISURFTYPE_LEN,')'\r
+  WRITE(YRECFM,YFMT) 'SN_',HSURFTYPE\r
+  IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) YRECFM=ADJUSTL(HPREFIX//YRECFM)\r
+  CALL READ_SURF(HPROGRAM,YRECFM,GSNOW,IRESP)\r
+ELSE\r
+  IF (TPSNOW%NLAYER==0) THEN\r
+    GSNOW = .FALSE.\r
+    IF (TPSNOW%SCHEME=='D95' .OR. TPSNOW%SCHEME=='1-L' .OR. TPSNOW%SCHEME=='EBA') TPSNOW%NLAYER=1\r
+    IF (TPSNOW%SCHEME=='3-L' .OR. TPSNOW%SCHEME=='CRO'                          ) TPSNOW%NLAYER=3\r
+  ELSE\r
+    GSNOW = .TRUE.\r
+  END IF\r
+END IF\r
+!\r
+!-------------------------------------------------------------------------------\r
+!\r
+!*       3.    Allocations\r
+!              -----------\r
+!\r
+ CALL ALLOCATE_GR_SNOW(TPSNOW,KLU,KPATCH)\r
+!\r
+IF (.NOT. GSNOW) THEN\r
+  IF (LHOOK) CALL DR_HOOK('READ_GR_SNOW',1,ZHOOK_HANDLE)\r
+  RETURN\r
+END IF\r
+!-------------------------------------------------------------------------------\r
+!\r
+!*       4.    Additional key\r
+!              ---------------\r
+!\r
+IF (IVERSION >= 7 .AND. HSURFTYPE=='VEG') CALL READ_SURF(HPROGRAM,'LSNOW_FRAC_T',LSNOW_FRAC_TOT,IRESP)\r
+!\r
+!-------------------------------------------------------------------------------\r
+!\r
+!*       5.    Snow reservoir\r
+!              --------------\r
+!\r
+ALLOCATE(ZWORK(SIZE(TPSNOW%WSNOW,1),SIZE(TPSNOW%WSNOW,3)))\r
+!\r
+  IF (TPSNOW%SCHEME=='1-L' .OR. TPSNOW%SCHEME=='D95' .OR. TPSNOW%SCHEME=='EBA' .OR. TPSNOW%SCHEME=='3-L' &\r
+     .OR. TPSNOW%SCHEME=='CRO') THEN  \r
+!\r
+    IF (IVERSION<7 .OR. IVERSION==7 .AND. IBUGFIX<3) THEN\r
+      YRECFM='WSNOW_'//HSURFTYPE\r
+    ELSE\r
+      YRECFM=ADJUSTL(HPREFIX//'WSN_'//HSURFTYPE)\r
+    ENDIF\r
+    CALL READ_SURF_FIELD3D(HPROGRAM,TPSNOW%WSNOW,1,TPSNOW%NLAYER,YRECFM,HDIR=YDIR)\r
+  END IF\r
+!\r
+!*       6.    Snow density\r
+!              ------------\r
+!\r
+  IF (TPSNOW%SCHEME=='1-L' .OR. TPSNOW%SCHEME=='D95' .OR. TPSNOW%SCHEME=='EBA' .OR. TPSNOW%SCHEME=='3-L' &\r
+     .OR. TPSNOW%SCHEME=='CRO') THEN  \r
+    IF (IVERSION<7 .OR. IVERSION==7 .AND. IBUGFIX<3) THEN\r
+      YRECFM='RSNOW_'//HSURFTYPE\r
+    ELSE\r
+      YRECFM=ADJUSTL(HPREFIX//'RSN_'//HSURFTYPE)\r
+    ENDIF\r
+    CALL READ_SURF_FIELD3D(HPROGRAM,TPSNOW%RHO,1,TPSNOW%NLAYER,YRECFM,HDIR=YDIR)\r
+    WHERE(TPSNOW%WSNOW(:,1:TPSNOW%NLAYER,:)==0.0)TPSNOW%RHO(:,1:TPSNOW%NLAYER,:)=XUNDEF\r
+  END IF\r
+!\r
+!*       7.    Snow temperature\r
+!              ----------------\r
+!\r
+  IF (TPSNOW%SCHEME=='1-L') THEN\r
+    IF (IVERSION<7 .OR. IVERSION==7 .AND. IBUGFIX<3) THEN\r
+      YRECFM='TSNOW_'//HSURFTYPE\r
+    ELSE\r
+      YRECFM=ADJUSTL(HPREFIX//'TSN_'//HSURFTYPE)\r
+    ENDIF\r
+    CALL READ_SURF_FIELD3D(HPROGRAM,TPSNOW%T,1,TPSNOW%NLAYER,YRECFM,HDIR=YDIR)\r
+    DO JLAYER = 1,TPSNOW%NLAYER\r
+      WHERE (TPSNOW%WSNOW(:,1,:) == 0.0) TPSNOW%T(:,JLAYER,:) = XUNDEF\r
+    ENDDO\r
+  END IF\r
+!\r
+!*       8.    Heat content\r
+!              ------------\r
+!\r
+  IF (TPSNOW%SCHEME=='3-L' .OR. TPSNOW%SCHEME=='CRO') THEN\r
+    IF (IVERSION<7 .OR. IVERSION==7 .AND. IBUGFIX<3) THEN\r
+      YRECFM='HSNOW_'//HSURFTYPE\r
+    ELSE\r
+      YRECFM=ADJUSTL(HPREFIX//'HSN_'//HSURFTYPE)\r
+    ENDIF\r
+    CALL READ_SURF_FIELD3D(HPROGRAM,TPSNOW%HEAT,1,TPSNOW%NLAYER,YRECFM,HDIR=YDIR)\r
+    DO JLAYER = 1,TPSNOW%NLAYER\r
+      WHERE (TPSNOW%WSNOW(:,1,:) == 0.0) TPSNOW%HEAT(:,JLAYER,:) = XUNDEF\r
+    ENDDO\r
+  END IF\r
+!\r
+!*       9.    Snow Gran1\r
+!              ------------\r
+!\r
+  IF (TPSNOW%SCHEME=='CRO') THEN\r
+    IF (IVERSION<7 .OR. IVERSION==7 .AND. IBUGFIX<3) THEN\r
+      YRECFM='SGRAN1_'//HSURFTYPE\r
+    ELSE\r
+      YRECFM=ADJUSTL(HPREFIX//'SG1_'//HSURFTYPE)\r
+    ENDIF\r
+    CALL READ_SURF_FIELD3D(HPROGRAM,TPSNOW%GRAN1,1,TPSNOW%NLAYER,YRECFM,HDIR=YDIR)\r
+    DO JLAYER = 1,TPSNOW%NLAYER\r
+      WHERE (TPSNOW%WSNOW(:,1,:) == 0.0) TPSNOW%GRAN1(:,JLAYER,:) = XUNDEF\r
+    ENDDO\r
+  END IF\r
+!\r
+!*       10.    Snow Gran2\r
+!              ------------\r
+!\r
+  IF (TPSNOW%SCHEME=='CRO') THEN\r
+    IF (IVERSION<7 .OR. IVERSION==7 .AND. IBUGFIX<3) THEN\r
+      YRECFM='SGRAN2_'//HSURFTYPE\r
+    ELSE\r
+      YRECFM=ADJUSTL(HPREFIX//'SG2_'//HSURFTYPE)\r
+    ENDIF\r
+    CALL READ_SURF_FIELD3D(HPROGRAM,TPSNOW%GRAN2,1,TPSNOW%NLAYER,YRECFM,HDIR=YDIR)\r
+    DO JLAYER = 1,TPSNOW%NLAYER\r
+      WHERE (TPSNOW%WSNOW(:,1,:) == 0.0) TPSNOW%GRAN2(:,JLAYER,:) = XUNDEF\r
+    ENDDO\r
+  END IF\r
+!\r
+!*       11.    Historical parameter\r
+!              -------------------\r
+!\r
+  IF (TPSNOW%SCHEME=='CRO') THEN\r
+    IF (IVERSION<7 .OR. IVERSION==7 .AND. IBUGFIX<3) THEN\r
+      YRECFM='SHIST_'//HSURFTYPE\r
+    ELSE\r
+      YRECFM=ADJUSTL(HPREFIX//'SHI_'//HSURFTYPE)\r
+    ENDIF\r
+    CALL READ_SURF_FIELD3D(HPROGRAM,TPSNOW%HIST,1,TPSNOW%NLAYER,YRECFM,HDIR=YDIR)\r
+    DO JLAYER = 1,TPSNOW%NLAYER\r
+      WHERE (TPSNOW%WSNOW(:,1,:) == 0.0) TPSNOW%HIST(:,JLAYER,:) = XUNDEF\r
+    ENDDO\r
+  END IF\r
+!\r
+!*       12.    Age parameter\r
+!              -------------------\r
+!\r
+  IF (TPSNOW%SCHEME=='CRO') THEN\r
+    IF (IVERSION<7 .OR. IVERSION==7 .AND. IBUGFIX<3) THEN\r
+      YRECFM='SAGE_'//HSURFTYPE\r
+    ELSE\r
+      YRECFM=ADJUSTL(HPREFIX//'SAG_'//HSURFTYPE)\r
+    ENDIF\r
+    CALL READ_SURF_FIELD3D(HPROGRAM,TPSNOW%AGE,1,TPSNOW%NLAYER,YRECFM,HDIR=YDIR)\r
+    DO JLAYER = 1,TPSNOW%NLAYER\r
+      WHERE (TPSNOW%WSNOW(:,1,:) == 0.0) TPSNOW%AGE(:,JLAYER,:) = XUNDEF\r
+    ENDDO\r
+  END IF\r
+!-------------------------------------------------------------------------------\r
+!\r
+!\r
+DEALLOCATE(ZWORK)\r
+!-------------------------------------------------------------------------------\r
+!\r
+!*       13.    Albedo\r
+!              ------\r
+!\r
+IF (TPSNOW%SCHEME=='D95' .OR. TPSNOW%SCHEME=='EBA' .OR. TPSNOW%SCHEME=='1-L' .OR. TPSNOW%SCHEME=='3-L' &\r
+    .OR. TPSNOW%SCHEME=='CRO') THEN  \r
+\r
+  IF (IVERSION<7 .OR. IVERSION==7 .AND. IBUGFIX<3) THEN\r
+    YRECFM='ASNOW_'//HSURFTYPE\r
+  ELSE\r
+    YRECFM=ADJUSTL(HPREFIX//'ASN_'//HSURFTYPE)\r
+  ENDIF\r
+  CALL READ_SURF_FIELD2D(HPROGRAM,TPSNOW%ALB,YRECFM,HDIR=YDIR)\r
+  WHERE (TPSNOW%WSNOW(:,1,:) == 0.0) TPSNOW%ALB(:,:) = XUNDEF\r
+END IF\r
+IF (LHOOK) CALL DR_HOOK('READ_GR_SNOW',1,ZHOOK_HANDLE)\r
+!\r
+!-------------------------------------------------------------------------------\r
+!\r
+END SUBROUTINE READ_GR_SNOW\r
index 5fe79ab..9c84ca7 100644 (file)
-!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 \r
+!SURFEX_LIC This is part of the SURFEX software governed by the CeCILL-C  licence\r
+!SURFEX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt\r
+!SURFEX_LIC for details. version 1.\r
+!     #########\r
+      SUBROUTINE READ_ISBA_n(HPROGRAM)\r
+!     ##################################\r
+!\r
+!!****  *READ_ISBA_n* - routine to initialise ISBA variables\r
+!!                         \r
+!!\r
+!!    PURPOSE\r
+!!    -------\r
+!!\r
+!!**  METHOD\r
+!!    ------\r
+!!\r
+!!    EXTERNAL\r
+!!    --------\r
+!!\r
+!!\r
+!!    IMPLICIT ARGUMENTS\r
+!!    ------------------\r
+!!\r
+!!    REFERENCE\r
+!!    ---------\r
+!!\r
+!!\r
+!!    AUTHOR\r
+!!    ------\r
+!!     V. Masson   *Meteo France*      \r
+!!\r
+!!    MODIFICATIONS\r
+!!    -------------\r
+!!      Original    01/2003\r
+!!\r
+!!      READ_SURF for general reading : 08/2003 (S.Malardel)\r
+!!      B. Decharme  2008    : Floodplains\r
+!!      B. Decharme  01/2009 : Optional Arpege deep soil temperature read\r
+!!      A.L. Gibelin   03/09 : modifications for CENTURY model \r
+!!      A.L. Gibelin    04/2009 : BIOMASS and RESP_BIOMASS arrays \r
+!!      A.L. Gibelin    06/2009 : Soil carbon variables for CNT option\r
+!!      B. Decharme  09/2012 : suppress NWG_LAYER (parallelization problems)\r
+!!     M.Moge    01/2016  using READ_SURF_FIELD2D/3D for 2D/3D surfex fields reads\r
+!!\r
+!-------------------------------------------------------------------------------\r
+!\r
+!*       0.    DECLARATIONS\r
+!              ------------\r
+!\r
+!\r
+USE MODD_CO2V_PAR,       ONLY : XANFMINIT, XCONDCTMIN\r
+USE MODD_ISBA_n,         ONLY : NGROUND_LAYER, NPATCH, NNBIOMASS,   &\r
+                                  NNLITTER, NNLITTLEVS, NNSOILCARB,   &\r
+                                  CPHOTO, CRESPSL, XTSRAD_NAT,        &\r
+                                  XTG, XWG, XWGI, XWR, XLAI, TSNOW,   &\r
+                                  XRESA, XANFM, XAN, XLE, XANDAY,     &\r
+                                  XBSLAI, XBIOMASS, XRESP_BIOMASS,    &\r
+                                  XLITTER, XSOILCARB, XLIGNIN_STRUC,  &\r
+                                  LFLOOD, XZ0_FLOOD, LTEMP_ARP,       &\r
+                                  NTEMPLAYER_ARP, LGLACIER, XICE_STO  \r
+!                                \r
+USE MODD_SURF_PAR,       ONLY : XUNDEF, NUNDEF\r
+USE MODD_SNOW_PAR,       ONLY : XZ0SN\r
+!\r
+USE MODI_READ_SURF\r
+USE MODI_READ_SURF_FIELD3D\r
+USE MODI_READ_SURF_FIELD2D\r
+!\r
+USE MODI_READ_GR_SNOW\r
+!\r
+USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK\r
+USE PARKIND1  ,ONLY : JPRB\r
+!\r
+USE MODI_GET_TYPE_DIM_n\r
+!\r
+IMPLICIT NONE\r
+!\r
+!*       0.1   Declarations of arguments\r
+!              -------------------------\r
+!\r
+ CHARACTER(LEN=6),  INTENT(IN)  :: HPROGRAM ! calling program\r
+!\r
+!*       0.2   Declarations of local variables\r
+!              -------------------------------\r
+INTEGER           :: ILU          ! 1D physical dimension\r
+!\r
+INTEGER           :: IRESP          ! Error code after redding\r
+!\r
+ CHARACTER(LEN=12) :: YRECFM         ! Name of the article to be read\r
+!\r
+ CHARACTER(LEN=4)  :: YLVL\r
+ CHARACTER(LEN=8)  :: YPATCH\r
+!\r
+REAL, DIMENSION(:,:),ALLOCATABLE  :: ZWORK      ! 2D array to write data in file\r
+!\r
+INTEGER :: IWORK   ! Work integer\r
+!\r
+INTEGER :: JP, JL, JNBIOMASS, JNLITTER, JNSOILCARB, JNLITTLEVS  ! loop counter on layers\r
+!\r
+INTEGER           :: IVERSION       ! surface version\r
+INTEGER           :: IBUGFIX\r
+!\r
+REAL(KIND=JPRB) :: ZHOOK_HANDLE\r
+!\r
+!-------------------------------------------------------------------------------\r
+!\r
+!\r
+!* 1D physical dimension\r
+!\r
+IF (LHOOK) CALL DR_HOOK('READ_ISBA_N',0,ZHOOK_HANDLE)\r
+YRECFM='SIZE_NATURE'\r
+ CALL GET_TYPE_DIM_n('NATURE',ILU)\r
+!\r
+!\r
+!*       2.     Prognostic fields:\r
+!               -----------------\r
+!\r
+ALLOCATE(ZWORK(ILU,NPATCH))\r
+!* soil temperatures\r
+!\r
+IF(LTEMP_ARP)THEN\r
+  IWORK=NTEMPLAYER_ARP\r
+ELSE\r
+  IWORK=NGROUND_LAYER\r
+ENDIF\r
+!\r
+ALLOCATE(XTG(ILU,IWORK,NPATCH))\r
+!\r
+YRECFM='TG'\r
+CALL READ_SURF_FIELD3D(HPROGRAM,XTG,1,IWORK,YRECFM)\r
+!\r
+!\r
+!* soil liquid and ice water contents\r
+!\r
+ALLOCATE(XWG (ILU,NGROUND_LAYER,NPATCH))\r
+ALLOCATE(XWGI(ILU,NGROUND_LAYER,NPATCH))\r
+!\r
+XWG (:,:,:)=XUNDEF\r
+XWGI(:,:,:)=XUNDEF\r
+!\r
+YRECFM='WG'\r
+CALL READ_SURF_FIELD3D(HPROGRAM,XWG,1,NGROUND_LAYER,YRECFM)\r
+!\r
+YRECFM='WGI'\r
+CALL READ_SURF_FIELD3D(HPROGRAM,XWGI,1,NGROUND_LAYER,YRECFM)\r
+!\r
+!* water intercepted on leaves\r
+!\r
+ALLOCATE(XWR(ILU,NPATCH))\r
+!\r
+YRECFM='WR'\r
+CALL READ_SURF_FIELD2D(HPROGRAM,XWR,YRECFM)\r
+!\r
+!* roughness length of Flood water\r
+!\r
+IF(LFLOOD)THEN\r
+  ALLOCATE(XZ0_FLOOD(ILU,NPATCH))\r
+  YRECFM = 'Z0_FLOOD'\r
+  CALL READ_SURF_FIELD2D(HPROGRAM,XZ0_FLOOD,YRECFM)\r
+ENDIF\r
+!\r
+!* Leaf Area Index\r
+!\r
+IF (CPHOTO=='LAI' .OR. CPHOTO=='LST' .OR. CPHOTO=='NIT' .OR. CPHOTO=='NCB') THEN\r
+  YRECFM = 'LAI'\r
+  CALL READ_SURF_FIELD2D(HPROGRAM,XLAI,YRECFM)\r
+END IF\r
+!\r
+!* snow mantel\r
+!\r
+ CALL READ_GR_SNOW(HPROGRAM,'VEG','     ',ILU,NPATCH,TSNOW  )\r
+!\r
+YRECFM='VERSION'\r
+ CALL READ_SURF(HPROGRAM,YRECFM,IVERSION,IRESP)\r
+!\r
+YRECFM='BUG'\r
+ CALL READ_SURF(HPROGRAM,YRECFM,IBUGFIX,IRESP)\r
+!\r
+IF(LGLACIER)THEN\r
+  ALLOCATE(XICE_STO(ILU,NPATCH))\r
+  IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=2) THEN\r
+    YRECFM = 'ICE_STO'\r
+    CALL READ_SURF_FIELD2D(HPROGRAM,XICE_STO,YRECFM)\r
+  ELSE\r
+    XICE_STO(:,:) = 0.0\r
+  ENDIF\r
+ENDIF\r
+!\r
+!-------------------------------------------------------------------------------\r
+!\r
+!*       4.  Semi-prognostic variables\r
+!            -------------------------\r
+!\r
+ALLOCATE(XRESA(ILU,NPATCH))\r
+ALLOCATE(XLE  (ILU,NPATCH))\r
+IF (CPHOTO/='NON') THEN\r
+  ALLOCATE(XANFM  (ILU,NPATCH))\r
+  ALLOCATE(XAN    (ILU,NPATCH))\r
+  ALLOCATE(XANDAY (ILU,NPATCH))\r
+END IF\r
+!\r
+IF(CPHOTO/='NON') THEN\r
+  ALLOCATE(XBIOMASS         (ILU,NNBIOMASS,NPATCH))\r
+  ALLOCATE(XRESP_BIOMASS    (ILU,NNBIOMASS,NPATCH))\r
+END IF\r
+!\r
+!\r
+!* aerodynamical resistance\r
+!\r
+YRECFM = 'RESA'\r
+XRESA(:,:) = 100.\r
+CALL READ_SURF_FIELD2D(HPROGRAM,XRESA,YRECFM)\r
+!\r
+!* patch averaged radiative temperature (K)\r
+!\r
+ALLOCATE(XTSRAD_NAT(ILU))\r
+IF (IVERSION<6) THEN\r
+  XTSRAD_NAT(:)=0.\r
+  DO JP=1,NPATCH\r
+    XTSRAD_NAT(:)=XTSRAD_NAT(:)+XTG(:,1,JP)\r
+  ENDDO\r
+  XTSRAD_NAT(:)=XTSRAD_NAT(:)/NPATCH\r
+ELSE\r
+  YRECFM='TSRAD_NAT'\r
+  CALL READ_SURF(HPROGRAM,YRECFM,XTSRAD_NAT(:),IRESP)\r
+ENDIF\r
+!\r
+XLE(:,:) = XUNDEF\r
+!\r
+!*       5. ISBA-AGS variables\r
+!\r
+IF (CPHOTO/='NON') THEN\r
+  YRECFM = 'AN'\r
+  XAN(:,:) = 0.\r
+  CALL READ_SURF_FIELD2D(HPROGRAM,XAN,YRECFM)\r
+  !\r
+  YRECFM = 'ANDAY'\r
+  XANDAY(:,:) = 0.\r
+  CALL READ_SURF_FIELD2D(HPROGRAM,XANDAY,YRECFM)\r
+  !\r
+  YRECFM = 'ANFM'\r
+  XANFM(:,:) = XANFMINIT\r
+  CALL READ_SURF_FIELD2D(HPROGRAM,XANFM,YRECFM)\r
+  !\r
+  YRECFM = 'LE_AGS'\r
+  XLE(:,:) = 0.\r
+  CALL READ_SURF_FIELD2D(HPROGRAM,XLE,YRECFM)\r
+END IF\r
+!\r
+IF (CPHOTO=='AGS' .OR. CPHOTO=='AST') THEN\r
+  !\r
+  XBIOMASS(:,:,:) = 0.\r
+  XRESP_BIOMASS(:,:,:) = 0.\r
+\r
+ELSEIF (CPHOTO=='LAI' .OR. CPHOTO=='LST') THEN\r
+  !\r
+  XBIOMASS(:,1,:) = XBSLAI(:,:) * XLAI(:,:)\r
+  XRESP_BIOMASS(:,:,:) = 0.\r
+\r
+ELSEIF (CPHOTO=='NIT') THEN\r
+  !\r
+  XBIOMASS(:,:,:) = 0.\r
+  IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) THEN\r
+    YRECFM='BIOMA'\r
+  ELSE\r
+    YRECFM='BIOMASS'\r
+  ENDIF\r
+  CALL READ_SURF_FIELD3D(HPROGRAM,XBIOMASS,1,NNBIOMASS,YRECFM)\r
+  !\r
+  XRESP_BIOMASS(:,:,:) = 0.\r
+  IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) THEN\r
+    YRECFM='RESPI'\r
+  ELSE\r
+    YRECFM='RESP_BIOM'\r
+  ENDIF\r
+  CALL READ_SURF_FIELD3D(HPROGRAM,XRESP_BIOMASS,2,NNBIOMASS,YRECFM)\r
+  !\r
+ELSEIF (CPHOTO=='NCB') THEN\r
+  !\r
+  XBIOMASS(:,:,:) = 0.\r
+  IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) THEN\r
+    YRECFM='BIOMA'\r
+  ELSE\r
+    YRECFM='BIOMASS'\r
+  ENDIF\r
+  CALL READ_SURF_FIELD3D(HPROGRAM,XBIOMASS,1,NNBIOMASS,YRECFM)\r
+  !\r
+  XRESP_BIOMASS(:,:,:) = 0.\r
+  IF (IVERSION>7 .OR. IVERSION==7 .AND. IBUGFIX>=3) THEN\r
+    YRECFM='RESPI'\r
+  ELSE\r
+    YRECFM='RESP_BIOM'\r
+  ENDIF\r
+  CALL READ_SURF_FIELD3D(HPROGRAM,XRESP_BIOMASS,2,NNBIOMASS-2,YRECFM)\r
+  !\r
+ENDIF\r
+!\r
+!*       6. Soil carbon\r
+!\r
+!\r
+IF (CRESPSL=='CNT') THEN\r
+  ALLOCATE(XLITTER          (ILU,NNLITTER,NNLITTLEVS,NPATCH))\r
+  ALLOCATE(XSOILCARB        (ILU,NNSOILCARB,NPATCH))\r
+  ALLOCATE(XLIGNIN_STRUC    (ILU,NNLITTLEVS,NPATCH))\r
+END IF\r
+!\r
+IF (CRESPSL=='CNT') THEN\r
+  !\r
+  XLITTER(:,:,:,:) = 0.\r
+  DO JNLITTER=1,NNLITTER\r
+    DO JNLITTLEVS=1,NNLITTLEVS\r
+      WRITE(YLVL,'(I1,A1,I1)') JNLITTER,'_',JNLITTLEVS\r
+      YRECFM='LITTER'//ADJUSTL(YLVL(:LEN_TRIM(YLVL)))\r
+      CALL READ_SURF_FIELD2D(HPROGRAM,ZWORK(:,:),YRECFM)\r
+      XLITTER(:,JNLITTER,JNLITTLEVS,:)=ZWORK\r
+    END DO\r
+  END DO\r
+\r
+  XSOILCARB(:,:,:) = 0.\r
+  YRECFM='SOILCARB'\r
+  CALL READ_SURF_FIELD3D(HPROGRAM,XSOILCARB,1,NNSOILCARB,YRECFM)\r
+!\r
+  XLIGNIN_STRUC(:,:,:) = 0.\r
+  YRECFM='LIGNIN_STR'\r
+  CALL READ_SURF_FIELD3D(HPROGRAM,XLIGNIN_STRUC,1,NNLITTLEVS,YRECFM)\r
+!\r
+ENDIF\r
+!\r
+!\r
+DEALLOCATE(ZWORK)\r
+IF (LHOOK) CALL DR_HOOK('READ_ISBA_N',1,ZHOOK_HANDLE)\r
+!\r
+!-------------------------------------------------------------------------------\r
+!\r
+END SUBROUTINE READ_ISBA_n\r
index c7a4971..1c70cab 100644 (file)
-!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 \r
+!SURFEX_LIC This is part of the SURFEX software governed by the CeCILL-C  licence\r
+!SURFEX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt\r
+!SURFEX_LIC for details. version 1.\r
+!     #########\r
+      SUBROUTINE READ_PGD_ISBA_PAR_n(HPROGRAM,KSIZE,OLAND_USE,HDIR)\r
+!     ################################################\r
+!\r
+!!****  *READ_PGD_ISBA_PAR_n* - reads ISBA physiographic fields                     \r
+!!\r
+!!    PURPOSE\r
+!!    -------\r
+!!\r
+!!**  METHOD\r
+!!    ------\r
+!!\r
+!!    EXTERNAL\r
+!!    --------\r
+!!\r
+!!\r
+!!    IMPLICIT ARGUMENTS\r
+!!    ------------------\r
+!!\r
+!!    REFERENCE\r
+!!    ---------\r
+!!\r
+!!\r
+!!    AUTHOR\r
+!!    ------\r
+!!     V. Masson   *Meteo France*      \r
+!!\r
+!!    MODIFICATIONS\r
+!!    -------------\r
+!!      Original    01/2003 \r
+!!      P. Le Moigne 12/2004 : add type of photosynthesis \r
+!!      M.Moge    01/2016  using READ_SURF_FIELD2D/3D for 2D/3D surfex fields reads\r
+!-------------------------------------------------------------------------------\r
+!\r
+!*       0.    DECLARATIONS\r
+!              ------------\r
+!\r
+USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE\r
+USE MODD_PREP,           ONLY : LINTERP\r
+!\r
+USE MODD_ISBA_GRID_n,    ONLY : NDIM\r
+USE MODD_ISBA_n,         ONLY : LECOCLIMAP, NGROUND_LAYER\r
+USE MODD_DATA_ISBA_n,    ONLY : NTIME, XPAR_VEG, XPAR_LAI,XPAR_RSMIN,XPAR_GAMMA,XPAR_WRMAX_CF, &\r
+                                XPAR_RGL,XPAR_CV,XPAR_DG,XPAR_Z0,XPAR_Z0_O_Z0H,         &\r
+                                XPAR_ALBNIR_VEG,XPAR_ALBVIS_VEG, XPAR_ALBUV_VEG,          &\r
+                                XPAR_ALBNIR_SOIL,XPAR_ALBVIS_SOIL, XPAR_ALBUV_SOIL,       &\r
+                                XPAR_EMIS, XPAR_DICE,                                      &\r
+                                XPAR_VEGTYPE,XPAR_ROOTFRAC,                                &\r
+                                XPAR_GMES,XPAR_BSLAI,XPAR_LAIMIN,XPAR_SEFOLD,XPAR_GC,   &\r
+                                XPAR_DMAX, XPAR_F2I, LPAR_STRESS, XPAR_H_TREE,XPAR_RE25,&\r
+                                XPAR_CE_NITRO,XPAR_CF_NITRO,XPAR_CNA_NITRO, &\r
+                                XPAR_GROUND_DEPTH, XPAR_ROOT_DEPTH,               &\r
+                                XPAR_ROOT_EXTINCTION, XPAR_ROOT_LIN,              &\r
+                                LPAR_STRESS, XPAR_IRRIG, XPAR_WATSUP, &\r
+                                LDATA_VEGTYPE, LDATA_LAI, LDATA_H_TREE, LDATA_DG, LDATA_ROOTFRAC,&  \r
+                                LDATA_VEG, LDATA_Z0, LDATA_EMIS, LDATA_DICE, &\r
+                                LDATA_RSMIN, LDATA_GAMMA, LDATA_WRMAX_CF, LDATA_RGL, &\r
+                                LDATA_CV, LDATA_Z0_O_Z0H, &\r
+                                LDATA_ALBNIR_VEG, LDATA_ALBVIS_VEG, LDATA_ALBUV_VEG, &\r
+                                LDATA_ALBVIS_SOIL, LDATA_ALBNIR_SOIL, LDATA_ALBUV_SOIL, &\r
+                                LDATA_GMES, LDATA_BSLAI, LDATA_SEFOLD, LDATA_GC, LDATA_DMAX, &\r
+                                LDATA_RE25, LDATA_LAIMIN, LDATA_F2I, &\r
+                                LDATA_CE_NITRO,LDATA_CF_NITRO, LDATA_CNA_NITRO,&\r
+                                LDATA_STRESS, LDATA_IRRIG, LDATA_WATSUP  ,&\r
+                                LDATA_GROUND_DEPTH, LDATA_ROOT_DEPTH,             &\r
+                                LDATA_ROOT_EXTINCTION, LDATA_ROOT_LIN, LDATA_MIXPAR\r
+!\r
+USE MODI_GET_LUOUT\r
+USE MODI_READ_SURF\r
+USE MODI_READ_SURF_FIELD2D\r
+USE MODI_HOR_INTERPOL\r
+USE MODI_READ_SURF_ISBA_PAR_n\r
+!\r
+USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK\r
+USE PARKIND1  ,ONLY : JPRB\r
+!\r
+IMPLICIT NONE\r
+!\r
+!*       0.1   Declarations of arguments\r
+!              -------------------------\r
+!\r
+ CHARACTER(LEN=6),  INTENT(IN)  :: HPROGRAM ! program calling\r
+INTEGER,           INTENT(IN)  :: KSIZE\r
+LOGICAL,           INTENT(IN)  :: OLAND_USE ! \r
+ CHARACTER(LEN=1),OPTIONAL,INTENT(IN)  :: HDIR       ! type of field :\r
+!                                                   ! 'H' : field with\r
+!                                                   !       horizontal spatial dim.\r
+!                                                   ! '-' : no horizontal dim.\r
+!\r
+!*       0.2   Declarations of local variables\r
+!              -------------------------------\r
+!\r
+REAL, DIMENSION(KSIZE,NVEGTYPE) :: ZFIELD\r
+REAL,    DIMENSION(:,:), ALLOCATABLE :: ZWORK\r
+INTEGER           :: ILUOUT\r
+INTEGER           :: ITIME\r
+INTEGER           :: IRESP          ! IRESP  : return-code if a problem appears\r
+ CHARACTER(LEN=12) :: YRECFM         ! Name of the article to be read\r
+ CHARACTER(LEN=16) :: YRECFM2\r
+ CHARACTER(LEN=100):: YCOMMENT       ! Comment string\r
+ CHARACTER(LEN=1)  :: YDIR\r
+INTEGER           :: JTIME          ! loop index\r
+INTEGER           :: JLAYER         ! loop index\r
+INTEGER           :: JPATCH         ! loop index\r
+INTEGER           :: IVERSION       ! surface version\r
+INTEGER           :: IBUGFIX\r
+REAL(KIND=JPRB) :: ZHOOK_HANDLE\r
+!\r
+!\r
+!-------------------------------------------------------------------------------\r
+!\r
+IF (LHOOK) CALL DR_HOOK('READ_PGD_ISBA_PAR_N',0,ZHOOK_HANDLE)\r
+!\r
+ CALL GET_LUOUT(HPROGRAM,ILUOUT)\r
+!\r
+YDIR = 'H'\r
+IF (PRESENT(HDIR)) YDIR = HDIR\r
+!\r
+YRECFM='VERSION'\r
+ CALL READ_SURF(HPROGRAM,YRECFM,IVERSION,IRESP)\r
+WRITE(ILUOUT,*) 'read version ',IVERSION\r
+!\r
+YRECFM='BUG'\r
+ CALL READ_SURF(HPROGRAM,YRECFM,IBUGFIX,IRESP)\r
+!\r
+LDATA_MIXPAR = .FALSE. \r
+!\r
+IF (IVERSION<7 .AND. .NOT.LECOCLIMAP) THEN\r
+  !\r
+  LDATA_VEGTYPE=.TRUE.\r
+  LDATA_VEG=.TRUE.\r
+  LDATA_LAI=.TRUE.\r
+  LDATA_Z0=.TRUE.\r
+  LDATA_EMIS=.TRUE.\r
+  LDATA_RSMIN=.TRUE.\r
+  LDATA_GAMMA=.TRUE.\r
+  LDATA_WRMAX_CF=.TRUE.\r
+  LDATA_RGL=.TRUE.\r
+  LDATA_CV=.TRUE.\r
+  LDATA_Z0_O_Z0H=.TRUE.\r
+  LDATA_DG=.TRUE.\r
+  LDATA_ROOTFRAC=.TRUE.\r
+  !\r
+  LDATA_DICE=.FALSE.\r
+  LDATA_GROUND_DEPTH=.FALSE.\r
+  LDATA_ROOT_DEPTH=.FALSE.\r
+  LDATA_ROOT_LIN=.FALSE.\r
+  LDATA_ROOT_EXTINCTION=.FALSE.  \r
+  !\r
+  LDATA_ALBNIR_VEG=.TRUE.\r
+  LDATA_ALBVIS_VEG=.TRUE.\r
+  LDATA_ALBUV_VEG=.TRUE.\r
+  LDATA_ALBNIR_SOIL=.TRUE.\r
+  LDATA_ALBVIS_SOIL=.TRUE.\r
+  LDATA_ALBUV_SOIL=.TRUE.\r
+  LDATA_GMES=.TRUE.\r
+  LDATA_BSLAI=.TRUE.\r
+  LDATA_LAIMIN=.TRUE.\r
+  LDATA_SEFOLD=.TRUE.\r
+  LDATA_GC=.TRUE.\r
+  LDATA_DMAX=.TRUE.\r
+  LDATA_F2I=.TRUE.\r
+  LDATA_STRESS=.TRUE.\r
+  LDATA_H_TREE=.TRUE.\r
+  LDATA_RE25=.TRUE.\r
+  LDATA_CE_NITRO=.TRUE.\r
+  LDATA_CF_NITRO=.TRUE.\r
+  LDATA_CNA_NITRO=.TRUE.\r
+  !\r
+  LDATA_IRRIG=.FALSE.\r
+  LDATA_WATSUP=.FALSE.\r
+  !\r
+ENDIF\r
+!\r
+IF (.NOT.OLAND_USE) THEN\r
+  !\r
+  IF (IVERSION>=7) THEN\r
+    !\r
+    YRECFM='L_VEGTYPE'\r
+    YCOMMENT=YRECFM\r
+    CALL READ_SURF(HPROGRAM,YRECFM,LDATA_VEGTYPE,IRESP,HCOMMENT=YCOMMENT)\r
+    IF (LDATA_VEGTYPE) LDATA_MIXPAR = .TRUE.\r
+    !\r
+    YRECFM='L_VEG'\r
+    YCOMMENT=YRECFM\r
+    CALL READ_SURF(HPROGRAM,YRECFM,LDATA_VEG,IRESP,HCOMMENT=YCOMMENT)\r
+    IF (LDATA_VEG) LDATA_MIXPAR = .TRUE.\r
+    YRECFM='L_LAI'\r
+    YCOMMENT=YRECFM\r
+    CALL READ_SURF(HPROGRAM,YRECFM,LDATA_LAI,IRESP,HCOMMENT=YCOMMENT)\r
+    IF (LDATA_LAI) LDATA_MIXPAR = .TRUE.\r
+    YRECFM='L_Z0'\r
+    YCOMMENT=YRECFM\r
+    CALL READ_SURF(HPROGRAM,YRECFM,LDATA_Z0,IRESP,HCOMMENT=YCOMMENT)\r
+    IF (LDATA_Z0) LDATA_MIXPAR = .TRUE.\r
+    YRECFM='L_EMIS'\r
+    YCOMMENT=YRECFM\r
+    CALL READ_SURF(HPROGRAM,YRECFM,LDATA_EMIS,IRESP,HCOMMENT=YCOMMENT)\r
+    IF (LDATA_EMIS) LDATA_MIXPAR = .TRUE.\r
+    !\r
+    YRECFM='L_RSMIN'\r
+    YCOMMENT=YRECFM\r
+    CALL READ_SURF(HPROGRAM,YRECFM,LDATA_RSMIN,IRESP,HCOMMENT=YCOMMENT)\r
+    IF (LDATA_RSMIN) LDATA_MIXPAR = .TRUE.\r
+    YRECFM='L_GAMMA'\r
+    YCOMMENT=YRECFM\r
+    CALL READ_SURF(HPROGRAM,YRECFM,LDATA_GAMMA,IRESP,HCOMMENT=YCOMMENT)\r
+    IF (LDATA_GAMMA) LDATA_MIXPAR = .TRUE.\r
+    YRECFM='L_WRMAX_CF'\r
+    YCOMMENT=YRECFM\r
+    CALL READ_SURF(HPROGRAM,YRECFM,LDATA_WRMAX_CF,IRESP,HCOMMENT=YCOMMENT)\r
+    IF (LDATA_WRMAX_CF) LDATA_MIXPAR = .TRUE.\r
+    YRECFM='L_RGL'\r
+    YCOMMENT=YRECFM\r
+    CALL READ_SURF(HPROGRAM,YRECFM,LDATA_RGL,IRESP,HCOMMENT=YCOMMENT)\r
+    IF (LDATA_RGL) LDATA_MIXPAR = .TRUE.\r
+    YRECFM='L_CV'\r
+    YCOMMENT=YRECFM\r
+    CALL READ_SURF(HPROGRAM,YRECFM,LDATA_CV,IRESP,HCOMMENT=YCOMMENT)\r
+    IF (LDATA_CV) LDATA_MIXPAR = .TRUE.\r
+    YRECFM='L_Z0_O_Z0H'\r
+    YCOMMENT=YRECFM\r
+    CALL READ_SURF(HPROGRAM,YRECFM,LDATA_Z0_O_Z0H,IRESP,HCOMMENT=YCOMMENT)\r
+    IF (LDATA_Z0_O_Z0H) LDATA_MIXPAR = .TRUE.\r
+    YRECFM='L_DG'\r
+    YCOMMENT=YRECFM\r
+    CALL READ_SURF(HPROGRAM,YRECFM,LDATA_DG,IRESP,HCOMMENT=YCOMMENT)\r
+    IF (LDATA_DG) LDATA_MIXPAR = .TRUE.\r
+    YRECFM='L_ROOTFRAC'\r
+    YCOMMENT=YRECFM\r
+    CALL READ_SURF(HPROGRAM,YRECFM,LDATA_ROOTFRAC,IRESP,HCOMMENT=YCOMMENT)\r
+    IF (LDATA_ROOTFRAC) LDATA_MIXPAR = .TRUE.\r
+    YRECFM='L_DICE'\r
+    YCOMMENT=YRECFM\r
+    CALL READ_SURF(HPROGRAM,YRECFM,LDATA_DICE,IRESP,HCOMMENT=YCOMMENT)\r
+    IF (LDATA_DICE) LDATA_MIXPAR = .TRUE.\r
+    !\r
+    IF (IBUGFIX>=2) THEN\r
+      YRECFM2='L_GROUND_DEPTH'\r
+      IF (IBUGFIX>=3) YRECFM2='L_GROUND_DPT'\r
+      YCOMMENT=YRECFM\r
+      CALL READ_SURF(HPROGRAM,YRECFM2,LDATA_GROUND_DEPTH,IRESP,HCOMMENT=YCOMMENT)\r
+      IF (LDATA_GROUND_DEPTH) LDATA_MIXPAR = .TRUE.\r
+      YRECFM='L_ROOT_DEPTH'\r
+ &nbs