canopy_grid_update.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 canopy_grid_update(KI,PH,PZFORC,SB)
!     #########################################
!
!!****  *CANOPY_GRID_UPDATE* - set the upper levels at and just below forcing level
!!                        
!!
!!    PURPOSE
!!    -------
!!
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    REFERENCE
!!    ---------
!!
!!
!!    AUTHOR
!!    ------
!!      V. Masson   *Meteo France*
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    07/2006 
!!      S. Riette   Oct 2010 Vectorisation
!-------------------------------------------------------------------------------
!
USE modd_canopy_n, ONLY : canopy_t
!
!*       0.    DECLARATIONS
!              ------------
!
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
USE modi_canopy_grid
!
IMPLICIT NONE
!
!*       0.1   Declarations of arguments
!              -------------------------
!
INTEGER,                  INTENT(IN)    :: KI        ! number of horizontal points
REAL, DIMENSION(KI),      INTENT(IN)    :: PH        ! maximum canopy height                 (m)
REAL, DIMENSION(KI),      INTENT(IN)    :: PZFORC    ! height of wind forcing                (m)
!
TYPE(canopy_t), INTENT(INOUT) :: SB
!
!*       0.2   Declarations of local variables
!              -------------------------------
!
INTEGER, DIMENSION(KI)      :: IL     ! latest level below forcing height
INTEGER, DIMENSION(KI,SB%NLVL) :: ILEVEL ! to test if level is high enough
!
INTEGER :: ICOUNT                 ! number of layers above forcing height, these must be changed
INTEGER :: JLAYER                 ! loop counter on layers
INTEGER :: JI                     ! loop counter on points
REAL    :: ZZTOP                  ! altitude of top of the grid of the initial level
!                                 ! just below forcing height
REAL    :: ZDZ                    ! difference of height between new levels
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('CANOPY_GRID_UPDATE',0,zhook_handle)
!
IF(all(sb%XZ(:,sb%NLVL)==pzforc(:)) .AND. lhook) CALL dr_hook('CANOPY_GRID_UPDATE',1,zhook_handle)
IF(all(sb%XZ(:,sb%NLVL)==pzforc(:))) RETURN
!
!-------------------------------------------------------------------------------
!
!*    1.  set upper level to forcing height
!         ---------------------------------
!
sb%XZ(:,sb%NLVL) = pzforc(:)
!
!*    2.  all canopy levels remaining above forcing height are relocated below
!         --------------------------------------------------------------------
!
! determination of levels below forcing height, low enough
!
ilevel=0
DO ji=1,ki
  DO jlayer=1,sb%NLVL-1
    IF( pzforc(ji) > sb%XZF(ji,jlayer+1) + 0.25 * sb%XDZ(ji,jlayer) .AND. &
        sb%XZ(ji,jlayer) < pzforc(ji) ) ilevel(ji,jlayer) = jlayer
  ENDDO
  ! determination of latest level from the ones selected before
  il(ji)=maxval(ilevel(ji,1:sb%NLVL-1))
  !
  icount = sb%NLVL-il(ji)-1
  !
  !* determination grid top of this level
  zztop = sb%XZF(ji,il(ji)+1) ! ZZTOP=0 for IL=0
  zdz   = 2. * ( sb%XZ(ji,sb%NLVL)-zztop ) / ( 2*icount+1 )
  DO jlayer=1,icount
    sb%XZ(ji,jlayer+il(ji)) = zztop + (jlayer-0.5) * zdz
  END DO
END DO
!
!*    3.  New grid characteristics
!         ------------------------
!
 CALL canopy_grid(ki,sb)
!
!
!*    5.  at least one canopy level in addition to forcing level must be above canopy top
!         -------------------------------------------------------------------------------
!
DO ji=1,ki
  !
  !* tests if the level below forcing height is high enough above canopy
  IF(sb%XZF(ji,sb%NLVL-1) < ph(ji) ) THEN
    !
    !* sets bottom of grid box that is below the forcing level one at canopy height
    !
    sb%XZF(ji,sb%NLVL-1) = ph(ji)
    !
    !* rebuilds vertical grid from the bottom of each grid
    !
    sb%XZ(ji,sb%NLVL-2) = 0.5 * ( sb%XZF(ji,sb%NLVL-2) + sb%XZF(ji,sb%NLVL-1) )
    sb%XZ(ji,sb%NLVL-1) = ( 2.* sb%XZF(ji,sb%NLVL-1) + sb%XZ (ji,sb%NLVL) ) /3.
  END IF
END DO
!
!*    6.  Final grid characteristics
!         --------------------------
!
 CALL canopy_grid(ki,sb)
!
IF (lhook) CALL dr_hook('CANOPY_GRID_UPDATE',1,zhook_handle)
!
!-------------------------------------------------------------------------------
END SUBROUTINE canopy_grid_update