source: trunk/LMDZ.GENERIC/libf/phystd/aeropacity.F90 @ 223

      subroutine aeropacity(ngrid,nlayer,nq,pplev,pq, &
         aerosol,reffrad,QREFvis3d,QREFir3d,tau_col)

       use radinc_h, only : naerkind
                  
       implicit none

!==================================================================
!     
!     Purpose
!     -------
!     Compute aerosol optical depth in each gridbox.
!     
!     Authors
!     ------- 
!     F. Forget
!     F. Montmessin (water ice scheme) 
!     update J.-B. Madeleine (2008)
!     dust removal, simplification by Robin Wordsworth (2009)
!
!     Input
!     ----- 
!     ngrid             Number of horizontal gridpoints
!     nlayer            Number of layers
!     nq                Number of tracers
!     pplev             Pressure (Pa) at each layer boundary
!     pq                Aerosol mixing ratio
!     reffrad(ngrid,nlayer,naerkind)         Aerosol effective radius
!     QREFvis3d(ngridmx,nlayermx,naerkind) \ 3d extinction coefficients
!     QREFir3d(ngridmx,nlayermx,naerkind)  / at reference wavelengths
!
!     Output
!     ------
!     aerosol            Aerosol optical depth in layer l, grid point ig
!     tau_col            Total column optical depth at grid point ig
!
!=======================================================================

#include "dimensions.h"
#include "dimphys.h"
#include "callkeys.h"
#include "comcstfi.h"
#include "comgeomfi.h"
#include "tracer.h"

      INTEGER ngrid,nlayer,nq

      REAL pplev(ngrid,nlayer+1)
      REAL pq(ngrid,nlayer,nq)
      REAL aerosol(ngrid,nlayer,naerkind)
      REAL reffrad(ngrid,nlayer,naerkind)
      REAL QREFvis3d(ngridmx,nlayermx,naerkind)
      REAL QREFir3d(ngridmx,nlayermx,naerkind)

      REAL tauref(ngrid), tau_col(ngrid)

      INTEGER l,ig,iq,iaer

      LOGICAL firstcall
      DATA firstcall/.true./
      SAVE firstcall

      REAL CBRT
      EXTERNAL CBRT

      INTEGER,SAVE :: i_co2ice=0      ! co2 ice
      INTEGER,SAVE :: i_h2oice=0      ! water ice
      CHARACTER(LEN=20) :: tracername ! to temporarily store text


! identify tracers
      IF (firstcall) THEN

         ! are these tests of any real use?
        IF(ngrid.NE.ngridmx) THEN
            PRINT*,'STOP in aeropacity!'
            PRINT*,'problem of dimensions:'
            PRINT*,'ngrid  =',ngrid
            PRINT*,'ngridmx  =',ngridmx
            STOP
        ENDIF

        if (nq.gt.nqmx) then
           write(*,*) 'STOP in aeropacity: (nq .gt. nqmx)!'
           write(*,*) 'nq=',nq,' nqmx=',nqmx
           stop
        endif


        do iq=1,nqmx
          tracername=noms(iq)
          if (tracername.eq."co2_ice") then
            i_co2ice=iq
          endif
          if (tracername.eq."h2o_ice") then
            i_h2oice=iq
          endif
        enddo
        
        write(*,*) "aeropacity: i_co2ice=",i_co2ice
        write(*,*) "            i_h2oice=",i_h2oice
        
        !if((i_h2oice.lt.1) .and. (naerkind.gt.1))then
        !   print*,'naerkind > 1 but no h2o ice, this will not work.'
        !   stop
        !endif

        firstcall=.false.
      ENDIF ! of IF (firstcall)


      aerosol(:,:,:)=0.0

      DO iaer = 1, naerkind ! Loop on aerosol kind (NOT tracer)
!     ---------------------------------------------------------
        aerkind: SELECT CASE (iaer)
!==================================================================
        CASE(1) aerkind                          ! CO2 ice (iaer=1)
!==================================================================

!       1. Initialization
        CALL zerophys(ngrid*nlayer,aerosol(1,1,iaer))

!       2. Opacity calculation
        if (aerofixed.or.(i_co2ice.eq.0)) then !  CO2 ice cloud prescribed
           do ig=1, ngrid
              do l=1,nlayer
                 aerosol(ig,l,iaer) =1.e-9
              end do
              aerosol(ig,14,iaer)=1.e-9 ! single cloud layer option
           end do
        else
           DO ig=1, ngrid
              DO l=1,nlayer
                 aerosol(ig,l,iaer) =                   &
                      (  0.75 * QREFvis3d(ig,l,iaer) /  &
                      ( rho_co2 * reffrad(ig,l,iaer) )  ) * &
                      ( pq(ig,l,i_co2ice) + 1.E-9 ) *   &
                      ( pplev(ig,l) - pplev(ig,l+1) ) / g
              ENDDO
           ENDDO
        end if

!==================================================================
        CASE(2) aerkind               ! Water ice crystals (iaer=2)
!==================================================================


!       1. Initialization
        CALL zerophys(ngrid*nlayer,aerosol(1,1,iaer))

!       2. Opacity calculation
!     if (1.eq.1) then
     if (aerofixed.or.(i_h2oice.eq.0)) then
!        print*,'No H2O clouds in the radiative transfer!'
        do ig=1, ngrid
           do l=1,nlayer
              aerosol(ig,l,iaer) =1.e-9
           end do
           aerosol(ig,5,iaer)=1.e-9 ! single cloud layer option
        end do
     else
        DO ig=1, ngrid
          DO l=1,nlayer
             aerosol(ig,l,iaer) =                   &
            (  0.75 * QREFvis3d(ig,l,iaer) /        &
              ( rho_ice * reffrad(ig,l,iaer) )  ) * &
              ( pq(ig,l,i_h2oice) + 1.E-9 ) *   &
              ( pplev(ig,l) - pplev(ig,l+1) ) / g
          ENDDO
        ENDDO

     end if


!==================================================================
        END SELECT aerkind

      ENDDO ! iaer (loop on aerosol kind)


! --------------------------------------------------------------------------
! Column integrated visible optical depth in each point (used for diagnostic)

      call zerophys(ngrid,tau_col)
      do iaer = 1, naerkind
         do l=1,nlayer
            do ig=1,ngrid
               tau_col(ig) = tau_col(ig) + aerosol(ig,l,iaer)
            end do
         end do
      end do

      return
    end subroutine aeropacity