source: trunk/libf/phytitan/radlwsw.F @ 130

      SUBROUTINE radlwsw(dist, rmu0, fract, dtimerad, zzlev,
     .                  paprs, pplay,tsol, pt, nq, nmicro, pq,
     .                  qaer,
     .                  heat,cool,radsol,
     .                  topsw,toplw,solsw,sollw,
     .                  sollwdown,
     .                  lwnet, swnet)
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 dtimerad-input-R- intervalle de temps du radiatif
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
      IMPLICIT none
#include "dimensions.h"
#include "YOMCST.h"
#include "clesphys.h" 
c
c ARGUMENTS
      INTEGER nq,nmicro
      real rmu0(klon), fract(klon), dist, dtimerad
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)
      real heat(klon,klev), cool(klon,klev)
      real radsol(klon), topsw(klon), toplw(klon)
      real solsw(klon), sollw(klon)
      real sollwdown(klon)
      REAL swnet(klon,kflev+1),lwnet(klon,kflev+1)
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 zheat(klon,klev), zcool(klon,klev)
      REAL zswnet(klon,kflev+1),zlwnet(klon,kflev+1)
      

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   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 =======================================
c CALCUL DU SW 
c =======================================

      print*,'On calcule le rayonnement SW'

      CALL heating(dist,rmu0,fract,zheat,zswnet)

c inversion de l'axe vertical
             do l=1,klev
                do i=1,klon
                   heat(i,l)=zheat(i,klev+1-l)
                enddo
             enddo
             do l=1,klev+1
                do i=1,klon
                   swnet(i,l)=zswnet(i,klev+2-l)
                enddo
             enddo

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

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

      print*,'On calcule le rayonnement LW'

      CALL cooling(klev+1,zp,zt,zz,zcool,zlwnet,sollwdown)

c inversion de l'axe vertical
             do l=1,klev
                do i=1,klon
                   cool(i,l)=zcool(i,klev+1-l)
                enddo
             enddo
             do l=1,klev+1
                do i=1,klon
                   lwnet(i,l)=zlwnet(i,klev+2-l)
                enddo
             enddo

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