*=*=*=*= LWV.html =*=*=*=*
SUBROUTINE LWV

SUBROUTINE LWV


      SUBROUTINE LWV (KDLON,KFLEV,KMODE,KFLUX,KRAD,KUAER,KTRAER
     S  , pga,pgb,pgab,pgbb
     S  , PABCUCO2,PABCUAER,PBINT,PBSUIN,PBSUR,PBTOP,PDBSL,PEMIS,PTAVE
     S  , PCTS,PHFG,PEMD,PEMU,PCOLC,PFLUC                 )
      IMPLICIT LOGICAL (L)
C
#include "dimensions.h"
#include "dimphys.h"
#include "dimradmars.h"
C
C**** *LWV*   - LONGWAVE RADIATION, VERTICAL INTEGRATION
C
C     PURPOSE.
C     --------
C           CARRIES OUT THE VERTICAL INTEGRATION TO GIVE LONGWAVE
C           FLUXES OR RADIANCES
C
C**   INTERFACE.
C     ----------
C     SUBROUTINE LWV ( KDLON,KFLEV,KMODE,KFLUX,KRAD,KUAER,KTRAER
C    S  , KXDIA,KXT,KXTSU,KXTTP
C    S  , PABCUCO2,PABCUAER,PBINT,PBSUIN,PBSUR,PBTOP,PDBSL,PEMIS,PTAVE
C    S  , PCNTRB,PCTS,PHFG,PEMD,PEMU,PCOLC,PFLUC                 )
C
C        EXPLICIT ARGUMENTS :
C        --------------------
C     ==== INPUTS ===
C KX...    (KDLON,...          ; TEMPERATURE INDICES
C PABCUCO2 : (KDLON,NUACO2,3*KFLEV+1); ABSORBER AMOUNTS (CO2)
C PABCUAER : (KDLON,NUAAER,3*KFLEV+1); ABSORBER AMOUNTS (AEROSOLS)
C PBINT  : (KDLON,0:KFLEV)     ; HALF-LEVEL PLANCK FUNCTION
C PBSUIN : (KDLON)             ; SURFACE PLANCK FUNCTION
C PBSUR  : (KDLON,nir)        ; SURFACE SPECTRAL PLANCK FUNCTION
C PBTOP  : (KDLON,nir)        ; T.O.A. SPECTRAL PLANCK FUNCTION
C PDBSL  : (KDLON,KFLEV*2)     ; SUB-LAYER PLANCK FUNCTION GRADIENT
C PEMIS  : (KDLON)             ; SURFACE EMISSIVITY
C PTAVE  : (KDLON,KFLEV)       ; TEMPERATURE
C     ==== OUTPUTS ===
c   tableau retire
C PCNTRB : (KDLON,KFLEV+1,KFLEV+1); CLEAR-SKY ENERGY EXCHANGE MATRIX
C PCTS   : (KDLON,KFLEV)       ; COOLING-TO-SPACE TERM
C PHFG   : (KDLON,KFLEV)       ; HEATING-FROM-GROUND TERM
C PEMD   : (KDLON,KFLEV)       ; CLEAR-SKY LAYER DOWNWARD EMISSIVITY
C PEMU   : (KDLON,KFLEV)       ; CLEAR-SKY LAYER UPWARD EMISSIVITY
C  IF KMODE = 0, 1, 2
C PFLUC(KDLON,2,KFLEV)         ; RADIATIVE FLUXES CLEAR-SKY:
C                     1  ==>  UPWARD   FLUX TOTAL
C PCOLC(KDLON,KFLEV)           ; LONG-WAVE TENDENCY CLEAR SKY
C
C        IMPLICIT ARGUMENTS :   NONE
C        --------------------
C
C     METHOD.
C     -------
C
C          1. PERFORMS THE VERTICAL INTEGRATION DISTINGUISHING BETWEEN
C     CONTRIBUTIONS BY -  THE NEARBY LAYERS
C                      -  THE DISTANT LAYERS
C                      -  THE BOUNDARY TERMS
C          2. COMPUTES THE CLEAR-SKY DOWNWARD AND UPWARD EMISSIVITIES.
C
C     EXTERNALS.
C     ----------
C
C          *LWVN*, *LWVD*, *LWVB*
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! 1)
c! la bande a 15 micron (CO2) reste inchangee : les poussieres
c! n'interviennent que comme un milieu gris non diffusif avec
c!                      Q=Qext*(1-Omega)
c! cette bande est decoupee en deux sous bandes (indices 1 et 2)
c! pour lesquelles les parametres optiques des poussieres sont
c! identiques
c! 2)
c! le reste est decoupe en 4 bandes : une bande qui recouvre toutes
c! les longueurs d'onde inferieures a celles de la bande a 15 microns
c! (indice 3) et trois bandes pour les grandes longueurs d'onde
c! (indices 4,5 et 6). sue chacune de ces 4 bandes, les poussieres
c! sont supposees diffusantes grises.
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*       0.1   ARGUMENTS
C              ---------
C
      REAL pga(NDLO2*2*3,kflev+1),pgb(NDLO2*2*3,kflev+1)
      REAL pgab(NDLO2*2*3,2),pgbb(NDLO2*2*3,2)

      REAL PABCUCO2(NDLO2,NUACO2,3*KFLEV+1)
      REAL PABCUAER(NDLO2,NIR,3*KFLEV+1)
      REAL PBINT(NDLO2,KFLEV+1)
     S  ,  PBSUR(NDLO2,nir), PBSUIN(NDLO2), PBTOP(NDLO2,nir)
     S  ,  PDBSL(NDLO2,nir,KFLEV*2), PEMIS(NDLO2)
     S  ,  PTAVE(NDLO2,KFLEV)
C
      REAL PCOLC(NDLO2,KFLEV)
     S  ,  PCTS(NDLO2,KFLEV), PEMD(NDLO2,KFLEV), PEMU(NDLO2,KFLEV)
     S  ,  PFLUC(NDLO2,2,KFLEV+1), PHFG(NDLO2,KFLEV)
C
C-------------------------------------------------------------------------
C
C*       0.2   LOCAL ARRAYS
C              ------------
C
      INTEGER ITX(NDLON)
C
      REAL ZADJD(NDLON,NFLEV+1), ZADJU(NDLON,NFLEV+1)
     S  ,  ZDBDT(NDLON,nir,NFLEV)
     S  ,  ZDISD(NDLON,NFLEV+1), ZDISU(NDLON,NFLEV+1)
     S  ,  ZFD(NDLON), ZFDN(NDLON,NFLEV+1), ZFU(NDLON)
     S  ,  ZFUP(NDLON,NFLEV+1),ZGLAYD(NDLON),ZGLAYU(NDLON)
     S  ,  ZOMEGADD(NDLON,NFLEV*2),ZGDD(NDLON,NFLEV*2)
     S  ,  ZTAUDD(NDLON,NFLEV*2)
     S  ,  ZBHDD(NDLON,NFLEV*2+1),ZBSDD(NDLON)
     S  ,  ZZBHDD(NDLON,NFLEV*2+1),ZZBSDD(NDLON)
     S  ,  ZFAHDD(NDLON,NFLEV*2+1),ZFDHDD(NDLON,NFLEV*2+1)
     S  ,  ZZFAHDD(NDLON,NFLEV*2+1),ZZFDHDD(NDLON,NFLEV*2+1)
C
      COMMON/scratch/ZADJD, ZADJU
     S  ,  ZDBDT
     S  ,  ZDISD, ZDISU
     S  ,  ZFD, ZFDN, ZFU
     S  ,  ZFUP,ZGLAYD,ZGLAYU
     S  ,  ZOMEGADD,ZGDD
     S  ,  ZTAUDD
     S  ,  ZBHDD,ZBSDD
     S  ,  ZZBHDD,ZZBSDD
     S  ,  ZFAHDD,ZFDHDD
     S  ,  ZZFAHDD,ZZFDHDD
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
      ZADJD(JL,JK) = 0.
      ZADJU(JL,JK) = 0.
      ZDISD(JL,JK) = 0.
      ZDISU(JL,JK) = 0.
 111  CONTINUE
 112  CONTINUE
C
      DO 114 JK = 1 , KFLEV
      DO 113 JL = 1 , KDLON
      PCTS(JL,JK) = 0.
      PHFG(JL,JK) = 0.
 113  CONTINUE
 114  CONTINUE
C
C     ------------------------------------------------------------------
C
C*         2.      VERTICAL INTEGRATION
C                  --------------------
C
C     ------------------------------------------------------------------
C
C
C  ==================================================================
C*         2.0     contribution des bandes "hors co2"
C  ==================================================================
C
 200  CONTINUE
C
C     ------------------------------------------------------------------
C
C*         2.0.1   preparation des Planck a chaque hauteur
C                  ----------------------------------
C
c!
c! le nombre de couche pour la diffusion sera le nombre de layer * 2
c! soit NDD=KFLEV*2, donc la taille du vecteur des Planck sera
c! KFLEV*2 + 1. la taille des vecteurs omega / g / tau sera
c! par contre KFLEV*2 (voir dans FLUSV.F).
c!
      NDD=KFLEV*2
      DO indd=1,ndd+1
                                            do jl=1,kdlon
         ZFAHDD(jl,indd)=0.
         ZFDHDD(jl,indd)=0.
         ZBHDD(jl,indd)=0.
                                            enddo
      ENDDO
                                            do jl=1,kdlon
      ZBSDD(jl)=0.
                                            enddo
c!
c! boucle sur les 4 bandes hors CO2
c!
      DO 10001 iir=3,nir
c!
                                            do jl=1,kdlon
        ZZBHDD(JL,1)=PBTOP(JL,iir)/rpi
                                            enddo
        DO J1=2,NDD+1
                                            do jl=1,kdlon
           ZZBHDD(JL,J1)=
     &     ZZBHDD(JL,J1-1)-PDBSL(JL,iir,NDD-J1+2)/rpi
                                            enddo
        ENDDO
                                            do jl=1,kdlon
        ZZBSDD(JL)=PBSUR(JL,iir)/rpi
                                            enddo
C
C     ------------------------------------------------------------------
C
C*         2.0.2   preparation des coefficients de diffusion
C                  -----------------------------------------
C
        ZOM=omegaer(iir)
        ZG=gaer(iir)
c! les omega, g, tau ... boucle de bas en haut
        DO J2=1,KFLEV-1
          J2DD2=(KFLEV-J2+1)*2
          J2DD1=J2DD2-1
          J2BOT=3*J2-2
          J2TOP=3*J2+1
                                            do jl=1,kdlon
          ZTADD=(PABCUAER(JL,iir,J2BOT)-PABCUAER(JL,iir,J2TOP))*0.5
          ZTAUDD(JL,J2DD1)=ZTADD
          ZTAUDD(JL,J2DD2)=ZTADD
          ZOMEGADD(JL,J2DD1)=ZOM
          ZOMEGADD(JL,J2DD2)=ZOM
          ZGDD(JL,J2DD1)=ZG
          ZGDD(JL,J2DD2)=ZG
                                            enddo
        ENDDO
        J2=KFLEV
        J2DD2=2
        J2DD1=1
        J2BOT=3*J2-2
                                            do jl=1,kdlon
        ZTADD=PABCUAER(JL,iir,J2BOT)*0.5
        ZTAUDD(JL,J2DD1)=ZTADD
        ZTAUDD(JL,J2DD2)=ZTADD
        ZOMEGADD(JL,J2DD1)=ZOM
        ZOMEGADD(JL,J2DD2)=ZOM
        ZGDD(JL,J2DD1)=ZG
        ZGDD(JL,J2DD2)=ZG
                                            enddo
C
C     ------------------------------------------------------------------
C
C*         2.0.3   calcul de la diffusion
C                  ----------------------
C
        CALL flusv(KDLON,0
     &  ,NDD,ZOMEGADD,ZGDD,ZTAUDD,PEMIS
     &  ,ZZBHDD,ZZBSDD
     &  ,ZZFAHDD,ZZFDHDD)
c!
c!  Cumul des flux sur le spectre hors bande du CO2
c!
        DO indd=1,ndd+1
                                            do jl=1,kdlon
           ZFAHDD(jl,indd)=ZFAHDD(jl,indd)+ZZFAHDD(jl,indd)
           ZFDHDD(jl,indd)=ZFDHDD(jl,indd)+ZZFDHDD(jl,indd)
           ZBHDD(jl,indd)=ZBHDD(jl,indd)+ZZBHDD(jl,indd)*rpi
                                            enddo
        ENDDO
                                            do jl=1,kdlon
        ZBSDD(jl)=ZBSDD(jl)+ZZBSDD(jl)*rpi
                                            enddo
c!
10001 CONTINUE
c!
C
C  ==================================================================
C   TRAITEMENT DE LA BANDE DE CO2 (Richard lui souhaite longue vie!)
C  ==================================================================

C     ------------------------------------------------------------------
C
C*         2.1     CONTRIBUTION FROM ADJACENT LAYERS
C                  ---------------------------------
C
      CALL LWVN ( KDLON,KFLEV,KUAER,KTRAER
     S  , pga,pgb, PABCUCO2,PABCUAER,PDBSL
     S  , ZADJD,ZADJU,ZDBDT                              )
C
C     ------------------------------------------------------------------
C
C*         2.2     CONTRIBUTION FROM DISTANT LAYERS
C                  ---------------------------------
C
 220  CONTINUE
C
      CALL LWVD ( KDLON,KFLEV,KUAER,KTRAER
     S  , pga,pgb,  PABCUCO2,PABCUAER,ZDBDT
     S  , ZDISD,ZDISU                             )
C
C     ------------------------------------------------------------------
C
C*         2.3     EXCHANGE WITH THE BOUNDARIES
C                  ----------------------------
c!
c! Les Plancks cumules hors CO2 sont passes a LWVB
c! pour corriger les BINT, BSURI et autres ...
c!
C
 230  CONTINUE
C
      CALL LWVB ( KDLON,KFLEV,KUAER,KTRAER
     S  , pgab,pgbb
     S  , PABCUCO2,PABCUAER,ZADJD,ZADJU,PBINT,PBSUIN,PBSUR,PBTOP
     S  , ZDISD,ZDISU,PEMIS
     S  , ZBHDD,ZBSDD
     S  , PCTS,PHFG,PFLUC                     )
C
C     ------------------------------------------------------------------
C
C*         2.3.1   somme de tous les flux
C                  ----------------------
c!
c! les flux du CO2 sont dans PFLUC. on y ajoute les resulats du
c! calcul diffusif hors CO2.
c!
      DO J2=1,KFLEV+1
      J2DD=(KFLEV-J2+1)*2+1
                                            do jl=1,kdlon
      PFLUC(JL,1,J2)=PFLUC(JL,1,J2)+ZFAHDD(JL,J2DD)
      PFLUC(JL,2,J2)=PFLUC(JL,2,J2)-ZFDHDD(JL,J2DD)
                                            enddo
      ENDDO
C
C     ------------------------------------------------------------------
C
C*         2.4     CLEAR-SKY FLUXES
C                  ----------------
C
 240  CONTINUE
C
c     IF (NIMP.LT.4) THEN
c        WRITE(NOUT,884) (PFLUC(NIMPRAD,1,JK),JK = 1 , KFLEV+1)
c        WRITE(NOUT,884) (PFLUC(NIMPRAD,2,JK),JK = 1 , KFLEV+1)
c     END IF
C
C     ------------------------------------------------------------------
C
C*         3.      EFFECTIVE DOWNWARD AND UPWARD CLEAR-SKY EMISSIVITIES
C                  ----------------------------------------------------
C
 300  CONTINUE
C
      DO 302 JKL = 1 , KFLEV
      JK = KFLEV+1 - JKL
      DO 301 JL = 1 , KDLON
      ZDFNET = PFLUC(JL,1,JK+1) + PFLUC(JL,2,JK+1)
     S              -PFLUC(JL,1,JK  ) - PFLUC(JL,2,JK  )
      PCOLC(JL,JK) = ZDFNET
      PEMD(JL,JK)= (-PFLUC(JL,2,JK)+PFLUC(JL,2,JK+1))
     S               /(RSIGMA*PTAVE(JL,JK)**4.+PFLUC(JL,2,JK+1))
      PEMU(JL,JKL)=(PFLUC(JL,1,JKL+1)-PFLUC(JL,1,JKL))
     S               /(RSIGMA*PTAVE(JL,JKL)**4.-PFLUC(JL,1,JKL))
 301  CONTINUE
 302  CONTINUE
C
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