| 1 | |
|---|
| 2 | ! $Id: splaeropt_5wv_rrtm.F90 2644 2016-10-02 16:55:08Z oboucher $ |
|---|
| 3 | |
|---|
| 4 | SUBROUTINE SPLAEROPT_5WV_RRTM(& |
|---|
| 5 | zdm, zdh, tr_seri, RHcl, & |
|---|
| 6 | tausum, tau) |
|---|
| 7 | |
|---|
| 8 | USE DIMPHY |
|---|
| 9 | USE aero_mod |
|---|
| 10 | USE infotrac_phy, ONLY: nqtot, nbtr, tracers |
|---|
| 11 | USE phys_local_var_mod, ONLY: od550aer, od865aer, ec550aer, od550lt1aer |
|---|
| 12 | |
|---|
| 13 | ! Olivier Boucher Jan 2017 |
|---|
| 14 | ! Based on Mie routines on ciclad CMIP6 |
|---|
| 15 | |
|---|
| 16 | IMPLICIT NONE |
|---|
| 17 | |
|---|
| 18 | ! Input arguments: |
|---|
| 19 | |
|---|
| 20 | REAL, DIMENSION(klon, klev), INTENT(IN) :: zdh !--m |
|---|
| 21 | REAL, DIMENSION(klon, klev), INTENT(IN) :: zdm !--kg/m2 |
|---|
| 22 | REAL, DIMENSION(klon, klev), INTENT(IN) :: RHcl ! humidite relative ciel clair |
|---|
| 23 | REAL, DIMENSION(klon, klev, nbtr), INTENT(IN) :: tr_seri |
|---|
| 24 | |
|---|
| 25 | ! Output arguments: |
|---|
| 26 | |
|---|
| 27 | REAL, DIMENSION(klon, nwave, naero_tot), INTENT(OUT) :: tausum |
|---|
| 28 | REAL, DIMENSION(klon, klev, nwave, naero_tot), INTENT(OUT) :: tau |
|---|
| 29 | |
|---|
| 30 | ! Local |
|---|
| 31 | |
|---|
| 32 | INTEGER, PARAMETER :: las = nwave_sw |
|---|
| 33 | LOGICAL :: soluble |
|---|
| 34 | |
|---|
| 35 | INTEGER :: i, k, m, iq, itr, irh, aerindex |
|---|
| 36 | INTEGER :: spsol, spinsol, la |
|---|
| 37 | INTEGER :: RH_num(klon, klev) |
|---|
| 38 | INTEGER, PARAMETER :: la443 = 1 |
|---|
| 39 | INTEGER, PARAMETER :: la550 = 2 |
|---|
| 40 | INTEGER, PARAMETER :: la670 = 3 |
|---|
| 41 | INTEGER, PARAMETER :: la765 = 4 |
|---|
| 42 | INTEGER, PARAMETER :: la865 = 5 |
|---|
| 43 | INTEGER, PARAMETER :: nbre_RH = 12 |
|---|
| 44 | INTEGER, PARAMETER :: naero_soluble = 2 |
|---|
| 45 | INTEGER, PARAMETER :: naero_insoluble = 2 |
|---|
| 46 | INTEGER, PARAMETER :: naero = naero_soluble + naero_insoluble |
|---|
| 47 | |
|---|
| 48 | REAL, PARAMETER :: RH_tab(nbre_RH) = (/0., 10., 20., 30., 40., 50., 60., 70., 80., 85., 90., 95./) |
|---|
| 49 | REAL, PARAMETER :: RH_MAX = 95. |
|---|
| 50 | REAL :: delta(klon, klev), rh(klon, klev) |
|---|
| 51 | REAL :: tau_ae5wv_int ! Intermediate computation of epaisseur optique aerosol |
|---|
| 52 | REAL :: zrho |
|---|
| 53 | CHARACTER*20 modname |
|---|
| 54 | |
|---|
| 55 | ! Soluble components 1-accumulation mode soluble; 2- seasalt coarse |
|---|
| 56 | REAL :: alpha_aers_5wv(nbre_RH, las, naero_soluble) ! Ext. coeff. ** m2/g |
|---|
| 57 | ! Insoluble components 1- Dust: 2- BC; 3- POM |
|---|
| 58 | REAL :: alpha_aeri_5wv(las, naero_insoluble) ! Ext. coeff. ** m2/g |
|---|
| 59 | |
|---|
| 60 | ! Proprietes optiques |
|---|
| 61 | |
|---|
| 62 | REAL :: fact_RH(nbre_RH) |
|---|
| 63 | |
|---|
| 64 | ! From here on we look at the optical parameters at 5 wavelengths: |
|---|
| 65 | ! 443nm, 550, 670, 765 and 865 nm |
|---|
| 66 | ! le 12 AVRIL 2006 |
|---|
| 67 | |
|---|
| 68 | DATA alpha_aers_5wv/ & |
|---|
| 69 | ! accumulation mode (sulfate+2% bc) soluble |
|---|
| 70 | 4.632, 4.632, 4.632, 4.632, 6.206, 6.827, 7.616, 8.716, 10.514, 12.025, 14.688, 21.539, & |
|---|
| 71 | 3.981, 3.981, 3.981, 3.981, 5.346, 5.923, 6.662, 7.704, 9.437, 10.914, 13.562, 20.591, & |
|---|
| 72 | 3.265, 3.265, 3.265, 3.265, 4.400, 4.909, 5.565, 6.500, 8.081, 9.449, 11.943, 18.791, & |
|---|
| 73 | 2.761, 2.761, 2.761, 2.761, 3.731, 4.182, 4.767, 5.606, 7.041, 8.294, 10.610, 17.118, & |
|---|
| 74 | 2.307, 2.307, 2.307, 2.307, 3.129, 3.522, 4.034, 4.774, 6.052, 7.180, 9.286, 15.340, & |
|---|
| 75 | |
|---|
| 76 | ! seasalt seasalt Coarse Soluble (CS) |
|---|
| 77 | 0.576, 0.690, 0.738, 0.789, 0.855, 0.935, 1.046, 1.212, 1.512, 1.785, 2.258, 3.449, & |
|---|
| 78 | 0.595, 0.713, 0.763, 0.814, 0.880, 0.963, 1.079, 1.248, 1.550, 1.826, 2.306, 3.507, & |
|---|
| 79 | 0.617, 0.738, 0.789, 0.842, 0.911, 0.996, 1.113, 1.286, 1.592, 1.871, 2.369, 3.562, & |
|---|
| 80 | 0.632, 0.755, 0.808, 0.862, 0.931, 1.018, 1.140, 1.316, 1.626, 1.909, 2.409, 3.622, & |
|---|
| 81 | 0.645, 0.771, 0.825, 0.880, 0.951, 1.039, 1.164, 1.344, 1.661, 1.948, 2.455, 3.682 / |
|---|
| 82 | |
|---|
| 83 | DATA alpha_aeri_5wv/ & |
|---|
| 84 | ! coarse dust insoluble |
|---|
| 85 | 0.605, 0.611, 0.661, 0.714, 0.760, & |
|---|
| 86 | ! super coarse insoluble |
|---|
| 87 | 0.153, 0.156, 0.158, 0.157, 0.161 / |
|---|
| 88 | |
|---|
| 89 | ! Initialisations |
|---|
| 90 | tausum(:, :, :) = 0. |
|---|
| 91 | tau(:, :, :, :) = 0. |
|---|
| 92 | |
|---|
| 93 | modname = 'splaeropt_5wv_rrtm' |
|---|
| 94 | |
|---|
| 95 | IF (naero>naero_tot) THEN |
|---|
| 96 | CALL abort_physic(modname, 'Too many aerosol types', 1) |
|---|
| 97 | ENDIF |
|---|
| 98 | |
|---|
| 99 | DO irh = 1, nbre_RH - 1 |
|---|
| 100 | fact_RH(irh) = 1. / (RH_tab(irh + 1) - RH_tab(irh)) |
|---|
| 101 | ENDDO |
|---|
| 102 | |
|---|
| 103 | DO k = 1, klev |
|---|
| 104 | DO i = 1, klon |
|---|
| 105 | rh(i, k) = MIN(RHcl(i, k) * 100., RH_MAX) |
|---|
| 106 | RH_num(i, k) = INT(rh(i, k) / 10. + 1.) |
|---|
| 107 | IF (rh(i, k)>85.) RH_num(i, k) = 10 |
|---|
| 108 | IF (rh(i, k)>90.) RH_num(i, k) = 11 |
|---|
| 109 | delta(i, k) = (rh(i, k) - RH_tab(RH_num(i, k))) * fact_RH(RH_num(i, k)) |
|---|
| 110 | ENDDO |
|---|
| 111 | ENDDO |
|---|
| 112 | |
|---|
| 113 | itr = 0 |
|---|
| 114 | DO iq = 1, nqtot |
|---|
| 115 | IF(.NOT.tracers(iq)%isInPhysics) CYCLE |
|---|
| 116 | itr = itr + 1 |
|---|
| 117 | SELECT CASE(tracers(iq)%name) |
|---|
| 118 | CASE('PREC'); CYCLE !--precursor |
|---|
| 119 | CASE('FINE'); soluble = .TRUE.; spsol = 1; aerindex = 1 !--fine mode accumulation mode |
|---|
| 120 | CASE('COSS'); soluble = .TRUE.; spsol = 2; aerindex = 2 !--coarse mode sea salt |
|---|
| 121 | CASE('CODU'); soluble = .FALSE.; spinsol = 1; aerindex = 3 !--coarse mode dust |
|---|
| 122 | CASE('SCDU'); soluble = .FALSE.; spinsol = 2; aerindex = 4 !--super coarse mode dust |
|---|
| 123 | CASE DEFAULT; CALL abort_physic(modname, 'I cannot do aerosol optics for ' // tracers(iq)%name, 1) |
|---|
| 124 | END SELECT |
|---|
| 125 | |
|---|
| 126 | DO la = 1, las |
|---|
| 127 | |
|---|
| 128 | !--only 550 and 865 nm are used |
|---|
| 129 | IF (la/=la550.AND.la/=la865) CYCLE |
|---|
| 130 | |
|---|
| 131 | IF (soluble) THEN !--soluble aerosol with RH dependence |
|---|
| 132 | |
|---|
| 133 | DO k = 1, klev |
|---|
| 134 | DO i = 1, klon |
|---|
| 135 | tau_ae5wv_int = alpha_aers_5wv(RH_num(i, k), la, spsol) + DELTA(i, k) * & |
|---|
| 136 | (alpha_aers_5wv(RH_num(i, k) + 1, la, spsol) - & |
|---|
| 137 | alpha_aers_5wv(RH_num(i, k), la, spsol)) |
|---|
| 138 | tau(i, k, la, aerindex) = tr_seri(i, k, itr) * zdm(i, k) * tau_ae5wv_int |
|---|
| 139 | tausum(i, la, aerindex) = tausum(i, la, aerindex) + tau(i, k, la, aerindex) |
|---|
| 140 | ENDDO |
|---|
| 141 | ENDDO |
|---|
| 142 | |
|---|
| 143 | ELSE !--cases of insoluble aerosol |
|---|
| 144 | |
|---|
| 145 | DO k = 1, klev |
|---|
| 146 | DO i = 1, klon |
|---|
| 147 | tau_ae5wv_int = alpha_aeri_5wv(la, spinsol) |
|---|
| 148 | tau(i, k, la, aerindex) = tr_seri(i, k, itr) * zdm(i, k) * tau_ae5wv_int |
|---|
| 149 | tausum(i, la, aerindex) = tausum(i, la, aerindex) + tau(i, k, la, aerindex) |
|---|
| 150 | ENDDO |
|---|
| 151 | ENDDO |
|---|
| 152 | |
|---|
| 153 | ENDIF |
|---|
| 154 | |
|---|
| 155 | ENDDO ! Boucle sur les longueurs d'onde |
|---|
| 156 | ENDDO ! Boucle sur les masses de traceurs |
|---|
| 157 | |
|---|
| 158 | !--AOD calculations for diagnostics |
|---|
| 159 | od550aer(:) = SUM(tausum(:, la550, 1:naero), dim = 2) |
|---|
| 160 | od865aer(:) = SUM(tausum(:, la865, 1:naero), dim = 2) |
|---|
| 161 | |
|---|
| 162 | !--extinction coefficient for diagnostic |
|---|
| 163 | ec550aer(:, :) = SUM(tau(:, :, la550, 1:naero), dim = 3) / zdh(:, :) |
|---|
| 164 | |
|---|
| 165 | !--aod for particles lower than 1 micron |
|---|
| 166 | od550lt1aer(:) = tausum(:, la550, 1) + tausum(:, la550, 2) * 0.3 + tausum(:, la550, 3) * 0.2 |
|---|
| 167 | |
|---|
| 168 | END SUBROUTINE SPLAEROPT_5WV_RRTM |
|---|
