| 1 | ! $Id: splaerosol_optic_rrtm.F90 2644 2016-10-02 16:55:08Z oboucher $ |
|---|
| 2 | ! |
|---|
| 3 | SUBROUTINE splaerosol_optic_rrtm( ok_alw, pplay, paprs, t_seri, rhcl, & |
|---|
| 4 | tr_seri, mass_solu_aero, mass_solu_aero_pi, & |
|---|
| 5 | tau_aero, piz_aero, cg_aero, & |
|---|
| 6 | tausum_aero, tau3d_aero ) |
|---|
| 7 | |
|---|
| 8 | ! This routine will : |
|---|
| 9 | ! 1) recevie the aerosols(already read and interpolated) corresponding to flag_aerosol |
|---|
| 10 | ! 2) calculate the optical properties for the aerosols |
|---|
| 11 | ! |
|---|
| 12 | |
|---|
| 13 | USE dimphy |
|---|
| 14 | USE aero_mod |
|---|
| 15 | USE infotrac_phy |
|---|
| 16 | USE YOMCST, ONLY: RD, RG |
|---|
| 17 | |
|---|
| 18 | IMPLICIT NONE |
|---|
| 19 | |
|---|
| 20 | INCLUDE "clesphys.h" |
|---|
| 21 | |
|---|
| 22 | |
|---|
| 23 | ! Input arguments |
|---|
| 24 | !**************************************************************************************** |
|---|
| 25 | LOGICAL, INTENT(IN) :: ok_alw ! Apply aerosol LW effect or not |
|---|
| 26 | REAL, DIMENSION(klon,klev), INTENT(IN) :: pplay |
|---|
| 27 | REAL, DIMENSION(klon,klev+1), INTENT(IN) :: paprs |
|---|
| 28 | REAL, DIMENSION(klon,klev), INTENT(IN) :: t_seri |
|---|
| 29 | REAL, DIMENSION(klon,klev), INTENT(IN) :: rhcl ! humidite relative ciel clair |
|---|
| 30 | REAL, DIMENSION(klon,klev,nbtr), INTENT(IN) :: tr_seri ! concentration tracer |
|---|
| 31 | |
|---|
| 32 | ! Output arguments |
|---|
| 33 | !**************************************************************************************** |
|---|
| 34 | REAL, DIMENSION(klon,klev), INTENT(OUT) :: mass_solu_aero ! Total mass for all soluble aerosols |
|---|
| 35 | REAL, DIMENSION(klon,klev), INTENT(OUT) :: mass_solu_aero_pi ! -"- preindustrial values |
|---|
| 36 | REAL, DIMENSION(klon,klev,2,NSW), INTENT(OUT) :: tau_aero ! Aerosol optical thickness |
|---|
| 37 | REAL, DIMENSION(klon,klev,2,NSW), INTENT(OUT) :: piz_aero ! Single scattering albedo aerosol |
|---|
| 38 | REAL, DIMENSION(klon,klev,2,NSW), INTENT(OUT) :: cg_aero ! asymmetry parameter aerosol |
|---|
| 39 | REAL, DIMENSION(klon,nwave,naero_tot), INTENT(OUT) :: tausum_aero |
|---|
| 40 | REAL, DIMENSION(klon,klev,nwave,naero_tot), INTENT(OUT) :: tau3d_aero |
|---|
| 41 | |
|---|
| 42 | INTEGER i, k, itr |
|---|
| 43 | REAL, DIMENSION(klon,klev) :: zdm, zdh |
|---|
| 44 | REAL zrho, pdel |
|---|
| 45 | ! |
|---|
| 46 | ! Calculate the total mass of all soluble accumulation mode aerosols |
|---|
| 47 | ! to be revisited for AR6 |
|---|
| 48 | ! |
|---|
| 49 | mass_solu_aero(:,:) = 0.0 |
|---|
| 50 | mass_solu_aero_pi(:,:) = 0.0 |
|---|
| 51 | ! |
|---|
| 52 | DO itr=1,nbtr |
|---|
| 53 | IF (tname(itr+nqo)=='FINE') THEN |
|---|
| 54 | mass_solu_aero(:,:) = tr_seri(:,:,itr) |
|---|
| 55 | mass_solu_aero_pi(:,:) = tr_seri(:,:,itr) |
|---|
| 56 | ENDIF |
|---|
| 57 | ENDDO |
|---|
| 58 | |
|---|
| 59 | ! Calculate layer thickness |
|---|
| 60 | DO k = 1, klev |
|---|
| 61 | DO i = 1, klon |
|---|
| 62 | pdel=paprs(i,k)-paprs(i,k+1) |
|---|
| 63 | zrho=pplay(i,k)/t_seri(i,k)/RD ! kg/m3 |
|---|
| 64 | zdh(i,k)=pdel/(RG*zrho) ! m |
|---|
| 65 | zdm(i,k)=pdel/RG ! kg/m2 |
|---|
| 66 | ENDDO |
|---|
| 67 | ENDDO |
|---|
| 68 | |
|---|
| 69 | !--new aerosol properties |
|---|
| 70 | ! aeropt_6bands for rrtm |
|---|
| 71 | CALL splaeropt_6bands_rrtm( & |
|---|
| 72 | zdm, tr_seri, rhcl, & |
|---|
| 73 | tau_aero, piz_aero, cg_aero ) |
|---|
| 74 | |
|---|
| 75 | ! aeropt_5wv only for validation and diagnostics |
|---|
| 76 | CALL splaeropt_5wv_rrtm( & |
|---|
| 77 | zdm, zdh, tr_seri, rhcl, & |
|---|
| 78 | tausum_aero, tau3d_aero ) |
|---|
| 79 | |
|---|
| 80 | ! LW optical properties for tropospheric aerosols |
|---|
| 81 | CALL splaeropt_lw_rrtm(ok_alw,zdm,tr_seri) |
|---|
| 82 | |
|---|
| 83 | END SUBROUTINE splaerosol_optic_rrtm |
|---|
