canopy_evol_field.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_evol_field(KI, KLVL, PTSTEP, KIMPL, PK, PDKDDVDZ,       &
                                  psflux_f, pforc_f, pdforc_fdf, pdz, pdzf,     &
                                  pext, pdextdv, pf, pwf, palfa, pbeta          ) 
!     #########################################
!
!!****  *CANOPY_EVOL_FIELD* - evolution of wind in canopy 
!!                        
!!
!!    PURPOSE
!!    -------
!!
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    REFERENCE
!!    ---------
!!
!!
!!    AUTHOR
!!    ------
!!      V. Masson   *Meteo France*
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    07/2006 
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
USE modi_tridiag_surf
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
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,                     INTENT(IN)    :: ptstep    ! time-step                             (s)
INTEGER,                  INTENT(IN)    :: kimpl     ! implicitation code: 
!                                                    ! 1 : computes only alfa and beta coupling
!                                                    !     coefficients for all variables
!                                                    ! 2 : computes temporal evolution of the
!                                                    !     variables
REAL, DIMENSION(KI,KLVL), INTENT(IN)    :: pk        ! mixing exchange coefficient           (m2/s)
REAL, DIMENSION(KI,KLVL), INTENT(IN)    :: pdkddvdz  ! derivative of mixing coefficient as a
!                                                    ! function of vertical gradient of wind
!                                                    ! (at mid levels)                       (m2)
REAL, DIMENSION(KI),      INTENT(IN)    :: psflux_f  ! surface flux w'Th'                    (mK/s)
REAL, DIMENSION(KI,KLVL), INTENT(IN)    :: pforc_f   ! tendency of wind due to canopy drag   (K/s)
REAL, DIMENSION(KI,KLVL), INTENT(IN)    :: pdforc_fdf! formal derivative of the tendency of
!                                                    ! wind due to canopy drag               (1/s)
REAL, DIMENSION(KI,KLVL), INTENT(IN)    :: pdz       ! deltaZ between canopy half levels,
!                                                    ! located at full levels                (m)
REAL, DIMENSION(KI,KLVL), INTENT(IN)    :: pdzf      ! deltaZ between canopy (full) levels,
!                                                    ! located at half levels                (m)
REAL, DIMENSION(KI,KLVL), INTENT(IN)    :: pext      ! external forcing at full levels
REAL, DIMENSION(KI,KLVL), INTENT(IN)    :: pdextdv   ! derivative of external forcing as a
!                                                    ! function of vertical variable
!                                                    ! (at full levels)
REAL, DIMENSION(KI,KLVL), INTENT(INOUT) :: pf        ! pot. temp. at canopy levels           (K)
REAL, DIMENSION(KI,KLVL), INTENT(OUT)   :: pwf       ! turbulent flux (at half levels)       (mK/s)
REAL, DIMENSION(KI), OPTIONAL, INTENT(OUT)   :: palfa     !  V+(1) = alfa F(1) + beta
REAL, DIMENSION(KI), OPTIONAL, INTENT(OUT)   :: pbeta     !  V+(1) = alfa F(1) + beta
!
!
!*       0.2   Declarations of local variables
!              -------------------------------
!
INTEGER                     :: jlayer   ! loop counter on layers
!
REAL, DIMENSION(KI,KLVL)   :: zdfdz    ! dTh/dz at mid levels
REAL, DIMENSION(KI,KLVL)   :: zwork    ! work variable : wind at futur instant 
!                                      ! (or past at the end of the routine)
REAL, DIMENSION(KI,KLVL)   :: zf       ! turbulent flux at mid levels
REAL, DIMENSION(KI,KLVL)   :: zdfddvdz ! derivative of turbulent flux as a
!                                      ! function of vertical gradient of wind variable
!                                      ! (at mid levels)
REAL, DIMENSION(KI)         :: zdfadt  ! dTHa/dt   at forcing level
REAL, DIMENSION(KI)         :: zdwfdz  ! dw'Th'/dz at forcing level
REAL, DIMENSION(KI)         :: zalfa, zbeta
LOGICAL                     :: limpl
REAL(KIND=JPRB) :: zhook_handle
!
!-------------------------------------------------------------------------------
!
!
!*    1. initializations
!        ---------------
!
!* external forces
!
IF (lhook) CALL dr_hook('CANOPY_EVOL_FIELD',0,zhook_handle)
!
!-------------------------------------------------------------------------------
!
!*    2. pot. temp. vertical derivative (at half levels below full levels)
!        ------------------------------
!
zdfdz(:,:) = -999.
DO jlayer=2,klvl
  zdfdz(:,jlayer) = (pf(:,jlayer) - pf(:,jlayer-1)) / pdzf(:,jlayer)
END DO
!
!-------------------------------------------------------------------------------
!
!*    3. turbulent flux (at half levels below full levels)
!        --------------
!
zwork    = -999.
!
!* surface flux
zwork(:,1) = psflux_f(:)
!
!* flux at other levels
DO jlayer=2,klvl
  zwork(:,jlayer) = -pk(:,jlayer) * zdfdz(:,jlayer)
END DO
!
!-------------------------------------------------------------------------------
!
!*    4. formal derivative of turbulent flux for variable X=(dU/dz)
!        ----------------------------------------------------------
!
!* no implicitation of surface flux
!
zdfddvdz(:,:) = 0.
!
!* other levels (at half levels below full levels)
!
zdfddvdz(:,2:klvl) = - pk(:,2:klvl) - pdkddvdz(:,2:klvl) * zdfdz(:,2:klvl)
!
!-------------------------------------------------------------------------------
!
!*    7. adds Forces & divergence of turbulent flux to dU/dt (at full levels)
!        ---------------------------------------------------
!
limpl=(kimpl==1)
 CALL tridiag_surf(pf, zwork, zdfddvdz, pext, pdextdv, ptstep, &
                  pdzf, pdz, zf, limpl, zalfa, zbeta    ) 
!
IF (present(palfa)) palfa = zalfa
IF (present(pbeta)) pbeta = zbeta
!
!-------------------------------------------------------------------------------
!
!*    8. updated turbulent flux (at half levels below full levels)
!        ----------------------
!
pwf(:,:) = -999.
pwf(:,1) = psflux_f(:) 
!
DO jlayer=2,klvl
  pwf(:,jlayer) = pwf(:,jlayer-1)                                                         &
    + ( pforc_f(:,jlayer-1) + pdforc_fdf(:,jlayer-1) * (zf(:,jlayer-1)-pf(:,jlayer-1)) )  &
      * pdz(:,jlayer-1) 
END DO
!
!-------------------------------------------------------------------------------
!
!*    8. New value of potential temperature (at full levels)
!        ----------------------------------
!
pf(:,:) = zf(:,:)
!
IF (lhook) CALL dr_hook('CANOPY_EVOL_FIELD',1,zhook_handle)
!----------------------------------------------------------------
!
END SUBROUTINE canopy_evol_field