[2630] | 1 | c This subroutine calculates the emissions of SEA SALT and DUST, part of |
---|
| 2 | C which goes to tracer 2 and other part to tracer 3. |
---|
| 3 | SUBROUTINE coarsemission(pctsrf,pdtphys, |
---|
| 4 | . t_seri,pmflxr,pmflxs,prfl,psfl, |
---|
| 5 | . xlat,xlon,debutphy, |
---|
| 6 | . zu10m,zv10m,wstar,ale_bl,ale_wake, |
---|
| 7 | . scale_param_ssacc,scale_param_sscoa, |
---|
| 8 | . scale_param_dustacc,scale_param_dustcoa, |
---|
| 9 | . scale_param_dustsco, |
---|
| 10 | . nbreg_dust, |
---|
| 11 | . iregion_dust,dust_ec, |
---|
| 12 | . param_wstarBLperregion,param_wstarWAKEperregion, |
---|
| 13 | . nbreg_wstardust, |
---|
| 14 | . iregion_wstardust, |
---|
| 15 | . lmt_sea_salt,qmin,qmax, |
---|
| 16 | . flux_sparam_ddfine,flux_sparam_ddcoa, |
---|
| 17 | . flux_sparam_ddsco, |
---|
| 18 | . flux_sparam_ssfine,flux_sparam_sscoa, |
---|
| 19 | . id_prec,id_fine,id_coss,id_codu,id_scdu, |
---|
| 20 | . ok_chimeredust, |
---|
| 21 | . source_tr,flux_tr) |
---|
| 22 | ! . wth,cly,zprecipinsoil,lmt_sea_salt, |
---|
| 23 | |
---|
| 24 | ! CALL dustemission( debutphy, xlat, xlon, pctsrf, |
---|
| 25 | ! . zu10m zv10m,wstar,ale_bl,ale_wake) |
---|
| 26 | ! |
---|
| 27 | |
---|
| 28 | USE dimphy |
---|
| 29 | USE indice_sol_mod |
---|
| 30 | USE infotrac |
---|
| 31 | USE dustemission_mod, ONLY : dustemission |
---|
| 32 | ! USE phytracr_spl_mod, ONLY : nbreg_dust, nbreg_ind, nbreg_bb |
---|
| 33 | IMPLICIT NONE |
---|
| 34 | |
---|
[4727] | 35 | INCLUDE "dimensions.h" |
---|
| 36 | INCLUDE "chem.h" |
---|
| 37 | INCLUDE "chem_spla.h" |
---|
| 38 | INCLUDE "YOMCST.h" |
---|
| 39 | INCLUDE "paramet.h" |
---|
[2630] | 40 | |
---|
| 41 | c============================== INPUT ================================== |
---|
| 42 | INTEGER nbjour |
---|
| 43 | LOGICAL ok_chimeredust |
---|
| 44 | REAL pdtphys ! pas d'integration pour la physique (seconde) |
---|
| 45 | REAL t_seri(klon,klev) ! temperature |
---|
| 46 | REAL pctsrf(klon,nbsrf) |
---|
| 47 | REAL pmflxr(klon,klev+1), pmflxs(klon,klev+1) !--convection |
---|
| 48 | ! REAL pmflxr(klon,klev), pmflxs(klon,klev) !--convection |
---|
| 49 | REAL prfl(klon,klev+1), psfl(klon,klev+1) !--large-scale |
---|
| 50 | ! REAL prfl(klon,klev), psfl(klon,klev) !--large-scale |
---|
| 51 | LOGICAL debutphy, lafinphy |
---|
| 52 | REAL, intent(in) :: xlat(klon) ! latitudes pour chaque point |
---|
| 53 | REAL, intent(in) :: xlon(klon) ! longitudes pour chaque point |
---|
| 54 | REAL,DIMENSION(klon),INTENT(IN) :: zu10m |
---|
| 55 | REAL,DIMENSION(klon),INTENT(IN) :: zv10m |
---|
| 56 | REAL,DIMENSION(klon),INTENT(IN) :: wstar,Ale_bl,ale_wake |
---|
| 57 | |
---|
| 58 | c |
---|
| 59 | c------------------------- Scaling Parameters -------------------------- |
---|
| 60 | c |
---|
| 61 | INTEGER iregion_dust(klon) !Defines dust regions |
---|
| 62 | REAL scale_param_ssacc !Scaling parameter for Fine Sea Salt |
---|
| 63 | REAL scale_param_sscoa !Scaling parameter for Coarse Sea Salt |
---|
| 64 | REAL scale_param_dustacc(nbreg_dust) !Scaling parameter for Fine Dust |
---|
| 65 | REAL scale_param_dustcoa(nbreg_dust) !Scaling parameter for Coarse Dust |
---|
| 66 | REAL scale_param_dustsco(nbreg_dust) !Scaling parameter for SCoarse Dust |
---|
| 67 | !JE20141124<< |
---|
| 68 | INTEGER iregion_wstardust(klon) !Defines dust regions in terms of wstar |
---|
| 69 | REAL param_wstarBLperregion(nbreg_wstardust) ! |
---|
| 70 | REAL param_wstarWAKEperregion(nbreg_wstardust) ! |
---|
| 71 | REAL param_wstarBL(klon) !parameter for surface wind correction.. |
---|
| 72 | REAL param_wstarWAKE(klon) !parameter for surface wind correction.. |
---|
| 73 | INTEGER nbreg_wstardust |
---|
| 74 | !JE20141124>> |
---|
| 75 | INTEGER nbreg_dust |
---|
| 76 | INTEGER, INTENT(IN) :: id_prec,id_fine,id_coss,id_codu,id_scdu |
---|
| 77 | c============================== OUTPUT ================================= |
---|
| 78 | REAL source_tr(klon,nbtr) |
---|
| 79 | REAL flux_tr(klon,nbtr) |
---|
| 80 | REAL flux_sparam_ddfine(klon), flux_sparam_ddcoa(klon) |
---|
| 81 | REAL flux_sparam_ddsco(klon) |
---|
| 82 | REAL flux_sparam_ssfine(klon), flux_sparam_sscoa(klon) |
---|
| 83 | c=========================== LOCAL VARIABLES =========================== |
---|
| 84 | INTEGER i, j |
---|
| 85 | REAL pct_ocean(klon) |
---|
| 86 | ! REAL zprecipinsoil(klon) |
---|
| 87 | ! REAL cly(klon), wth(klon) |
---|
| 88 | REAL clyfac, avgdryrate, drying |
---|
| 89 | |
---|
| 90 | c---------------------------- SEA SALT emissions ------------------------ |
---|
| 91 | REAL lmt_sea_salt(klon,ss_bins) !Sea salt 0.03-8.0 um |
---|
| 92 | c |
---|
| 93 | c--------vent 10 m CEPMMT |
---|
| 94 | c |
---|
| 95 | REAL dust_ec(klon) |
---|
| 96 | |
---|
| 97 | real tmp_var2(klon,nbtr) ! auxiliary variable to replace source |
---|
| 98 | REAL qmin, qmax |
---|
| 99 | !----------------------DUST Sahara --------------- |
---|
| 100 | REAL, DIMENSION(klon) :: dustsourceacc,dustsourcecoa,dustsourcesco |
---|
| 101 | INTEGER, DIMENSION(klon) :: maskd |
---|
| 102 | C*********************** DUST EMMISSIONS ******************************* |
---|
| 103 | c |
---|
| 104 | |
---|
| 105 | ! avgdryrate=300./365.*pdtphys/86400. |
---|
| 106 | c |
---|
| 107 | ! DO i=1, klon |
---|
| 108 | c |
---|
| 109 | ! IF (cly(i).LT.9990..AND.wth(i).LT.9990.) THEN |
---|
| 110 | ! zprecipinsoil(i)=zprecipinsoil(i) + |
---|
| 111 | ! . (pmflxr(i,1)+pmflxs(i,1)+prfl(i,1)+psfl(i,1))*pdtphys |
---|
| 112 | c |
---|
| 113 | ! clyfac=MIN(16., cly(i)*0.4+8.) ![mm] max amount of water hold in top soil |
---|
| 114 | ! drying=avgdryrate*exp(0.03905491* |
---|
| 115 | ! . exp(0.17446*(t_seri(i,1)-273.15))) ! [mm] |
---|
| 116 | ! zprecipinsoil(i)=min(max(0.,zprecipinsoil(i)-drying),clyfac) ! [mm] |
---|
| 117 | c |
---|
| 118 | ! ENDIF |
---|
| 119 | c |
---|
| 120 | ! ENDDO |
---|
| 121 | c |
---|
| 122 | c ==================== CALCULATING DUST EMISSIONS ====================== |
---|
| 123 | c |
---|
| 124 | ! IF (lminmax) THEN |
---|
| 125 | DO j=1,nbtr |
---|
| 126 | DO i=1,klon |
---|
| 127 | tmp_var2(i,j)=source_tr(i,j) |
---|
| 128 | ENDDO |
---|
| 129 | ENDDO |
---|
| 130 | CALL minmaxsource(tmp_var2,qmin,qmax,'src: before DD emiss') |
---|
| 131 | ! print *,'Source = ',SUM(source_tr),MINVAL(source_tr), |
---|
| 132 | ! . MAXVAL(source_tr) |
---|
| 133 | ! ENDIF |
---|
| 134 | |
---|
| 135 | c |
---|
| 136 | IF (.NOT. ok_chimeredust) THEN |
---|
| 137 | DO i=1, klon |
---|
| 138 | !! IF (cly(i).GE.9990..OR.wth(i).GE.9990..OR. |
---|
| 139 | !! . t_seri(i,1).LE.273.15.OR.zprecipinsoil(i).GT.1.e-8) THEN |
---|
| 140 | !! dust_ec(i)=0.0 |
---|
| 141 | !! ENDIF |
---|
| 142 | !c Corresponds to dust_emission.EQ.3 |
---|
| 143 | !!!!!!!****************AQUIIIIIIIIIIIIIIIIIIIIIIIIIIII |
---|
| 144 | !! Original line (4 tracers) |
---|
| 145 | !JE<< old 4 tracer(nhl scheme) source_tr(i,id_fine)=scale_param_dustacc(iregion_dust(i))* |
---|
| 146 | ! . dust_ec(i)*1.e3*0.093 ! g/m2/s |
---|
| 147 | ! source_tr(i,id_codu)=scale_param_dustcoa(iregion_dust(i))* |
---|
| 148 | ! . dust_ec(i)*1.e3*0.905 ! g/m2/s bin 0.5-10um |
---|
| 149 | !! Original line (4 tracers) |
---|
| 150 | ! flux_tr(i,id_fine)=scale_param_dustacc(iregion_dust(i))* |
---|
| 151 | ! . dust_ec(i)*1.e3*0.093*1.e3 !mg/m2/s |
---|
| 152 | ! flux_tr(i,id_codu)=scale_param_dustcoa(iregion_dust(i))* |
---|
| 153 | ! . dust_ec(i)*1.e3*0.905*1.e3 !mg/m2/s bin 0.5-10um |
---|
| 154 | ! flux_sparam_ddfine(i)=scale_param_dustacc(iregion_dust(i)) * |
---|
| 155 | ! . dust_ec(i)*1.e3*0.093*1.e3 |
---|
| 156 | ! flux_sparam_ddcoa(i)=scale_param_dustcoa(iregion_dust(i)) * |
---|
| 157 | ! . dust_ec(i)*1.e3*0.905*1.e3 |
---|
| 158 | IF(id_fine>0) source_tr(i,id_fine)= |
---|
| 159 | . scale_param_dustacc(iregion_dust(i))* |
---|
| 160 | . dust_ec(i)*1.e3*0.093 ! g/m2/s |
---|
| 161 | IF(id_codu>0) source_tr(i,id_codu)= |
---|
| 162 | . scale_param_dustcoa(iregion_dust(i))* |
---|
| 163 | . dust_ec(i)*1.e3*0.905 ! g/m2/s bin 0.5-10um |
---|
| 164 | IF(id_scdu>0) source_tr(i,id_scdu)=0. ! no supercoarse |
---|
| 165 | ! Original line (4 tracers) |
---|
| 166 | IF(id_fine>0) flux_tr(i,id_fine)= |
---|
| 167 | . scale_param_dustacc(iregion_dust(i))* |
---|
| 168 | . dust_ec(i)*1.e3*0.093*1.e3 !mg/m2/s |
---|
| 169 | IF(id_codu>0) flux_tr(i,id_codu)= |
---|
| 170 | . scale_param_dustcoa(iregion_dust(i))* |
---|
| 171 | . dust_ec(i)*1.e3*0.905*1.e3 !mg/m2/s bin 0.5-10um |
---|
| 172 | IF(id_scdu>0) flux_tr(i,id_scdu)=0. |
---|
| 173 | |
---|
| 174 | flux_sparam_ddfine(i)=scale_param_dustacc(iregion_dust(i)) * |
---|
| 175 | . dust_ec(i)*1.e3*0.093*1.e3 |
---|
| 176 | flux_sparam_ddcoa(i)=scale_param_dustcoa(iregion_dust(i)) * |
---|
| 177 | . dust_ec(i)*1.e3*0.905*1.e3 |
---|
| 178 | flux_sparam_ddsco(i)=0. |
---|
| 179 | ENDDO |
---|
| 180 | ENDIF |
---|
| 181 | !*****************NEW CHIMERE DUST EMISSION Sahara***** |
---|
| 182 | ! je 20140522 |
---|
| 183 | IF(ok_chimeredust) THEN |
---|
| 184 | print *,'MIX- NEW SAHARA DUST SOURCE SCHEME...' |
---|
| 185 | |
---|
| 186 | DO i=1,klon |
---|
| 187 | param_wstarBL(i) =param_wstarBLperregion(iregion_wstardust(i)) |
---|
| 188 | param_wstarWAKE(i)=param_wstarWAKEperregion(iregion_wstardust(i)) |
---|
| 189 | ENDDO |
---|
| 190 | |
---|
| 191 | |
---|
| 192 | CALL dustemission( debutphy, xlat, xlon, pctsrf, |
---|
| 193 | . zu10m,zv10m,wstar,ale_bl,ale_wake, |
---|
| 194 | . param_wstarBL, param_wstarWAKE, |
---|
| 195 | . dustsourceacc,dustsourcecoa, |
---|
| 196 | . dustsourcesco,maskd) |
---|
| 197 | |
---|
| 198 | DO i=1,klon |
---|
| 199 | if (maskd(i).gt.0) then |
---|
| 200 | IF(id_fine>0) source_tr(i,id_fine)= |
---|
| 201 | . scale_param_dustacc(iregion_dust(i))* |
---|
| 202 | . dustsourceacc(i)*1.e3 ! g/m2/s bin 0.03-0.5 |
---|
| 203 | IF(id_codu>0) source_tr(i,id_codu)= |
---|
| 204 | . scale_param_dustcoa(iregion_dust(i))* |
---|
| 205 | . dustsourcecoa(i)*1.e3 ! g/m2/s bin 0.5-3um |
---|
| 206 | IF(id_scdu>0) source_tr(i,id_scdu)= |
---|
| 207 | . scale_param_dustsco(iregion_dust(i))* |
---|
| 208 | . dustsourcesco(i)*1.e3 ! g/m2/s bin 3-15um |
---|
| 209 | ! Original line (4 tracers) |
---|
| 210 | IF(id_fine>0) flux_tr(i,id_fine)= |
---|
| 211 | . scale_param_dustacc(iregion_dust(i))* |
---|
| 212 | . dustsourceacc(i)*1.e3*1.e3 !mg/m2/s |
---|
| 213 | IF(id_codu>0) flux_tr(i,id_codu)= |
---|
| 214 | . scale_param_dustcoa(iregion_dust(i))* |
---|
| 215 | . dustsourcecoa(i)*1.e3*1.e3 !mg/m2/s bin 0.5-3um |
---|
| 216 | IF(id_scdu>0) flux_tr(i,id_scdu)= |
---|
| 217 | . scale_param_dustsco(iregion_dust(i))* |
---|
| 218 | . dustsourcesco(i)*1.e3*1.e3 !mg/m2/s bin 3-15um |
---|
| 219 | flux_sparam_ddfine(i)=scale_param_dustacc(iregion_dust(i)) * |
---|
| 220 | . dustsourceacc(i)*1.e3*1.e3 |
---|
| 221 | flux_sparam_ddcoa(i)=scale_param_dustcoa(iregion_dust(i)) * |
---|
| 222 | . dustsourcecoa(i)*1.e3*1.e3 |
---|
| 223 | flux_sparam_ddsco(i)=scale_param_dustsco(iregion_dust(i)) * |
---|
| 224 | . dustsourcesco(i)*1.e3*1.e3 |
---|
| 225 | else |
---|
| 226 | IF(id_fine>0) source_tr(i,id_fine)= |
---|
| 227 | . scale_param_dustacc(iregion_dust(i))* |
---|
| 228 | . dust_ec(i)*1.e3*0.114 ! g/m2/s |
---|
| 229 | IF(id_codu>0) source_tr(i,id_codu)= |
---|
| 230 | . scale_param_dustcoa(iregion_dust(i))* |
---|
| 231 | . dust_ec(i)*1.e3*0.108 ! g/m2/s bin 0.5-3um |
---|
| 232 | IF(id_scdu>0) source_tr(i,id_scdu)= |
---|
| 233 | . scale_param_dustsco(iregion_dust(i))* |
---|
| 234 | . dust_ec(i)*1.e3*0.778 ! g/m2/s bin 3-15um |
---|
| 235 | ! Original line (4 tracers) |
---|
| 236 | IF(id_fine>0) flux_tr(i,id_fine)= |
---|
| 237 | . scale_param_dustacc(iregion_dust(i))* |
---|
| 238 | . dust_ec(i)*1.e3*0.114*1.e3 !mg/m2/s |
---|
| 239 | IF(id_codu>0) flux_tr(i,id_codu)= |
---|
| 240 | . scale_param_dustcoa(iregion_dust(i))* |
---|
| 241 | . dust_ec(i)*1.e3*0.108*1.e3 !mg/m2/s bin 0.5-3um |
---|
| 242 | IF(id_scdu>0) flux_tr(i,id_scdu)= |
---|
| 243 | . scale_param_dustsco(iregion_dust(i))* |
---|
| 244 | . dust_ec(i)*1.e3*0.778*1.e3 !mg/m2/s bin 0.5-3um |
---|
| 245 | |
---|
| 246 | flux_sparam_ddfine(i)=scale_param_dustacc(iregion_dust(i)) * |
---|
| 247 | . dust_ec(i)*1.e3*0.114*1.e3 |
---|
| 248 | flux_sparam_ddcoa(i)=scale_param_dustcoa(iregion_dust(i)) * |
---|
| 249 | . dust_ec(i)*1.e3*0.108*1.e3 |
---|
| 250 | flux_sparam_ddsco(i)=scale_param_dustsco(iregion_dust(i)) * |
---|
| 251 | . dust_ec(i)*1.e3*0.778*1.e3 |
---|
| 252 | |
---|
| 253 | endif |
---|
| 254 | ENDDO |
---|
| 255 | |
---|
| 256 | |
---|
| 257 | |
---|
| 258 | |
---|
| 259 | |
---|
| 260 | ENDIF |
---|
| 261 | !***************************************************** |
---|
| 262 | C******************* SEA SALT EMMISSIONS ******************************* |
---|
| 263 | DO i=1,klon |
---|
| 264 | pct_ocean(i)=pctsrf(i,is_oce) |
---|
| 265 | ENDDO |
---|
| 266 | c |
---|
| 267 | ! IF (lminmax) THEN |
---|
| 268 | DO j=1,nbtr |
---|
| 269 | DO i=1,klon |
---|
| 270 | tmp_var2(i,j)=source_tr(i,j) |
---|
| 271 | ENDDO |
---|
| 272 | ENDDO |
---|
| 273 | CALL minmaxsource(tmp_var2,qmin,qmax,'src: before SS emiss') |
---|
| 274 | IF(id_coss>0) then |
---|
| 275 | print *,'Source = ',SUM(source_tr(:,id_coss)), |
---|
| 276 | . MINVAL(source_tr(:,id_coss)), MAXVAL(source_tr(:,id_coss)) |
---|
| 277 | ENDIF |
---|
| 278 | ! |
---|
| 279 | DO i=1,klon |
---|
| 280 | ! Original line (4 tracers) |
---|
| 281 | IF(id_fine>0) source_tr(i,id_fine)= |
---|
| 282 | . source_tr(i,id_fine)+scale_param_ssacc* |
---|
| 283 | . lmt_sea_salt(i,1)*1.e4 !g/m2/s |
---|
| 284 | |
---|
| 285 | ! Original line (4 tracers) |
---|
| 286 | IF(id_fine>0) flux_tr(i,id_fine)= |
---|
| 287 | . flux_tr(i,id_fine)+scale_param_ssacc |
---|
| 288 | . *lmt_sea_salt(i,1)*1.e4*1.e3 !mg/m2/s |
---|
| 289 | ! |
---|
| 290 | IF(id_coss>0) source_tr(i,id_coss)= |
---|
| 291 | . scale_param_sscoa*lmt_sea_salt(i,2)*1.e4 !g/m2/s |
---|
| 292 | IF(id_coss>0) flux_tr(i,id_coss)= |
---|
| 293 | . scale_param_sscoa*lmt_sea_salt(i,2)*1.e4*1.e3 !mg/m2/s |
---|
| 294 | c |
---|
| 295 | flux_sparam_ssfine(i)=scale_param_ssacc * |
---|
| 296 | . lmt_sea_salt(i,1)*1.e4*1.e3 |
---|
| 297 | flux_sparam_sscoa(i)=scale_param_sscoa * |
---|
| 298 | . lmt_sea_salt(i,2)*1.e4*1.e3 |
---|
| 299 | ENDDO |
---|
| 300 | ! IF (lminmax) THEN |
---|
| 301 | DO j=1,nbtr |
---|
| 302 | DO i=1,klon |
---|
| 303 | tmp_var2(i,j)=source_tr(i,j) |
---|
| 304 | ENDDO |
---|
| 305 | ENDDO |
---|
| 306 | CALL minmaxsource(tmp_var2,qmin,qmax,'src: after SS emiss') |
---|
| 307 | IF(id_coss>0) then |
---|
| 308 | print *,'Source = ',SUM(source_tr(:,id_coss)), |
---|
| 309 | . MINVAL(source_tr(:,id_coss)), MAXVAL(source_tr(:,id_coss)) |
---|
| 310 | ENDIF |
---|
| 311 | c |
---|
| 312 | |
---|
| 313 | END |
---|