source: trunk/libf/phyvenus/radlwsw.1mat @ 109

!
! $Header: /home/cvsroot/LMDZ4/libf/phylmd/radlwsw.F,v 1.2 2004/10/27 10:14:46 lmdzadmin Exp $
!
      SUBROUTINE radlwsw(dist, rmu0, fract, 
     .                  paprs, pplay,tsol, t,
     .                  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 solaire--input-R- constante solaire (W/m**2) (dans clesphys.h)
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 heat-----output-R- echauffement atmospherique (visible) (K/jour)
c cool-----output-R- refroidissement dans l'IR (K/jour)
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======================================================================
      use dimphy
      IMPLICIT none
#include "dimensions.h"
c
      real rmu0(klon), fract(klon), dist
#include "clesphys.h" 
c
      real paprs(klon,klev+1), pplay(klon,klev)
      real tsol(klon)
      real t(klon,klev)
      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
#include "YOMCST.h"
c
      INTEGER k, kk, i, j, nb_gr
c
      REAL   PSCT
c
      REAL   PDT0
      REAL   PPSOL
      REAL   PTL(kflev+1), PPB(kflev+1)
      REAL   PTAVE(kflev)
c
      REAL   zfract, zrmu0, zdist
c
      REAL   zheat(kflev), zcool(kflev)
      REAL   ZFSNET(KFLEV+1),ZFLNET(KFLEV+1)
      REAL   ztopsw, ztoplw
      REAL   zsolsw, zsollw
cIM BEG
      REAL   zsollwdown
cIM END
      REAL   zznormcp
c
      REAL   zx_alpha1, zx_alpha2
c
c-------------------------------------------
      nb_gr = klon
c-------------------------------------------
c  Initialisations
c-----------------
      DO k = 1, klev
      DO i = 1, klon
         heat(i,k)=0.
         cool(i,k)=0.
      ENDDO
      ENDDO
c
      zdist = dist
c
c     PRINT*,'IMradlwsw : solaire= ', solaire
c     PSCT = solaire/zdist/zdist
c
c+++++++ BOUCLE SUR LA GRILLE +++++++++++++++++++++++++
      DO 99999 j = 1, nb_gr
 
       DO k = 1, klev
        zheat(k) = 0.0
        zcool(k) = 0.0
       ENDDO
       DO k = 1, klev+1
        ZFLNET(k) = 0.0
        ZFSNET(k) = 0.0
       ENDDO
       ztopsw = 0.0
       ztoplw = 0.0
       zsolsw = 0.0
       zsollw = 0.0
       zsollwdown = 0.0
      
         zfract = fract(j)
         zrmu0 = rmu0(j)
         PPSOL = paprs(j,1)
         zx_alpha1 = (paprs(j,1)-pplay(j,2)) 
     .             / (pplay(j,1)-pplay(j,2))
         zx_alpha2 = 1.0 - zx_alpha1
         PTL(1) = t(j,1) * zx_alpha1 + t(j,2) * zx_alpha2
         PTL(klev+1) = t(j,klev)
         PDT0 = tsol(j) - PTL(1)
      DO k = 2, kflev
         PTL(k) = (t(j,k)+t(j,k-1))*0.5
      ENDDO
      DO k = 1, kflev
         PTAVE(k) = t(j,k)
      ENDDO
c
      DO k = 1, kflev
         PPB(k) = paprs(j,k)/1.e5
      ENDDO
c     PPB(kflev+1) = pplay(j,kflev)/2.e5 ! pour eviter le 0. (=paprs(j,kflev+1))
      PPB(kflev+1) = paprs(j,kflev)/1.e9 ! pour eviter le 0. (=paprs(j,kflev+1))
c
c======================================================================
c LW call
c---------
      CALL LW_venus_ve(
     .        PPB, PTAVE, tsol(j),
     .        zcool,
     .        ztoplw,zsollw,
     .        zsollwdown,ZFLNET)

c---------
c SW call
c---------
      CALL SW_venus_dc(zrmu0, zfract,
     S        PPB, 
     S        zheat, 
     S        ztopsw,zsolsw,ZFSNET)
      
c======================================================================
         radsol(j) = zsolsw - zsollw  ! + vers bas
         topsw(j) = ztopsw            ! + vers bas
         toplw(j) = ztoplw            ! + vers haut
         solsw(j) = zsolsw            ! + vers bas
         sollw(j) = -zsollw           ! + vers bas
         sollwdown(j) = zsollwdown    ! + vers bas

         DO k = 1, kflev+1
         lwnet  (j,k)   = ZFLNET(k)
         swnet  (j,k)   = ZFSNET(k)
         ENDDO

      DO k = 1, kflev
C        scale factor to take into account the difference between
C        dry air and watter vapour scpecific heat capacity
         zznormcp=1.0
         heat (j,k) = zheat(k)/zznormcp
         cool (j,k) = zcool(k)/zznormcp
      ENDDO
c
99999 CONTINUE
c+++++++ FIN BOUCLE SUR LA GRILLE +++++++++++++++++++++++++

c tests

c     j = klon/2
c     j = 1
c     print*,'mu0=',rmu0(j)
c     print*,'   net flux vis   HEAT(K/day)'
c     do k=1,kflev
c     print*,k,ZFSNET(k),heat(j,k)*8.56548e-3
c     enddo
c     print*,'   net flux IR    COOL(K/day)'
c     do k=1,kflev
c     print*,k,ZFLNET(k),cool(j,k)*8.56548e-3
c     enddo
      
      RETURN
      END