source: trunk/LMDZ.TITAN/libf/phytitan/radlwsw.F @ 1530

      SUBROUTINE radlwsw(dist, rmu0, fract, zzlev,
     .                  paprs, pplay,tsol, pt, nq, nmicro, pq,qaer)
c      
c======================================================================
c Auteur(s): Z.X. Li (LMD/CNRS) date: 19960719
c Objet: interface entre le modele et les rayonnements
c Arguments:
c dist-----input-R- distance astronomique terre-soleil
c rmu0-----input-R- cosinus de l'angle zenithal
c fract----input-R- duree d'ensoleillement normalisee
c falbe----input-R- surface albedo
c zzlev----input-R- altitudes des inter-couches (m)
c paprs----input-R- pression a inter-couche (Pa)
c pplay----input-R- pression au milieu de couche (Pa)
c tsol-----input-R- temperature du sol (en K)
c t--------input-R- temperature (K)
c nq-------input-R- nombre de traceurs 
c nmicro---input-R- nombre de traceurs microphysiques
c pq-------input-R- traceurs (rapports de melange)
c heat-----output-R- echauffement atmospherique (visible) (K/s)
c cool-----output-R- refroidissement dans l'IR (K/s)
c radsol---output-R- bilan radiatif net au sol (W/m**2) (+ vers le bas)
c topsw----output-R- flux solaire net au sommet de l'atm. (+ vers le bas)
c toplw----output-R- ray. IR net au sommet de l'atmosphere (+ vers le haut)
c solsw----output-R- flux solaire net a la surface (+ vers le bas)
c sollw----output-R- ray. IR net a la surface (+ vers le bas)
c sollwdown-output-R- ray. IR descendant a la surface (+ vers le bas)
c lwnet____output-R- flux IR net (+ vers le haut)
c swnet____output-R- flux solaire net (+ vers le bas)
c
      
c   S. Lebonnois    05/2008
c  VERSION TITAN 

c======================================================================
      use dimphy
      USE comgeomphy
      USE phys_state_var_mod, only: falbe,heat,cool,radsol,
     .      topsw,toplw,solsw,sollw,sollwdown,lwnet,swnet,
     .      lwup,lwdn,swup,swdn
      USE write_field_phy
       IMPLICIT none
#include "YOMCST.h"
#include "clesphys.h" 
c
c ARGUMENTS
      INTEGER nq,nmicro
      real rmu0(klon), fract(klon), dist
c
      real zzlev(klon,klev+1),paprs(klon,klev+1), pplay(klon,klev)
      real tsol(klon)
      real pt(klon,klev)
      real pq(klon,klev,nq)
      REAL qaer(klon,klev,nq)
c
c LOCAL VARIABLES
      integer i,k,l,iq
      real zp(klon,klev+1),zt(klon,klev+1),zz(klon,klev+1)
      real zq(klon,klev,nq)
      real zheatc(klon,klev), zcoolc(klon,klev)
      real zheatp(klon,klev), zcoolp(klon,klev)
      REAL zswupc(klon,klev+1),zlwupc(klon,klev+1)
      REAL zswupp(klon,klev+1),zlwupp(klon,klev+1)
      REAL zswdnc(klon,klev+1),zlwdnc(klon,klev+1)
      REAL zswdnp(klon,klev+1),zlwdnp(klon,klev+1)
      REAL zsollwdownc(klon),zsollwdownp(klon)
      INTEGER icld


c =======================================
c INITIALISATIONS
c =======================================

c   passage au pressions en bar avec indice 1 au sommet.
             do l=2,klev+1
                do i=1,klon
                   zp(i,l)=paprs(i,klev+2-l)*1.e-5
                enddo
             enddo
             do i=1,klon
                zp(i,1)=zp(i,2)*.001
             enddo

c     call WriteField_phy('radlwsw_zp',zp,klev+1)

c =======================================
c   altitudes (m) avec indice 1 en haut
             do l=1,klev+1
                do i=1,klon
                   zz(i,l)=zzlev(i,klev+2-l)
                enddo
             enddo

c   temperatures avec indice 1 en haut
             do l=1,klev
                do i=1,klon
                   zt(i,l)=pt(i,klev+1-l)
                enddo
             enddo
             do i=1,klon
                zt(i,klev+1)=tsol(i)
             enddo

c  traceurs avec indice 1 en haut
             do l=1,klev
                do i=1,klon
                 do iq=1,nq
                   zq(i,l,iq)=pq(i,klev+1-l,iq)
                 enddo
                enddo
             enddo

c =======================================
c CALCUL DES TAU V+IR  (dans des common...)
c =======================================

      print*,'On calcule les opacites'

         CALL radtitan(zp,nq,nmicro,zq,qaer)

c CALCUL DU SW 
c =======================================

      print*,'On calcule le rayonnement SW'

       IF (clouds.eq.1) THEN
         ICLD = 1   ! colonne avec nuages
         CALL heating(dist,rmu0,fract,falbe,zheatc,zswupc,zswdnc,icld)
       ELSE
         zheatc  = 0.
         zswupc = 0.
         zswdnc = 0.
       ENDIF 
       ICLD = 0   ! colonne sans nuages
       CALL heating(dist,rmu0,fract,falbe,zheatp,zswupp,zswdnp,icld)

c inversion de l'axe vertical
       do l=1,klev
         do i=1,klon
           heat(i,l)=zheatc(i,klev+1-l)*xnuf +
     &               zheatp(i,klev+1-l)*(1.-xnuf)
         enddo
       enddo
       do l=1,klev+1
         do i=1,klon
           swup(i,l) =zswupc(i,klev+2-l)*xnuf +
     &                zswupp(i,klev+2-l)*(1.-xnuf)
           swdn(i,l) =zswdnc(i,klev+2-l)*xnuf +
     &                zswdnp(i,klev+2-l)*(1.-xnuf)
           swnet(i,l)=swdn(i,l)-swup(i,l)
         enddo
       enddo

      solsw = swnet(:,1)
      topsw = swnet(:,klev+1)

c =======================================
c CALCUL DU LW
c =======================================

      print*,'On calcule le rayonnement LW'

       IF (clouds.eq.1) THEN
         ICLD = 1
         CALL cooling(klon,klev+1,zp,zt,zz,zcoolc,zlwupc,zlwdnc,
     &   zsollwdownc,icld)
       ELSE
         zcoolc      = 0.
         zlwupc      = 0.
         zlwdnc      = 0.
         zsollwdownc = 0.
       ENDIF
       ICLD = 0
       CALL cooling(klon,klev+1,zp,zt,zz,zcoolp,zlwupp,zlwdnp,
     & zsollwdownp,icld)

c inversion de l'axe vertical
       do l=1,klev
         do i=1,klon
           cool(i,l)=zcoolc(i,klev+1-l)*xnuf +
     &               zcoolp(i,klev+1-l)*(1.-xnuf)
         enddo
       enddo
       do l=1,klev+1
         do i=1,klon
           lwup(i,l) =zlwupc(i,klev+2-l)*xnuf +
     &                zlwupp(i,klev+2-l)*(1.-xnuf)
           lwdn(i,l) =zlwdnc(i,klev+2-l)*xnuf +
     &                zlwdnp(i,klev+2-l)*(1.-xnuf)
           lwnet(i,l)=lwup(i,l)-lwdn(i,l)
         enddo
       enddo
   
       do i=1,klon
         sollwdown(i)=zsollwdownc(i)*xnuf +
     &                zsollwdownp(i)*(1.-xnuf)
       enddo

      sollw  = -lwnet(:,1)
      toplw  = lwnet(:,klev+1)
      radsol = solsw+sollw
      
      RETURN
      END