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