Ignore:
Timestamp:
May 3, 2016, 5:09:56 PM (9 years ago)
Author:
oboucher
Message:

Adding a template for tropospheric aerosol LW optical properties
Only works for aerosol_couple = TRUE

File:
1 edited

Legend:

Unmodified
Added
Removed
  • LMDZ5/trunk/libf/phylmd/rrtm/aeropt_lw_rrtm.F90

    r2231 r2501  
    11!
    22! aeropt_lw_rrtm.F90 2014-05-13 C. Kleinschmitt
     3!                    2016-05-03 O. Boucher
    34!
     5! This routine feeds aerosol LW properties to RRTM
     6! we only consider absorption (not scattering)
    47
    5 SUBROUTINE AEROPT_LW_RRTM
     8SUBROUTINE AEROPT_LW_RRTM(aerosol_couple,paprs,tr_seri)
    69
     10  USE dimphy
     11  USE aero_mod
    712  USE phys_state_var_mod, ONLY : tau_aero_lw_rrtm
    813
    914  IMPLICIT NONE
    1015
    11   tau_aero_lw_rrtm(:,:,:,:) = 1.e-15
     16  INCLUDE "YOMCST.h"
     17  INCLUDE "clesphys.h"
     18  !
     19  ! Input arguments:
     20  !
     21  LOGICAL, INTENT(IN)                      :: aerosol_couple
     22  REAL, DIMENSION(klon,klev+1), INTENT(in)  :: paprs
     23  !
     24  REAL, DIMENSION(klon,klev) :: zdp, mass_temp
     25  !
     26  INTEGER inu, k
     27  INTEGER :: id_ASBCM, id_ASPOMM, id_ASSO4M, id_ASMSAM, id_CSSO4M, id_CSMSAM, id_SSSSM
     28  INTEGER :: id_CSSSM, id_ASSSM, id_CIDUSTM, id_AIBCM, id_AIPOMM, id_ASNO3M, id_CSNO3M, id_CINO3M
    1229
     30  !
     31  !--absorption coefficient for CIDUST
     32  REAL:: alpha_abs_CIDUST_16bands(nbands_lw_rrtm)   !--unit m2/g
     33  DATA alpha_abs_CIDUST_16bands /              &
     34       0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, &
     35       0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0  /
     36  !
     37  IF (NLW.NE.nbands_lw_rrtm) THEN
     38     print *,'Erreur NLW doit etre egal a 16 pour cette routine'
     39     stop
     40  ENDIF
     41  !
     42  IF (aerosol_couple) THEN
     43  !
     44      do i=1,nbtr
     45      select case(trim(solsym(i)))
     46         case ("ASBCM")
     47            id_ASBCM = i
     48         case ("ASPOMM")
     49            id_ASPOMM = i
     50         case ("ASSO4M")
     51            id_ASSO4M = i
     52         case ("ASMSAM")
     53            id_ASMSAM = i
     54         case ("CSSO4M")
     55            id_CSSO4M = i
     56         case ("CSMSAM")
     57            id_CSMSAM = i
     58         case ("SSSSM")
     59            id_SSSSM = i
     60         case ("CSSSM")
     61            id_CSSSM = i
     62         case ("ASSSM")
     63            id_ASSSM = i
     64         case ("CIDUSTM")
     65            id_CIDUSTM = i
     66         case ("AIBCM")
     67            id_AIBCM = i
     68         case ("AIPOMM")
     69            id_AIPOMM = i
     70         case ("ASNO3M")
     71            id_ASNO3M = i
     72         case ("CSNO3M")
     73            id_CSNO3M = i
     74         case ("CINO3M")
     75            id_CINO3M = i
     76         end select
     77    enddo
     78    !
     79    DO k=1, klev
     80       zdp(:,k) = (paprs(i,k)-paprs(i,k+1))/RG !--kg/m2
     81    ENDDO
     82    !
     83    !--for now only consider dust
     84    mass_temp(:,:)=tr_seri(:,:,id_CIDUSTM)  !--kg/kg
     85    !
     86    DO inu=1,NLW
     87      !
     88      !--total aerosol
     89      tau_aero_lw_rrtm(:,:,2,inu) = mass_temp(:,:)*zdp(:,:)*1000.*alpha_abs_CIDUST_16bands(inu)
     90      !--no aerosol at all
     91      tau_aero_lw_rrtm(:,:,1,inu) = 0.0
     92      !
     93    ENDDO
     94    !
     95    !--avoid very small values
     96    tau_aero_lw_rrtm = MAX(tau_aero_lw_rrtm,1.e-15)
     97    !
     98  ELSE !--not aerosol_couple
     99    !
     100    !--no LW effects if not coupled to INCA
     101    tau_aero_lw_rrtm = 1.e-15
     102  ENDIF
     103  !
    13104END SUBROUTINE AEROPT_LW_RRTM
Note: See TracChangeset for help on using the changeset viewer.