arrange_cover.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 arrange_cover (DTCO, OWATER_TO_NATURE, OTOWN_TO_ROCK, &
                                PDATA_NATURE,PDATA_TOWN,PDATA_SEA,PDATA_WATER,PDATA_VEGTYPE, &
                               PDATA_GARDEN, OGARDEN, PDATA_BLD, PDATA_WALL_O_HOR           )
!     #########################
!
!!**** *ARRANGE_COVER*
!!
!!    PURPOSE
!!    -------
!!
!!    change water and intertidal (not lake) to nature and/or town to rock : arrange cover properly
!!
!!    METHOD
!!    ------
!!
!!
!!    EXTERNAL
!!    --------
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    REFERENCE
!!    ---------
!!
!!    AUTHOR
!!    ------
!!
!!    B. Decharme        Meteo-France
!!
!!    MODIFICATION
!!    ------------
!!
!!    Original    03/2009
!!                04/2013 (V. Masson) Fusion of Arrange_cover & update_data_frac
!!                        to allow distinct cover change options between submodels (_n)
!----------------------------------------------------------------------------
!
!*    0.     DECLARATION
!            -----------
!
!
USE modd_data_cover_n, ONLY : data_cover_t
!
USE modd_surf_par,       ONLY : xundef
!
!
USE modd_data_cover,     ONLY : xdata_root_depth, xdata_ground_depth, xdata_dice, &
                                xdata_lai, xdata_lai_all_years,                   &
                                xdata_alb_veg_nir, xdata_alb_veg_vis,             &
                                xdata_alb_soil_nir, xdata_alb_soil_vis
!
USE modd_data_cover_par, ONLY : nvegtype, jpcover, nrock, nvt_rock
!
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*    0.1    Declaration of arguments
!            ------------------------
!
!
TYPE(data_cover_t), INTENT(INOUT) :: DTCO
!
LOGICAL, INTENT(IN) :: OWATER_TO_NATURE
LOGICAL, INTENT(IN) :: OTOWN_TO_ROCK
REAL, DIMENSION(:), INTENT(IN)  :: PDATA_NATURE
REAL, DIMENSION(:), INTENT(IN)  :: PDATA_TOWN
REAL, DIMENSION(:), INTENT(IN)  :: PDATA_SEA
REAL, DIMENSION(:), INTENT(IN)  :: PDATA_WATER
REAL, DIMENSION(:), INTENT(IN)  :: PDATA_GARDEN
REAL, DIMENSION(:,:),INTENT(IN) :: PDATA_VEGTYPE
LOGICAL,            INTENT(IN)  :: OGARDEN
REAL, DIMENSION(:), INTENT(IN)  :: PDATA_BLD
REAL, DIMENSION(:), INTENT(IN)  :: PDATA_WALL_O_HOR
!
!
!*    0.2    Declaration of local variables
!            ------------------------------
!
REAL     :: ZWORK
!
INTEGER  :: JCOVER, JVEGTYPE, JL
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------
IF (lhook) CALL dr_hook('ARRANGE_COVER',0,zhook_handle)
!-------------------------------------------------------------------------------
! Allocate fields from submodel module
!-------------------------------------------------------------------------------
!
IF (ASSOCIATED(dtco%XDATA_NATURE)) DEALLOCATE(dtco%XDATA_NATURE)
IF (ASSOCIATED(dtco%XDATA_TOWN)) DEALLOCATE(dtco%XDATA_TOWN)
IF (ASSOCIATED(dtco%XDATA_SEA)) DEALLOCATE(dtco%XDATA_SEA)
IF (ASSOCIATED(dtco%XDATA_WATER)) DEALLOCATE(dtco%XDATA_WATER)
IF (ASSOCIATED(dtco%XDATA_VEGTYPE)) DEALLOCATE(dtco%XDATA_VEGTYPE)
IF (ASSOCIATED(dtco%XDATA_GARDEN)) DEALLOCATE(dtco%XDATA_GARDEN)
IF (ASSOCIATED(dtco%XDATA_BLD)) DEALLOCATE(dtco%XDATA_BLD)
IF (ASSOCIATED(dtco%XDATA_WALL_O_HOR)) DEALLOCATE(dtco%XDATA_WALL_O_HOR)
!
ALLOCATE(dtco%XDATA_NATURE    (jpcover))
ALLOCATE(dtco%XDATA_TOWN      (jpcover))
ALLOCATE(dtco%XDATA_SEA       (jpcover))
ALLOCATE(dtco%XDATA_WATER     (jpcover))
ALLOCATE(dtco%XDATA_VEGTYPE   (jpcover,nvegtype))
ALLOCATE(dtco%XDATA_GARDEN    (jpcover))
ALLOCATE(dtco%XDATA_BLD       (jpcover))
ALLOCATE(dtco%XDATA_WALL_O_HOR(jpcover))
!
!-------------------------------------------------------------------------------
! Default values
!-------------------------------------------------------------------------------
!
dtco%LGARDEN = ogarden
!
dtco%XDATA_NATURE     = pdata_nature
dtco%XDATA_TOWN       = pdata_town
dtco%XDATA_SEA        = pdata_sea
dtco%XDATA_WATER      = pdata_water
dtco%XDATA_VEGTYPE    = pdata_vegtype
dtco%XDATA_GARDEN     = pdata_garden
dtco%XDATA_BLD        = pdata_bld
dtco%XDATA_WALL_O_HOR = pdata_wall_o_hor
!
!-------------------------------------------------------------------------------
! Change water (not lake) to nature
!-------------------------------------------------------------------------------
!
IF(owater_to_nature)THEN
  DO jcover=1,jpcover
     IF(dtco%XDATA_WATER(jcover)>0.0.AND.dtco%XDATA_WATER(jcover)<1.0)THEN
       dtco%XDATA_NATURE(jcover)=dtco%XDATA_NATURE(jcover)+dtco%XDATA_WATER(jcover)
       dtco%XDATA_WATER (jcover)=0.0
     ENDIF
  ENDDO
ENDIF
!
!-------------------------------------------------------------------------------
! Change town to rock but keep other natural fraction
!-------------------------------------------------------------------------------
!
IF(otown_to_rock)THEN
!        
  DO jcover=1,jpcover
     IF(dtco%XDATA_TOWN(jcover)>0.0.OR.dtco%XDATA_GARDEN(jcover)>0.0)THEN
!
       dtco%XDATA_NATURE(jcover) = dtco%XDATA_NATURE(jcover) + dtco%XDATA_GARDEN(jcover) * dtco%XDATA_TOWN(jcover)
       dtco%XDATA_TOWN  (jcover) = dtco%XDATA_TOWN  (jcover) * ( 1. - dtco%XDATA_GARDEN(jcover))
       dtco%XDATA_GARDEN(jcover) = 0.0
!
       zwork=dtco%XDATA_NATURE(jcover)+dtco%XDATA_TOWN(jcover)
!       
       DO jvegtype=1,nvegtype
             dtco%XDATA_VEGTYPE(jcover,jvegtype)=dtco%XDATA_VEGTYPE(jcover,jvegtype)*dtco%XDATA_NATURE(jcover)/zwork
       ENDDO
!      
       dtco%XDATA_VEGTYPE(jcover,nvt_rock) = dtco%XDATA_VEGTYPE(jcover,nvt_rock)+dtco%XDATA_TOWN(jcover)/zwork
!
       dtco%XDATA_NATURE(jcover)=dtco%XDATA_NATURE(jcover)+dtco%XDATA_TOWN(jcover)
!       
       dtco%XDATA_TOWN  (jcover)=0.0
!
!      Initialise some variables
       xdata_lai(jcover,:,nvt_rock) = 0.0
       xdata_lai_all_years(jcover,:,nvt_rock) = 0.0
       xdata_root_depth(jcover,  nvt_rock) = 0.2
       xdata_ground_depth(jcover,  nvt_rock) = 0.2
       xdata_dice(jcover,  nvt_rock) = 0.2
       xdata_alb_veg_nir(jcover,:,nvt_rock) = 0.3
       xdata_alb_veg_vis(jcover,:,nvt_rock) = 0.1
       xdata_alb_soil_nir(jcover,:,nvt_rock) = 0.3
       xdata_alb_soil_vis(jcover,:,nvt_rock) = 0.1
!
     ENDIF
  ENDDO
!
ELSE
!-------------------------------------------------------------------------------
! Town is kept, but if gardens are not treated specifically, 
! they are included into nature fraction.
!-------------------------------------------------------------------------------
!
  IF (.NOT. ogarden) THEN
    dtco%XDATA_NATURE     = dtco%XDATA_NATURE + dtco%XDATA_GARDEN * dtco%XDATA_TOWN
    dtco%XDATA_TOWN       = dtco%XDATA_TOWN   * ( 1. - dtco%XDATA_GARDEN)
    dtco%XDATA_BLD        = dtco%XDATA_BLD / (1. - dtco%XDATA_GARDEN)
    dtco%XDATA_WALL_O_HOR = dtco%XDATA_WALL_O_HOR / (1. - dtco%XDATA_GARDEN)
    dtco%XDATA_GARDEN     = 0.    
  END IF
!
ENDIF
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('ARRANGE_COVER',1,zhook_handle)
!
!-------------------------------------------------------------------------------
!
END SUBROUTINE arrange_cover