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

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

USE yoelw    , ONLY : nsil     ,nipd     ,nua
USE yoerdu   , ONLY : nuaer    ,ntraer

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)    :: KMODE 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PDT0(klon) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PEMIS(klon) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PEMIW(klon) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTL(klon,klev+1) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTAVE(klon,klev) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PEMIT(klon) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFLUC(klon,2,klev+1) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PABCU(klon,nua,3*klev+1) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PBINT(klon,klev+1) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PBSUI(klon) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCNTRB(klon,klev+1,klev+1) 
!-----------------------------------------------------------------------

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

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

!              ------------
REAL(KIND=JPRB) ::&
 & 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)  

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

#include "lwb.intfb.h"
#include "lwv.intfb.h"

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

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

IF (lhook) CALL dr_hook('LWBV',0,zhook_handle)
print *,'LWBV: avant LWB'
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)=0.0_jprb
  pbsui(jl)=0.0_jprb
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

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

IF (lhook) CALL dr_hook('LWBV',1,zhook_handle)
END SUBROUTINE lwbv