source: trunk/LMDZ.MARS/libf/phymars/lwdiff.F @ 2156

      subroutine lwdiff (kdlon,kflev
     .         ,pbsur,pbtop,pdbsl
     .         ,tautotal,omegtotal,gtotal
     .         ,pemis,pfluc)

      use dimradmars_mod, only: nir, npademx, nabsmx, nflev, ndlon,
     &                          ndlo2
      use yomlw_h, only: nlaylte
      USE comcstfi_h
      IMPLICIT NONE
 
#include "callkeys.h"

C-----------------------------------------------------------------------
C
c  ABSORPTION ET DIFUSION HORS DE LA BANDE A 15 MICRONS :
c! 1) Dans la bande a 15 micron (CO2), 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)  le reste est decoupe en "nir-2" bandes : une bande qui recouvre toutes
c! les longueurs d'onde inferieures a celles de la bande a 15 microns
c! (indice 3) et nir-3 bandes pour les grandes longueurs d'onde
c! (indices 4...nir) sur chacune de ces  bandes, les poussieres
c! sont supposees diffusantes grises.
c!
C
C-----------------------------------------------------------------------
C
C
C-----------------------------------------------------------------------
C
C*       0.1   ARGUMENTS
C              ---------
C
      integer kdlon,kflev
      REAL PBSUR(NDLO2,nir), PBTOP(NDLO2,nir)
     S  ,  PDBSL(NDLO2,nir,KFLEV*2), PEMIS(NDLO2)

      real PFLUC(NDLO2,2,KFLEV+1)
      real tautotal(ndlon,nflev,nir)
      real omegtotal(ndlon,nflev,nir), gtotal(ndlon,nflev,nir)

C
C
C-------------------------------------------------------------------------
C
C*       0.2   LOCAL ARRAYS
C              ------------
C
C
      integer jl, jk, ndd, indd, iir, j1
      integer  j2, j2dd2, j2dd1,j2bot,j2top, j2dd
      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
C-----------------------------------------------------------------------
C
C*         1.    INITIALIZATION
C                --------------
C
 100  CONTINUE
C
C*         1.1     INITIALIZE LAYER CONTRIBUTIONS
C                  ------------------------------
C
 110  CONTINUE
C

      do jl = 1 , kdlon
        do jk = 1 , nlaylte
          PFLUC(jl,1,jk) = 0.
          PFLUC(jl,2,jk) = 0.
        enddo
      enddo

      DO 112 JK = 1 , nlaylte+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
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=nlaylte*2, donc la taille du vecteur des Planck sera
c! nlaylte*2 + 1. la taille des vecteurs omega / g / tau sera
c! par contre nlaylte*2 (voir dans FLUSV.F).
c!
      NDD=nlaylte*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  bandes hors CO2
c!
      DO 10001 iir=3,nir
c!
                                            do jl=1,kdlon
        ZZBHDD(JL,1)=PBTOP(JL,iir)/pi
                                            enddo
        DO J1=2,NDD+1
                                            do jl=1,kdlon
           ZZBHDD(JL,J1)=
     &     ZZBHDD(JL,J1-1)-PDBSL(JL,iir,NDD-J1+2)/pi
                                            enddo
        ENDDO
                                            do jl=1,kdlon
        ZZBSDD(JL)=PBSUR(JL,iir)/pi
                                            enddo

C
C     ------------------------------------------------------------------
C
C*         2.0.2   preparation des coefficients de diffusion
C                  -----------------------------------------
C
c! les omega, g, tau ... boucle de bas en haut
        DO J2=1,nlaylte-1
          J2DD2=(nlaylte-J2+1)*2
          J2DD1=J2DD2-1
          J2BOT=3*J2-2
          J2TOP=3*J2+1
          do jl=1,kdlon
            ZTAUDD(JL,J2DD1)=tautotal(jl,J2,iir)*0.5
            ZTAUDD(JL,J2DD2)=ZTAUDD(JL,J2DD1)
            ZOMEGADD(JL,J2DD1)=omegtotal(jl,J2,iir)
            ZOMEGADD(JL,J2DD2)=omegtotal(jl,J2,iir)
            ZGDD(JL,J2DD1)=gtotal(jl,J2,iir)
            ZGDD(JL,J2DD2)=gtotal(jl,J2,iir)
          enddo
        ENDDO
        J2=nlaylte
        J2DD2=2
        J2DD1=1
        J2BOT=3*J2-2
                                            do jl=1,kdlon
        ZTAUDD(JL,J2DD1)= tautotal(jl,J2,iir)*0.5
        ZTAUDD(JL,J2DD2)= tautotal(jl,J2,iir)*0.5
        ZOMEGADD(JL,J2DD1)= omegtotal(jl,J2,iir)
        ZOMEGADD(JL,J2DD2)= omegtotal(jl,J2,iir)
        ZGDD(JL,J2DD1)= gtotal(jl,J2,iir)
        ZGDD(JL,J2DD2)= gtotal(jl,J2,iir)
                                            enddo
C
C     ------------------------------------------------------------------
C
C*         2.0.3   calcul de la diffusion
C                  ----------------------
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)
           enddo
        ENDDO
10001 CONTINUE

      DO J2=1,nlaylte+1
        J2DD=(nlaylte-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


      END