*=*=*=*= LWVN.html =*=*=*=*
SUBROUTINE LWVN

SUBROUTINE LWVN


      SUBROUTINE LWVN ( KDLON,KFLEV,KUAER,KTRAER
     S  , pga,pgb
     s  , PABCUCO2,PABCUAER,PDBSL
     S  , PADJD,PADJU,PDBDT                              )
      IMPLICIT LOGICAL (L)
C
#include "dimensions.h"
#include "dimphys.h"
#include "dimradmars.h"
C
C**** *LWVN*   - L.W., VERTICAL INTEGRATION, NEARBY LAYERS
C
C     PURPOSE.
C     --------
C           CARRIES OUT THE VERTICAL INTEGRATION ON NEARBY LAYERS
C           TO GIVE LONGWAVE FLUXES OR RADIANCES
C
C**   INTERFACE.
C     ----------
C     SUBROUTINE LWVN ( KDLON,KFLEV,KUAER,KTRAER
C    S  , KXDIA, PABCUCO2,PABCUAER,PDBSL
C    S  , PADJD,PADJU,PDBDT                              )
C
C        EXPLICIT ARGUMENTS :
C        --------------------
C     ==== INPUTS ===
C KX...    (KDLON,...          ; TEMPERATURE INDICES
C PABCUCO2 : (KDLON,NUA,3*KFLEV+1); ABSORBER AMOUNTS (CO2)
C PABCUAER : (KDLON,NUA,3*KFLEV+1); ABSORBER AMOUNTS (AEROSOLS)
C PDBSL  : (KDLON,KFLEV*2)     ; SUB-LAYER PLANCK FUNCTION GRADIENT
C     ==== OUTPUTS ===
C PADJ.. : (KDLON,KFLEV+1)     ; CONTRIBUTION OF ADJACENT LAYERS
C PDBDT  : (KDLON,NUA,KFLEV)   ; LAYER PLANCK FUNCTION GRADIENT
C
C        IMPLICIT ARGUMENTS :   NONE
C        --------------------
C
C     METHOD.
C     -------
C
C          1. PERFORMS THE VERTICAL INTEGRATION CORRESPONDING TO THE
C     CONTRIBUTIONS OF THE ADJACENT LAYERS USING A GAUSSIAN QUADRATURE
C
C     EXTERNALS.
C     ----------
C
C          *LWTT*
C
C     REFERENCE.
C     ----------
C
C        SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
C        ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE "IN CORE MODEL"
C
C     AUTHOR.
C     -------
C        JEAN-JACQUES MORCRETTE  *ECMWF*
C
C     MODIFICATIONS.
C     --------------
C        ORIGINAL : 89-07-14
C-----------------------------------------------------------------------
C
c! modif diffusion
c! on ne prend en compte que les deux bandes du CO2.
c!
C
C-----------------------------------------------------------------------
C
#include "yomcst.h"
#include "yomrad.h"
#include "yomaer.h"
#include "yomlw.h"
#include "yomsw.h"
#include "yomrdu.h"
C
C-----------------------------------------------------------------------
C
C
C*       0.1   ARGUMENTS
C              ---------
C
      REAL pga(NDLO2*2*3,kflev+1),pgb(NDLO2*2*3,kflev+1)

      REAL PABCUCO2(NDLO2,NUACO2,3*KFLEV+1)
      REAL PABCUAER(NDLO2,NIR,3*KFLEV+1)
     S  ,  PDBSL(NDLO2,nir,KFLEV*2)
C
      REAL PADJD(NDLO2,KFLEV+1), PADJU(NDLO2,KFLEV+1)
c    S  ,  PCNTRB(NDLO2,KFLEV+1,KFLEV+1)
     S  ,  PDBDT(NDLO2,nir,KFLEV)
C
C-------------------------------------------------------------------------
C
C*       0.2   LOCAL ARRAYS
C              ------------
C
      REAL ZGLAYD(NDLON),ZGLAYU(NDLON)
     S  ,  ZTT(NDLON,NTRA), ZTT1(NDLON,NTRA), ZTT2(NDLON,NTRA)
     S  ,  ZUU(NDLON,NUA)
C
C-----------------------------------------------------------------------
C
C*         1.    INITIALIZATION
C                --------------
C
 100  CONTINUE
C
C*         1.1     INITIALIZE LAYER CONTRIBUTIONS
C                  ------------------------------
C
 110  CONTINUE
C
      DO 112 JK = 1 , KFLEV+1
      DO 111 JL = 1 , KDLON
      PADJD(JL,JK) = 0.
      PADJU(JL,JK) = 0.
 111  CONTINUE
 112  CONTINUE
C
C*         1.2     INITIALIZE TRANSMISSION FUNCTIONS
C                  ---------------------------------
C
 120  CONTINUE
C
      DO 122 JA = 1 , NTRA
      DO 121 JL = 1 , KDLON
      ZTT (JL,JA) = 1.0
      ZTT1(JL,JA) = 1.0
      ZTT2(JL,JA) = 1.0
 121  CONTINUE
 122  CONTINUE
C
      DO 124 JA = 1 , NUA
      DO 123 JL = 1 , KDLON
      ZUU(JL,JA) = 0.
 123  CONTINUE
 124  CONTINUE
C
C     ------------------------------------------------------------------
C
C*         2.      VERTICAL INTEGRATION
C                  --------------------
C
 200  CONTINUE
C
      IND1=0
      IND3=0
      IND4=1
      IND2=1
C
C*         2.1     CONTRIBUTION FROM ADJACENT LAYERS
C                  ---------------------------------
C
 210  CONTINUE
C
      DO 215 JK = 1 , KFLEV
C
C*         2.1.1   DOWNWARD LAYERS
C                  ---------------
C
 2110 CONTINUE
C
      KM12 = 2 * (JK - 1)
      KND = (JK - 1) * NG1P1 + 1
      KXD = KND
      KNU = JK * NG1P1 + 1
      KXU = KND
C
      DO 2111 JL = 1 , KDLON
      ZGLAYD(JL) = 0.
      ZGLAYU(JL) = 0.
 2111 CONTINUE
C
      DO 213 IG = 1 , NG1
      KBS = KM12 + IG
      KDD = KXD + IG
      DO 2113 JA = 1 , 4
      DO 2112 JL = 1 , KDLON
      ZUU(JL,JA) = PABCUCO2(JL,JA,KND) - PABCUCO2(JL,JA,KDD)
 2112 CONTINUE
 2113 CONTINUE
      DO ja=3,4
        DO jl=1,kdlon
        ztt(jl,ja)=pabcuaer(jl,ja-2,knd)/pabcuaer(jl,ja-2,kdd)
        ENDDO
      ENDDO
C
            CALL LWTT(KDLON,pga(1,jk),pgb(1,jk),ZUU,ZTT)
C
      DO 2114 JL = 1 , KDLON
      ZWTR=
     1     PDBSL(JL,1,KBS)*ZTT(JL,1)*ZTT(JL,3)
     2   + PDBSL(JL,2,KBS)*ZTT(JL,2)*ZTT(JL,4)
      ZGLAYD(JL)=ZGLAYD(JL)+ZWTR*WG1(IG)
 2114 CONTINUE
C
C*         2.1.2   UPWARD LAYERS
C                  ---------------
C
 2120 CONTINUE
C
      KMU = KXU + IG
      DO 2122 JA = 1 , 4
      DO 2121 JL = 1 , KDLON
      ZUU(JL,JA) = PABCUCO2(JL,JA,KMU) - PABCUCO2(JL,JA,KNU)
 2121 CONTINUE
 2122 CONTINUE
      DO ja=3,4
      DO jl=1,kdlon
        ztt(jl,ja)=pabcuaer(jl,ja-2,kmu)/pabcuaer(jl,ja-2,knu)
      ENDDO
      ENDDO
C
            CALL LWTT(KDLON,pga(1,jk),pgb(1,jk),ZUU,ZTT)
C
      DO 2123 JL = 1 , KDLON
      ZWTR=
     1     PDBSL(JL,1,KBS)*ZTT(JL,1)*ZTT(JL,3)
     2   + PDBSL(JL,2,KBS)*ZTT(JL,2)*ZTT(JL,4)
      ZGLAYU(JL)=ZGLAYU(JL)+ZWTR*WG1(IG)
 2123 CONTINUE
C
 213  CONTINUE
C
      DO 214 JL = 1 , KDLON
      PADJD(JL,JK) = ZGLAYD(JL)
c     PCNTRB(JL,JK,JK+1) = ZGLAYD(JL)
      PADJU(JL,JK+1) = ZGLAYU(JL)
c     PCNTRB(JL,JK+1,JK) = ZGLAYU(JL)
c     PCNTRB(JL,JK  ,JK) = 0.0
 214  CONTINUE
C
 215  CONTINUE
C
      DO 218 JK = 1 , KFLEV
      JK2 = 2 * JK
      JK1 = JK2 - 1
      DO 217 JNU = 1 , nir
      DO 216 JL = 1 , KDLON
      PDBDT(JL,JNU,JK) = PDBSL(JL,JNU,JK1) + PDBSL(JL,JNU,JK2)
 216  CONTINUE
 217  CONTINUE
 218  CONTINUE
C
      RETURN
C
C-----------------------------------------------------------------------
C                       FORMATS
C                       -------
C
 884  FORMAT (1X,F7.2,18F6.1,F7.2)
 886  FORMAT (1X,20I5)
 888  FORMAT (1X,13E9.2)
 890  FORMAT (1X,2I4,13F9.2)
C
      END