*=*=*=*= LWU.html =*=*=*=*
SUBROUTINE LWU

SUBROUTINE LWU


      SUBROUTINE LWU ( KDLON,KFLEV,KAER,KMODE,KFLUX,KRAD
     S  ,  PAER,PCCO2,PDP,PPMB,PPSOL,PQOF,PTAVE,PVIEW,PWV
     S  ,  PABCUCO2,PABCUAER             )
      IMPLICIT LOGICAL (L)
C
#include "dimensions.h"
#include "dimphys.h"
#include "dimradmars.h"
C
C**** *LWU* - LONGWAVE EFFECTIVE ABSORBER AMOUNTS
C
C     PURPOSE.
C     --------
C           COMPUTES ABSORBER AMOUNTS INCLUDING PRESSURE AND
C           TEMPERATURE EFFECTS
C
C**   INTERFACE.
C     ----------
C     SUBROUTINE LWU ( KDLON,KFLEV,KAER,KMODE,KFLUX,KRAD
C    S  ,  PAER,PCCO2,PDP,PPMB,PPSOL,PQOF,PTAVE,PVIEW,PWV
C    S  ,  KXDIA,KXT,KXTSU,KXTTP, PABCUCO2,PABCUAER             )
C
C        EXPLICIT ARGUMENTS :
C        --------------------
C     ==== INPUTS ===
C PAER   : (KDLON,KFLEV,5)     ; OPTICAL THICKNESS OF THE AEROSOLS
C PCCO2  :                     ; CONCENTRATION IN CO2 (PA/PA)
C PDP    : (KDLON,KFLEV)       ; LAYER PRESSURE THICKNESS (PA)
C PPMB   : (KDLON,0:KFLEV)     ; HALF LEVEL PRESSURE
C PPSOL  : (KDLON)             ; SURFACE PRESSURE
C PQOF   : (KDLON,KFLEV)       ; CONCENTRATION IN OZONE (PA/PA)
C PTAVE  : (KDLON,KFLEV)       ; TEMPERATURE
C PWV    : (KDLSUR,KFLEV)      ; SPECIFIC HUMIDITY PA/PA
C PVIEW  : (KDLON)             ; COSECANT OF VIEWING ANGLE
C     ==== OUTPUTS ===
C KX...  : (KDLON,...          ; TEMPERATURE INDICES
C PABCUCO2  :(KDLON,NUACO2,3*KFLEV+1); EFFECTIVE ABSORBER AMOUNTS (CO2)
C PABCUAER  :(KDLON,NIR,3*KFLEV+1); EFFECTIVE ABSORBER AMOUNTS (AEROSOLS)
C
C        IMPLICIT ARGUMENTS :   NONE
C        --------------------
C
C     METHOD.
C     -------
C
C          1. COMPUTES THE PRESSURE AND TEMPERATURE WEIGHTED AMOUNTS OF
C     ABSORBERS.
C
C     EXTERNALS.
C     ----------
C
C          NONE
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 change rien a la bande CO2 : les quantites d'absorbant CO2
c! sont multipliees par 1.66 et les extinctions par les poussieres
c! sont directement calculees ici sous forme d'exponentielles.
c! pour les bandes "poussieres", on calcule les quantites d'absorbant
c! selon la normale (pas de facteur 1.66).
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 PAER(NDLO2,KFLEV,5), PDP(NDLO2,KFLEV)
     S  ,  PPMB(NDLO2,KFLEV+1), PPSOL(NDLO2), PQOF(NDLO2,KFLEV)
     S  ,  PTAVE(NDLO2,KFLEV), PVIEW(NDLO2),  PWV(NDLO2,KFLEV)
C
      REAL PABCUCO2(NDLO2,NUACO2,3*KFLEV+1)
      REAL PABCUAER(NDLO2,NIR,3*KFLEV+1)
C
C-------------------------------------------------------------------------
C
C*       0.2   LOCAL ARRAYS
C              ------------
      REAL ZABLY(NDLON,NUA,3*NFLEV+1)
     S  ,  ZDST(NDLON,NFLEV+1), ZDUC(NDLON, 3*NFLEV+1)
      REAL ZPHIO(NDLON)
      REAL ZPSC11(NDLON),ZPSC12(NDLON),ZPSC21(NDLON),ZPSC22(NDLON)
      REAL ZSSIG(NDLON,3*NFLEV+1)
     S  ,  ZUAER(NDLON,nir), ZXOZ(NDLON), ZXWV(NDLON)
      REAL zphi(ndlon,2),zpsi(ndlon,2)

      common/scratch/ZABLY,ZDST,ZDUC,ZSSIG
C
C-----------------------------------------------------------------------
C
C*         1.    INITIALIZATION
C                --------------
C
 100  CONTINUE
C
C-----------------------------------------------------------------------
C
C
C*         2.    PRESSURE OVER GAUSS SUB-LEVELS
C                ------------------------------
C
 200  CONTINUE
C
      DO 201 JL = 1 , KDLON
      ZSSIG(JL, 1 ) = 1.0
 201  CONTINUE
C
      DO 206 JK = 1 , KFLEV
      JKJ=(JK-1)*NG1P1+1
      JKJR = JKJ
      JKJP = JKJ + NG1P1
      DO 203 JL = 1 , KDLON
      ZSSIG(JL,JKJP)=PPMB(JL,JK+1)/PPMB(JL,1)
 203  CONTINUE
      DO 205 IG1=1,NG1
      JKJ=JKJ+1
      DO 204 JL = 1 , KDLON
      ZSSIG(JL,JKJ)= (ZSSIG(JL,JKJR)+ZSSIG(JL,JKJP))*0.5
     S  + RT1(IG1) * (ZSSIG(JL,JKJP) - ZSSIG(JL,JKJR)) * 0.5
 204  CONTINUE
 205  CONTINUE
 206  CONTINUE

C
C-----------------------------------------------------------------------
C
C
C*         4.    PRESSURE THICKNESS AND MEAN PRESSURE OF SUB-LAYERS
C                --------------------------------------------------
C
 400  CONTINUE

c-----------------------------------------------------------------------
c ATTENTION AUX UNITES:
c psol est en Pa
c pmb, comme son nom l'indique est en mb
c le facteur .1 dans ZABLY(JL,3,JKI) fait passer des kg m-2 aux g cm-2
c  ZDPM est la quantite d'absorbant en g cm-2
c  ZPPP est la pression en Pa
c-----------------------------------------------------------------------

      DO 402 JKI=1,3*KFLEV
      JKIP1=JKI+1
      DO 401 JL = 1 , KDLON
      ZABLY(JL,5,JKI)=(ZSSIG(JL,JKI)+ZSSIG(JL,JKIP1))*0.5
      ZABLY(JL,3,JKI)=(ZSSIG(JL,JKI)-ZSSIG(JL,JKIP1))
     S                       *PPSOL(JL)/(10.*RG)
 401  CONTINUE
 402  CONTINUE
C
      DO 406 JK = 1 , KFLEV
      JKP1=JK+1
      JKL = KFLEV+1 - JK
      JKJ=(JK-1)*NG1P1+1
      JKJPN=JKJ+NG1
      DO 405 JKK=JKJ,JKJPN
      DO 404 JL = 1 , KDLON
      ZDPM = ZABLY(JL,3,JKK)
      ZPPP = ZABLY(JL,5,JKK) * PPSOL(JL)
      ZDUC(JL,JKK)=ZDPM
      ZABLY(JL,1,JKK)= PCCO2  * ZDPM
      ZABLY(JL,2,JKK)= PCCO2  * ZDPM * ZPPP / 101325.
 404  CONTINUE
 405  CONTINUE
 406  CONTINUE
C

C-----------------------------------------------------------------------
C
C
C*         5.    CUMULATIVE ABSORBER AMOUNTS FROM TOP OF ATMOSPHERE
C                --------------------------------------------------
C
 500  CONTINUE
C
      DO 502 JI=1,NUACO2
      DO 501 JL = 1 , KDLON
      PABCUCO2(JL,JI,3*KFLEV+1)=0.
 501  CONTINUE
 502  CONTINUE
C
      DO 503 JI=1,NIR
      DO 504 JL = 1 , KDLON
      PABCUAER(JL,JI,3*KFLEV+1)=0.
 504  CONTINUE
 503  CONTINUE
C
      DO 529 JK = 1 , KFLEV
      JJ=(JK-1)*NG1P1+1
      JJPN=JJ+NG1
      JKL=KFLEV+1-JK
C
C
C*         5.1  CUMULATIVE AEROSOL AMOUNTS FROM TOP OF ATMOSPHERE
C               --------------------------------------------------
C
 510  CONTINUE
C
      JAE1=3*KFLEV+1-JJ
      JAE2=3*KFLEV+1-(JJ+1)
      JAE3=3*KFLEV+1-JJPN
      DO iir=1,nir
        do jl=1,kdlon
          zuaer(jl,iir)=0.
          do itra=1,ntra
             zuaer(jl,iir)=
     &       zuaer(jl,iir)+qextaer(iir)*paer(jl,jkl,itra)
          enddo
          zuaer(jl,iir)=zuaer(jl,iir)/
     &      (ZDUC(JL,JAE1)+ZDUC(JL,JAE2)+ZDUC(JL,JAE3))
        enddo
      enddo
C

C
C*         5.2  INTRODUCES TEMPERATURE EFFECTS ON ABSORBER AMOUNTS
C               --------------------------------------------------
C
 520  CONTINUE
C
C
      DO ja=1,2
         DO jl=1,kdlon
c   modif 20 09 96, consolidation du code
            ztx=sign(min(abs(ptave(jl,jkl)-tref),70.)
     ,         ,ptave(jl,jkl)-tref)
            ztx2=ztx*ztx
            zphi(jl,ja)=at(1,ja)*ztx+bt(1,ja)*ztx2
            zpsi(jl,ja)=at(2,ja)*ztx+bt(2,ja)*ztx2
            zphi(jl,ja)=exp(zphi(jl,ja)/cst_voigt(2,ja))
            zpsi(jl,ja)=exp(2.*zpsi(jl,ja))
         ENDDO
      ENDDO


c-----------------------------------------------------------------------
c   ZABLY(1) quantite d'absorbant u en g ms-2
c   ZABLY(2) u*p/p0
c-----------------------------------------------------------------------

      DO jkk=jj,jjpn
         jc=3*kflev+1-jkk
         jcp1=jc+1
c!
c! le co2
c!
         DO jl=1,kdlon
           zdiff = pview(jl)
           pabcuco2(jl,1,jc)=pabcuco2(jl,1,jcp1)
     S +                   zably(jl,1,jc)*zphi(jl,1)*zdiff
           pabcuco2(jl,2,jc)=pabcuco2(jl,2,jcp1)
     s +                   zably(jl,2,jc)*zpsi(jl,1)*zdiff
           pabcuco2(jl,3,jc)=pabcuco2(jl,3,jcp1)
     S +                   zably(jl,1,jc)*zphi(jl,2)*zdiff
           pabcuco2(jl,4,jc)=pabcuco2(jl,4,jcp1)
     s +                   zably(jl,2,jc)*zpsi(jl,2)*zdiff
         ENDDO
c!

c! les poussieres dans toutes les bandes (y compris la bande co2)
c!
         DO iir=1,nir
            DO jl=1,kdlon
               pabcuaer(jl,iir,jc)=pabcuaer(jl,iir,jcp1)
     S                +zuaer(jl,iir)    *zduc(jl,jc)
            ENDDO
         ENDDO
      ENDDO
C
 529  CONTINUE
C
c!
c! les poussieres dans la bande du co2
c!
c   on calcule directement les transmissions pour les aerosols.
c   on multiplie le Qext  par 1-omega dans la bande du CO2.
c   et pourquoi pas d'abord?  hourdin@lmd.ens.fr

      DO jc=1,3*kflev+1
        DO iir=1,2
          DO jl=1,kdlon
               zzz=pview(jl)*(1.-omegaer(iir))
             pabcuaer(jl,iir,jc)=exp(-zzz*pabcuaer(jl,iir,jc))
          ENDDO
        ENDDO
      ENDDO
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