lwv.F90

Go to the documentation of this file.

SUBROUTINE lwv &
 &( kidia, kfdia, klon , klev , kuaer , ktraer &
 &, pabcu, pb   , pbint, pbsur, pbtop , pdbsl &
 &, pemis, pemiw &
 &, pga  , pgb  , pgasur,pgbsur,pgatop, pgbtop &
 &, pcntrb,pfluc &
 &)

!**** *LWV*   - LONGWAVE RADIATION, VERTICAL INTEGRATION

!     PURPOSE.
!     --------
!           CARRIES OUT THE VERTICAL INTEGRATION TO GIVE LONGWAVE
!           FLUXES OR RADIANCES

!**   INTERFACE.
!     ----------

!        EXPLICIT ARGUMENTS :
!        --------------------
!     ==== INPUTS ===
! PABCU : (KLON,NUA,3*KLEV+1); ABSORBER AMOUNTS
! PB     : (KLON,NSIL,KLEV+1); SPECTRAL HALF-LEVEL PLANCK FUNCTIONS
! PBINT  : (KLON,KLEV+1)     ; HALF-LEVEL PLANCK FUNCTIONS
! PBSUR  : (KLON,NSIL)       ; SURFACE SPECTRAL PLANCK FUNCTION
! PBTOP  : (KLON,NSIL)       ; T.O.A. SPECTRAL PLANCK FUNCTION
! PDBSL  : (KLON,KLEV*2)     ; SUB-LAYER PLANCK FUNCTION GRADIENT
! PEMIS  : (KLON)            ; SURFACE LW EMISSIVITY
! PEMIW  : (KLON)            ; SURFACE LW WINDOW EMISSIVITY
! PGA, PGB                   ; PADE APPROXIMANTS
! PGASUR, PGBSUR             ; SURFACE PADE APPROXIMANTS
! PGATOP, PGBTOP             ; T.O.A. PADE APPROXIMANTS
!     ==== OUTPUTS ===
! PCNTRB : (KLON,KLEV+1,KLEV+1); CLEAR-SKY ENERGY EXCHANGE MATRIX
! PFLUC(KLON,2,KLEV)           ; RADIATIVE FLUXES CLEAR-SKY

!        IMPLICIT ARGUMENTS :   NONE
!        --------------------

!     METHOD.
!     -------

!          1. PERFORMS THE VERTICAL INTEGRATION DISTINGUISHING BETWEEN
!     CONTRIBUTIONS BY -  THE NEARBY LAYERS
!                      -  THE DISTANT LAYERS
!                      -  THE BOUNDARY TERMS
!          2. COMPUTES THE CLEAR-SKY DOWNWARD AND UPWARD EMISSIVITIES.

!     EXTERNALS.
!     ----------

!          *LWVN*, *LWVD*, *LWVB*

!     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
!        JJ Morcrette 96-06-07 Surface LW window emissivity
!-----------------------------------------------------------------------

#include "tsmbkind.h"

USE yoelw    , ONLY : nsil     ,nipd     ,nua


IMPLICIT NONE


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



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

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


real_b :: pabcu(klon,nua,3*klev+1)&
  &,  pb(klon,nsil,klev+1)   , pbint(klon,klev+1)&
  &,  pbsur(klon,nsil)       , pbtop(klon,nsil)&
  &,  pdbsl(klon,nsil,klev*2)&
  &,  pemis(klon)            , pemiw(klon)&
  &,  pga(klon,nipd,2,klev)  , pgb(klon,nipd,2,klev)&
  &,  pgasur(klon,nipd,2)    , pgbsur(klon,nipd,2)&
  &,  pgatop(klon,nipd,2)    , pgbtop(klon,nipd,2)

real_b :: pcntrb(klon,klev+1,klev+1),  pfluc(klon,2,klev+1)

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

!*       0.2   LOCAL ARRAYS
!              ------------

real_b :: zadjd(klon,klev+1)  , zadju(klon,klev+1)&
  &,  zdbdt(klon,nsil,klev)&
  &,  zdisd(klon,klev+1)  , zdisu(klon,klev+1)&
  &,  zdwfsu(klon,nsil)

!     LOCAL INTEGER SCALARS
integer_m :: ja, jk, jl


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

!*         1.    INITIALIZATION
!                --------------

!*         1.1     INITIALIZE LAYER CONTRIBUTIONS
!                  ------------------------------

DO jk=1,klev+1
  DO jl=kidia,kfdia
    zadjd(jl,jk)=_zero_
    zadju(jl,jk)=_zero_
    zdisd(jl,jk)=_zero_
    zdisu(jl,jk)=_zero_
  ENDDO
ENDDO
DO ja=1,nsil
  DO jl=kidia,kfdia
    zdwfsu(jl,ja)=_zero_
  ENDDO
ENDDO

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

!*         2.      VERTICAL INTEGRATION
!                  --------------------

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

!*         2.1     CONTRIBUTION FROM ADJACENT LAYERS
!                  ---------------------------------

CALL lwvn &
  &( kidia, kfdia, klon  , klev , kuaer &
  &, pabcu, pdbsl, pga   , pgb &
  &, zadjd, zadju, pcntrb, zdbdt, zdwfsu  &
  &)

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

!*         2.2     CONTRIBUTION FROM DISTANT LAYERS
!                  ---------------------------------

CALL lwvd &
  &( kidia , kfdia, klon , klev  , ktraer &
  &, pabcu , zdbdt, pga  , pgb &
  &, pcntrb, zdisd, zdisu, zdwfsu &
  &)

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

!*         2.3     EXCHANGE WITH THE BOUNDARIES
!                  ----------------------------

CALL lwvb &
  &( kidia , kfdia , klon  , klev  , kuaer &
  &, pabcu , zadjd , zadju &
  &, pb    , pbint , pbsur , pbtop &
  &, zdisd , zdisu , pemis , pemiw &
  &, pgasur, pgbsur, pgatop, pgbtop &
  &, zdwfsu,pfluc  &
  &)

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

RETURN
END SUBROUTINE lwv