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,KLVL,PH,PZFORC,PZ,PZF,PDZ,PDZF)
!     #########################################
!
!!****  *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
!-------------------------------------------------------------------------------
!
!*       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
INTEGER,                  INTENT(IN)    :: klvl      ! number of levels in canopy
REAL, DIMENSION(KI),      INTENT(IN)    :: ph        ! maximum canopy height                 (m)
REAL, DIMENSION(KI),      INTENT(IN)    :: pzforc    ! height of wind forcing                (m)
REAL, DIMENSION(KI,KLVL), INTENT(INOUT) :: pz        ! heights of canopy levels              (m)
REAL, DIMENSION(KI,KLVL), INTENT(INOUT) :: pzf       ! heights of bottom of canopy levels    (m)
REAL, DIMENSION(KI,KLVL), INTENT(INOUT) :: pdz       ! depth   of canopy levels              (m)
REAL, DIMENSION(KI,KLVL), INTENT(INOUT) :: pdzf      ! depth between canopy levels           (m)
!
!*       0.2   Declarations of local variables
!              -------------------------------
!
INTEGER, DIMENSION(KI)      :: il     ! latest level below forcing height
INTEGER, DIMENSION(KI,KLVL) :: 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(pz(:,klvl)==pzforc(:)) .AND. lhook) CALL dr_hook('CANOPY_GRID_UPDATE',1,zhook_handle)
IF(all(pz(:,klvl)==pzforc(:))) RETURN
!
!-------------------------------------------------------------------------------
!
!*    1.  set upper level to forcing height
!         ---------------------------------
!
pz(:,klvl) = 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,klvl-1
    IF( pzforc(ji) > pzf(ji,jlayer+1) + 0.25 * pdz(ji,jlayer) .AND. &
        pz(ji,jlayer) < pzforc(ji) ) ilevel(ji,jlayer) = jlayer
  ENDDO
  ! determination of latest level from the ones selected before
  il(ji)=maxval(ilevel(ji,1:klvl-1))
  !
  icount = klvl-il(ji)-1
  !
  !* determination grid top of this level
  zztop = pzf(ji,il(ji)+1) ! ZZTOP=0 for IL=0
  zdz   = 2. * ( pz(ji,klvl)-zztop ) / ( 2*icount+1 )
  DO jlayer=1,icount
    pz(ji,jlayer+il(ji)) = zztop + (jlayer-0.5) * zdz
  END DO
END DO
!
!*    3.  New grid characteristics
!         ------------------------
!
 CALL canopy_grid(ki,klvl,pz,pzf,pdz,pdzf)
!
!
!*    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(pzf(ji,klvl-1) < ph(ji) ) THEN
    !
    !* sets bottom of grid box that is below the forcing level one at canopy height
    !
    pzf(ji,klvl-1) = ph(ji)
    !
    !* rebuilds vertical grid from the bottom of each grid
    !
    pz(ji,klvl-2) = 0.5 * ( pzf(ji,klvl-2) + pzf(ji,klvl-1) )
    pz(ji,klvl-1) = ( 2.* pzf(ji,klvl-1) + pz(ji,klvl) ) /3.
  END IF
END DO
!
!*    6.  Final grid characteristics
!         --------------------------
!
 CALL canopy_grid(ki,klvl,pz,pzf,pdz,pdzf)
!
IF (lhook) CALL dr_hook('CANOPY_GRID_UPDATE',1,zhook_handle)
!
!-------------------------------------------------------------------------------
END SUBROUTINE canopy_grid_update