source: LMDZ6/trunk/libf/phylmd/Dust/precuremission.f90 @ 5277

Last change on this file since 5277 was 5274, checked in by abarral, 9 hours ago

Replace yomcst.h by existing module
File size: 11.3 KB
Line 
1! Subroutine that calculates the emission of aerosols precursors
2SUBROUTINE 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  USE dimensions_mod, ONLY: iim, jjm, llm, ndm
23USE paramet_mod_h, ONLY: iip1, iip2, iip3, jjp1, llmp1, llmp2, llmm1, kftd, ip1jm, ip1jmp1, &
24          ip1jmi1, ijp1llm, ijmllm, mvar, jcfil, jcfllm
25USE yomcst_mod_h, ONLY: RPI, RCLUM, RHPLA, RKBOL, RNAVO                   &
26          , RDAY, REA, REPSM, RSIYEA, RSIDAY, ROMEGA                  &
27          , R_ecc, R_peri, R_incl                                      &
28          , RA, RG, R1SA                                         &
29          , RSIGMA                                                     &
30          , R, RMD, RMV, RD, RV, RCPD                    &
31          , RMO3, RMCO2, RMC, RMCH4, RMN2O, RMCFC11, RMCFC12        &
32          , RCPV, RCVD, RCVV, RKAPPA, RETV, eps_w                    &
33          , RCW, RCS                                                 &
34          , RLVTT, RLSTT, RLMLT, RTT, RATM                           &
35          , RESTT, RALPW, RBETW, RGAMW, RALPS, RBETS, RGAMS            &
36          , RALPD, RBETD, RGAMD
37IMPLICIT NONE
38
39
40  INCLUDE "chem.h"
41  INCLUDE "chem_spla.h"
42
43
44
45  !============================= INPUT ===================================
46  INTEGER :: kminbc, kmaxbc
47  REAL :: ftsol(klon,nbsrf)  ! temperature du sol par type
48  REAL :: tsol(klon)         ! temperature du sol moyenne
49  REAL :: t_seri(klon,klev)  ! temperature
50  REAL :: u_seri(klon,klev)  ! vent
51  REAL :: v_seri(klon,klev)  ! vent
52  REAL :: q_seri(klon,klev)  ! vapeur d eau kg/kg
53  REAL :: u10m_ec(klon), v10m_ec(klon)  ! vent a 10 metres
54  REAL :: pctsrf(klon,nbsrf)
55  REAL :: pdtphys  ! pas d'integration pour la physique (seconde)
56  REAL :: paprs(klon,klev+1)  ! pression pour chaque inter-couche (en Pa)
57  REAL :: pplay(klon,klev)  ! pression pour le mileu de chaque couche (en Pa)
58  REAL :: cdragh(klon), cdragm(klon)
59  REAL :: fracso2emis        !--fraction so2 emis en so2
60  REAL :: frach2sofso2       !--fraction h2s from so2
61  REAL :: zdz(klon,klev)
62  LOGICAL :: edgar, bateau
63  INTEGER :: id_prec,id_fine
64  !
65  !------------------------- Scaling Parameters --------------------------
66  !
67  INTEGER :: nbreg_ind, nbreg_bb
68  INTEGER :: iregion_ind(klon)  !Defines regions for SO2, BC & OM
69  INTEGER :: iregion_bb(klon)  !Defines regions for SO2, BC & OM
70  REAL :: scale_param_bb(nbreg_bb)  !Scaling parameter for biomas burning
71  REAL :: scale_param_ind(nbreg_ind) !Scaling parameter for industrial emissions
72  !
73  !============================= OUTPUT ==================================
74  !
75  REAL :: source_tr(klon,nbtr)
76  REAL :: flux_tr(klon,nbtr)
77  REAL :: tr_seri(klon,klev,nbtr) ! traceur
78  REAL :: flux_sparam_ind(klon), flux_sparam_bb(klon)
79  !========================= LOCAL VARIABLES =============================
80  INTEGER :: i, k, kkk_cont(klon), kkk_expl(klon)
81  REAL :: zalt(klon,klev), zaltmid(klon,klev)
82  REAL :: zzdz
83  !------------------------- SULFUR emissions ----------------------------
84  REAL :: lmt_so2volc_cont(klon)  ! emissions so2 volcan (continuous)
85  REAL :: lmt_altvolc_cont(klon)  ! altitude  so2 volcan (continuous)
86  REAL :: lmt_so2volc_expl(klon)  ! emissions so2 volcan (explosive)
87  REAL :: lmt_altvolc_expl(klon)  ! altitude  so2 volcan (explosive)
88  REAL :: lmt_so2ff_l(klon)       ! emissions so2 fossil fuel (low)
89  REAL :: lmt_so2ff_h(klon)       ! emissions so2 fossil fuel (high)
90  REAL :: lmt_so2nff(klon)        ! emissions so2 non-fossil fuel
91  REAL :: lmt_so2bb_l(klon)       ! emissions de so2 biomass burning (low)
92  REAL :: lmt_so2bb_h(klon)       ! emissions de so2 biomass burning (high)
93  REAL :: lmt_so2ba(klon)         ! emissions de so2 bateau
94  REAL :: lmt_dms(klon)           ! emissions de dms
95  REAL :: lmt_dmsconc(klon)       ! concentration de dms oceanique
96  REAL :: lmt_dmsbio(klon)        ! emissions de dms bio
97  REAL :: lmt_h2sbio(klon)        ! emissions de h2s bio
98
99  EXTERNAL condsurfs, liss, nightingale
100  !=========================================================================
101  ! Modifications introduced by NHL
102  ! -Variables to save fluxes were introduced
103  ! -lmt_so2ba was multiplied by fracso2emis in line 117
104  ! -scale_param_bb was introduced in line 105
105  ! The last two modifications were errors existing in the original version
106  !=========================================================================
107  !=========================================================================
108                     ! LOW LEVEL EMISSIONS
109  !=========================================================================
110
111     CALL nightingale(u_seri, v_seri, u10m_ec, v10m_ec, paprs, &
112           pplay, cdragh, cdragm, t_seri, q_seri, ftsol, &
113           tsol, pctsrf, lmt_dmsconc, lmt_dms)
114
115  IF (.not.bateau) THEN
116    DO i=1, klon
117      lmt_so2ba(i)=0.0
118    ENDDO
119  ENDIF
120
121  DO i=1, klon
122     IF (iregion_ind(i).GT.0) THEN
123   IF(id_prec>0) source_tr(i,id_prec)=source_tr(i,id_prec) &
124         + fracso2emis &
125         *scale_param_ind(iregion_ind(i))*lmt_so2ff_l(i)*1.e4 &
126         +scale_param_ind(iregion_ind(i))*lmt_so2ff_l(i)*1.e4 &
127         *frach2sofso2            ! molec/m2/s
128  !
129  IF(id_fine>0) source_tr(i,id_fine)= &
130        source_tr(i,id_fine)+(1-fracso2emis) &
131        *scale_param_ind(iregion_ind(i))*lmt_so2ff_l(i) &
132        *1.e4*masse_ammsulfate/RNAVO  ! g/m2/s
133  !
134   IF(id_prec>0)   flux_tr(i,id_prec)=flux_tr(i,id_prec) + ( &
135         scale_param_ind(iregion_ind(i))*(lmt_so2ff_l(i)+ &
136         lmt_so2ff_h(i)) &
137         *frach2sofso2 &
138         +scale_param_ind(iregion_ind(i))*(lmt_so2ff_l(i)+ &
139         lmt_so2ff_h(i)) &
140         *fracso2emis &
141         )*1.e4/RNAVO*masse_s*1.e3          ! mgS/m2/s
142  !
143  IF(id_fine>0)  flux_tr(i,id_fine)= &
144        flux_tr(i,id_fine)+(1-fracso2emis) &
145        *scale_param_ind(iregion_ind(i))*(lmt_so2ff_l(i)+ &
146        lmt_so2ff_h(i)) &
147        *1.e4/RNAVO*masse_ammsulfate*1.e3    ! mgS/m2/s
148  !
149  flux_sparam_ind(i)=flux_sparam_ind(i)+ (1-fracso2emis) &
150        *scale_param_ind(iregion_ind(i))*(lmt_so2ff_l(i)+ &
151        lmt_so2ff_h(i)) &
152        *1.e4/RNAVO*masse_ammsulfate*1.e3    ! mgS/m2/s
153     ENDIF
154     IF (iregion_bb(i).GT.0) THEN
155  IF(id_prec>0) source_tr(i,id_prec)= &
156        source_tr(i,id_prec) + fracso2emis &
157        *scale_param_bb(iregion_bb(i))*lmt_so2bb_l(i) &
158        *(1.-pctsrf(i,is_oce))*1.e4
159  !
160  IF(id_fine>0)     source_tr(i,id_fine)= &
161        source_tr(i,id_fine)+(1-fracso2emis) &
162        *scale_param_bb(iregion_bb(i))*lmt_so2bb_l(i)* &
163        (1.-pctsrf(i,is_oce))*1.e4* &
164        masse_ammsulfate/RNAVO  ! g/m2/s
165  !
166  IF(id_prec>0)     flux_tr(i,id_prec)=flux_tr(i,id_prec) + &
167        (scale_param_bb(iregion_bb(i))*lmt_so2bb_l(i) &
168        +scale_param_bb(iregion_bb(i))*lmt_so2bb_h(i)) &
169        * (1.-pctsrf(i,is_oce))*fracso2emis &
170        *1.e4/RNAVO*masse_s*1.e3          ! mgS/m2/s
171  !
172  IF(id_fine>0) flux_tr(i,id_fine)= &
173        flux_tr(i,id_fine)+(1-fracso2emis) &
174        *(scale_param_bb(iregion_bb(i))*lmt_so2bb_l(i) &
175        +scale_param_bb(iregion_bb(i))*lmt_so2bb_h(i)) &
176        *(1.-pctsrf(i,is_oce)) &
177        *1.e4/RNAVO*masse_ammsulfate*1.e3    ! mgS/m2/s
178  !
179       flux_sparam_bb(i)= &
180             scale_param_bb(iregion_bb(i))*(lmt_so2bb_l(i)+ &
181             lmt_so2bb_h(i)) &
182             * (1.-pctsrf(i,is_oce))*fracso2emis &
183             *1.e4/RNAVO*masse_s*1.e3          ! mgS/m2/s
184       flux_sparam_bb(i)= flux_sparam_bb(i) + (1-fracso2emis) * &
185             (scale_param_bb(iregion_bb(i))*lmt_so2bb_l(i)+ &
186             scale_param_bb(iregion_bb(i))*lmt_so2bb_h(i)) &
187             *(1.-pctsrf(i,is_oce)) &
188             *1.e4/RNAVO*masse_ammsulfate*1.e3    ! mgS/m2/s
189     ENDIF
190  IF(id_prec>0)   source_tr(i,id_prec)=source_tr(i,id_prec) &
191        + fracso2emis &
192        *(lmt_so2ba(i)+lmt_so2nff(i))*1.e4 &
193        +(lmt_h2sbio(i) &
194        +lmt_dms(i)+lmt_dmsbio(i))*1.e4            ! molec/m2/s
195  !
196  IF(id_fine>0)   source_tr(i,id_fine)=source_tr(i,id_fine) &
197        +(1-fracso2emis) &
198        *(lmt_so2ba(i)+lmt_so2nff(i))*1.e4* &
199        masse_ammsulfate/RNAVO  ! g/m2/s
200  !
201  IF(id_prec>0)   flux_tr(i,id_prec)=flux_tr(i,id_prec) &
202        + (lmt_h2sbio(i) &
203        +lmt_so2volc_cont(i)+lmt_so2volc_expl(i) &
204        +(lmt_so2ba(i)+lmt_so2nff(i))*fracso2emis &
205        +lmt_dms(i)+lmt_dmsbio(i) ) &
206        *1.e4/RNAVO*masse_s*1.e3          ! mgS/m2/s
207  !
208  IF(id_fine>0)   flux_tr(i,id_fine)=flux_tr(i,id_fine) &
209        +(1-fracso2emis) &
210        *(lmt_so2ba(i) + lmt_so2nff(i)) &
211        *1.e4/RNAVO*masse_ammsulfate*1.e3    ! mgS/m2/s
212  !
213     flux_sparam_ind(i)=flux_sparam_ind(i)+ (1-fracso2emis) &
214           *lmt_so2nff(i) &
215           *1.e4/RNAVO*masse_ammsulfate*1.e3    ! mgS/m2/s
216  !
217  ENDDO
218
219  !========================================================================
220                     ! HIGH LEVEL EMISSIONS
221  !========================================================================
222  !  Source de SO2 volcaniques
223  DO i = 1, klon
224    kkk_cont(i)=1
225    kkk_expl(i)=1
226  ENDDO
227  DO k=1, klev-1
228  DO i = 1, klon
229    zaltmid(i,k)=zalt(i,k)+zdz(i,k)/2.
230    IF (zalt(i,k+1).LT.lmt_altvolc_cont(i)) kkk_cont(i)=k+1
231    IF (zalt(i,k+1).LT.lmt_altvolc_expl(i)) kkk_expl(i)=k+1
232  ENDDO
233  ENDDO
234  IF(id_prec>0) THEN
235  DO i = 1, klon
236    tr_seri(i,kkk_cont(i),id_prec)=tr_seri(i,kkk_cont(i),id_prec) + &
237          lmt_so2volc_cont(i)/zdz(i,kkk_cont(i))/100.*pdtphys
238    tr_seri(i,kkk_expl(i),id_prec)=tr_seri(i,kkk_expl(i),id_prec) + &
239          lmt_so2volc_expl(i)/zdz(i,kkk_expl(i))/100.*pdtphys
240  ENDDO
241  ENDIF
242  !  Sources hautes de SO2
243
244  !
245  !--only GEIA SO2 emissions has high emissions
246  !--unit: molec/cm2/s divided by layer height (in cm) multiplied by timestep
247  !
248  k=2                             !introducing emissions in level 2
249  DO i = 1, klon
250  !
251     IF (iregion_bb(i).GT.0) THEN
252  IF(id_prec>0)   tr_seri(i,k,id_prec)= &
253        tr_seri(i,k,id_prec) + fracso2emis &
254        *scale_param_bb(iregion_bb(i))*lmt_so2bb_h(i) &
255        /zdz(i,k)/100.*pdtphys
256  !
257  IF(id_fine>0)     tr_seri(i,k,id_fine)=tr_seri(i,k,id_fine) &
258        + (1.-fracso2emis) &
259        *scale_param_bb(iregion_bb(i))*lmt_so2bb_h(i) &
260        *masse_ammsulfate/RNAVO/zdz(i,k)/100.*pdtphys   !g/cm3
261     ENDIF
262     IF (iregion_ind(i).GT.0) THEN
263   IF(id_prec>0)  tr_seri(i,k,id_prec)= &
264         tr_seri(i,k,id_prec) + (fracso2emis &
265         *scale_param_ind(iregion_ind(i))*lmt_so2ff_h(i) &
266         + frach2sofso2 &
267         *scale_param_ind(iregion_ind(i))*lmt_so2ff_h(i)) &
268         /zdz(i,k)/100.*pdtphys
269  !
270   IF(id_fine>0)    tr_seri(i,k,id_fine)=tr_seri(i,k,id_fine) &
271         + (1.-fracso2emis) &
272         *scale_param_ind(iregion_ind(i))*lmt_so2ff_h(i) &
273         *masse_ammsulfate/RNAVO/zdz(i,k)/100.*pdtphys   !g/cm3
274     ENDIF
275  !
276  ENDDO
277
278END SUBROUTINE precuremission
Note: See TracBrowser for help on using the repository browser.