!$Id: mksflx.F90 163 2010-02-22 15:41:45Z acosce $ !! ========================================================================= !! INCA - INteraction with Chemistry and Aerosols !! !! Copyright Laboratoire des Sciences du Climat et de l'Environnement (LSCE) !! Unite mixte CEA-CNRS-UVSQ !! !! Contributors to this INCA subroutine: !! !! Didier Hauglustaine, LSCE, hauglustaine@cea.fr !! Michael Schulz, LSCE, Michael.Schulz@cea.fr !! Christiane Textor, LSCE !! !! Anne Cozic, LSCE, anne.cozic@cea.fr !! Yann Meurdesoif, LSCE, yann.meurdesoif@cea.fr !! !! This software is a computer program whose purpose is to simulate the !! atmospheric gas phase and aerosol composition. The model is designed to be !! used within a transport model or a general circulation model. This version !! of INCA was designed to be coupled to the LMDz GCM. LMDz-INCA accounts !! for emissions, transport (resolved and sub-grid scale), photochemical !! transformations, and scavenging (dry deposition and washout) of chemical !! species and aerosols interactively in the GCM. Several versions of the INCA !! model are currently used depending on the envisaged applications with the !! chemistry-climate model. !! !! This software is governed by the CeCILL license under French law and !! abiding by the rules of distribution of free software. You can use, !! modify and/ or redistribute the software under the terms of the CeCILL !! license as circulated by CEA, CNRS and INRIA at the following URL !! "http://www.cecill.info". !! !! As a counterpart to the access to the source code and rights to copy, !! modify and redistribute granted by the license, users are provided only !! with a limited warranty and the software's author, the holder of the !! economic rights, and the successive licensors have only limited !! liability. !! !! In this respect, the user's attention is drawn to the risks associated !! with loading, using, modifying and/or developing or reproducing the !! software by the user in light of its specific status of free software, !! that may mean that it is complicated to manipulate, and that also !! therefore means that it is reserved for developers and experienced !! professionals having in-depth computer knowledge. Users are therefore !! encouraged to load and test the software's suitability as regards their !! requirements in conditions enabling the security of their systems and/or !! data to be ensured and, more generally, to use and operate it in the !! same conditions as regards security. !! !! The fact that you are presently reading this means that you have had !! knowledge of the CeCILL license and that you accept its terms. !! ========================================================================= #include SUBROUTINE MKSFLX_P2P(calday, oro, lat, lon, area, & loc_angle, polar_night, polar_day, sunon, sunoff, & u, v, paprs, pmid, cdragh, cdragm, temp, sh, & ftsol, ts, pctsrf ) !-------------------------------------------------------- ! ... Form the surface fluxes for this time slice ! Didier Hauglustaine, IPSL, 2000, 2018 !-------------------------------------------------------- USE RADON_SRF_FLX USE SRF_FLUX_INT USE SPECIES_NAMES USE SFLX USE CONST_MOD, ONLY : pi USE SURF_CHEM_MOD USE CONST_LMDZ USE INCA_DIM USE MOD_INCA_PARA USE CHEM_CONS, ONLY : dayspy USE TIME_MOD_INCA, ONLY : one_year,month_len,month,day USE AEROSOL_METEO, ONLY : zheight USE PARAM_CHEM #ifdef AER USE AEROSOL_MOD, ONLY : srcsigmaln,rop,asmode #endif #ifdef GES USE CARBONATOR #endif IMPLICIT NONE !-------------------------------------------------------- ! ... Dummy arguments !-------------------------------------------------------- REAL, INTENT(in) :: oro(PLON) REAL, INTENT(in) :: area(PLON) REAL, INTENT(in) :: lat(PLON) REAL, INTENT(in) :: lon(PLON) REAL, INTENT(in) :: calday !time of year in days ! variables used in nightingale REAL, INTENT(in) :: u(PLON,PLEV),v(PLON,PLEV) REAL, INTENT(in) :: paprs(PLON,PLEV+1) REAL, INTENT(in) :: pmid(PLON,PLEV) REAL, INTENT(in) :: cdragh(PLON), cdragm(PLON) REAL, INTENT(in) :: temp(PLON,PLEV) REAL, INTENT(in) :: sh(PLON,PLEV) REAL, INTENT(in) :: ftsol(PLON,nbsrf) REAL, INTENT(in) :: ts(PLON) REAL, INTENT(in) :: pctsrf(PLON,nbsrf) !-------------------------------------------------------- ! ... Dummy arguments needed to calculate diurnal ! variation of isoprene and monoterpenes ! added by Gerd Folberth, LSCE, 2001. !-------------------------------------------------------- REAL, INTENT(in) :: loc_angle(PLON) ! "local" time angle LOGICAL, INTENT(in) :: polar_day(PLON) ! continuous daylight flag LOGICAL, INTENT(in) :: polar_night(PLON) ! continuous night flag REAL, INTENT(in) :: sunon(PLON) ! sunrise angle in radians REAL, INTENT(in) :: sunoff(PLON) ! sunset angle in radians !-------------------------------------------------------- ! ... Local variables !-------------------------------------------------------- REAL :: econc_dms(PLON) INTEGER :: i, m, last, next REAL :: dels REAL :: sflux1, sflux2 REAL :: sflux1_loc(PLON), sflux2_loc(PLON) REAL :: sflux1_glo(nbp_glo), sflux2_glo(nbp_glo) REAL :: total_flux REAL, PARAMETER :: secpyr = dayspy * 8.64e4 LOGICAL, SAVE :: entered = .FALSE. !$OMP THREADPRIVATE(entered) #ifdef NMHC !-------------------------------------------------------- ! ... Local variables for calculating diurnal variations ! added by Gerd Folberth, LSCE, 2001. !-------------------------------------------------------- REAL :: factor REAL :: dayfrac ! fraction of day in light REAL :: iso_off ! time isoprene flux turns off REAL :: iso_on ! time isoprene flux turns on #endif #ifdef AER ! source mass median diameter [m] REAL :: srcmmd_id_ASBCM = 0.14e-6 REAL :: srcmmd_id_ASPOMM = 0.34e-6 REAL :: fdistBC ! Number/Mass factor to compute number flux REAL :: fdistPOM ! Number/Mass factor to compute number flux REAL :: fdistSO4 REAL :: srcmmd_id_ASSO4M = 0.3e-6 #endif INTEGER :: ll REAL :: fracthh ! single value instead of array(4) REAL :: zalt REAL, PARAMETER :: emi_height = 2000. LOGICAL, SAVE :: first = .TRUE. !$OMP THREADPRIVATE(first) IF (first) THEN IF (CoupSurfAtm) THEN ! allocation des eflux_notfromveg et veg dans le cas du couplage avec orchidee ALLOCATE(eflux_notfromveg(PLON,nb_flux)) ALLOCATE(eflux_veg(PLON,nb_flux)) eflux_notfromveg(:,:) = 0. eflux_veg(:,:) = 0. ENDIF first = .FALSE. ENDIF !-------------------------------------------------------- ! ... Setup the time interpolation ! Note: 365 day year inconsistent with LMDz (360 days) !!! !-------------------------------------------------------- SELECT CASE(emi_interp_time) CASE(0) !--no time interpolation at all dels = 0. last = month ! Added ThL: in this case, last = current month and next = next month IF ( month == 12 ) THEN ! (considering months as 1st to 30th) next = 1 ELSE next = month + 1 ENDIF CASE(1) !--default time interpolation IF ( calday < days(1) ) THEN next = 1 last = 12 dels = REAL(365. + calday - days(12)) & / REAL(365. + days(1) - days(12)) ELSE IF ( calday >= days(12) ) THEN next = 1 last = 12 dels = REAL(calday - days(12)) & / REAL(365. + days(1) - days(12)) ELSE DO m = 11,1,-1 IF ( calday >= days(m) ) THEN EXIT ENDIF ENDDO last = m next = m + 1 dels = REAL(calday - days(m)) / REAL(days(m+1) - days(m)) ENDIF dels = MAX( MIN( 1.,dels ),0. ) END SELECT !-------------------------------------------------------- ! ... Radon emission (called once) ! Note : radon global emission = 15 Kg/yr !-------------------------------------------------------- ! calcul eflux(rn222) at each time step because oro is modify at the end of the day ! IF( .NOT. entered ) THEN total_flux = 15. / secpyr ! kg/s baseflux = 0. sflux1 = 0. sflux2 = 0. sflux1_loc(:)=0. sflux2_loc(:)=0. DO i = 1, PLON IF( lat(i) < 70. .AND. lat(i) > -60. ) THEN sflux1_loc(i) = 1.*baseflux*area(i)*(1.-oro(i)) IF ( lat(i) >= 60. ) THEN IF (lon(i) < -20. .AND. lon(i) > -70.) THEN sflux2_loc(i) = 0.5*baseflux*oro(i)*area(i) ELSE sflux2_loc(i) = 0.5*oro(i)*area(i) ENDIF ELSE sflux2_loc(i) = 1.0*oro(i)*area(i) ENDIF ENDIF ENDDO CALL gather(sflux1_loc,sflux1_glo) CALL gather(sflux2_loc,sflux2_glo) !$OMP MASTER IF (is_mpi_root) THEN DO i = 1, nbp_glo sflux1=sflux1+sflux1_glo(i) sflux2=sflux2+sflux2_glo(i) ENDDO landflux = (total_flux - sflux1) / sflux2 ENDIF !$OMP END MASTER CALL bcast(landflux) DO i = 1,PLON IF (lat(i) >= 70. .OR. lat(i) <= -60.) THEN eflux(i,id_Rn222) = baseflux ELSE IF (lat(i) >= 60.) THEN IF (lon(i) < -20. .AND. lon(i) > -70.) THEN eflux(i,id_Rn222) = 0.5 * baseflux * oro(i) & + baseflux * (1.-oro(i)) ELSE eflux(i,id_Rn222) = 0.5 * landflux * oro(i) & + baseflux * (1.-oro(i)) ENDIF ELSE eflux(i,id_Rn222) = 1.0 * landflux * oro(i) & + baseflux * (1.-oro(i)) ENDIF ENDIF ENDDO ! entered = .TRUE. ! ENDIF !-------------------------------------------------------- ! ... Set non-zero fluxes !-------------------------------------------------------- #ifdef NMHC flx_mcf = flx_mcf_ant + flx_mcf_nat eflux(:,id_MCF) = flx_mcf(:,last) + dels * (flx_mcf(:,next) - flx_mcf(:,last)) flx_n2o = flx_n2o_ant + flx_n2o_nat eflux(:,id_N2O) = flx_n2o(:,last) + dels * (flx_n2o(:,next) - flx_n2o(:,last)) flx_ch4 = flx_ch4_ant + flx_ch4_nat eflux(:,id_CH4) = flx_ch4(:,last) + dels * (flx_ch4(:,next) - flx_ch4(:,last)) flx_co = flx_co_ant + flx_co_nat eflux(:,id_CO) = flx_co(:,last) + dels * (flx_co(:,next) - flx_co(:,last)) flx_h2 = flx_h2_ant + flx_h2_nat eflux(:,id_H2) = flx_h2(:,last) + dels * (flx_h2(:,next) - flx_h2(:,last)) flx_no = flx_no_ant + flx_no_nat eflux(:,id_NO) = flx_no(:,last) + dels * (flx_no(:,next) - flx_no(:,last)) flx_c2h5oh = flx_c2h5oh_ant + flx_c2h5oh_nat eflux(:,id_C2H5OH) = flx_c2h5oh(:,last) + dels * (flx_c2h5oh(:,next) - flx_c2h5oh(:,last)) flx_alkan = flx_alkan_ant + flx_alkan_nat eflux(:,id_ALKAN) = flx_alkan(:,last)+ dels * (flx_alkan(:,next) - flx_alkan(:,last)) flx_arom = flx_arom_ant + flx_arom_nat eflux(:,id_AROM) = flx_arom(:,last) + dels * (flx_arom(:,next) - flx_arom(:,last)) flx_mek = flx_mek_ant + flx_mek_nat eflux(:,id_MEK) = flx_mek(:,last) + dels * (flx_mek(:,next) - flx_mek(:,last)) flx_mvk = flx_mvk_ant + flx_mvk_nat eflux(:,id_MVK) = flx_mvk(:,last) + dels * (flx_mvk(:,next) - flx_mvk(:,last)) flx_c2h6 = flx_c2h6_ant + flx_c2h6_nat eflux(:,id_C2H6) = flx_c2h6(:,last) + dels * (flx_c2h6(:,next) - flx_c2h6(:,last)) flx_c3h8 = flx_c3h8_ant + flx_c3h8_nat eflux(:,id_C3H8) = flx_c3h8(:,last) + dels * (flx_c3h8(:,next) - flx_c3h8(:,last)) flx_c2h4 = flx_c2h4_ant + flx_c2h4_nat eflux(:,id_C2H4) = flx_c2h4(:,last) + dels * (flx_c2h4(:,next) - flx_c2h4(:,last)) flx_c3h6 = flx_c3h6_ant + flx_c3h6_nat eflux(:,id_C3H6) = flx_c3h6(:,last) + dels * (flx_c3h6(:,next) - flx_c3h6(:,last)) flx_c2h2 = flx_c2h2_ant + flx_c2h2_nat eflux(:,id_C2H2) = flx_c2h2(:,last) + dels * (flx_c2h2(:,next) - flx_c2h2(:,last)) flx_alken = flx_alken_ant + flx_alken_nat eflux(:,id_ALKEN) = flx_alken(:,last) + dels * (flx_alken(:,next) - flx_alken(:,last)) IF (id_Orch_iso .EQ. 0) THEN flx_isop = flx_isop_ant + flx_isop_nat eflux(:,id_ISOP) = flx_isop(:,last) + dels * (flx_isop(:,next) - flx_isop(:,last)) ELSE ! dans ce cas la eflux(iso) = flux_no_veg + flux_orchidee ! le flux orchidee sera ajoute apres l'ajustement diurne du flux ocean flx_isop_no_veg = flx_isop_ant + flx_isop_nat eflux_notfromveg(:,id_Orch_iso) = flx_isop_no_veg(:,last) + dels * (flx_isop_no_veg(:,next) - flx_isop_no_veg(:,last)) ENDIF IF (id_Orch_apin .EQ. 0) THEN flx_apin = flx_apin_ant + flx_apin_nat eflux(:,id_APIN) = flx_apin(:,last) + dels * (flx_apin(:,next) - flx_apin(:,last)) ELSE flx_apin_no_veg = flx_apin_ant + flx_apin_nat eflux_notfromveg(:,id_Orch_apin) = flx_apin_no_veg(:,last) + dels * (flx_apin_no_veg(:,next) - flx_apin_no_veg(:,last)) ENDIF IF (id_Orch_ch3oh .EQ. 0 ) THEN flx_ch3oh = flx_ch3oh_ant + flx_ch3oh_nat eflux(:,id_CH3OH) = flx_ch3oh(:,last)+ dels * (flx_ch3oh(:,next) - flx_ch3oh(:,last)) ELSE flx_ch3oh_no_veg = flx_ch3oh_ant + flx_ch3oh_nat eflux_notfromveg(:,id_Orch_ch3oh) = flx_ch3oh_no_veg(:,last)+ dels * (flx_ch3oh_no_veg(:,next) - flx_ch3oh_no_veg(:,last)) ENDIF IF (id_Orch_formal .EQ. 0) THEN flx_ch2o = flx_ch2o_ant + flx_ch2o_nat eflux(:,id_CH2O) = flx_ch2o(:,last) + dels * (flx_ch2o(:,next) - flx_ch2o(:,last)) ELSE flx_ch2o_no_veg = flx_ch2o_ant + flx_ch2o_nat eflux_notfromveg(:,id_Orch_formal) = flx_ch2o_no_veg(:,last) + dels * (flx_ch2o_no_veg(:,next) - flx_ch2o_no_veg(:,last)) ENDIF IF (id_Orch_acetal .EQ. 0) THEN flx_ch3cho = flx_ch3cho_ant + flx_ch3cho_nat eflux(:,id_CH3CHO) = flx_ch3cho(:,last) + dels * (flx_ch3cho(:,next) - flx_ch3cho(:,last)) ELSE flx_ch3cho_no_veg = flx_ch3cho_ant + flx_ch3cho_nat eflux_notfromveg(:,id_Orch_acetal) = flx_ch3cho_no_veg(:,last)+ dels * (flx_ch3cho_no_veg(:,next) - flx_ch3cho_no_veg(:,last)) ENDIF IF (id_Orch_ch3coch3 .EQ. 0) THEN flx_ch3coch3 = flx_ch3coch3_ant + flx_ch3coch3_nat eflux(:,id_CH3COCH3)= flx_ch3coch3(:,last)+ dels * (flx_ch3coch3(:,next) - flx_ch3coch3(:,last)) ELSE flx_ch3coch3_no_veg = flx_ch3coch3_ant + flx_ch3coch3_nat eflux_notfromveg(:,id_Orch_ch3coch3) = flx_ch3coch3_no_veg(:,last)+ dels * (flx_ch3coch3_no_veg(:,next) - flx_ch3coch3_no_veg(:,last)) ENDIF IF ((id_Orch_acetic .EQ. 0) .OR. (id_Orch_formic .EQ. 0)) THEN flx_ch3cooh = flx_ch3cooh_ant + flx_ch3cooh_nat eflux(:,id_CH3COOH) = flx_ch3cooh(:,last) + dels * (flx_ch3cooh(:,next) - flx_ch3cooh(:,last)) ELSE flx_ch3cooh_no_veg = flx_ch3cooh_ant + flx_ch3cooh_nat eflux_notfromveg(:,id_Orch_acetic) = flx_ch3cooh_no_veg(:,last)+ dels * (flx_ch3cooh_no_veg(:,next) - flx_ch3cooh_no_veg(:,last)) eflux_notfromveg(:,id_Orch_formic) = eflux_notfromveg(:,id_Orch_acetic) ENDIF #endif #ifdef GES flx_mcf = flx_mcf_ant + flx_mcf_nat eflux(:,id_MCF) = flx_mcf(:,last) + dels * (flx_mcf(:,next) - flx_mcf(:,last)) flx_n2o = flx_n2o_ant + flx_n2o_nat eflux(:,id_N2O) = flx_n2o(:,last) + dels * (flx_n2o(:,next) - flx_n2o(:,last)) flx_ch4 = flx_ch4_ant + flx_ch4_nat eflux(:,id_CH4) = flx_ch4(:,last) + dels * (flx_ch4(:,next) - flx_ch4(:,last)) flx_co = flx_co_ant + flx_co_nat eflux(:,id_CO) = flx_co(:,last) + dels * (flx_co(:,next) - flx_co(:,last)) ! champ calcule dans carbonator - independant de sflx*.nc eflux(:,id_CO2BIH) = eflux_CO2(:,id_co2bih_loc)/3600. #endif #ifndef DUSS #ifdef AER fdistBC= 1./pi*6./rop(id_ASBCM)/srcmmd_id_ASBCM**3 *EXP(4.5*srcsigmaln(asmode)**2) fdistPOM=1./pi*6./rop(id_ASPOMM)/srcmmd_id_ASPOMM**3 *EXP(4.5*srcsigmaln(asmode)**2) fdistSO4= 1./pi*6./rop(id_ASSO4M) /srcmmd_id_ASSO4M**3 *EXP(4.5*srcsigmaln(asmode)**2) flx_so2 = flx_so2_ant + flx_so2_nat eflux(:,id_SO2) = flx_so2(:,last) + dels * (flx_so2(:,next) - flx_so2(:,last)) flx_nh3 = flx_nh3_ant + flx_nh3_nat eflux(:,id_NH3) = flx_nh3(:,last) + dels * (flx_nh3(:,next) - flx_nh3(:,last)) flx_h2s = flx_h2s_ant + flx_h2s_nat eflux(:,id_H2S) = flx_h2s(:,last) + dels * (flx_h2s(:,next) - flx_h2s(:,last)) !****************source function !--------unit of flxBCM are cgs: g cm**-2 s-1 ! computation of flux ! Injection in Low Height ! 20% of the BC is hydrophilic upon emission and 80% is hydrophobic ! 50% of POM is hydrophilic as it is emitted and 50% is hydrophobic flx_pom = flx_pom_ant + flx_pom_nat flx_bc = flx_bc_ant + flx_bc_nat eflux(:,id_AIBCM) = 0.8 * ( flx_bc(:,last) + dels * (flx_bc(:,next) - flx_bc(:,last)) ) eflux(:,id_AIPOMM) = 0.5 * ( flx_pom(:,last) + dels * (flx_pom(:,next)- flx_pom(:,last))) eflux(:,id_ASBCM) = 0.2 *( flx_bc(:,last) + dels * (flx_bc(:,next) - flx_bc(:,last)) ) eflux(:,id_ASPOMM) = 0.5 * ( flx_pom(:,last) + dels * (flx_pom(:,next)- flx_pom(:,last))) ! and for the number mixing ratio eflux(:,id_AIN) = eflux(:,id_AIN) + eflux(:,id_AIBCM) * fdistBC eflux(:,id_AIN) = eflux(:,id_AIN) + eflux(:,id_AIPOMM) * fdistPOM eflux(:,id_ASN) = eflux(:,id_ASN) + eflux(:,id_ASBCM) * fdistBC eflux(:,id_ASN) = eflux(:,id_ASN) + eflux(:,id_ASPOMM) * fdistPOM flx_asso4m = flx_so4_ant + flx_so4_nat eflux(:,id_ASSO4M) = flx_asso4m(:,last) + dels * (flx_asso4m(:,next) - flx_asso4m(:,last)) eflux(:,id_ASN) = eflux(:,id_ASN) + eflux(:,id_ASSO4M)*fdistSO4 !Emissions in altitude (biomass burning) are prepared here. !For AERONLY they are injected in bcpomsource.F90 for aerosols, NO2, NH3, and SO2. !For NMHC-AER they are injected in SETEXT_BBG for all tracers. #ifdef AERONLY flx_no = flx_no_ant + flx_no_nat eflux(:,id_NO2) = 46./30. * (flx_no(:,last) + dels * (flx_no(:,next) - flx_no(:,last))) ! bc/pom/so2 emission at altitude from biomass burning aerosols DO i = 1, PLON zalt = 0.0 DO ll = 1, PLEV fracthh = (MIN(zalt+zheight(i,ll),emi_height)-MIN(zalt,emi_height))/emi_height zalt = zalt + zheight(i,ll) eflux_alt(i,ll,id_AIBCM) = 0.8 * fracthh * (flx_bc_bbg(i,last) +dels*(flx_bc_bbg(i,next) -flx_bc_bbg(i,last))) eflux_alt(i,ll,id_AIPOMM) = 0.5 * fracthh * (flx_pom_bbg(i,last)+dels*(flx_pom_bbg(i,next)-flx_pom_bbg(i,last))) eflux_alt(i,ll,id_ASBCM) = 0.2 * fracthh * (flx_bc_bbg(i,last) +dels*(flx_bc_bbg(i,next) -flx_bc_bbg(i,last))) eflux_alt(i,ll,id_ASPOMM) = 0.5 * fracthh * (flx_pom_bbg(i,last)+dels*(flx_pom_bbg(i,next)-flx_pom_bbg(i,last))) eflux_alt(i,ll,id_AIN) = eflux_alt(i,ll,id_AIN)+ eflux_alt(i,ll,id_AIBCM) * fdistBC eflux_alt(i,ll,id_AIN) = eflux_alt(i,ll,id_AIN)+ eflux_alt(i,ll,id_AIPOMM) * fdistPOM eflux_alt(i,ll,id_ASN) = eflux_alt(i,ll,id_ASN)+ eflux_alt(i,ll,id_ASBCM) * fdistBC eflux_alt(i,ll,id_ASN) = eflux_alt(i,ll,id_ASN)+ eflux_alt(i,ll,id_ASPOMM) * fdistPOM ! Modif ThL: only anthro SO2 is emitted from ground; BBSO2 was injected in altitude (same for nh3 and no2) eflux_alt_so2(i,ll) = fracthh * (flx_so2_bbg(i,last) + dels*(flx_so2_bbg(i,next) - flx_so2_bbg(i,last))) eflux_alt_nh3(i,ll) = fracthh * (flx_nh3_bbg(i,last) + dels*(flx_nh3_bbg(i,next) - flx_nh3_bbg(i,last))) eflux_alt_no2(i,ll) = 46./30. * fracthh * (flx_no_bbg(i,last) + dels*(flx_no_bbg(i,next) - flx_no_bbg(i,last))) ENDDO ENDDO #else DO i = 1, PLON zalt = 0.0 DO ll = 1, PLEV fracthh = (MIN(zalt+zheight(i,ll),emi_height)-MIN(zalt,emi_height))/emi_height zalt = zalt + zheight(i,ll) aflux(i,ll,id_N2O) = fracthh * (flx_n2o_bbg(i,last) + dels*(flx_n2o_bbg(i,next) - flx_n2o_bbg(i,last))) aflux(i,ll,id_CH4) = fracthh * (flx_ch4_bbg(i,last) + dels*(flx_ch4_bbg(i,next) - flx_ch4_bbg(i,last))) aflux(i,ll,id_CO) = fracthh * (flx_co_bbg(i,last) + dels*(flx_co_bbg(i,next) - flx_co_bbg(i,last))) aflux(i,ll,id_H2) = fracthh * (flx_h2_bbg(i,last) + dels*(flx_h2_bbg(i,next) - flx_h2_bbg(i,last))) aflux(i,ll,id_NO) = fracthh * (flx_no_bbg(i,last) + dels*(flx_no_bbg(i,next) - flx_no_bbg(i,last))) aflux(i,ll,id_MCF) = fracthh * (flx_mcf_bbg(i,last) + dels*(flx_mcf_bbg(i,next) - flx_mcf_bbg(i,last))) aflux(i,ll,id_CH3OH) = fracthh * (flx_ch3oh_bbg(i,last) + dels*(flx_ch3oh_bbg(i,next) - flx_ch3oh_bbg(i,last))) aflux(i,ll,id_C2H5OH) = fracthh * (flx_c2h5oh_bbg(i,last) + dels*(flx_c2h5oh_bbg(i,next) - flx_c2h5oh_bbg(i,last))) aflux(i,ll,id_C2H6) = fracthh * (flx_c2h6_bbg(i,last) + dels*(flx_c2h6_bbg(i,next) - flx_c2h6_bbg(i,last))) aflux(i,ll,id_C3H8) = fracthh * (flx_c3h8_bbg(i,last) + dels*(flx_c3h8_bbg(i,next) - flx_c3h8_bbg(i,last))) aflux(i,ll,id_ALKAN) = fracthh * (flx_alkan_bbg(i,last) + dels*(flx_alkan_bbg(i,next) - flx_alkan_bbg(i,last))) aflux(i,ll,id_C2H4) = fracthh * (flx_c2h4_bbg(i,last) + dels*(flx_c2h4_bbg(i,next) - flx_c2h4_bbg(i,last))) aflux(i,ll,id_C3H6) = fracthh * (flx_c3h6_bbg(i,last) + dels*(flx_c3h6_bbg(i,next) - flx_c3h6_bbg(i,last))) aflux(i,ll,id_C2H2) = fracthh * (flx_c2h2_bbg(i,last) + dels*(flx_c2h2_bbg(i,next) - flx_c2h2_bbg(i,last))) aflux(i,ll,id_ALKEN) = fracthh * (flx_alken_bbg(i,last) + dels*(flx_alken_bbg(i,next) - flx_alken_bbg(i,last))) aflux(i,ll,id_AROM) = fracthh * (flx_arom_bbg(i,last) + dels*(flx_arom_bbg(i,next) - flx_arom_bbg(i,last))) aflux(i,ll,id_CH2O) = fracthh * (flx_ch2o_bbg(i,last) + dels*(flx_ch2o_bbg(i,next) - flx_ch2o_bbg(i,last))) aflux(i,ll,id_CH3CHO) = fracthh * (flx_ch3cho_bbg(i,last) + dels*(flx_ch3cho_bbg(i,next) - flx_ch3cho_bbg(i,last))) aflux(i,ll,id_CH3COCH3) = fracthh * (flx_ch3coch3_bbg(i,last) + dels*(flx_ch3coch3_bbg(i,next) - flx_ch3coch3_bbg(i,last))) aflux(i,ll,id_MEK) = fracthh * (flx_mek_bbg(i,last) + dels*(flx_mek_bbg(i,next) - flx_mek_bbg(i,last))) aflux(i,ll,id_MVK) = fracthh * (flx_mvk_bbg(i,last) + dels*(flx_mvk_bbg(i,next) - flx_mvk_bbg(i,last))) aflux(i,ll,id_CH3COOH) = fracthh * (flx_ch3cooh_bbg(i,last) + dels*(flx_ch3cooh_bbg(i,next) - flx_ch3cooh_bbg(i,last))) aflux(i,ll,id_ISOP) = fracthh * (flx_isop_bbg(i,last) + dels*(flx_isop_bbg(i,next) - flx_isop_bbg(i,last))) aflux(i,ll,id_APIN) = fracthh * (flx_apin_bbg(i,last) + dels*(flx_apin_bbg(i,next) - flx_apin_bbg(i,last))) aflux(i,ll,id_NH3) = fracthh * (flx_nh3_bbg(i,last) + dels*(flx_nh3_bbg(i,next) - flx_nh3_bbg(i,last))) aflux(i,ll,id_H2S) = fracthh * (flx_h2s_bbg(i,last) + dels*(flx_h2s_bbg(i,next) - flx_h2s_bbg(i,last))) aflux(i,ll,id_SO2) = fracthh * (flx_so2_bbg(i,last) + dels*(flx_so2_bbg(i,next) - flx_so2_bbg(i,last))) aflux(i,ll,id_AIBCM) = 0.8 * fracthh * (flx_bc_bbg(i,last) +dels*(flx_bc_bbg(i,next) -flx_bc_bbg(i,last))) aflux(i,ll,id_AIPOMM) = 0.5 * fracthh * (flx_pom_bbg(i,last)+dels*(flx_pom_bbg(i,next)-flx_pom_bbg(i,last))) aflux(i,ll,id_ASBCM) = 0.2 * fracthh * (flx_bc_bbg(i,last) +dels*(flx_bc_bbg(i,next) -flx_bc_bbg(i,last))) aflux(i,ll,id_ASPOMM) = 0.5 * fracthh * (flx_pom_bbg(i,last)+dels*(flx_pom_bbg(i,next)-flx_pom_bbg(i,last))) aflux(i,ll,id_AIN) = aflux(i,ll,id_AIN) + aflux(i,ll,id_AIBCM) * fdistBC aflux(i,ll,id_AIN) = aflux(i,ll,id_AIN) + aflux(i,ll,id_AIPOMM) * fdistPOM aflux(i,ll,id_ASN) = aflux(i,ll,id_ASN) + aflux(i,ll,id_ASBCM) * fdistBC aflux(i,ll,id_ASN) = aflux(i,ll,id_ASN) + aflux(i,ll,id_ASPOMM) * fdistPOM aflux(i,ll,id_ASSO4M) = fracthh * (flx_so4_bbg(i,last) + dels*(flx_so4_bbg(i,next) - flx_so4_bbg(i,last))) aflux(i,ll,id_ASN) = aflux(i,ll,id_ASN) + aflux(i,ll,id_ASSO4M)*fdistSO4 ENDDO ENDDO #endif econc_dms(:) = conc_dms(:,last) + dels * (conc_dms(:,next) - conc_dms(:,last)) #endif #endif #ifndef AER #ifdef NMHC DO i = 1, PLON zalt = 0.0 DO ll = 1, PLEV fracthh = (MIN(zalt+zheight(i,ll),emi_height)-MIN(zalt,emi_height))/emi_height zalt = zalt + zheight(i,ll) aflux(i,ll,id_CH4) = fracthh * (flx_ch4_bbg(i,last) + dels*(flx_ch4_bbg(i,next) - flx_ch4_bbg(i,last))) aflux(i,ll,id_CO) = fracthh * (flx_co_bbg(i,last) + dels*(flx_co_bbg(i,next) - flx_co_bbg(i,last))) aflux(i,ll,id_NO) = fracthh * (flx_no_bbg(i,last) + dels*(flx_no_bbg(i,next) - flx_no_bbg(i,last))) ENDDO ENDDO #endif #endif #ifdef NMHC !-------------------------------------------------------- ! ... calculate diurnal variation for biogenic NMHCs ! included in one loop to save calculation time ! Gerd Folberth, LSCE, for LMDZ/INCA, 2001. !-------------------------------------------------------- !-------------------------------------------------------- ! ... loop starts here ! Gerd Folberth, LSCE, for LMDZ/INCA, 2001. !-------------------------------------------------------- DO i = 1, PLON !-------------------------------------------------------- ! ... Adjust isoprene for diurnal variation ! Modified by Gerd Folberth, LSCE, for LMDZ/INCA, 2001. !-------------------------------------------------------- IF( polar_night(i) ) THEN CYCLE ELSE IF( polar_day(i) ) THEN iso_off = 0.8 * pi iso_on = 1.2 * pi ELSE iso_off = 0.8 * sunoff(i) iso_on = (2. * pi) - iso_off ENDIF IF ( (loc_angle(i) >= iso_off) .AND. (loc_angle(i) <= iso_on) ) THEN IF (id_Orch_iso .EQ. 0 ) THEN eflux(i,id_ISOP) = 0. ELSE eflux_notfromveg(i,id_Orch_iso) = 0. ENDIF ELSE factor = loc_angle(i) - iso_on IF (factor <= 0.) THEN factor = factor + 2.*pi ENDIF factor = factor / (2.*iso_off + 1.e-6) IF (id_Orch_iso .EQ. 0) THEN eflux(i,id_ISOP) = eflux(i,id_ISOP) * 2. / iso_off & * pi * (SIN(pi*factor))**2 ELSE eflux_notfromveg(i,id_Orch_iso) = eflux_notfromveg(i,id_Orch_iso) * 2. / iso_off & * pi * (SIN(pi*factor))**2 ENDIF ENDIF ENDIF !-------------------------------------------------------- ! ... Adjust alpha-pinene for diurnal variation ! Modified by Gerd Folberth, LSCE, for LMDZ/INCA, 2001. !-------------------------------------------------------- IF ( .NOT. polar_night(i) .AND. .NOT. polar_day(i) ) THEN dayfrac = sunoff(i) / pi IF (id_Orch_apin .EQ. 0) THEN eflux(i,id_APIN) = eflux(i,id_APIN) / (0.7 + 0.3*dayfrac) ELSE eflux_notfromveg(i,id_Orch_apin) = eflux_notfromveg(i,id_Orch_apin) / (0.7 + 0.3*dayfrac) ENDIF IF ( (loc_angle(i) >= sunoff(i)) .AND. (loc_angle(i) <= sunon(i)) ) THEN IF (id_Orch_apin .EQ. 0) THEN eflux(i,id_APIN) = eflux(i,id_APIN) * 0.7 ELSE eflux_notfromveg(i,id_Orch_apin) = eflux_notfromveg(i,id_Orch_apin) * 0.7 ENDIF ENDIF ENDIF !-------------------------------------------------------- ! ... loop ends here ! Gerd Folberth, LSCE, for LMDZ/INCA, 2001. !-------------------------------------------------------- ENDDO !! finalisation des calculs de flux a partir des donnees de orchidee !! Isoprene IF (id_Orch_iso .NE. 0) THEN ! ponderation par les fractions de surface terre + changement d'unite --> kgC/m2/s en kg/m2/s eflux_veg(:,id_Orch_iso) = tot_emiflx_fromOrch(:,id_Orch_iso)* pctsrf(:,is_ter) * 68./60. ! calcul du flux eflux(:,id_ISOP) = eflux_veg(:,id_Orch_iso) + eflux_notfromveg(:,id_Orch_iso) ENDIF IF (id_Orch_apin .NE. 0) THEN ! ponderation par les fractions de surface terre + changement d'unite --> kgC/m2/s en kg/m2/s eflux_veg(:,id_Orch_apin) = tot_emiflx_fromOrch(:,id_Orch_apin) * pctsrf(:,is_ter) * 136./120. ! calcul du flux eflux(:,id_APIN) = eflux_veg(:,id_Orch_apin) + eflux_notfromveg(:,id_Orch_apin) ENDIF !! Methanol if (id_Orch_ch3oh .NE. 0) THEN ! ponderation par les fractions de surface terre + changement d'unite --> kgC/m2/s en kg/m2/s eflux_veg(:,id_Orch_ch3oh) = tot_emiflx_fromOrch(:,id_Orch_ch3oh) * pctsrf(:,is_ter) * 32/12 ! calcul du flux eflux(:,id_CH3OH) = eflux_veg(:,id_Orch_ch3oh) + eflux_notfromveg(:,id_Orch_ch3oh) ENDIF !! Acetone IF (id_Orch_ch3coch3 .NE. 0) THEN ! ponderation par les fractions de surface terre + changement d'unite --> kgC/m2/s en kg/m2/s eflux_veg(:,id_Orch_ch3coch3) = tot_emiflx_fromOrch(:,id_Orch_ch3coch3) * pctsrf(:,is_ter) * 58/36 ! calcul du flux eflux(:,id_CH3COCH3) = eflux_veg(:,id_Orch_ch3coch3) + eflux_notfromveg(:,id_Orch_ch3coch3) ENDIF !! Aldehydes if (id_Orch_formal .ne. 0)then ! ponderation par les fractions de surface terre + changement d'unite --> kgC/m2/s en kg/m2/s eflux_veg(:,id_Orch_formal) = tot_emiflx_fromOrch(:,id_Orch_formal) * pctsrf(:,is_ter) * 30/12 ! calcul du flux eflux(:,id_CH2O) = eflux_veg(:,id_Orch_formal) + eflux_notfromveg(:,id_Orch_formal) endif IF (id_Orch_acetal .NE. 0)THEN ! ponderation par les fractions de surface terre + changement d'unite --> kgC/m2/s en kg/m2/s eflux_veg(:, id_Orch_acetal) = tot_emiflx_fromOrch(:,id_Orch_acetal) * pctsrf(:,is_ter) * 44/24 ! calcul du flux eflux(:,id_CH3CHO) = eflux_veg(:,id_Orch_acetal) + eflux_notfromveg(:,id_Orch_acetal) ENDIF !! Acides carboxyliques IF ((id_Orch_acetic .NE. 0).AND.(id_Orch_formic .NE. 0)) THEN ! ponderation par les fractions de surface terre + changement d'unite --> kgC/m2/s en kg/m2/s ! =acide acetique+acide formique (HCOOH, converti en C acide acetique) d'ORCHIDEE eflux_veg(:,id_Orch_acetic) = (tot_emiflx_fromOrch(:,id_Orch_acetic)+tot_emiflx_fromOrch(:,id_Orch_formic)) * pctsrf(:,is_ter) * 60/24 ! calcul du flux eflux(:,id_CH3COOH) = eflux_veg(:,id_Orch_acetic) + eflux_notfromveg(:,id_Orch_acetic) ENDIF #endif #ifndef DUSS #ifdef AER CALL nightingale(u, v, paprs, pmid, & cdragh, cdragm, temp, sh, ftsol, ts, & pctsrf,econc_dms,eflux(:,id_DMS)) #endif #endif END SUBROUTINE MKSFLX_P2P