[2753] | 1 | ! |
---|
| 2 | ! $Id: splaeropt_6bands_rrtm.F90 2644 2016-10-02 16:55:08Z oboucher $ |
---|
| 3 | ! |
---|
| 4 | SUBROUTINE SPLAEROPT_6BANDS_RRTM ( & |
---|
| 5 | zdm, tr_seri, RHcl, & |
---|
| 6 | tau_allaer, piz_allaer, cg_allaer ) |
---|
| 7 | |
---|
| 8 | USE dimphy |
---|
| 9 | USE aero_mod |
---|
| 10 | USE infotrac_phy |
---|
[3798] | 11 | USE phys_local_var_mod, ONLY: abs550aer |
---|
[2753] | 12 | |
---|
| 13 | ! Olivier Boucher Jan 2017 |
---|
| 14 | ! based on Mie routines on ciclad CMIP6 |
---|
| 15 | ! |
---|
| 16 | IMPLICIT NONE |
---|
| 17 | |
---|
| 18 | INCLUDE "clesphys.h" |
---|
| 19 | ! |
---|
| 20 | ! Input arguments: |
---|
| 21 | ! |
---|
| 22 | REAL, DIMENSION(klon,klev), INTENT(IN) :: zdm !--hauteur des couches en kg/m2 |
---|
| 23 | REAL, DIMENSION(klon,klev), INTENT(IN) :: RHcl ! humidite relative ciel clair |
---|
| 24 | REAL, DIMENSION(klon,klev,nbtr),INTENT(IN) :: tr_seri |
---|
| 25 | ! |
---|
| 26 | ! Output arguments: |
---|
| 27 | ! 2= total aerosols |
---|
| 28 | ! 1= natural aerosols |
---|
| 29 | ! |
---|
| 30 | REAL, DIMENSION(klon,klev,2,nbands_sw_rrtm), INTENT(OUT) :: tau_allaer ! epaisseur optique aerosol |
---|
| 31 | REAL, DIMENSION(klon,klev,2,nbands_sw_rrtm), INTENT(OUT) :: piz_allaer ! single scattering albedo aerosol |
---|
| 32 | REAL, DIMENSION(klon,klev,2,nbands_sw_rrtm), INTENT(OUT) :: cg_allaer ! asymmetry parameter aerosol |
---|
| 33 | ! |
---|
| 34 | ! Local |
---|
| 35 | ! |
---|
| 36 | LOGICAL :: soluble |
---|
| 37 | INTEGER :: i, k, irh, itr, inu |
---|
| 38 | INTEGER :: aerindex, spsol, spinsol |
---|
| 39 | INTEGER :: RH_num(klon,klev) |
---|
| 40 | |
---|
| 41 | INTEGER, PARAMETER :: naero_soluble=2 ! 1- accumulation soluble; 2- coarse soluble |
---|
| 42 | INTEGER, PARAMETER :: naero_insoluble=2 ! 1- coarse dust; 2- supercoarse dust |
---|
| 43 | INTEGER, PARAMETER :: naero=naero_soluble+naero_insoluble |
---|
| 44 | |
---|
| 45 | INTEGER, PARAMETER :: nbre_RH=12 |
---|
| 46 | REAL,PARAMETER :: RH_tab(nbre_RH)=(/0.,10.,20.,30.,40.,50.,60.,70.,80.,85.,90.,95./) |
---|
| 47 | REAL, PARAMETER :: RH_MAX=95. |
---|
| 48 | REAL :: delta(klon,klev), rh(klon,klev) |
---|
| 49 | REAL :: tau_ae2b_int ! Intermediate computation of epaisseur optique aerosol |
---|
| 50 | REAL :: piz_ae2b_int ! Intermediate computation of Single scattering albedo |
---|
| 51 | REAL :: cg_ae2b_int ! Intermediate computation of Assymetry parameter |
---|
| 52 | REAL :: fact_RH(nbre_RH), tmp_var |
---|
| 53 | ! |
---|
| 54 | REAL, DIMENSION(klon,klev,naero_tot,nbands_sw_rrtm) :: tau_ae |
---|
| 55 | REAL, DIMENSION(klon,klev,naero_tot,nbands_sw_rrtm) :: piz_ae |
---|
| 56 | REAL, DIMENSION(klon,klev,naero_tot,nbands_sw_rrtm) :: cg_ae |
---|
| 57 | ! |
---|
| 58 | ! Proprietes optiques |
---|
| 59 | ! |
---|
| 60 | REAL:: alpha_aers_6bands(nbre_RH,nbands_sw_rrtm,naero_soluble) !--unit m2/g aer |
---|
| 61 | REAL:: alpha_aeri_6bands(nbands_sw_rrtm,naero_insoluble) !--unit m2/g aer |
---|
| 62 | REAL:: cg_aers_6bands(nbre_RH,nbands_sw_rrtm,naero_soluble) !--unitless |
---|
| 63 | REAL:: cg_aeri_6bands(nbands_sw_rrtm,naero_insoluble) !--unitless |
---|
| 64 | REAL:: piz_aers_6bands(nbre_RH,nbands_sw_rrtm,naero_soluble) !--unitless |
---|
| 65 | REAL:: piz_aeri_6bands(nbands_sw_rrtm,naero_insoluble) !--unitless |
---|
| 66 | ! |
---|
| 67 | REAL, PARAMETER :: tau_min = 1.e-8 |
---|
| 68 | CHARACTER*20 modname |
---|
| 69 | |
---|
| 70 | !*************************************************************************** |
---|
| 71 | !--the order of the soluble species has to follow the spsol index below |
---|
| 72 | !--the order of the insoluble species has to follow the spinsol index below |
---|
| 73 | |
---|
| 74 | DATA alpha_aers_6bands/ & |
---|
| 75 | ! accumulation (sulfate+2% bc) mode soluble |
---|
| 76 | 5.212, 5.212, 5.212, 5.212, 6.973, 7.581, 8.349, 9.400,11.078,12.463,14.857,20.837, & |
---|
| 77 | 4.906, 4.906, 4.906, 4.906, 6.568, 7.195, 7.989, 9.088,10.869,12.354,14.951,21.545, & |
---|
| 78 | 3.940, 3.940, 3.940, 3.940, 5.291, 5.861, 6.591, 7.620, 9.332,10.791,13.410,20.370, & |
---|
| 79 | 2.292, 2.292, 2.292, 2.292, 3.105, 3.493, 3.996, 4.724, 5.978, 7.084, 9.146,15.067, & |
---|
| 80 | 0.762, 0.762, 0.762, 0.762, 1.050, 1.201, 1.401, 1.699, 2.232, 2.721, 3.675, 6.678, & |
---|
| 81 | 0.090, 0.090, 0.090, 0.090, 0.122, 0.141, 0.166, 0.204, 0.275, 0.344, 0.484, 0.973, & |
---|
| 82 | ! coarse seasalt |
---|
| 83 | 0.547, 0.657, 0.705, 0.754, 0.817, 0.896, 1.008, 1.169, 1.456, 1.724, 2.199, 3.358, & |
---|
| 84 | 0.566, 0.679, 0.727, 0.776, 0.840, 0.920, 1.032, 1.196, 1.492, 1.760, 2.238, 3.416, & |
---|
| 85 | 0.596, 0.714, 0.764, 0.816, 0.882, 0.965, 1.081, 1.250, 1.552, 1.828, 2.310, 3.509, & |
---|
| 86 | 0.644, 0.771, 0.825, 0.880, 0.951, 1.040, 1.164, 1.345, 1.666, 1.957, 2.462, 3.700, & |
---|
| 87 | 0.640, 0.772, 0.829, 0.887, 0.965, 1.061, 1.198, 1.398, 1.758, 2.085, 2.658, 4.031, & |
---|
| 88 | 0.452, 0.562, 0.609, 0.659, 0.728, 0.813, 0.938, 1.125, 1.471, 1.797, 2.384, 3.855 / |
---|
| 89 | |
---|
| 90 | DATA alpha_aeri_6bands/ & |
---|
| 91 | ! coarse dust insoluble |
---|
| 92 | 0.594, 0.610, 0.619, 0.762, 0.791, 0.495, & |
---|
| 93 | ! supercoarse dust insoluble |
---|
| 94 | 0.151, 0.152, 0.155, 0.159, 0.168, 0.167 / |
---|
| 95 | |
---|
| 96 | DATA cg_aers_6bands/ & |
---|
| 97 | ! accumulation (sulfate+2% bc) mode soluble |
---|
| 98 | 0.692, 0.692, 0.692, 0.692, 0.735, 0.739, 0.744, 0.749, 0.755, 0.759, 0.765, 0.772, & |
---|
| 99 | 0.690, 0.690, 0.690, 0.690, 0.736, 0.740, 0.746, 0.752, 0.760, 0.765, 0.771, 0.779, & |
---|
| 100 | 0.678, 0.678, 0.678, 0.678, 0.727, 0.733, 0.740, 0.748, 0.759, 0.766, 0.775, 0.787, & |
---|
| 101 | 0.641, 0.641, 0.641, 0.641, 0.692, 0.700, 0.710, 0.721, 0.736, 0.746, 0.760, 0.781, & |
---|
| 102 | 0.553, 0.553, 0.553, 0.553, 0.603, 0.615, 0.627, 0.643, 0.664, 0.678, 0.699, 0.735, & |
---|
| 103 | 0.343, 0.343, 0.343, 0.343, 0.386, 0.399, 0.414, 0.433, 0.460, 0.480, 0.510, 0.569, & |
---|
| 104 | ! seasalt coarse Soluble |
---|
| 105 | 0.754, 0.770, 0.776, 0.781, 0.784, 0.791, 0.797, 0.805, 0.815, 0.822, 0.828, 0.840, & |
---|
| 106 | 0.736, 0.753, 0.759, 0.765, 0.771, 0.778, 0.785, 0.793, 0.804, 0.811, 0.820, 0.831, & |
---|
| 107 | 0.716, 0.735, 0.742, 0.748, 0.754, 0.762, 0.769, 0.778, 0.789, 0.796, 0.807, 0.819, & |
---|
| 108 | 0.704, 0.725, 0.733, 0.739, 0.745, 0.752, 0.759, 0.768, 0.778, 0.784, 0.792, 0.803, & |
---|
| 109 | 0.716, 0.737, 0.744, 0.751, 0.756, 0.763, 0.770, 0.777, 0.786, 0.790, 0.795, 0.800, & |
---|
| 110 | 0.688, 0.730, 0.741, 0.751, 0.761, 0.771, 0.782, 0.795, 0.810, 0.820, 0.833, 0.849 / |
---|
| 111 | |
---|
| 112 | DATA cg_aeri_6bands/ & |
---|
| 113 | ! coarse dust insoluble |
---|
| 114 | 0.801, 0.779, 0.709, 0.698, 0.710, 0.687, & |
---|
| 115 | ! super coarse dust insoluble |
---|
| 116 | 0.862, 0.871, 0.852, 0.799, 0.758, 0.651 / |
---|
| 117 | |
---|
| 118 | DATA piz_aers_6bands/& |
---|
| 119 | ! accumulation (sulfate+2% bc) mode soluble |
---|
| 120 | 0.941, 0.941, 0.941, 0.941, 0.958, 0.961, 0.965, 0.969, 0.974, 0.977, 0.981, 0.987, & |
---|
| 121 | 0.941, 0.941, 0.941, 0.941, 0.959, 0.963, 0.967, 0.971, 0.976, 0.979, 0.983, 0.988, & |
---|
| 122 | 0.953, 0.953, 0.953, 0.953, 0.967, 0.971, 0.974, 0.978, 0.982, 0.984, 0.988, 0.992, & |
---|
| 123 | 0.955, 0.955, 0.955, 0.955, 0.969, 0.972, 0.976, 0.980, 0.984, 0.986, 0.989, 0.994, & |
---|
| 124 | 0.936, 0.936, 0.936, 0.936, 0.955, 0.961, 0.966, 0.972, 0.978, 0.982, 0.987, 0.993, & |
---|
| 125 | 0.792, 0.792, 0.792, 0.792, 0.848, 0.867, 0.887, 0.907, 0.931, 0.944, 0.960, 0.980, & |
---|
| 126 | ! seasalt coarse soluble |
---|
| 127 | 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.001, 1.000, & |
---|
| 128 | 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, & |
---|
| 129 | 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, & |
---|
| 130 | 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, 1.000, & |
---|
| 131 | 0.994, 0.994, 0.995, 0.995, 0.995, 0.995, 0.996, 0.996, 0.996, 0.996, 0.996, 0.996, & |
---|
| 132 | 0.976, 0.867, 0.837, 0.814, 0.796, 0.774, 0.754, 0.735, 0.713, 0.702, 0.690, 0.675 / |
---|
| 133 | |
---|
| 134 | DATA piz_aeri_6bands/ & |
---|
| 135 | ! coarse dust insoluble |
---|
| 136 | 0.866, 0.875, 0.915, 0.977, 0.993, 0.971, & |
---|
| 137 | ! super coarse dust insoluble |
---|
| 138 | 0.789, 0.749, 0.791, 0.918, 0.970, 0.909 / |
---|
| 139 | ! |
---|
| 140 | spsol = 0 |
---|
| 141 | spinsol = 0 |
---|
| 142 | |
---|
| 143 | modname='splaeropt_6bands_rrt' |
---|
| 144 | |
---|
| 145 | IF (NSW.NE.nbands_sw_rrtm) THEN |
---|
| 146 | CALL abort_physic(modname,'Erreur NSW doit etre egal a 6 pour cette routine',1) |
---|
| 147 | ENDIF |
---|
| 148 | |
---|
| 149 | DO irh=1,nbre_RH-1 |
---|
| 150 | fact_RH(irh)=1./(RH_tab(irh+1)-RH_tab(irh)) |
---|
| 151 | ENDDO |
---|
| 152 | |
---|
| 153 | DO k=1, klev |
---|
| 154 | DO i=1, klon |
---|
| 155 | rh(i,k)=MIN(RHcl(i,k)*100.,RH_MAX) |
---|
| 156 | RH_num(i,k) = INT(rh(i,k)/10. + 1.) |
---|
| 157 | IF (rh(i,k).GT.85.) RH_num(i,k)=10 |
---|
| 158 | IF (rh(i,k).GT.90.) RH_num(i,k)=11 |
---|
| 159 | delta(i,k)=(rh(i,k)-RH_tab(RH_num(i,k)))*fact_RH(RH_num(i,k)) |
---|
| 160 | ENDDO |
---|
| 161 | ENDDO |
---|
| 162 | |
---|
| 163 | tau_ae(:,:,:,:)=0. |
---|
| 164 | piz_ae(:,:,:,:)=0. |
---|
| 165 | cg_ae(:,:,:,:)=0. |
---|
| 166 | |
---|
| 167 | DO itr=1, nbtr |
---|
| 168 | |
---|
| 169 | IF (tname(itr+nqo)=='PREC') THEN !--precursor |
---|
| 170 | CYCLE |
---|
| 171 | ELSE IF (tname(itr+nqo)=='FINE') THEN !--fine mode accumulation mode |
---|
| 172 | soluble=.TRUE. |
---|
| 173 | spsol=1 |
---|
| 174 | aerindex=1 |
---|
| 175 | ELSE IF (tname(itr+nqo)=='COSS') THEN !--coarse mode sea salt |
---|
| 176 | soluble=.TRUE. |
---|
| 177 | spsol=2 |
---|
| 178 | aerindex=2 |
---|
| 179 | ELSE IF (tname(itr+nqo)=='CODU') THEN !--coarse mode dust |
---|
| 180 | soluble=.FALSE. |
---|
| 181 | spinsol=1 |
---|
| 182 | aerindex=3 |
---|
| 183 | ELSE IF (tname(itr+nqo)=='SCDU') THEN !--super coarse mode dust |
---|
| 184 | soluble=.FALSE. |
---|
| 185 | spinsol=2 |
---|
| 186 | aerindex=4 |
---|
| 187 | ELSE |
---|
| 188 | CALL abort_physic(modname,'I cannot do aerosol optics for '//tname(itr+nqo),1) |
---|
| 189 | ENDIF |
---|
| 190 | |
---|
| 191 | IF (soluble) THEN ! For aerosol soluble components |
---|
| 192 | |
---|
| 193 | DO k=1, klev |
---|
| 194 | DO i=1, klon |
---|
| 195 | |
---|
| 196 | tmp_var=tr_seri(i,k,itr)*zdm(i,k) !-- g/m2 |
---|
| 197 | |
---|
| 198 | DO inu=1,NSW |
---|
| 199 | |
---|
| 200 | tau_ae2b_int= alpha_aers_6bands(RH_num(i,k),inu,spsol)+ & |
---|
| 201 | delta(i,k)* (alpha_aers_6bands(RH_num(i,k)+1,inu,spsol) - & |
---|
| 202 | alpha_aers_6bands(RH_num(i,k),inu,spsol)) |
---|
| 203 | |
---|
| 204 | piz_ae2b_int = piz_aers_6bands(RH_num(i,k),inu,spsol) + & |
---|
| 205 | delta(i,k)* (piz_aers_6bands(RH_num(i,k)+1,inu,spsol) - & |
---|
| 206 | piz_aers_6bands(RH_num(i,k),inu,spsol)) |
---|
| 207 | |
---|
| 208 | cg_ae2b_int = cg_aers_6bands(RH_num(i,k),inu,spsol) + & |
---|
| 209 | delta(i,k)* (cg_aers_6bands(RH_num(i,k)+1,inu,spsol) - & |
---|
| 210 | cg_aers_6bands(RH_num(i,k),inu,spsol)) |
---|
| 211 | |
---|
| 212 | tau_ae(i,k,aerindex,inu) = tmp_var*tau_ae2b_int |
---|
| 213 | piz_ae(i,k,aerindex,inu) = piz_ae2b_int |
---|
| 214 | cg_ae(i,k,aerindex,inu) = cg_ae2b_int |
---|
| 215 | |
---|
| 216 | ENDDO |
---|
| 217 | ENDDO |
---|
| 218 | ENDDO |
---|
| 219 | |
---|
| 220 | ELSE ! For all aerosol insoluble components |
---|
| 221 | |
---|
| 222 | DO k=1, klev |
---|
| 223 | DO i=1, klon |
---|
| 224 | |
---|
| 225 | tmp_var=tr_seri(i,k,itr)*zdm(i,k) !-- g/m2 |
---|
| 226 | |
---|
| 227 | DO inu=1,NSW |
---|
| 228 | tau_ae2b_int = alpha_aeri_6bands(inu,spinsol) |
---|
| 229 | piz_ae2b_int = piz_aeri_6bands(inu,spinsol) |
---|
| 230 | cg_ae2b_int = cg_aeri_6bands(inu,spinsol) |
---|
| 231 | |
---|
| 232 | tau_ae(i,k,aerindex,inu) = tmp_var*tau_ae2b_int |
---|
| 233 | piz_ae(i,k,aerindex,inu) = piz_ae2b_int |
---|
| 234 | cg_ae(i,k,aerindex,inu)= cg_ae2b_int |
---|
| 235 | ENDDO |
---|
| 236 | ENDDO |
---|
| 237 | ENDDO |
---|
| 238 | |
---|
| 239 | ENDIF ! soluble / insoluble |
---|
| 240 | |
---|
| 241 | ENDDO ! nbtr |
---|
| 242 | |
---|
| 243 | !--all (natural + anthropogenic) aerosol |
---|
| 244 | tau_allaer(:,:,2,:)=SUM(tau_ae(:,:,1:naero,:),dim=3) |
---|
| 245 | tau_allaer(:,:,2,:)=MAX(tau_allaer(:,:,2,:),tau_min) |
---|
| 246 | |
---|
| 247 | piz_allaer(:,:,2,:)=SUM(tau_ae(:,:,1:naero,:)*piz_ae(:,:,1:naero,:),dim=3)/tau_allaer(:,:,2,:) |
---|
| 248 | piz_allaer(:,:,2,:)=MIN(MAX(piz_allaer(:,:,2,:),0.01),1.0) |
---|
| 249 | WHERE (tau_allaer(:,:,2,:).LE.tau_min) piz_allaer(:,:,2,:)=1.0 |
---|
| 250 | |
---|
| 251 | cg_allaer(:,:,2,:)=SUM(tau_ae(:,:,1:naero,:)*piz_ae(:,:,1:naero,:)*cg_ae(:,:,1:naero,:),dim=3)/ & |
---|
| 252 | (tau_allaer(:,:,2,:)*piz_allaer(:,:,2,:)) |
---|
| 253 | cg_allaer(:,:,2,:)=MIN(MAX(cg_allaer(:,:,2,:),0.0),1.0) |
---|
| 254 | |
---|
| 255 | !--no aerosol |
---|
| 256 | tau_allaer(:,:,1,:)=tau_min |
---|
| 257 | piz_allaer(:,:,1,:)=1.0 |
---|
| 258 | cg_allaer(:,:,1,:)=0.0 |
---|
| 259 | |
---|
| 260 | !--waveband 2 and all aerosol (third index = 2) |
---|
| 261 | inu=2 |
---|
[3798] | 262 | abs550aer(:)=SUM((1-piz_allaer(:,:,2,inu))*tau_allaer(:,:,2,inu),dim=2) |
---|
[2753] | 263 | |
---|
| 264 | END SUBROUTINE SPLAEROPT_6BANDS_RRTM |
---|