lwbv.F90

Go to the documentation of this file.

SUBROUTINE lwbv &
  &( kidia, kfdia, klon , klev  , kmode &
  &, pdt0 , pemis, pemiw &
  &, ptl  , ptave &
  &, pemit, pfluc &
  &, pabcu, pbint, pbsui, pcntrb &
  &)

!**** *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 :
!        --------------------
! PDT0   : (KLON)            ; SURFACE TEMPERATURE DISCONTINUITY
! PEMIS  : (KLON)            ; SURFACE LW EMISSIVITY
! PEMIW  : (KLON)            ; SURFACE LW WINDOW EMISSIVITY
! PTAVE  : (KLON,KLEV)       ; TEMPERATURE
! PTL    : (KLON,KLEV+1)     ; HALF LEVEL TEMPERATURE
!     ==== OUTPUTS ===
! PABCU  :
! PBINT  :
! PBSUI  :
! PCNTRB : 
! PCOLC  :
! PEMIT  :
! PFLUC  :

!        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 yoelw    , ONLY : nsil     ,nipd     ,nua
USE yoerdu   , ONLY : nuaer    ,ntraer


IMPLICIT NONE


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



!-----------------------------------------------------------------------

!*       0.1   ARGUMENTS
!              ---------

real_b :: pdt0(klon)&
  &,  pemis(klon)               , pemiw(klon)&
  &,  ptl(klon,klev+1)          , ptave(klon,klev)

real_b :: pabcu(klon,nua,3*klev+1)&
  &,  pbint(klon,klev+1)        , pbsui(klon)&
  &,  pcntrb(klon,klev+1,klev+1)&
  &,  pemit(klon)&
  &,  pfluc(klon,2,klev+1)

!-------------------------------------------------------------------------

!*       0.2   LOCAL ARRAYS
!              ------------
real_b ::&
     &zb(klon,nsil,klev+1), zbsur(klon,nsil)   , zbtop(klon,nsil)&
  &,  zdbsl(klon,nsil,klev*2)&
  &,  zga(klon,nipd,2,klev)  , zgb(klon,nipd,2,klev)&
  &,  zgasur(klon,nipd,2)    , zgbsur(klon,nipd,2)&
  &,  zgatop(klon,nipd,2)    , zgbtop(klon,nipd,2)

!     LOCAL INTEGER SCALARS
integer_m :: jl, jlw


!     ------------------------------------------------------------------

!*         2.    COMPUTES PLANCK FUNCTIONS
!                -------------------------

CALL lwb &
 &( kidia, kfdia, klon  , klev  , kmode &
 &, pdt0 , ptave, ptl &
 &, zb   , pbint, zbsur , zbtop , zdbsl &
 &, zga  , zgb  , zgasur, zgbsur, zgatop, zgbtop    &
 &)

!     ------------------------------------------------------------------

!*         3.    PERFORMS THE VERTICAL INTEGRATION
!                ---------------------------------

CALL lwv &
 &( kidia , kfdia, klon  , klev &
 &, nuaer , ntraer &
 &, pabcu , zb   , pbint , zbsur , zbtop , zdbsl &
 &, pemis , pemiw &
 &, zga   , zgb  , zgasur, zgbsur, zgatop, zgbtop &
 &, pcntrb, pfluc &
 &)

DO jl=kidia,kfdia
  pemit(jl)=_zero_
  pbsui(jl)=_zero_
ENDDO
DO jlw=1,nsil
  DO jl=kidia,kfdia
    pbsui(jl)=pbsui(jl)+zbsur(jl,jlw)
    IF (jlw >= 3.AND. jlw <= 4) THEN
      pemit(jl)=pemit(jl)+zbsur(jl,jlw)*pemiw(jl)
    ELSE
      pemit(jl)=pemit(jl)+zbsur(jl,jlw)*pemis(jl)
    ENDIF
  ENDDO
ENDDO
DO jl=kidia,kfdia
  pemit(jl)=pemit(jl)/pbsui(jl)
ENDDO

!     ------------------------------------------------------------------

RETURN
END SUBROUTINE lwbv