| 1 | ! Subroutine that calculates the emission of aerosols precursors |
|---|
| 2 | SUBROUTINE precuremission(ftsol, u10m_ec, v10m_ec, & |
|---|
| 3 | pctsrf, u_seri, v_seri, paprs, pplay, cdragh, & |
|---|
| 4 | cdragm, t_seri, q_seri, tsol, fracso2emis, & |
|---|
| 5 | frach2sofso2, bateau, zdz, zalt, & |
|---|
| 6 | kminbc, kmaxbc, pdtphys, scale_param_bb, & |
|---|
| 7 | scale_param_ind, iregion_ind, iregion_bb, & |
|---|
| 8 | nbreg_ind, nbreg_bb, & |
|---|
| 9 | lmt_so2ff_l, lmt_so2ff_h, lmt_so2nff, & |
|---|
| 10 | lmt_so2ba, lmt_so2bb_l, lmt_so2bb_h, & |
|---|
| 11 | lmt_so2volc_cont, lmt_altvolc_cont, & |
|---|
| 12 | lmt_so2volc_expl, lmt_altvolc_expl, & |
|---|
| 13 | lmt_dmsbio, lmt_h2sbio, lmt_dmsconc, & |
|---|
| 14 | lmt_dms, id_prec, id_fine, & |
|---|
| 15 | flux_sparam_ind, flux_sparam_bb, & |
|---|
| 16 | source_tr, flux_tr, tr_seri) |
|---|
| 17 | |
|---|
| 18 | USE dimphy |
|---|
| 19 | USE indice_sol_mod |
|---|
| 20 | USE infotrac |
|---|
| 21 | ! USE phytracr_spl_mod, ONLY: nbreg_dust, nbreg_ind, nbreg_bb |
|---|
| 22 | IMPLICIT NONE |
|---|
| 23 | |
|---|
| 24 | INCLUDE "dimensions.h" |
|---|
| 25 | INCLUDE "chem.h" |
|---|
| 26 | INCLUDE "chem_spla.h" |
|---|
| 27 | INCLUDE "YOMCST.h" |
|---|
| 28 | INCLUDE "paramet.h" |
|---|
| 29 | |
|---|
| 30 | !============================= INPUT =================================== |
|---|
| 31 | INTEGER :: kminbc, kmaxbc |
|---|
| 32 | REAL :: ftsol(klon, nbsrf) ! temperature du sol par type |
|---|
| 33 | REAL :: tsol(klon) ! temperature du sol moyenne |
|---|
| 34 | REAL :: t_seri(klon, klev) ! temperature |
|---|
| 35 | REAL :: u_seri(klon, klev) ! vent |
|---|
| 36 | REAL :: v_seri(klon, klev) ! vent |
|---|
| 37 | REAL :: q_seri(klon, klev) ! vapeur d eau kg/kg |
|---|
| 38 | REAL :: u10m_ec(klon), v10m_ec(klon) ! vent a 10 metres |
|---|
| 39 | REAL :: pctsrf(klon, nbsrf) |
|---|
| 40 | REAL :: pdtphys ! pas d'integration pour la physique (seconde) |
|---|
| 41 | REAL :: paprs(klon, klev + 1) ! pression pour chaque inter-couche (en Pa) |
|---|
| 42 | REAL :: pplay(klon, klev) ! pression pour le mileu de chaque couche (en Pa) |
|---|
| 43 | REAL :: cdragh(klon), cdragm(klon) |
|---|
| 44 | REAL :: fracso2emis !--fraction so2 emis en so2 |
|---|
| 45 | REAL :: frach2sofso2 !--fraction h2s from so2 |
|---|
| 46 | REAL :: zdz(klon, klev) |
|---|
| 47 | LOGICAL :: edgar, bateau |
|---|
| 48 | INTEGER :: id_prec, id_fine |
|---|
| 49 | ! |
|---|
| 50 | !------------------------- Scaling Parameters -------------------------- |
|---|
| 51 | ! |
|---|
| 52 | INTEGER :: nbreg_ind, nbreg_bb |
|---|
| 53 | INTEGER :: iregion_ind(klon) !Defines regions for SO2, BC & OM |
|---|
| 54 | INTEGER :: iregion_bb(klon) !Defines regions for SO2, BC & OM |
|---|
| 55 | REAL :: scale_param_bb(nbreg_bb) !Scaling parameter for biomas burning |
|---|
| 56 | REAL :: scale_param_ind(nbreg_ind) !Scaling parameter for industrial emissions |
|---|
| 57 | ! |
|---|
| 58 | !============================= OUTPUT ================================== |
|---|
| 59 | ! |
|---|
| 60 | REAL :: source_tr(klon, nbtr) |
|---|
| 61 | REAL :: flux_tr(klon, nbtr) |
|---|
| 62 | REAL :: tr_seri(klon, klev, nbtr) ! traceur |
|---|
| 63 | REAL :: flux_sparam_ind(klon), flux_sparam_bb(klon) |
|---|
| 64 | !========================= LOCAL VARIABLES ============================= |
|---|
| 65 | INTEGER :: i, k, kkk_cont(klon), kkk_expl(klon) |
|---|
| 66 | REAL :: zalt(klon, klev), zaltmid(klon, klev) |
|---|
| 67 | REAL :: zzdz |
|---|
| 68 | !------------------------- SULFUR emissions ---------------------------- |
|---|
| 69 | REAL :: lmt_so2volc_cont(klon) ! emissions so2 volcan (continuous) |
|---|
| 70 | REAL :: lmt_altvolc_cont(klon) ! altitude so2 volcan (continuous) |
|---|
| 71 | REAL :: lmt_so2volc_expl(klon) ! emissions so2 volcan (explosive) |
|---|
| 72 | REAL :: lmt_altvolc_expl(klon) ! altitude so2 volcan (explosive) |
|---|
| 73 | REAL :: lmt_so2ff_l(klon) ! emissions so2 fossil fuel (low) |
|---|
| 74 | REAL :: lmt_so2ff_h(klon) ! emissions so2 fossil fuel (high) |
|---|
| 75 | REAL :: lmt_so2nff(klon) ! emissions so2 non-fossil fuel |
|---|
| 76 | REAL :: lmt_so2bb_l(klon) ! emissions de so2 biomass burning (low) |
|---|
| 77 | REAL :: lmt_so2bb_h(klon) ! emissions de so2 biomass burning (high) |
|---|
| 78 | REAL :: lmt_so2ba(klon) ! emissions de so2 bateau |
|---|
| 79 | REAL :: lmt_dms(klon) ! emissions de dms |
|---|
| 80 | REAL :: lmt_dmsconc(klon) ! concentration de dms oceanique |
|---|
| 81 | REAL :: lmt_dmsbio(klon) ! emissions de dms bio |
|---|
| 82 | REAL :: lmt_h2sbio(klon) ! emissions de h2s bio |
|---|
| 83 | |
|---|
| 84 | EXTERNAL condsurfs, liss, nightingale |
|---|
| 85 | !========================================================================= |
|---|
| 86 | ! Modifications introduced by NHL |
|---|
| 87 | ! -Variables to save fluxes were introduced |
|---|
| 88 | ! -lmt_so2ba was multiplied by fracso2emis in line 117 |
|---|
| 89 | ! -scale_param_bb was introduced in line 105 |
|---|
| 90 | ! The last two modifications were errors existing in the original version |
|---|
| 91 | !========================================================================= |
|---|
| 92 | !========================================================================= |
|---|
| 93 | ! LOW LEVEL EMISSIONS |
|---|
| 94 | !========================================================================= |
|---|
| 95 | |
|---|
| 96 | CALL nightingale(u_seri, v_seri, u10m_ec, v10m_ec, paprs, & |
|---|
| 97 | pplay, cdragh, cdragm, t_seri, q_seri, ftsol, & |
|---|
| 98 | tsol, pctsrf, lmt_dmsconc, lmt_dms) |
|---|
| 99 | |
|---|
| 100 | IF (.NOT.bateau) THEN |
|---|
| 101 | DO i = 1, klon |
|---|
| 102 | lmt_so2ba(i) = 0.0 |
|---|
| 103 | ENDDO |
|---|
| 104 | ENDIF |
|---|
| 105 | |
|---|
| 106 | DO i = 1, klon |
|---|
| 107 | IF (iregion_ind(i)>0) THEN |
|---|
| 108 | IF(id_prec>0) source_tr(i, id_prec) = source_tr(i, id_prec) & |
|---|
| 109 | + fracso2emis & |
|---|
| 110 | * scale_param_ind(iregion_ind(i)) * lmt_so2ff_l(i) * 1.e4 & |
|---|
| 111 | + scale_param_ind(iregion_ind(i)) * lmt_so2ff_l(i) * 1.e4 & |
|---|
| 112 | * frach2sofso2 ! molec/m2/s |
|---|
| 113 | ! |
|---|
| 114 | IF(id_fine>0) source_tr(i, id_fine) = & |
|---|
| 115 | source_tr(i, id_fine) + (1 - fracso2emis) & |
|---|
| 116 | * scale_param_ind(iregion_ind(i)) * lmt_so2ff_l(i) & |
|---|
| 117 | * 1.e4 * masse_ammsulfate / RNAVO ! g/m2/s |
|---|
| 118 | ! |
|---|
| 119 | IF(id_prec>0) flux_tr(i, id_prec) = flux_tr(i, id_prec) + (& |
|---|
| 120 | scale_param_ind(iregion_ind(i)) * (lmt_so2ff_l(i) + & |
|---|
| 121 | lmt_so2ff_h(i)) & |
|---|
| 122 | * frach2sofso2 & |
|---|
| 123 | + scale_param_ind(iregion_ind(i)) * (lmt_so2ff_l(i) + & |
|---|
| 124 | lmt_so2ff_h(i)) & |
|---|
| 125 | * fracso2emis & |
|---|
| 126 | ) * 1.e4 / RNAVO * masse_s * 1.e3 ! mgS/m2/s |
|---|
| 127 | ! |
|---|
| 128 | IF(id_fine>0) flux_tr(i, id_fine) = & |
|---|
| 129 | flux_tr(i, id_fine) + (1 - fracso2emis) & |
|---|
| 130 | * scale_param_ind(iregion_ind(i)) * (lmt_so2ff_l(i) + & |
|---|
| 131 | lmt_so2ff_h(i)) & |
|---|
| 132 | * 1.e4 / RNAVO * masse_ammsulfate * 1.e3 ! mgS/m2/s |
|---|
| 133 | ! |
|---|
| 134 | flux_sparam_ind(i) = flux_sparam_ind(i) + (1 - fracso2emis) & |
|---|
| 135 | * scale_param_ind(iregion_ind(i)) * (lmt_so2ff_l(i) + & |
|---|
| 136 | lmt_so2ff_h(i)) & |
|---|
| 137 | * 1.e4 / RNAVO * masse_ammsulfate * 1.e3 ! mgS/m2/s |
|---|
| 138 | ENDIF |
|---|
| 139 | IF (iregion_bb(i)>0) THEN |
|---|
| 140 | IF(id_prec>0) source_tr(i, id_prec) = & |
|---|
| 141 | source_tr(i, id_prec) + fracso2emis & |
|---|
| 142 | * scale_param_bb(iregion_bb(i)) * lmt_so2bb_l(i) & |
|---|
| 143 | * (1. - pctsrf(i, is_oce)) * 1.e4 |
|---|
| 144 | ! |
|---|
| 145 | IF(id_fine>0) source_tr(i, id_fine) = & |
|---|
| 146 | source_tr(i, id_fine) + (1 - fracso2emis) & |
|---|
| 147 | * scale_param_bb(iregion_bb(i)) * lmt_so2bb_l(i) * & |
|---|
| 148 | (1. - pctsrf(i, is_oce)) * 1.e4 * & |
|---|
| 149 | masse_ammsulfate / RNAVO ! g/m2/s |
|---|
| 150 | ! |
|---|
| 151 | IF(id_prec>0) flux_tr(i, id_prec) = flux_tr(i, id_prec) + & |
|---|
| 152 | (scale_param_bb(iregion_bb(i)) * lmt_so2bb_l(i) & |
|---|
| 153 | + scale_param_bb(iregion_bb(i)) * lmt_so2bb_h(i)) & |
|---|
| 154 | * (1. - pctsrf(i, is_oce)) * fracso2emis & |
|---|
| 155 | * 1.e4 / RNAVO * masse_s * 1.e3 ! mgS/m2/s |
|---|
| 156 | ! |
|---|
| 157 | IF(id_fine>0) flux_tr(i, id_fine) = & |
|---|
| 158 | flux_tr(i, id_fine) + (1 - fracso2emis) & |
|---|
| 159 | * (scale_param_bb(iregion_bb(i)) * lmt_so2bb_l(i) & |
|---|
| 160 | + scale_param_bb(iregion_bb(i)) * lmt_so2bb_h(i)) & |
|---|
| 161 | * (1. - pctsrf(i, is_oce)) & |
|---|
| 162 | * 1.e4 / RNAVO * masse_ammsulfate * 1.e3 ! mgS/m2/s |
|---|
| 163 | ! |
|---|
| 164 | flux_sparam_bb(i) = & |
|---|
| 165 | scale_param_bb(iregion_bb(i)) * (lmt_so2bb_l(i) + & |
|---|
| 166 | lmt_so2bb_h(i)) & |
|---|
| 167 | * (1. - pctsrf(i, is_oce)) * fracso2emis & |
|---|
| 168 | * 1.e4 / RNAVO * masse_s * 1.e3 ! mgS/m2/s |
|---|
| 169 | flux_sparam_bb(i) = flux_sparam_bb(i) + (1 - fracso2emis) * & |
|---|
| 170 | (scale_param_bb(iregion_bb(i)) * lmt_so2bb_l(i) + & |
|---|
| 171 | scale_param_bb(iregion_bb(i)) * lmt_so2bb_h(i)) & |
|---|
| 172 | * (1. - pctsrf(i, is_oce)) & |
|---|
| 173 | * 1.e4 / RNAVO * masse_ammsulfate * 1.e3 ! mgS/m2/s |
|---|
| 174 | ENDIF |
|---|
| 175 | IF(id_prec>0) source_tr(i, id_prec) = source_tr(i, id_prec) & |
|---|
| 176 | + fracso2emis & |
|---|
| 177 | * (lmt_so2ba(i) + lmt_so2nff(i)) * 1.e4 & |
|---|
| 178 | + (lmt_h2sbio(i) & |
|---|
| 179 | + lmt_dms(i) + lmt_dmsbio(i)) * 1.e4 ! molec/m2/s |
|---|
| 180 | ! |
|---|
| 181 | IF(id_fine>0) source_tr(i, id_fine) = source_tr(i, id_fine) & |
|---|
| 182 | + (1 - fracso2emis) & |
|---|
| 183 | * (lmt_so2ba(i) + lmt_so2nff(i)) * 1.e4 * & |
|---|
| 184 | masse_ammsulfate / RNAVO ! g/m2/s |
|---|
| 185 | ! |
|---|
| 186 | IF(id_prec>0) flux_tr(i, id_prec) = flux_tr(i, id_prec) & |
|---|
| 187 | + (lmt_h2sbio(i) & |
|---|
| 188 | + lmt_so2volc_cont(i) + lmt_so2volc_expl(i) & |
|---|
| 189 | + (lmt_so2ba(i) + lmt_so2nff(i)) * fracso2emis & |
|---|
| 190 | + lmt_dms(i) + lmt_dmsbio(i)) & |
|---|
| 191 | * 1.e4 / RNAVO * masse_s * 1.e3 ! mgS/m2/s |
|---|
| 192 | ! |
|---|
| 193 | IF(id_fine>0) flux_tr(i, id_fine) = flux_tr(i, id_fine) & |
|---|
| 194 | + (1 - fracso2emis) & |
|---|
| 195 | * (lmt_so2ba(i) + lmt_so2nff(i)) & |
|---|
| 196 | * 1.e4 / RNAVO * masse_ammsulfate * 1.e3 ! mgS/m2/s |
|---|
| 197 | ! |
|---|
| 198 | flux_sparam_ind(i) = flux_sparam_ind(i) + (1 - fracso2emis) & |
|---|
| 199 | * lmt_so2nff(i) & |
|---|
| 200 | * 1.e4 / RNAVO * masse_ammsulfate * 1.e3 ! mgS/m2/s |
|---|
| 201 | ! |
|---|
| 202 | ENDDO |
|---|
| 203 | |
|---|
| 204 | !======================================================================== |
|---|
| 205 | ! HIGH LEVEL EMISSIONS |
|---|
| 206 | !======================================================================== |
|---|
| 207 | ! Source de SO2 volcaniques |
|---|
| 208 | DO i = 1, klon |
|---|
| 209 | kkk_cont(i) = 1 |
|---|
| 210 | kkk_expl(i) = 1 |
|---|
| 211 | ENDDO |
|---|
| 212 | DO k = 1, klev - 1 |
|---|
| 213 | DO i = 1, klon |
|---|
| 214 | zaltmid(i, k) = zalt(i, k) + zdz(i, k) / 2. |
|---|
| 215 | IF (zalt(i, k + 1)<lmt_altvolc_cont(i)) kkk_cont(i) = k + 1 |
|---|
| 216 | IF (zalt(i, k + 1)<lmt_altvolc_expl(i)) kkk_expl(i) = k + 1 |
|---|
| 217 | ENDDO |
|---|
| 218 | ENDDO |
|---|
| 219 | IF(id_prec>0) THEN |
|---|
| 220 | DO i = 1, klon |
|---|
| 221 | tr_seri(i, kkk_cont(i), id_prec) = tr_seri(i, kkk_cont(i), id_prec) + & |
|---|
| 222 | lmt_so2volc_cont(i) / zdz(i, kkk_cont(i)) / 100. * pdtphys |
|---|
| 223 | tr_seri(i, kkk_expl(i), id_prec) = tr_seri(i, kkk_expl(i), id_prec) + & |
|---|
| 224 | lmt_so2volc_expl(i) / zdz(i, kkk_expl(i)) / 100. * pdtphys |
|---|
| 225 | ENDDO |
|---|
| 226 | ENDIF |
|---|
| 227 | ! Sources hautes de SO2 |
|---|
| 228 | |
|---|
| 229 | ! |
|---|
| 230 | !--only GEIA SO2 emissions has high emissions |
|---|
| 231 | !--unit: molec/cm2/s divided by layer height (in cm) multiplied by timestep |
|---|
| 232 | ! |
|---|
| 233 | k = 2 !introducing emissions in level 2 |
|---|
| 234 | DO i = 1, klon |
|---|
| 235 | ! |
|---|
| 236 | IF (iregion_bb(i)>0) THEN |
|---|
| 237 | IF(id_prec>0) tr_seri(i, k, id_prec) = & |
|---|
| 238 | tr_seri(i, k, id_prec) + fracso2emis & |
|---|
| 239 | * scale_param_bb(iregion_bb(i)) * lmt_so2bb_h(i) & |
|---|
| 240 | / zdz(i, k) / 100. * pdtphys |
|---|
| 241 | ! |
|---|
| 242 | IF(id_fine>0) tr_seri(i, k, id_fine) = tr_seri(i, k, id_fine) & |
|---|
| 243 | + (1. - fracso2emis) & |
|---|
| 244 | * scale_param_bb(iregion_bb(i)) * lmt_so2bb_h(i) & |
|---|
| 245 | * masse_ammsulfate / RNAVO / zdz(i, k) / 100. * pdtphys !g/cm3 |
|---|
| 246 | ENDIF |
|---|
| 247 | IF (iregion_ind(i)>0) THEN |
|---|
| 248 | IF(id_prec>0) tr_seri(i, k, id_prec) = & |
|---|
| 249 | tr_seri(i, k, id_prec) + (fracso2emis & |
|---|
| 250 | * scale_param_ind(iregion_ind(i)) * lmt_so2ff_h(i) & |
|---|
| 251 | + frach2sofso2 & |
|---|
| 252 | * scale_param_ind(iregion_ind(i)) * lmt_so2ff_h(i)) & |
|---|
| 253 | / zdz(i, k) / 100. * pdtphys |
|---|
| 254 | ! |
|---|
| 255 | IF(id_fine>0) tr_seri(i, k, id_fine) = tr_seri(i, k, id_fine) & |
|---|
| 256 | + (1. - fracso2emis) & |
|---|
| 257 | * scale_param_ind(iregion_ind(i)) * lmt_so2ff_h(i) & |
|---|
| 258 | * masse_ammsulfate / RNAVO / zdz(i, k) / 100. * pdtphys !g/cm3 |
|---|
| 259 | ENDIF |
|---|
| 260 | ! |
|---|
| 261 | ENDDO |
|---|
| 262 | |
|---|
| 263 | END SUBROUTINE precuremission |
|---|
