[2753] | 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 | |
---|
[5282] | 13 | USE clesphys_mod_h |
---|
[2753] | 14 | USE dimphy |
---|
| 15 | USE aero_mod |
---|
[4056] | 16 | USE infotrac_phy, ONLY: nbtr, nqtot, tracers |
---|
[5264] | 17 | USE yomcst_mod_h, ONLY: RD, RG |
---|
[2753] | 18 | |
---|
| 19 | IMPLICIT NONE |
---|
| 20 | |
---|
| 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 | |
---|
[4056] | 42 | INTEGER i, k, iq, itr |
---|
[2753] | 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 | ! |
---|
[4056] | 52 | itr = 0 |
---|
| 53 | DO iq = 1, nqtot |
---|
[4071] | 54 | IF(.NOT.tracers(iq)%isInPhysics) CYCLE |
---|
[4056] | 55 | itr = itr+1 |
---|
| 56 | IF(tracers(iq)%name/='FINE') THEN |
---|
[2753] | 57 | mass_solu_aero(:,:) = tr_seri(:,:,itr) |
---|
| 58 | mass_solu_aero_pi(:,:) = tr_seri(:,:,itr) |
---|
| 59 | ENDIF |
---|
| 60 | ENDDO |
---|
| 61 | |
---|
| 62 | ! Calculate layer thickness |
---|
| 63 | DO k = 1, klev |
---|
| 64 | DO i = 1, klon |
---|
| 65 | pdel=paprs(i,k)-paprs(i,k+1) |
---|
| 66 | zrho=pplay(i,k)/t_seri(i,k)/RD ! kg/m3 |
---|
| 67 | zdh(i,k)=pdel/(RG*zrho) ! m |
---|
| 68 | zdm(i,k)=pdel/RG ! kg/m2 |
---|
| 69 | ENDDO |
---|
| 70 | ENDDO |
---|
| 71 | |
---|
| 72 | !--new aerosol properties |
---|
| 73 | ! aeropt_6bands for rrtm |
---|
| 74 | CALL splaeropt_6bands_rrtm( & |
---|
| 75 | zdm, tr_seri, rhcl, & |
---|
| 76 | tau_aero, piz_aero, cg_aero ) |
---|
| 77 | |
---|
| 78 | ! aeropt_5wv only for validation and diagnostics |
---|
| 79 | CALL splaeropt_5wv_rrtm( & |
---|
| 80 | zdm, zdh, tr_seri, rhcl, & |
---|
| 81 | tausum_aero, tau3d_aero ) |
---|
| 82 | |
---|
| 83 | ! LW optical properties for tropospheric aerosols |
---|
| 84 | CALL splaeropt_lw_rrtm(ok_alw,zdm,tr_seri) |
---|
| 85 | |
---|
| 86 | END SUBROUTINE splaerosol_optic_rrtm |
---|