*=*=*=*= lwi.html =*=*=*=*
subroutine lwi

subroutine lwi


      subroutine lwi (ig0,kdlon,kflev,psi,zdblay,pdp
     .                ,newpcolc )


      implicit logical (l)


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

CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C
C                             -   lwi    -
C
C     PURPOSE:       Shema semi - implicite
C
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC

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

c************************************************************************
c
c        0.    Declarations
c              ------------
c
c-------------------------------------------------------------------------
c        0.1   Arguments
c              ---------
c

      integer ig0

      real    psi(ndlo2,kflev)
     .     ,  zdblay(ndlo2,nir,kflev)
     .     ,  pdp(ndlo2,kflev)


      real    newpcolc(ndlo2,kflev)

c-------------------------------------------------------------------------
c        0.2   local arrays
c              ------------
c
      real    di(ndlon,nflev)
     .      , hi(ndlon,nflev)
     .      , bi(ndlon,nflev)

      real  , ci(ndlon,nflev)
     .      , ai(ndlon,nflev)

      real   semit

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

c************************************************************************
c
c        1.    Initialisations
c              ---------------
c
c-----------------------------------------------------------------------

        deltat = dtphys * iradia
c       print*,'SEMI = ',semi, '(expl:0  semi-implicite:0.5  impl:1)'
        semit = semi * deltat
c       semi = 0.

c       print*,'dtphys,iradia,deltat,semit:',dtphys,iradia,deltat,semit
c       print*,'g,cpp',g,cpp


c************************************************************************
c
c        2.
c              ---------------
c
c-------------------------------------------------------------------------
c        2.1   Calcul des di
c              -------------
c


      do i = 1 , kflev-1
        do jl = 1 , kdlon
c     -------------------
      di(jl,i) =  1 + semit * (g / pdp(jl,i) / cpp) * (
     .    ( xi(ig0+jl,1,i,kflev+1)
     .    + xi(ig0+jl,1,i,i+1)
     .    + xi(ig0+jl,1,i,i-1) )
     .    *    zdblay(jl,1,i)
     .  + ( xi(ig0+jl,2,i,kflev+1)
     .    + xi(ig0+jl,2,i,i+1)
     .    + xi(ig0+jl,2,i,i-1) )
     .    *    zdblay(jl,2,i)
     .     )
c     -------------------
        enddo
      enddo



c couche kflev
c ------------
c      , on enleve i,i+1 sinon on a 2 fois le cooling2space

      do jl = 1 , kdlon
c     -------------------
      di(jl,kflev) =  1 + semit * (g / pdp(jl,kflev) / cpp) * (
     .    ( xi(ig0+jl,1,kflev,kflev+1)
     .    + xi(ig0+jl,1,kflev,kflev-1) )
     .    *    zdblay(jl,1,kflev)
     .  + ( xi(ig0+jl,2,kflev,kflev+1)
     .    + xi(ig0+jl,2,kflev,kflev-1) )
     .    *    zdblay(jl,2,kflev)
     .     )
c     -------------------
      enddo


c-------------------------------------------------------------------------
c        2.2   Calcul des hi
c              -------------
c

      do i = 1 , kflev-1
        do jl = 1 , kdlon
c     -------------------
      hi(jl,i) =    - semit * (g / pdp(jl,i) / cpp) *
     .            (    xi(ig0+jl,1,i,i+1) * zdblay(jl,1,i+1)
     .               + xi(ig0+jl,2,i,i+1) * zdblay(jl,2,i+1)   )
c     -------------------
        enddo
      enddo

c-------------------------------------------------------------------------
c        2.3   Calcul des bi
c              -------------
c


      do i = 2 , kflev
        do jl = 1 , kdlon
c     -------------------
      bi(jl,i) =   - semit * (g / pdp(jl,i) / cpp) *
     .           (     xi(ig0+jl,1,i,i-1) * zdblay(jl,1,i-1)
     .               + xi(ig0+jl,2,i,i-1) * zdblay(jl,2,i-1)   )
c     -------------------
        enddo
      enddo


c couche 1
c --------
c  tant qu'on a pas un calcul propre de zdblay(0) qui tienne compte de
c    la discontinuite de temperature au sol , on met  b1 = 0


      do jl = 1 , kdlon
        bi(jl,1) = 0
      enddo

c-------------------------------------------------------------------------
c        2.4
c              -------------
c

c couche kflev
c ------------

      do jl = 1 , kdlon
c     -------------------
      ci(jl,kflev) = (cday * psi(jl,kflev) / pdp(jl,kflev))
     .                   / di(jl,kflev)

      ai(jl,kflev) = - bi(jl,kflev) / di(jl,kflev)
c     -------------------
      enddo



      do i = kflev-1 , 1 , -1
        do jl = 1 , kdlon
c     -------------------
      denom = di(jl,i) + hi(jl,i) * ai(jl,i+1)

      ci(jl,i) = (  cday * psi(jl,i) / pdp(jl,i)
     .             - hi(jl,i) * ci(jl,i+1)  )  / denom

      ai(jl,i) = -bi(jl,i) / denom
c     -------------------
        enddo
      enddo


c-------------------------------------------------------------------------
c        2.5
c              -------------
c

c couche 1
c -------
      do jl = 1 , kdlon
        newpcolc(jl,1) = ci(jl,1)
      enddo


      do i = 2 , kflev
        do jl = 1 , kdlon
           newpcolc(jl,i) = ci(jl,i) + ai(jl,i) * newpcolc(jl,i-1)
        enddo
      enddo



c-------------------------------------------------------------------------
      RETURN
      END