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
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!-----------------------------------------------------------------------

USE parkind1  ,ONLY : jpim     ,jprb
USE yomhook   ,ONLY : lhook,   dr_hook

USE yoelw    , ONLY : nsil     ,nipd     ,nua

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KLON 
INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV 
INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA 
INTEGER(KIND=JPIM),INTENT(IN)    :: KFDIA 
INTEGER(KIND=JPIM),INTENT(IN)    :: KUAER 
INTEGER(KIND=JPIM),INTENT(IN)    :: KTRAER 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PABCU(klon,nua,3*klev+1) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PB(klon,nsil,klev+1) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PBINT(klon,klev+1) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PBSUR(klon,nsil) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PBTOP(klon,nsil) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PDBSL(klon,nsil,klev*2) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PEMIS(klon) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PEMIW(klon) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGA(klon,nipd,2,klev) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGB(klon,nipd,2,klev) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGASUR(klon,nipd,2) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGBSUR(klon,nipd,2) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGATOP(klon,nipd,2) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGBTOP(klon,nipd,2) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCNTRB(klon,klev+1,klev+1) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFLUC(klon,2,klev+1) 
!-----------------------------------------------------------------------

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

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

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

REAL(KIND=JPRB) :: ZADJD(klon,klev+1)  , ZADJU(klon,klev+1)&
 & ,  ZDBDT(KLON,NSIL,KLEV)&
 & ,  ZDISD(KLON,KLEV+1)  , ZDISU(KLON,KLEV+1)&
 & ,  ZDWFSU(KLON,NSIL)  

INTEGER(KIND=JPIM) :: JA, JK, JL
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "lwvb.intfb.h"
#include "lwvd.intfb.h"
#include "lwvn.intfb.h"

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

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

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

IF (lhook) CALL dr_hook('LWV',0,zhook_handle)
DO jk=1,klev+1
  DO jl=kidia,kfdia
    zadjd(jl,jk)=0.0_jprb
    zadju(jl,jk)=0.0_jprb
    zdisd(jl,jk)=0.0_jprb
    zdisu(jl,jk)=0.0_jprb
  ENDDO
ENDDO
DO ja=1,nsil
  DO jl=kidia,kfdia
    zdwfsu(jl,ja)=0.0_jprb
  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  &
 & )  

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

IF (lhook) CALL dr_hook('LWV',1,zhook_handle)
END SUBROUTINE lwv