*=*=*=*= lwmain.html =*=*=*=*
subroutine lwmain

subroutine lwmain


       subroutine lwmain (ig0,icount,kdlon,kflev
     .                   ,dp,dt0,emis
     .                   ,plev,tlev,tlay,paer,coolrate,fluxground
     .                   ,netrad)

c----------------------------------------------------------------------
c     LWMAIN     organizes the longwave calculations
c----------------------------------------------------------------------

      implicit none

#include "dimensions.h"
#include "dimphys.h"
#include "dimradmars.h"
#include "callkeys.h"
#include "comg1d.h"

#include "yomcst.h"
#include "yomrad.h"
#include "yomrdu.h"
#include "yomaer.h"
#include "yomsw.h"
#include "yomlw.h"

c----------------------------------------------------------------------
c         0.1   arguments
c               ---------
c                                                            inputs:
c                                                            -------
      integer ig0
      integer icount
      integer kdlon            ! part of ngrid
      integer kflev            ! part of nlayer

      real dp (ndlo2,kflev)         ! layer pressure thickness (Pa)
      real dt0 (ndlo2)              ! surface temperature discontinuity (K)
      real emis (ndlo2)             ! surface emissivity
      real plev (ndlo2,kflev+1)     ! level pressure (Pa)
      real tlev (ndlo2,kflev+1)     ! level temperature (K)
      real tlay (ndlo2,kflev)       ! layer temperature (K)
      real paer (ndlo2,kflev)       ! optical thickness of the aerosol

c                                                            outputs:
c                                                            --------
      real coolrate(ndlo2,kflev)      ! cooling rate (K/j)
      real fluxground(ndlo2)          ! downward ground flux (W/m2)
      real netrad (ndlo2,kflev)       ! radiative budget (W/m2)

c----------------------------------------------------------------------
c         0.2   local arrays
c               ------------

      real aer_u (ndlon,nir,nflev+1)    ! absorber amounts (aer)
      real aer_t (ndlon,nuco2,nflev+1)  ! transmission (aer)
      real co2_u (ndlon,nuco2,nflev+1)  ! absorber amounts (co2)
      real co2_up (ndlon,nuco2,nflev+1) ! idem scaled by the pressure (co2)

      real bsurf (ndlon,nir)            ! surface spectral planck function
      real btop (ndlon,nir)             ! top spectral planck function
      real blev (ndlon,nir,nflev+1)     ! level   spectral planck function
      real blay (ndlon,nir,nflev)       ! layer   spectral planck function
      real dblay (ndlon,nir,nflev)      ! layer gradient spectral planck functio
      real dbsublay (ndlon,nir,2*nflev) ! layer gradient spectral planck functio
                                        ! in sub layers

      real newcoolrate(ndlon,nflev) ! cooling rate (K/j) / with implicite scheme

      integer jk,jkk,ja,jl

      logical firstcall
      save firstcall
      data firstcall/.true./

      real xi (ngridmx,nuco2,0:nlayermx+1,0:nlayermx+1)
      common/ksicom/xi

c----------------------------------------------------------------------
c         0.3   Initialisation
c               --------------

      if (firstcall) then

        firstcall = .false.

        do jkk = 0 , nlayermx+1
          do jk = 0 , nlayermx+1
            do ja = 1 , nuco2
              do jl = 1 , ngridmx
                  xi (jl,ja,jk,jkk)=0.
              enddo
            enddo
          enddo
        enddo

      endif

c----------------------------------------------------------------------
c         1.0   planck function
c               ---------------

      call lwb ( kdlon, kflev, tlev, tlay, dt0
     .         , bsurf, btop, blay, blev, dblay, dbsublay)

c----------------------------------------------------------------------
c         2.0   absorber amounts
c               ----------------

      call lwu ( kdlon, kflev, dp, plev, tlay, paer
     .         , aer_u, aer_t, co2_u, co2_up)

c----------------------------------------------------------------------
c         3.0   transmission functions / exchange coefficiants
c               ----------------------------------------------

c                                                                distants
c                                                                --------
                    if( mod(icount-1,ilwd).eq.0) then

      print*, 'CALL of DISTANTS'
      call lwxd ( ig0, kdlon, kflev, emis
     .          , aer_t, co2_u, co2_up)

                    endif
c                                                              neighbours
c                                                              ----------
                    if( mod(icount-1,ilwn).eq.0) then

      print*, 'CALL of NEIGHBOURS'
      call lwxn ( ig0, kdlon, kflev
     .          , dp
     .          , aer_t, co2_u, co2_up)

                    endif
c                                                              boundaries
c                                                              ----------
                    if( mod(icount-1,ilwb).eq.0) then

      print*, 'CALL of BOUNDARIES'
      call lwxb ( ig0, kdlon, kflev, emis
     .          , aer_t, co2_u, co2_up)

                    endif

c----------------------------------------------------------------------
c         4.0   cooling rate
c               ------------

      call lwflux ( ig0, kdlon, kflev, dp
     .            , bsurf, btop, blev, blay, dbsublay
     .            , tlay, tlev, dt0      ! pour sortie dans g2d uniquement
     .            , aer_u, emis
     .            , coolrate, fluxground
     .            , netrad)

c     do jk = 1, nlayermx
c       print*,coolrate(1,jk)
c     enddo

c       do jkk = 0 , nlayermx+1
c         do jk = 0 , nlayermx+1
c           do ja = 1 , nuco2
c             do jl = 1 , ngridmx
c      if (xi (jl,ja,jk,jkk) .LT. 0
c    .       .OR. xi (jl,ja,jk,jkk) .GT. 1 ) then
c                 print*,'xi bande',ja,jk,jkk,xi (jl,ja,jk,jkk)
c      endif
c             enddo
c           enddo
c         enddo
c       enddo

c----------------------------------------------------------------------
c
c          5.    shema semi-implicite  (lwi)
c                ---------------------------
c
c
      call lwi (ig0,kdlon,kflev,netrad,dblay,dp
     .          , newcoolrate)
c
c  Verif que   (X sol,space) + somme(X i,sol) = 1
c
      do jkk = 1 , kflev
        do jl = 1 , kdlon
c     print*,'NEW et OLD coolrate :',jkk,newcoolrate(jl,jkk)
c    .  ,coolrate(jl,jkk)
      coolrate(jl,jkk) = newcoolrate(jl,jkk)
        enddo
      enddo
c
c----------------------------------------------------------------------

      return
      end