olwbv.F90

Go to the documentation of this file.

SUBROUTINE olwbv &
     &  ( kidia, kfdia, klon , klev &
     &  , pdp  , pdt0 , pemis, pth &
     &  , pt   &
     &  , pcolc, pfluc &
     &  , pabcu, pbint, pbsui, pcntrb, pfdn, pfup )
!
!**** *LWBV*   - COMPUTE PLANCK FUNC., PERF. VERT. INTEGRATION
!
!     PURPOSE.
!     --------
!           TO COMPUTE THE PLANCK FUNCTION AND PERFORM THE
!           VERTICAL INTEGRATION. SPLIT OUT FROM LW FOR MEMORY
!           SAVING
!
!**   INTERFACE.
!     ----------
!
!        *LWVB* IS CALLED FROM *LW*
!
!        EXPLICIT ARGUMENTS :
!        --------------------
! PDP    : (KLON,KLEV)       ; LAYER PRESSURE THICKNESS
! PDT0   : (KLON)            ; SURFACE TEMPERATURE DISCONTINUITY
! PEMIS  : (KLON)            ; SURFACE EMISSIVITY
! PT     : (KLON,KLEV)       ; TEMPERATURE
! PTH    : (KLON,KLEV+1)     ; HALF LEVEL TEMPERATURE
!     ==== OUTPUTS ===
!
!        IMPLICIT ARGUMENTS :   NONE
!        --------------------
!
!     METHOD.
!     -------
!
!          1. COMPUTES THE PLANCK FUNCTIONS ON THE INTERFACES AND THE
!     GRADIENT OF PLANCK FUNCTIONS IN THE LAYERS.
!          2. PERFORMS THE VERTICAL INTEGRATION DISTINGUISHING THE CON-
!     TRIBUTIONS OF THE ADJACENT AND DISTANT LAYERS AND THOSE FROM THE
!     BOUNDARIES.
!          3. COMPUTES THE CLEAR-SKY COOLING RATES.
!
!     EXTERNALS.
!     ----------
!
!          *LWB*, *LWV*
!
!     REFERENCE.
!     ----------
!
!        SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
!        ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
!
!     AUTHOR.
!     -------
!        JEAN-JACQUES MORCRETTE  *ECMWF*
!
!     MODIFICATIONS.
!     --------------
!        ORIGINAL : 89-07-14
!        MODIFICATION : 93-10-15 M.HAMRUD (SPLIT OUT FROM LW TO SAVE
!                                          MEMORY)
!-----------------------------------------------------------------------

#include "tsmbkind.h"

USE yoeolw   , ONLY : nisp     ,nipd     ,nua
USE yoerdu   , ONLY : nuaer    ,ntraer   ,rcday
USE yoedbug  , ONLY : ldebug

IMPLICIT NONE


!     DUMMY INTEGER SCALARS
integer_m :: kfdia
integer_m :: kidia
integer_m :: klev
integer_m :: klon

!-----------------------------------------------------------------------
!
!*       0.1   ARGUMENTS
!              ---------
!
real_b :: pdp(klon,klev) &
     &  ,  pdt0(klon)        ,pemis(klon) &
     &  ,  pth(klon,klev+1) &
     &  ,  pt(klon,klev)
!
real_b :: pcolc(klon,klev), pfluc(klon,2,klev+1)
!     
real_b :: pabcu(klon,nua,3*klev+1) &
     &  ,  pbint(klon,klev+1) &
     &  ,  pbsui(klon) &
     &  ,  pcntrb(klon,klev+1,klev+1) &
     &  ,  pfdn(klon,klev+1) &
     &  ,  pfup(klon,klev+1)
!
!-------------------------------------------------------------------------
!
!*       0.2   LOCAL ARRAYS
!              ------------
real_b :: zb(klon,nisp,klev+1) &
     &  ,  zbsur(klon,nisp), zbtop(klon,nisp) &
     &  ,  zdbsl(klon,nisp,klev*2) &
     &  ,  zga(klon,8,2,klev), zgb(klon,8,2,klev) &
     &  ,  zgasur(klon,8,2)   , zgbsur(klon,8,2) &
     &  ,  zgatop(klon,8,2)   , zgbtop(klon,8,2)
     
real_b :: zdfnet     
!
!     LOCAL INTEGER SCALARS
integer_m :: jk, jkl, jl, jlw

!     ------------------------------------------------------------------
!
!*         2.    COMPUTES PLANCK FUNCTIONS
!                -------------------------
!
if (ldebug) print *, 'CALL OLWB'
CALL olwb ( kidia, kfdia, klon  , klev  &
     &    , pdt0 , pt   , pth &
     &    , zb   , pbint, pbsui , zbsur , zbtop , zdbsl &
     &    , zga  , zgb  , zgasur, zgbsur, zgatop, zgbtop     )
!
!     ------------------------------------------------------------------
!
!*         3.    PERFORMS THE VERTICAL INTEGRATION
!                ---------------------------------
!
if (ldebug) print *, 'CALL OLWV'
CALL olwv ( kidia, kfdia, klon , klev , nuaer, ntraer &
     &    , pabcu, zb   , pbint, pbsui, zbsur, zbtop, zdbsl &
     &    , pemis &
     &    , zga  , zgb  , zgasur,zgbsur,zgatop,zgbtop &
     &    , pcntrb,pcolc, pfluc )
!
DO jk = 1 , klev+1
  DO jl = kidia,kfdia
    pfdn(jl,jk) = pfluc(jl,2,jk)
    pfup(jl,jk) = pfluc(jl,1,jk)
  END DO
END DO
!
!
DO jkl = 1 , klev
  jk = klev+1 - jkl
  DO jl = kidia,kfdia
    zdfnet = pfluc(jl,1,jk+1) + pfluc(jl,2,jk+1) &
    &        -pfluc(jl,1,jk  ) - pfluc(jl,2,jk  )
    pcolc(jl,jk) = rcday * zdfnet / pdp(jl,jkl)
  END DO
END DO
!
!     ------------------------------------------------------------------
!
RETURN
END SUBROUTINE olwbv