*=*=*=*= LWMAIN.html =*=*=*=*
SUBROUTINE LWMAIN

SUBROUTINE LWMAIN


       SUBROUTINE LWMAIN( KDLON,KFLEV,KAER,KMODE,KFLUX,KRAD
     S  , PCCO2,PCLDLW,PDP,PDT0,PEMIS,PPMB,PPSOL,PQOF,PTL
     S  , PAER,PTAVE,PVIEW,PWV
     S  , PEMD,PEMU,PCOLR,PCOLC,PFLUX,PFLUC,PRAD,PRADC  )
      IMPLICIT LOGICAL (L)
C
#include "dimensions.h"
#include "dimphys.h"
#include "dimradmars.h"
C
C**** *LW*   - ORGANIZES THE LONGWAVE CALCULATIONS
C
C     PURPOSE.
C     --------
C           DEPENDING ON KMODE, COMPUTES LONGWAVE FLUXES AND/OR
C           RADIANCES
C
C**   INTERFACE.
C     ----------
C      SUBROUTINE LWMAIN ( KDLON,KFLEV,KAER,KMODE,KFLUX,KRAD
C    S  , PCCO2,PCLDLW,PDP,PDT0,PEMIS,PPMB,PPSOL,PQOF,PTL
C    S  , PAER,PTAVE,PVIEW,PWV
C    S  , PEMD,PEMU,PCOLR,PCOLC,PFLUX,PFLUC,PRAD,PRADC  )
C
C        EXPLICIT ARGUMENTS :
C        --------------------
C PEMIS  : (KDLON)             ; SURFACE EMISSIVITY
C PCCO2  :                     ; CONCENTRATION IN CO2 (PA/PA)
C PQOF   : (KDLON,KFLEV)       ; CONCENTRATION IN OZONE (PA/PA)
C PTAVE  : (KDLON,KFLEV)       ; TEMPERATURE
C PTL    : (KDLON,0:KFLEV)     ; HALF LEVEL TEMPERATURE
C PPMB   : (KDLON,0:KFLEV)     ; HALF LEVEL PRESSURE
C PWV    : (KDLSUR,KFLEV)      ; SPECIFIC HUMIDITY PA/PA
C PCLDLW : (KDLON,KFLEV)       ; CLOUD FRACTIONAL COVER
C PAER   : (KDLON,KFLEV,5)     ; OPTICAL THICKNESS OF THE AEROSOLS
C PVIEW  : (KDLON)             ; COSECANT OF VIEWING ANGLE
C     ==== OUTPUTS ===
C  IF KMODE = 0, 1, 2
C PFLUX(KDLON,2,KFLEV)         ; RADIATIVE FLUXES :
C                     1  ==>  UPWARD   FLUX TOTAL
C                     2  ==>  DOWNWARD FLUX TOTAL
C PFLUC(KDLON,2,KFLEV)         ; RADIATIVE FLUXES CLEAR SKY:
C                     1  ==>  UPWARD   FLUX TOTAL
C                     2  ==>  DOWNWARD FLUX TOTAL
C PCOLR(KDLON,KFLEV)           ; LONG-WAVE TENDENCY
C PCOLC(KDLON,KFLEV)           ; LONG-WAVE TENDENCY CLEAR SKY
C  IF KMODE = 2, 3
C PRAD (KDLON,KRAD)            ; RADIANCES
C PRADC(KDLON,KRAD)            ; CLEAR SKY RADIANCES
C
C        IMPLICIT ARGUMENTS :   NONE
C        --------------------
C
C     METHOD.
C     -------
C
C          1. COMPUTES THE PRESSURE AND TEMPERATURE WEIGHTED AMOUNTS OF
C     ABSORBERS.
C          2. COMPUTES THE PLANCK FUNCTIONS ON THE INTERFACES AND THE
C     GRADIENT OF PLANCK FUNCTIONS IN THE LAYERS.
C          3. PERFORMS THE VERTICAL INTEGRATION DISTINGUISHING THE CON-
C     TRIBUTIONS OF THE ADJACENT AND DISTANT LAYERS AND THOSE FROM THE
C     BOUNDARIES.
C          4. COMPUTES THE CLEAR-SKY DOWNWARD AND UPWARD EMISSIVITIES.
C          5. INTRODUCES THE EFFECTS OF THE CLOUDS ON THE FLUXES.
C
C     EXTERNALS.
C     ----------
C
C          *LWU*, *LWB*, *LWV*, *LWC*
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
#include "yomcst.h"
#include "yomrad.h"
#include "yomrdu.h"
#include "yomaer.h"
#include "yomsw.h"
#include "yomlw.h"
C
C-----------------------------------------------------------------------
C
C*       0.1   ARGUMENTS
C              ---------
C
      REAL PCLDLW(NDLO2,KFLEV), PDP(NDLO2,KFLEV), PDT0(NDLO2)
     S  ,  PEMIS(NDLO2), PPMB(NDLO2,KFLEV+1)
     S  ,  PPSOL(NDLO2), PQOF(NDLO2,KFLEV), PTL(NDLO2,KFLEV+1)
     S  ,  PAER(NDLO2,KFLEV,5), PTAVE(NDLO2,KFLEV), PVIEW(NDLO2)
     S  ,  PWV(NDLO2,KFLEV)
C
      REAL PEMD(NDLO2,KFLEV), PEMU(NDLO2,KFLEV), PCOLR(NDLO2,KFLEV)
     S  ,  PCOLC(NDLO2,KFLEV), PFLUX(NDLO2,2,KFLEV+1)
     S  ,  PFLUC(NDLO2,2,KFLEV+1), PRAD(NDLO2,KRAD),PRADC(NDLO2,KRAD)
C
C-------------------------------------------------------------------------
C
C*       0.2   LOCAL ARRAYS
C              ------------
C
      REAL zga(ndlon*2*3,nflev+1),zgb(ndlon*2*3,nflev+1)
      REAL zgab(ndlon*2*3,2),zgbb(ndlon*2*3,2)

      REAL ZABCUCO2(NDLON,NUACO2,3*NFLEV+1)
      REAL ZABCUAER(NDLON,nir,3*NFLEV+1)
      REAL ZBINT(NDLON,NFLEV+1)
     S  ,  ZBSUR(NDLON,nir), ZBSUI(NDLON), ZBTOP(NDLON,nir)
     S  ,  ZCTS(NDLON,NFLEV)
c  soulagement d'un gros tableau inutile
c    S  , ZCNTRB(NDLON,NFLEV+1,NFLEV+1)
     S  , ZDBSL(NDLON,nir,NFLEV*2), ZFDN(NDLON,NFLEV+1)
     S  ,  ZFUP(NDLON,NFLEV+1), ZHFG(NDLON,NFLEV)
C
C     ------------------------------------------------------------------
C
C*         1.    INITIALIZATION
C                --------------
C
 100  CONTINUE
C
C     ------------------------------------------------------------------
C
C*         1.1   COMPUTES ABSORBER AMOUNTS
C                -------------------------
C
 110  CONTINUE
C
      CALL LWU ( KDLON,KFLEV,KAER,KMODE,KFLUX,KRAD
     S  ,  PAER,PCCO2,PDP,PPMB,PPSOL,PQOF,PTAVE,PVIEW,PWV
     S  ,  ZABCUCO2,ZABCUAER                      )
C
C     ------------------------------------------------------------------
C
C*         2.    COMPUTES PLANCK FUNCTIONS
C                -------------------------
C
 200  CONTINUE
C
       CALL LWB ( KDLON,KFLEV,KMODE,KFLUX,KRAD
     S          , PDT0,PTAVE,PTL
     S          , ZBINT,ZBSUI,ZBSUR,ZBTOP,ZDBSL
     S          , zga,zgb,zgab,zgbb)
C
C     ------------------------------------------------------------------
C
C*         3.    PERFORMS THE VERTICAL INTEGRATION
C                ---------------------------------
C
 300  CONTINUE
C
      CALL LWV ( KDLON,KFLEV,KMODE,KFLUX,KRAD,NUAER,NTRAER
     s   ,  zga,zgb,zgab,zgbb
     S  , ZABCUCO2,ZABCUAER,ZBINT,ZBSUI,ZBSUR,ZBTOP,ZDBSL,PEMIS,PTAVE
     S  , ZCTS,ZHFG,PEMD,PEMU,PCOLC,PFLUC                     )
C
      DO 302 JK = 1 , KFLEV+1
      DO 301 JL = 1 , KDLON
      ZFDN(JL,JK) = PFLUC(JL,2,JK)
      ZFUP(JL,JK) = PFLUC(JL,1,JK)
 301  CONTINUE
 302  CONTINUE
C
      DO 303 JL = 1 , KDLON
      PFLUC(JL,1,KFLEV+1) = PFLUC(JL,1,KFLEV)+ZCTS(JL,KFLEV)
     S                      - ZHFG(JL,KFLEV)
     S                      + PFLUC(JL,2,KFLEV)
 303  CONTINUE
C
      DO 306 JK = 1 , KFLEV
      DO 305 JL = 1 , KDLON
      ZDFNET = PFLUC(JL,1,JK  ) + PFLUC(JL,2,JK  )
     S        -PFLUC(JL,1,JK+1) - PFLUC(JL,2,JK+1)
      PCOLC(JL,JK) = CDAY * ZDFNET / PDP(JL,JK)
 305  CONTINUE
 306  CONTINUE
C
      IF (NIMP.LT.4) THEN
       PRINT*,'NIMP = ',NIMP
         WRITE(NOUT,9300)
         WRITE(NOUT,9301) (PFLUC(JLIMPRAD,1,JK),JK = 1 , KFLEV+1)
         WRITE(NOUT,9301) (PFLUC(JLIMPRAD,2,JK),JK = 1 , KFLEV+1)
         WRITE(NOUT,9302) (PCOLC(JLIMPRAD,JK),JK = 1 , KFLEV)
      END IF
C
C     ------------------------------------------------------------------
C
C*         4.    INTRODUCES THE EFFECTS OF CLOUDS
C                --------------------------------
C
 400  CONTINUE
C
c   a partir de la c'est les nuages et on enleve tout
c      CALL LWC ( KDLON,KFLEV
c    S  ,  ZBINT,ZBSUI,PCLDLW,ZCTS,PEMIS,ZFDN,ZFUP,ZHFG
c    S  ,  PFLUX                                                )
c
c     DO 402 JK = 1 , KFLEV
c     DO 401 JL = 1 , KDLON
c     ZDFNET = PFLUX(JL,1,JK  ) + PFLUX(JL,2,JK  )
c    S        -PFLUX(JL,1,JK+1) - PFLUX(JL,2,JK+1)
c     PCOLR(JL,JK) = CDAY * ZDFNET / PDP(JL,JK)
c401  CONTINUE
c402  CONTINUE
c
c     ------------------------------------------------------------------
c
c*         5.    FILLS UP DIAGNOSTIC ARRAYS
c                --------------------------
c
c500  CONTINUE
c
c
c     IF (NIMP.LT.4) THEN
c        WRITE(NOUT,9500)
c        WRITE(NOUT,9501) (PFLUX(JLIMPRAD,1,JK),JK = 1 , KFLEV+1)
c        WRITE(NOUT,9501) (PFLUX(JLIMPRAD,2,JK),JK = 1 , KFLEV+1)
c        WRITE(NOUT,9502) (PCOLR(JLIMPRAD,JK),JK = 1 , KFLEV)
c     END IF
c
c     ------------------------------------------------------------------
C
      RETURN
C
C-----------------------------------------------------------------------
C                       FORMATS
C                       -------
C
 9300 FORMAT (1X,'LW-CLEAR FLUXES')
 9301 FORMAT (1X,'LW-C',F7.2,18F6.1,F7.2)
 9302 FORMAT (1X,'LW-C',3X,19F6.3)
 9500 FORMAT (1X,'LW-TOTAL FLUXES')
 9501 FORMAT (1X,'LW-T',F7.2,18F6.1,F7.2)
 9502 FORMAT (1X,'LW-T',3X,19F6.3)
C
      END