source: codes/icosagcm/branches/SATURN_DYNAMICO/LMDZ.COMMON/config/ppsrc/phys/aerave.f @ 224

      subroutine aerave( ndata,
     &     longdata,epdata,omegdata,gdata,          
     &     longref,epref,temp,nir,longir
     &     ,epir,omegir,gir,qref )


      implicit none

!==================================================================
!     
!     Purpose
!     -------
!     Calculate mean values of aerosol quantities in each band.
!     
!     Authors
!     ------- 
!     R. Fournier (1996) 
!     F. Forget (1996)
!     
!     Called by
!     ---------
!     suaer_corrk.F90
!     
!     Calls
!     -----
!     blackl.F
!     
!==================================================================

!     
!     R.Fournier 02/1996 
!     (modif F.Forget 02/1996)
!     le spectre est decoupe en "nir" bandes et cette routine calcule
!     les donnees radiatives moyenne sur chaque bande : l'optimisation
!     est faite pour une temperature au sol "temp" et une epaisseur
!     optique de l'atmosphere "epref" a la longueur d'onde "longref"
!     
!     dans la version actuelle, les ponderations sont independantes de
!     l'epaisseur optique : c'est a dire que "omegir", "gir"
!     et "epir/epre" sont independants de "epref".
!     en effet les ponderations sont choisies pour une solution exacte
!     en couche mince et milieu isotherme. 
!     
!     entree
!     
!     ndata : taille des champs data
!     longdata,epdata,omegdata,gdata : proprietes radiative de l'aerosol
!     (longdata longueur d'onde en METRES)
!     * longref : longueur d'onde a laquelle l'epaisseur optique
!     est connue
!     * epref : epaisseur optique a longref
!     * temp : temperature choisie pour la ponderation (Planck)
!     * nir : nombre d'intervals dans la discretisation spectrale
!     du GCM
!     * longir : longueurs d'onde definissant ces intervals
!     
!     sortie
!     
!     * epir : epaisseur optique moyenne pour chaque interval
!     * omegir : "scattering albedo" moyen pour chaque interval
!     * gir : "assymetry factor" moyen pour chaque interval
!     * qref : extinction coefficient at reference wavelength

!=======================================================================
! output

      REAL longref
      REAL epref
      REAL temp
      INTEGER nir
      REAL*8 longir(nir+1)
      REAL epir(nir)
      REAL omegir(nir)
      REAL gir(nir)

!=======================================================================

      INTEGER iir,nirmx
      PARAMETER (nirmx=100)
      INTEGER idata,ndata

      DOUBLE PRECISION tmp1
      REAL tmp2,tmp3

!=======================================================================
! input

      REAL emit
      REAL totalemit(nirmx)
      REAL longdata(ndata),epdata(ndata)
     &     ,omegdata(ndata),gdata(ndata)
      REAL qextcorrdata(ndata)
      INTEGER ibande,nbande
      PARAMETER (nbande=1000)

      REAL long,deltalong
      INTEGER ilong
      INTEGER i1,i2
      REAL c1,c2
      REAL factep,qextcorr,omeg,g,qref

      long=longref


!=======================================================================
!     pre-interpolation
      ilong=1
      DO idata=2,ndata
         IF (long.gt.longdata(idata)) ilong=idata
      ENDDO
      i1=ilong
      i2=ilong+1
      IF (i2.gt.ndata) i2=ndata
      IF (long.lt.longdata(1)) i2=1
      IF (i1.eq.i2) THEN
         c1=1.E+0
         c2=0.E+0
      ELSE
         c1=(longdata(i2)-long) / (longdata(i2)-longdata(i1))
         c2=(longdata(i1)-long) / (longdata(i1)-longdata(i2))
      ENDIF

      qref=c1*epdata(i1)+c2*epdata(i2)
      factep=qref/epref
      DO idata=1,ndata
         qextcorrdata(idata)=epdata(idata)/factep
      ENDDO
!=======================================================================

      DO iir=1,nir

         deltalong=(longir(iir+1)-longir(iir)) / nbande
         totalemit(iir)=0.E+0
         epir(iir)=0.E+0
         omegir(iir)=0.E+0
         gir(iir)=0.E+0

         DO ibande=1,nbande

            long=longir(iir) + (ibande-0.5E+0) * deltalong
            CALL blackl(DBLE(long),DBLE(temp),tmp1)
            emit=REAL(tmp1)

!=======================================================================
!     interpolation
            ilong=1
            DO idata=2,ndata
               IF (long.gt.longdata(idata)) ilong=idata
            ENDDO
            i1=ilong
            i2=ilong+1

            IF (i2.gt.ndata) i2=ndata
            IF (long.lt.longdata(1)) i2=1
            IF (i1.eq.i2) THEN
               c1=1.E+0
               c2=0.E+0
            ELSE
               c1=(longdata(i2)-long) / (longdata(i2)-longdata(i1))
               c2=(longdata(i1)-long) / (longdata(i1)-longdata(i2))
            ENDIF
!=======================================================================

            qextcorr=c1*qextcorrdata(i1)+c2*qextcorrdata(i2)
            omeg=c1*omegdata(i1)+c2*omegdata(i2)
            g=c1*gdata(i1)+c2*gdata(i2)

            totalemit(iir)=totalemit(iir)+deltalong*emit
            epir(iir)=epir(iir)+deltalong*emit*qextcorr
            omegir(iir)=omegir(iir)+deltalong*emit*omeg*qextcorr
            gir(iir)=gir(iir)+deltalong*emit*omeg*qextcorr*g

         ENDDO

         gir(iir)=gir(iir)/omegir(iir)
         omegir(iir)=omegir(iir)/epir(iir)
         epir(iir)=epir(iir)/totalemit(iir)

      ENDDO

      return
      end