| 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 | USE dimphy |
|---|
| 13 | USE aero_mod |
|---|
| 14 | USE infotrac_phy, ONLY: nbtr, nqtot, tracers |
|---|
| 15 | USE lmdz_yomcst, ONLY: RD, RG |
|---|
| 16 | USE lmdz_clesphys |
|---|
| 17 | |
|---|
| 18 | IMPLICIT NONE |
|---|
| 19 | |
|---|
| 20 | ! Input arguments |
|---|
| 21 | !**************************************************************************************** |
|---|
| 22 | LOGICAL, INTENT(IN) :: ok_alw ! Apply aerosol LW effect or not |
|---|
| 23 | REAL, DIMENSION(klon, klev), INTENT(IN) :: pplay |
|---|
| 24 | REAL, DIMENSION(klon, klev + 1), INTENT(IN) :: paprs |
|---|
| 25 | REAL, DIMENSION(klon, klev), INTENT(IN) :: t_seri |
|---|
| 26 | REAL, DIMENSION(klon, klev), INTENT(IN) :: rhcl ! humidite relative ciel clair |
|---|
| 27 | REAL, DIMENSION(klon, klev, nbtr), INTENT(IN) :: tr_seri ! concentration tracer |
|---|
| 28 | |
|---|
| 29 | ! Output arguments |
|---|
| 30 | !**************************************************************************************** |
|---|
| 31 | REAL, DIMENSION(klon, klev), INTENT(OUT) :: mass_solu_aero ! Total mass for all soluble aerosols |
|---|
| 32 | REAL, DIMENSION(klon, klev), INTENT(OUT) :: mass_solu_aero_pi ! -"- preindustrial values |
|---|
| 33 | REAL, DIMENSION(klon, klev, 2, NSW), INTENT(OUT) :: tau_aero ! Aerosol optical thickness |
|---|
| 34 | REAL, DIMENSION(klon, klev, 2, NSW), INTENT(OUT) :: piz_aero ! Single scattering albedo aerosol |
|---|
| 35 | REAL, DIMENSION(klon, klev, 2, NSW), INTENT(OUT) :: cg_aero ! asymmetry parameter aerosol |
|---|
| 36 | REAL, DIMENSION(klon, nwave, naero_tot), INTENT(OUT) :: tausum_aero |
|---|
| 37 | REAL, DIMENSION(klon, klev, nwave, naero_tot), INTENT(OUT) :: tau3d_aero |
|---|
| 38 | |
|---|
| 39 | INTEGER i, k, iq, itr |
|---|
| 40 | REAL, DIMENSION(klon, klev) :: zdm, zdh |
|---|
| 41 | REAL zrho, pdel |
|---|
| 42 | |
|---|
| 43 | ! Calculate the total mass of all soluble accumulation mode aerosols |
|---|
| 44 | ! to be revisited for AR6 |
|---|
| 45 | |
|---|
| 46 | mass_solu_aero(:, :) = 0.0 |
|---|
| 47 | mass_solu_aero_pi(:, :) = 0.0 |
|---|
| 48 | |
|---|
| 49 | itr = 0 |
|---|
| 50 | DO iq = 1, nqtot |
|---|
| 51 | IF(.NOT.tracers(iq)%isInPhysics) CYCLE |
|---|
| 52 | itr = itr + 1 |
|---|
| 53 | IF(tracers(iq)%name/='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 |
|---|
