olwv.F90

Go to the documentation of this file.

SUBROUTINE olwv ( KIDIA,KFDIA,KLON,KLEV &
     &  , kuaer,ktraer &
     &  , pabcu,pb,pbint,pbsuin,pbsur,pbtop,pdbsl,pemis &
     &  , pga,pgb,pgasur,pgbsur,pgatop,pgbtop &
     &  , pcntrb,pcolc,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,NISP,KLEV+1); SPECTRAL HALF-LEVEL PLANCK FUNCTIONS
! PBINT  : (KLON,KLEV+1)     ; HALF-LEVEL PLANCK FUNCTIONS
! PBSUIN : (KLON)            ; SURFACE PLANCK FUNCTION
! PBSUR  : (KLON,NISP)       ; SURFACE SPECTRAL PLANCK FUNCTION
! PBTOP  : (KLON,NISP)       ; T.O.A. SPECTRAL PLANCK FUNCTION
! PDBSL  : (KLON,KLEV*2)     ; SUB-LAYER PLANCK FUNCTION GRADIENT
! PEMIS  : (KLON)            ; SURFACE 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:
!                     1  ==>  UPWARD   FLUX TOTAL
! PCOLC(KLON,KLEV)           ; LONG-WAVE TENDENCY 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
!-----------------------------------------------------------------------

#include "tsmbkind.h"

USE yoeolw   , ONLY : nisp     ,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,nisp,klev+1) &
     &  ,  pbint(klon,klev+1) &
     &  ,  pbsur(klon,nisp), pbsuin(klon), pbtop(klon,nisp) &
     &  ,  pdbsl(klon,nisp,klev*2), pemis(klon) &
     &  ,  pga(klon,8,2,klev), pgb(klon,8,2,klev) &
     &  ,  pgasur(klon,8,2)  , pgbsur(klon,8,2) &
     &  ,  pgatop(klon,8,2)  , pgbtop(klon,8,2)
!
real_b :: pcntrb(klon,klev+1,klev+1), pcolc(klon,klev) &
     &  ,  pfluc(klon,2,klev+1)
!
!-----------------------------------------------------------------------
!
!*       0.2   LOCAL ARRAYS
!              ------------
!
integer_m :: itx(klon)
!
real_b :: zadjd(klon,klev+1), zadju(klon,klev+1) &
     &  ,  zdbdt(klon,nisp,klev) &
     &  ,  zdisd(klon,klev+1), zdisu(klon,klev+1) &
     &  ,  zfd(klon), zfdn(klon,klev+1), zfu(klon) &
     &  ,  zfup(klon,klev+1),zglayd(klon),zglayu(klon)
     
real_b :: zdfnet     
!
!     LOCAL INTEGER SCALARS
integer_m :: ja, jk, jl, jkl

!-----------------------------------------------------------------------
!
!*         1.    INITIALIZATION
!                --------------
!
!*         1.1     INITIALIZE LAYER CONTRIBUTIONS
!                  ------------------------------
!
DO jk=1,klev+1
  DO jl=kidia,kfdia
    zadjd(jl,jk)=0.
    zadju(jl,jk)=0.
    zdisd(jl,jk)=0.
    zdisu(jl,jk)=0.
  END DO
END DO
!
!     ------------------------------------------------------------------
!
!*         2.      VERTICAL INTEGRATION
!                  --------------------
!
!     ------------------------------------------------------------------
!
!*         2.1     CONTRIBUTION FROM ADJACENT LAYERS
!                  ---------------------------------
!
CALL olwvn ( kidia,kfdia,klon,klev,kuaer &
     &  , pabcu,pdbsl,pga,pgb &
     &  , zadjd,zadju,pcntrb,zdbdt )
!
!     ------------------------------------------------------------------
!
!*         2.2     CONTRIBUTION FROM DISTANT LAYERS
!                  ---------------------------------
!
CALL olwvd ( kidia,kfdia,klon,klev,ktraer &
     &  , pabcu,zdbdt,pga,pgb &
     &  , pcntrb,zdisd,zdisu )
!
!     ------------------------------------------------------------------
!
!*         2.3     EXCHANGE WITH THE BOUNDARIES
!                  ----------------------------
!
CALL olwvb ( kidia,kfdia,klon,klev,kuaer &
     &  , pabcu,zadjd,zadju,pb,pbint,pbsuin,pbsur,pbtop &
     &  , zdisd,zdisu,pemis &
     &  , pga,pgb,pgasur,pgbsur,pgatop,pgbtop &
     &  , pfluc                     )
!
!
!     ------------------------------------------------------------------
RETURN
END SUBROUTINE olwv