! $Id: soilnoxems.f,v 1.4 2010/04/28 21:00:00 daven Exp $ SUBROUTINE SOILNOXEMS( SUNCOS ) ! !****************************************************************************** ! Subroutine SOILNOXEMS computes the emission of soil and fertilizer NOx ! for the GEOS-CHEM model. (yhw, gmg, djj, 8/94; bdf, bmy, 10/4/06) ! ! Arguments as Input: ! ============================================================================ ! (1 ) SUNCOS (REAL*8) : Array for COSINE( solar zenith angle ) [unitless] ! ! Other Important variables (mostly via common blocks or F90 modules) ! ============================================================================ ! (1 ) IJLOOP (INTEGER) : Grid-box number ! (2 ) JLOP (INTEGER) : Index to IJLOOP; for a given I,J ! (3 ) NLAND (INTEGER) : Total number of land boxes ! (4 ) NSRCE (INTEGER) : Emission timestep [seconds] ! (5 ) INDEXSOIL (INTEGER) : (I,J) of the grid ! (6 ) IREG (INTEGER) : Number of landtypes in grid square (I,J) ! (7 ) ILAND (INTEGER) : ID in grid square (I,J) for IREG landtypes ! (8 ) IUSE (INTEGER) : Fraction ((per mil) of box covered by land types ! (9 ) NCONSOIL (INTEGER) : Converts from Olson type -> soil type ! (10) FRAC (REAL*8 ) : Fraction of grid-box that rained ! (11) RATE (REAL*8 ) : Rate of total rain fall mm/day ! (12) RPULSE (REAL*8 ) : Pulsing rate (computed via "pulsing.f") ! (13) SOILTEMP (REAL*8 ) : Temperature factor (external function) ! (14) TMMPK (REAL*8 ) : Local air temperature (K), w/ diurnal variation ! (15) SOILCRF (REAL*8 ) : Soil canopy reduction factor [unitless] ! (16) WINDSQR (REAL*8 ) : Surface winds squared [m2/s2] (from sfcwindsqr.f) ! (17) SOILBASE (REAL*8 ) : Emissions ! (18) BXHEIGHT (REAL*8 ) : Grid-box height [m] ! (19) SOILNOX (REAL*8 ) : Output [molec NOx/cm2/s] ! ! References: ! ============================================================================ ! (1 ) Yienger and Levy [1995] ! (2 ) Wang et al [1998], Global Simulation of tropospheric ! O3-NOx-hydrocarbon; JGR Vol 103, pages 10713-10725 ! ! NOTES: ! (1 ) Be sure to force double precision with the DBLE function and the "D" ! exponent, wherever necessary (bmy, 10/6/99) ! (2 ) Made JLOP a local variable, so as not to have to reference it from ! "comode.h". "comode.h" should be only for SMVGEAR. (bmy, 10/19/00) ! (3 ) Now save soil NOx into GEMISNOX2 array (bdf, bmy, 6/15/01) ! (4 ) Replaced IM with IIPAR and JM with JJPAR (bmy, 6/25/02) ! (5 ) Now reference BXHEIGHT from "dao_mod.f". Also updated comments and ! made cosmetic changes. (bmy, 9/18/02) ! (6 ) Removed NSRCE from the call to "pulsing.f". Now add I0, J0 as local ! variables. Now use functions GET_XOFFSET and GET_YOFFSET from ! "grid_mod.f". (bmy, 2/11/03) ! (7 ) Need to pass SUNCOS to SOILCRF when computing FERTDIAG. (bmy, 10/14/03) ! (8 ) Now references LFUTURE from "logical_mod.f" and GET_FUTURE_SCALE_NOxft ! from "future_emissions_mod.f". Now compute future emissions of NOx ! from soils if necessary. (swu, bmy, 5/30/06) ! (9 ) Bug fix: future emissions only need to be applied the fertilizer ! term in the NOx emissions below. (swu, bmy, 10/4/06) !****************************************************************************** ! ! References to F90 modules USE DAO_MOD, ONLY : BXHEIGHT USE DIAG_MOD, ONLY : AD32_fe, AD32_so USE FUTURE_EMISSIONS_MOD, ONLY : GET_FUTURE_SCALE_NOxft USE GRID_MOD, ONLY : GET_XOFFSET, GET_YOFFSET USE LOGICAL_MOD, ONLY : LFUTURE ! adj_group: add scaling factors (dkh, 11/08/09) USE TIME_MOD, ONLY : GET_DIRECTION USE CHECKPT_MOD, ONLY : SOILNOX_CHK USE ERROR_MOD, ONLY : ERROR_STOP USE LOGICAL_ADJ_MOD, ONLY : LADJ IMPLICIT NONE # include "CMN_SIZE" ! Size parameters # include "CMN_DIAG" ! Diagnostic switches & arrays # include "CMN_NOX" ! GEMISNOX2 # include "CMN_DEP" ! CANOPYNOX # include "commsoil.h" ! Soil pulsing & wetness variables ! Arguments REAL*8, INTENT(IN) :: SUNCOS(MAXIJ) ! Local variables INTEGER :: I, J, M, III, NN INTEGER :: K, IREF, JREF, IJLOOP, L INTEGER :: KBL, JLOP(IIPAR,JJPAR,1), I0, J0 REAL*8 :: TMMP, WINDSQR, RPULSE, ZBL, DUM REAL*8 :: FERTDIAG(IIPAR,JJPAR), FUT_SCL ! External functions REAL*8, EXTERNAL :: BOXVL, FERTADD, PULSING REAL*8, EXTERNAL :: SFCWINDSQR, SOILBASE, SOILCRF REAL*8, EXTERNAL :: SOILTEMP, XLTMMP !================================================================= ! SOILNOXEMS begins here! !================================================================= ! Get nested-grid offsets (bmy, 2/11/03) I0 = GET_XOFFSET() J0 = GET_YOFFSET() ! Initalize IJLOOP = 0 DO J = 1, JJPAR DO I = 1, IIPAR SOILNOX(I,J) = 0.D0 FERTDIAG(I,J) = 0.D0 IJLOOP = IJLOOP + 1 JLOP(I,J,1) = IJLOOP ENDDO ENDDO ! Call soiltype to determine whether soil is dry or ! wet for all land grid-boxes CALL SOILTYPE ! Loop over each land grid-box DO M = 1, NLAND IREF = INDEXSOIL(1,M) JREF = INDEXSOIL(2,M) I = IREF - I0 J = JREF - J0 IJLOOP = JLOP(I,J,1) IF ( (I.GE.1) .AND. (I.LE.IIPAR) .AND. & (J.GE.1) .AND. (J.LE.JJPAR) ) THEN !=========================================================== ! PULSING FACTOR "FUNCTION PULSING(I,J,M,NSRCE)" ! ! ECO SYSTEM DEPENDENT ! TEMPERATURE FACTOR "FUNCTION SOILTEMP(I,J,M,NN)" ! BASE EMISSION WITH FERTERLIZATION ! CANOPY REDkUCTION ! SOIL NOX EMISSIONS (WATCH OUT FOR TROP. EVERGREEN) !=========================================================== TMMP = XLTMMP(I,J,IJLOOP)-273.15 WINDSQR = SFCWINDSQR(I,J) RPULSE = PULSING( I, J, M ) DO K = 1, IREG(IREF,JREF) NN = NCONSOIL(ILAND(IREF,JREF,K)+1) ! IPCC future emission scenario for NOx from fertilizers IF ( LFUTURE ) THEN FUT_SCL = GET_FUTURE_SCALE_NOXft( I, J ) ELSE FUT_SCL = 1d0 ENDIF ! SOILNOX contains soil NOx emissions in [molec NOx/cm2/s] SOILNOX(I,J) = SOILNOX(I,J) + & ( SOILTEMP(I,J,M,NN,TMMP) * SOILBASE(I,J,M,NN,RPULSE) + & FERTADD(J,M,NN) * FUT_SCL ) & *(1.D0-SOILCRF(I,J,IREF,JREF,IJLOOP,M,NN,K, & WINDSQR,SUNCOS))*DBLE(IUSE(IREF,JREF,K))/1000.D0 ! Archive fertilizer for ND32 diagnostic (bey) FERTDIAG(I,J) = FERTDIAG(I,J) + & FERTADD(J,M,NN) * FUT_SCL & *(1.D0-SOILCRF(I,J,IREF,JREF,IJLOOP,M,NN,K, & WINDSQR,SUNCOS))*DBLE(IUSE(IREF,JREF,K))/1000.D0 ENDDO ENDIF ! adj_group: add scaling and checkpointing of soil nox ! (dkh, 02/06/07) IF ( GET_DIRECTION() > 0 .and. LADJ ) THEN ! now apply scaling factor in setemis (dkh, 03/30/10) !! Apply scaling factor if active !IF ( IDADJ_ENOxso > 0 ) THEN ! ! IF ( MMSCL /= 1 ) THEN ! CALL ERROR_STOP('MMSCL', 'soilnoxems.f') ! ENDIF ! ! ! Apply scaling factor ! SOILNOX(I,J) = SOILNOX(I,J) ! * EMS_SF(I,J,1,IDADJ_ENOxso) ! !ENDIF ! Checkpoint SOILNOX emissions SOILNOX_CHK(I,J) = SOILNOX(I,J) ELSEIF( LADJ ) THEN ! Overwrite with checkpointed values, thus correctly accounting ! for dependence of PULSING on previous time step. SOILNOX(I,J) = SOILNOX_CHK(I,J) ENDIF ! Skip if there are no soil NOx emissions IF ( SOILNOX(I,J) .EQ. 0.0 ) GOTO 110 ! Archive soil NOx and fertilizer NOx emissions [molec NOx/cm2/s] IF ( ND32 > 0 ) THEN AD32_so(I,J) = AD32_so(I,J) + SOILNOX(I,J) AD32_fe(I,J) = AD32_fe(I,J) + FERTDIAG(I,J) ENDIF ! Spread NOx emission into the boundary layer ! NOTE: BXHEIGHT is in m, so BXHEIGHT * 100 is in cm. ZBL = 0.D0 KBL = 1 DO L = 1, KBL ZBL = ZBL + BXHEIGHT(I,J,L)*100.D0 ENDDO ! Store soil NOx in GEMISNOX2, the global NOx emissions array, which ! gets passed to SMVGEAR. GEMISNOX2 has units of [molec NOx/cm3/s]. GEMISNOX2(I,J) = GEMISNOX2(I,J) + ( SOILNOX(I,J) / ZBL ) 110 CONTINUE ENDDO ! M ! Return to calling program END SUBROUTINE SOILNOXEMS