init_from_data_grdnn.F90

Go to the documentation of this file.

!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt  
!SFX_LIC for details. version 1.
!     #########
      SUBROUTINE init_from_data_grdn_n (DTGD, &
                                        kdecade, hphoto,                               &
                                               pveg,                                  &
                                               plai,prsmin,pgamma,pwrmax_cf,          &
                                               prgl,pcv,pdg,pd_ice,pz0,pz0_o_z0h,     &
                                               palbnir_veg,palbvis_veg,palbuv_veg,    &
                                               pemis,                                 &
                                               pvegtype,prootfrac,                    &
                                               pgmes,pbslai,plaimin,psefold,pgc,      &
                                               pdmax, pf2i, ostress,                  &
                                               ph_tree, pre25,                        &
                                               pce_nitro, pcf_nitro, pcna_nitro,      &
                                               palbnir_soil,palbvis_soil,palbuv_soil  )  
!     ##############################################################
!
!!**** *CONVERT_COVER* convert surface cover classes into secondary 
!!                     physiographic variables for ISBA
!!
!!    PURPOSE
!!    -------
!!
!!    METHOD
!!    ------
!!   
!!    EXTERNAL
!!    --------
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    REFERENCE
!!    ---------
!!
!!    AUTHOR
!!    ------
!!
!!    V. Masson        Meteo-France
!!
!!    MODIFICATION
!!    ------------
!!
!!    Original   01/2004
!     
!!      P Le Moigne 09/2005 AGS modifs of L. Jarlan
!----------------------------------------------------------------------------
!
!*    0.     DECLARATION
!            -----------
!

!
!
!
USE modd_data_teb_garden_n, ONLY : data_teb_garden_t
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*    0.1    Declaration of arguments
!            ------------------------
!
!
TYPE(data_teb_garden_t), INTENT(INOUT) :: dtgd
!
INTEGER,                INTENT(IN)    :: kdecade
 CHARACTER(LEN=*),       INTENT(IN)    :: hphoto  ! type of photosynthesis
!
REAL, DIMENSION(:),   OPTIONAL, INTENT(OUT)   :: pveg
REAL, DIMENSION(:),   OPTIONAL, INTENT(OUT)   :: plai
REAL, DIMENSION(:),   OPTIONAL, INTENT(OUT)   :: prsmin
REAL, DIMENSION(:),   OPTIONAL, INTENT(OUT)   :: pgamma
REAL, DIMENSION(:),   OPTIONAL, INTENT(OUT)   :: pwrmax_cf
REAL, DIMENSION(:),   OPTIONAL, INTENT(OUT)   :: prgl
REAL, DIMENSION(:),   OPTIONAL, INTENT(OUT)   :: pcv
REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT)   :: pdg
REAL, DIMENSION(:),   OPTIONAL, INTENT(OUT)   :: pd_ice
REAL, DIMENSION(:,:), OPTIONAL, INTENT(OUT)   :: prootfrac
REAL, DIMENSION(:),   OPTIONAL, INTENT(OUT)   :: pz0
REAL, DIMENSION(:),   OPTIONAL, INTENT(OUT)   :: pz0_o_z0h
REAL, DIMENSION(:),   OPTIONAL, INTENT(OUT)   :: palbnir_veg
REAL, DIMENSION(:),   OPTIONAL, INTENT(OUT)   :: palbvis_veg
REAL, DIMENSION(:),   OPTIONAL, INTENT(OUT)   :: palbuv_veg
REAL, DIMENSION(:),   OPTIONAL, INTENT(OUT)   :: pemis
!
REAL, DIMENSION(:,:),   OPTIONAL, INTENT(OUT)   :: pvegtype
!
REAL, DIMENSION(:),   OPTIONAL, INTENT(OUT)   :: pgmes
REAL, DIMENSION(:),   OPTIONAL, INTENT(OUT)   :: pre25
REAL, DIMENSION(:),   OPTIONAL, INTENT(OUT)   :: pbslai
REAL, DIMENSION(:),   OPTIONAL, INTENT(OUT)   :: plaimin
REAL, DIMENSION(:),   OPTIONAL, INTENT(OUT)   :: psefold
REAL, DIMENSION(:),   OPTIONAL, INTENT(OUT)   :: pgc
REAL, DIMENSION(:),   OPTIONAL, INTENT(OUT)   :: pdmax
REAL, DIMENSION(:),   OPTIONAL, INTENT(OUT)   :: pf2i
LOGICAL, DIMENSION(:),OPTIONAL, INTENT(OUT)   :: ostress
!
REAL, DIMENSION(:),   OPTIONAL, INTENT(OUT)   :: ph_tree
!
REAL, DIMENSION(:),   OPTIONAL, INTENT(OUT)   :: pce_nitro
REAL, DIMENSION(:),   OPTIONAL, INTENT(OUT)   :: pcf_nitro
REAL, DIMENSION(:),   OPTIONAL, INTENT(OUT)   :: pcna_nitro
REAL, DIMENSION(:),   OPTIONAL, INTENT(OUT)   :: palbnir_soil
REAL, DIMENSION(:),   OPTIONAL, INTENT(OUT)   :: palbvis_soil
REAL, DIMENSION(:),   OPTIONAL, INTENT(OUT)   :: palbuv_soil
!
!*    0.2    Declaration of local variables
!            ------------------------------
!
INTEGER :: itime
INTEGER :: iluout
REAL(KIND=JPRB) :: zhook_handle
!-------------------------------------------------------------------------------
!
!*    1.      TIME INITIALIZATION
!             -------------------
!
! data every month
IF (lhook) CALL dr_hook('INIT_FROM_DATA_GRDN_N',0,zhook_handle)
IF (dtgd%NTIME==12) THEN
  itime = (kdecade+2)/3    
ELSEIF (dtgd%NTIME==1) THEN
  itime = 1
ENDIF
!
!*    2.      SECONDARY VARIABLES
!             -------------------
!
!*    2.1     fields on natural surfaces only, taking into account patches/ 
!             -------------------------------
!
!
IF (present(ph_tree)) THEN
  IF (SIZE(ph_tree)>0) ph_tree = dtgd%XDATA_H_TREE
ENDIF
!
IF (present(pvegtype)) pvegtype = dtgd%XDATA_VEGTYPE
!
! vegetation fraction
! -------------------
!
IF (present(pveg)) pveg(:) =  dtgd%XDATA_VEG (:,itime)
!
! Leaf Aera Index
! ---------------
!
IF (present(plai)) plai(:) = dtgd%XDATA_LAI (:,itime)
!
! roughness length
! ----------------
!
IF (present(pz0)) pz0(:) =  dtgd%XDATA_Z0 (:,itime)
!
IF (present(pz0_o_z0h)) pz0_o_z0h = dtgd%XDATA_Z0_O_Z0H
!
!
!emis-eco
!--------
!
IF (present(pemis)) pemis(:) =  dtgd%XDATA_EMIS (:,itime)
! 
!---------------------------------------------------------------------------------
! 
!* 1/Rsmin
!
IF (present(prsmin)) THEN
  IF (SIZE(prsmin)>0) prsmin = dtgd%XDATA_RSMIN
END IF
!
!* other vegetation parameters
!
IF (present(pgamma)) pgamma = dtgd%XDATA_GAMMA
IF (present(pwrmax_cf)) pwrmax_cf = dtgd%XDATA_WRMAX_CF
!
!
IF (present(prgl)) prgl = dtgd%XDATA_RGL
IF (present(pcv)) pcv = dtgd%XDATA_CV
!
!---------------------------------------------------------------------------------
!
!* soil layers
!  -----------
!
IF (present(pdg)) pdg = dtgd%XDATA_DG
!
!* cumulative root fraction
!
IF (present(prootfrac)) THEN
  IF (SIZE(prootfrac)>0) prootfrac = dtgd%XDATA_ROOTFRAC
ENDIF
!
!* soil ice for runoff
!
IF (present(pd_ice)) pd_ice = dtgd%XDATA_DICE
!
!---------------------------------------------------------------------------------
IF (present(palbnir_veg)) palbnir_veg = dtgd%XDATA_ALBNIR_VEG
IF (present(palbvis_veg)) palbvis_veg = dtgd%XDATA_ALBVIS_VEG
IF (present(palbuv_veg)) palbuv_veg = dtgd%XDATA_ALBUV_VEG

IF (present(palbnir_soil)) palbnir_soil(:) = dtgd%XDATA_ALBNIR_SOIL
IF (present(palbvis_soil)) palbvis_soil(:) = dtgd%XDATA_ALBVIS_SOIL
IF (present(palbuv_soil)) palbuv_soil(:) = dtgd%XDATA_ALBUV_SOIL

IF (present(pgmes)) THEN
  IF (SIZE(pgmes)>0) pgmes = dtgd%XDATA_GMES
END IF

IF (present(pbslai)) THEN
  IF (SIZE(pbslai)>0) pbslai = dtgd%XDATA_BSLAI
END IF

IF (present(psefold)) THEN
  IF (SIZE(psefold)>0) psefold = dtgd%XDATA_SEFOLD
END IF

IF (present(pgc)) THEN
  IF (SIZE(pgc)>0) pgc = dtgd%XDATA_GC
END IF

IF (present(pdmax)) THEN
  IF (SIZE(pdmax)>0) pdmax = dtgd%XDATA_DMAX
END IF

IF (present(pre25)) THEN
  IF (SIZE(pre25)>0) pre25 = dtgd%XDATA_RE25
END IF

IF (present(plaimin)) THEN
  IF (SIZE(plaimin)>0) plaimin = dtgd%XDATA_LAIMIN
END IF

IF (present(pce_nitro)) THEN
  IF (SIZE(pce_nitro)>0) pce_nitro = dtgd%XDATA_CE_NITRO
END IF

IF (present(pcf_nitro)) THEN
  IF (SIZE(pcf_nitro)>0) pcf_nitro = dtgd%XDATA_CF_NITRO
END IF

IF (present(pcna_nitro)) THEN
  IF (SIZE(pcna_nitro)>0) pcna_nitro = dtgd%XDATA_CNA_NITRO
END IF

IF (present(pf2i)) THEN
  IF (SIZE(pf2i)>0) pf2i = dtgd%XDATA_F2I
END IF
!
IF (present(ostress)) THEN
  IF (SIZE(ostress)>0) ostress = dtgd%LDATA_STRESS
END IF
IF (lhook) CALL dr_hook('INIT_FROM_DATA_GRDN_N',1,zhook_handle)
!
!-------------------------------------------------------------------------------
!
END SUBROUTINE init_from_data_grdn_n