2034 lines
66 KiB
Fortran
2034 lines
66 KiB
Fortran
!------------------------------------------------------------------------------
|
||
! Prasad Kasibhatla - Duke University !
|
||
!------------------------------------------------------------------------------
|
||
!BOP
|
||
!
|
||
! !MODULE: gfed3_biomass_mod
|
||
!
|
||
! !DESCRIPTION: Module GFED3\_BIOMASS\_MOD contains routines and variables
|
||
! used to incorporate GFED3 emissions into GEOS-Chem
|
||
!\\
|
||
!\\
|
||
! !INTERFACE:
|
||
!
|
||
MODULE GFED3_BIOMASS_MOD
|
||
!
|
||
! !USES:
|
||
!
|
||
IMPLICIT NONE
|
||
# include "define.h"
|
||
PRIVATE
|
||
|
||
!
|
||
! !PUBLIC MEMBER FUNCTIONS:
|
||
!
|
||
PUBLIC :: GFED3_COMPUTE_BIOMASS
|
||
PUBLIC :: CLEANUP_GFED3_BIOMASS
|
||
PUBLIC :: GFED3_IS_NEW
|
||
!
|
||
! PRIVATE MEMBER FUNCTIONS:
|
||
!
|
||
PRIVATE :: CHECK_GFED3
|
||
PRIVATE :: GFED3_AVAILABLE
|
||
PRIVATE :: GFED3_SCALE_FUTURE
|
||
PRIVATE :: GFED3_TOTAL_Tg
|
||
PRIVATE :: INIT_GFED3_BIOMASS
|
||
PRIVATE :: REARRANGE_BIOM
|
||
PRIVATE :: GRID_GFED3
|
||
PRIVATE :: YMAP_GFED3
|
||
PRIVATE :: XMAP_GFED3
|
||
PRIVATE :: READ_BPCH2_GFED3
|
||
!
|
||
! !REMARKS:
|
||
! Monthly emissions of DM are read from disk,
|
||
! multiplied by daily and 3hourly fractions (if necessary), and then
|
||
! multiplied by the appropriate emission factors to produce biomass
|
||
! burning emissions on the GFED3 0.5x0.5 degree grid The emissions are
|
||
! then regridded to the current GEOS-Chem or GCAP grid (1x1, 2x25, or 4x5).
|
||
! .
|
||
! GFED3 biomass burning emissions are computed for the following gas-phase
|
||
! and aerosol-phase species:
|
||
! .
|
||
! (1 ) NOx [ molec/cm2/s] (13) BC [atoms C/cm2/s]
|
||
! (2 ) CO [ molec/cm2/s] (14) OC [atoms C/cm2/s]
|
||
! (3 ) ALK4 [atoms C/cm2/s] (15) GLYX [ molec/cm2/s]
|
||
! (4 ) ACET [atoms C/cm2/s] (16) MGLY [ molec/cm2/s]
|
||
! (5 ) MEK [atoms C/cm2/s] (17) BENZ [atoms C/cm2/s]
|
||
! (6 ) ALD2 [atoms C/cm2/s] (18) TOLU [atoms C/cm2/s]
|
||
! (7 ) PRPE [atoms C/cm2/s] (19) XYLE [atoms C/cm2/s]
|
||
! (8 ) C3H8 [atoms C/cm2/s] (20) C2H4 [atoms C/cm2/s]
|
||
! (9 ) CH2O [ molec/cm2/s] (21) C2H2 [atoms C/cm2/s]
|
||
! (10) C2H6 [atoms C/cm2/s] (22) GLYC [ molec/cm2/s]
|
||
! (11) SO2 [ molec/cm2/s] (23) HAC [ molec/cm2/s]
|
||
! (12) NH3 [ molec/cm2/s] (24) CO2 [ molec/cm2/s]
|
||
! (25) CH4 [ molec/cm2/s]
|
||
! .
|
||
! References:
|
||
! ============================================================================
|
||
! (1 ) Original GFED3 database from Guido van der Werf
|
||
! http://www.falw.vu/~gwerf/GFED/GFED3/emissions/
|
||
! (2 ) Giglio, L., Randerson, J. T., van der Werf, G. R., Kasibhatla, P. S.,
|
||
! Collatz, G. J., Morton, D. C., and DeFries, R. S.: Assessing
|
||
! variability and long-term trends in burned area by merging multiple
|
||
! satellite fire products, Biogeosciences, 7, 1171-1186,
|
||
! doi:10.5194/bg-7-1171-2010, 2010.
|
||
! (3 ) van der Werf, G. R., Randerson, J. T., Giglio, L., Collatz, G. J.,
|
||
! Mu, M., Kasibhatla, P. S., Morton, D. C., DeFries, R. S., Jin, Y.,
|
||
! and van Leeuwen, T. T.: Global fire emissions and the contribution of
|
||
! deforestation, savanna, forest, agricultural, and peat fires
|
||
! (1997–2009), Atmos. Chem. Phys., 10, 11707-11735,
|
||
! doi:10.5194/acp-10-11707-2010, 2010.
|
||
!
|
||
! !REVISION HISTORY:
|
||
! 07 Sep 2011 - P. Kasibhatla - Initial version, based on GFED2
|
||
! 07 Sep 2011 - R. Yantosca - Added ProTeX headers
|
||
! 14 Feb 2012 - M. Payer - Add modifications for CH4 (K. Wecht)
|
||
! 06 Mar 2012 - P. Kasibhatla - Final version
|
||
! 25 Jul 2012 - M. Payer - Modified for the GC adjoint
|
||
!EOP
|
||
!------------------------------------------------------------------------------
|
||
!BOC
|
||
!
|
||
! !DEFINED PARAMETERS:
|
||
!
|
||
!=================================================================
|
||
! MODULE PARAMETERS
|
||
!
|
||
! N_EMFAC : Number of emission factors per species
|
||
! N_SPEC : Number of species
|
||
!=================================================================
|
||
INTEGER, PARAMETER :: N_EMFAC = 6
|
||
INTEGER, PARAMETER :: N_SPEC = 25 ! add CH4, kjw
|
||
!
|
||
! PRIVATE TYPES:
|
||
!
|
||
!=================================================================
|
||
! MODULE VARIABLES:
|
||
!
|
||
! Scalars
|
||
!
|
||
! T3HR : HH at start of the current 3-hr period.
|
||
! UPDATED : flag to indicate if GFED3 emissions are updated
|
||
! UPDATED_MON : flag to indicate if new month
|
||
! UPDATED_DAY : flag to indicate if new day
|
||
! - only set to true if daily emissions are used
|
||
! UPDATED_3HR : flag to indicate if new 3-hour period
|
||
! - only set to true if 3-hourly emissions are used
|
||
! SECONDS : Number of seconds in the current month
|
||
!
|
||
! Arrays
|
||
!
|
||
! GFED3_SPEC_NAME : Array for GFED3 biomass species names
|
||
! GFED3_SPEC_MOLWT: Array for GFED3 biomass species molecular wts
|
||
! GFED3_SPEC_UNIT : Array for GFED3 biomass species emissions units
|
||
! GFED3_EMFAC : Array for user-defined emission factors
|
||
! DM_GFED3_MON : Array for monthly GFED3 DM burnt GFED3 grid
|
||
! DM_GFED3_DAY : Array for daily GFED3 DM burnt on GFED3 grid
|
||
! FR_GFED3_3HR : Array for 3hourly fractions on GFED3 grid
|
||
! HUMTROP_GFED3 : Array for GFED3 0.5x0.5 humid trop forest map
|
||
! BIOMASS_MODEL : Array for GFED3 species emissions on model grid
|
||
! BIO_SAVE : Index array to store IDBxxx values
|
||
! XEDGE_GFED3 : Array for lon edges of GFED3 grid
|
||
! YEDGE_GFED3 : Array for sin of at edges of GFED3 grid
|
||
! XEDGE_MODELG : Array for lat edges of global grid at model res
|
||
! YEDGE_MODELG : Array for sin of lat edges of global grid at model res
|
||
!=================================================================
|
||
|
||
! Scalars
|
||
INTEGER :: IDBNOx, IDBCO, IDBALK4
|
||
INTEGER :: IDBACET, IDBMEK, IDBALD2
|
||
INTEGER :: IDBPRPE, IDBC3H8, IDBCH2O
|
||
INTEGER :: IDBC2H6, IDBBC, IDBOC
|
||
INTEGER :: IDBSO2, IDBNH3, IDBCO2
|
||
INTEGER :: IDBBENZ, IDBTOLU, IDBXYLE
|
||
INTEGER :: IDBC2H2, IDBC2H4, IDBGLYX
|
||
INTEGER :: IDBMGLY, IDBGLYC, IDBHAC
|
||
INTEGER :: IDBCH4
|
||
LOGICAL :: UPDATED
|
||
LOGICAL :: UPDATED_MON
|
||
LOGICAL :: UPDATED_DAY
|
||
LOGICAL :: UPDATED_3HR
|
||
INTEGER :: T3HR
|
||
REAL*8 :: SECONDS
|
||
INTEGER :: IIIPAR0
|
||
INTEGER :: JJJPAR0
|
||
|
||
! Arrays
|
||
CHARACTER(LEN=4), ALLOCATABLE :: GFED3_SPEC_NAME(:)
|
||
REAL*8, ALLOCATABLE :: GFED3_SPEC_MOLWT(:)
|
||
CHARACTER(LEN=6), ALLOCATABLE :: GFED3_SPEC_UNIT(:)
|
||
REAL*8, ALLOCATABLE :: GFED3_EMFAC(:,:)
|
||
REAL*8, ALLOCATABLE :: DM_GFED3_MON(:,:,:)
|
||
REAL*8, ALLOCATABLE :: DM_GFED3_DAY(:,:,:)
|
||
REAL*4, ALLOCATABLE :: FR_GFED3_3HR(:,:,:)
|
||
INTEGER, ALLOCATABLE :: HUMTROP_GFED3(:,:)
|
||
REAL*8, ALLOCATABLE :: BIOMASS_MODEL(:,:,:)
|
||
INTEGER, ALLOCATABLE :: BIO_SAVE(:)
|
||
REAL*8, ALLOCATABLE :: XEDGE_GFED3(:)
|
||
REAL*8, ALLOCATABLE :: YEDGE_GFED3(:)
|
||
REAL*8, ALLOCATABLE :: XEDGE_MODELG(:)
|
||
REAL*8, ALLOCATABLE :: YEDGE_MODELG(:)
|
||
|
||
!=================================================================
|
||
! MODULE ROUTINES -- follow below the "CONTAINS" statement
|
||
!=================================================================
|
||
CONTAINS
|
||
!EOC
|
||
!------------------------------------------------------------------------------
|
||
! Harvard University Atmospheric Chemistry Modeling Group !
|
||
!------------------------------------------------------------------------------
|
||
!BOP
|
||
!
|
||
! !IROUTINE: gfed3_is_new
|
||
!
|
||
! !DESCRIPTION: Function GFED3\_IS\_NEW returns TRUE if GFED3 emissions
|
||
! have been updated.
|
||
!\\
|
||
!\\
|
||
! !INTERFACE:
|
||
!
|
||
FUNCTION GFED3_IS_NEW( ) RESULT( IS_UPDATED )
|
||
!
|
||
! !RETURN VALUE:
|
||
!
|
||
LOGICAL :: IS_UPDATED ! =T if GFED3 is updated; =F otherwise
|
||
!
|
||
! !REMARKS:
|
||
! Called from carbon_mod.f and sulfate_mod.f
|
||
!
|
||
! !REVISION HISTORY:
|
||
! 07 Sep 2011 - P. Kasibhatla - Initial version, based on GFED2
|
||
! 07 Sep 2011 - R. Yantosca - Added ProTeX headers
|
||
!EOP
|
||
!------------------------------------------------------------------------------
|
||
!BOC
|
||
IS_UPDATED = UPDATED
|
||
|
||
END FUNCTION GFED3_IS_NEW
|
||
!EOC
|
||
!------------------------------------------------------------------------------
|
||
! Harvard University Atmospheric Chemistry Modeling Group !
|
||
!------------------------------------------------------------------------------
|
||
!BOP
|
||
!
|
||
! !IROUTINE: check_gfed3
|
||
!
|
||
! !DESCRIPTION: Subroutine CHECK\_GFED3 checks if we entered a new GFED period
|
||
! since last emission timestep (ie, last call). The result depends
|
||
! on the emissions time step, and the GFED time period used, as well
|
||
! as MMDDHH at beginning of the GEOS-Chem run
|
||
!\\
|
||
!\\
|
||
! !INTERFACE:
|
||
!
|
||
SUBROUTINE CHECK_GFED3( DOY, HH )
|
||
!
|
||
! !USES:
|
||
!
|
||
USE LOGICAL_MOD, ONLY : LDAYBB3
|
||
USE LOGICAL_MOD, ONLY : L3HRBB3
|
||
USE TIME_MOD, ONLY : ITS_A_NEW_MONTH
|
||
USE TIME_MOD, ONLY : ITS_A_NEW_DAY
|
||
!
|
||
! !INPUT PARAMETERS:
|
||
!
|
||
INTEGER, INTENT(IN) :: DOY ! Day of year (0-365 or 0-366 leap years)
|
||
INTEGER, INTENT(IN) :: HH ! Hour of day (0-23)
|
||
!
|
||
! !REMARKS:
|
||
! The routine computes the DOY (resp. HOUR) at start of the 1-day (resp.
|
||
! 3-hour) period we are in, if the 1-day (resp. 3-hr ) GFED3
|
||
! option is on. Result is compared to previous value to indicate if new
|
||
! data should be read.
|
||
!
|
||
! !REVISION HISTORY:
|
||
! 07 Sep 2011 - P. Kasibhatla - Initial version, based on GFED2
|
||
! 07 Sep 2011 - R. Yantosca - Added ProTeX headers
|
||
! 06 Mar 2012 - P. Kasibhatla - final GFED3 version
|
||
!EOP
|
||
!------------------------------------------------------------------------------
|
||
!BOC
|
||
!
|
||
! !LOCAL VARIABLES:
|
||
!
|
||
INTEGER :: NEW_T3HR
|
||
|
||
! Reset to default
|
||
UPDATED = .FALSE.
|
||
UPDATED_MON = .FALSE.
|
||
UPDATED_DAY = .FALSE.
|
||
UPDATED_3HR = .FALSE.
|
||
|
||
! Check if it is a new month
|
||
IF ( ITS_A_NEW_MONTH() ) THEN
|
||
UPDATED = .TRUE.
|
||
UPDATED_MON = .TRUE.
|
||
ENDIF
|
||
|
||
! Check if it is a new day
|
||
IF ( LDAYBB3 ) THEN
|
||
IF ( ITS_A_NEW_DAY() ) THEN
|
||
UPDATED = .TRUE.
|
||
UPDATED_DAY = .TRUE.
|
||
ENDIF
|
||
ENDIF
|
||
|
||
! Check if it is a new 3-hr period
|
||
IF ( L3HRBB3 ) THEN
|
||
|
||
NEW_T3HR = INT( HH / 3 ) * 3
|
||
|
||
IF ( NEW_T3HR .NE. T3HR ) THEN
|
||
UPDATED = .TRUE.
|
||
UPDATED_3HR = .TRUE.
|
||
T3HR = NEW_T3HR
|
||
ENDIF
|
||
ENDIF
|
||
|
||
END SUBROUTINE CHECK_GFED3
|
||
!EOC
|
||
!------------------------------------------------------------------------------
|
||
! Harvard University Atmospheric Chemistry Modeling Group !
|
||
!------------------------------------------------------------------------------
|
||
!BOP
|
||
!
|
||
! !IROUTINE: gfed3_available
|
||
!
|
||
! !DESCRIPTION: Function GFED3\_AVAILABLE checks an input YYYY year and MM
|
||
! month against the available data dates. If the requested YYYY and MM
|
||
! lie outside of the valid range of dates, then GFED3\_AVAILABLE will return
|
||
! the last valid YYYY and MM.
|
||
!\\
|
||
!\\
|
||
! !INTERFACE:
|
||
!
|
||
SUBROUTINE GFED3_AVAILABLE( YYYY, YMIN, YMAX, MM, MMIN, MMAX )
|
||
!
|
||
! !INPUT PARAMETERS:
|
||
!
|
||
INTEGER, INTENT(IN) :: YMIN, YMAX ! Min & max years
|
||
INTEGER, INTENT(IN), OPTIONAL :: MMIN, MMAX ! Min & max months
|
||
!
|
||
! !INPUT/OUTPUT PARAMETERS:
|
||
!
|
||
INTEGER, INTENT(INOUT) :: YYYY ! Year of GFED3 data
|
||
INTEGER, INTENT(INOUT), OPTIONAL :: MM ! Month of GFED3 data
|
||
!
|
||
! !REVISION HISTORY:
|
||
! 07 Sep 2011 - P. Kasibhatla - Initial version, based on GFED2
|
||
! 07 Sep 2011 - R. Yantosca - Added ProTeX headers
|
||
!EOP
|
||
!------------------------------------------------------------------------------
|
||
!BOC
|
||
|
||
! Check year
|
||
IF ( YYYY > YMAX .OR. YYYY < YMIN ) THEN
|
||
|
||
YYYY = MAX( YMIN, MIN( YYYY, YMAX) )
|
||
|
||
WRITE( 6, 100 ) YMAX, YMIN, YYYY
|
||
100 FORMAT( 'YEAR > ', i4, ' or YEAR < ', i4,
|
||
$ '. Using GFED3 biomass for ', i4)
|
||
ENDIF
|
||
|
||
|
||
! Check month
|
||
IF ( PRESENT( MM ) ) THEN
|
||
IF ( MM > MMAX .OR. MM < MMIN ) THEN
|
||
|
||
MM = MAX( MMIN, MIN( MM, MMAX) )
|
||
|
||
WRITE( 6, 200 ) MMIN, MMAX, MM
|
||
200 FORMAT( ' ** WARNING ** : MONTH is not within ', i2,'-',
|
||
$ i2, '. Using GFED3 biomass for month #', i2)
|
||
ENDIF
|
||
ENDIF
|
||
|
||
END SUBROUTINE GFED3_AVAILABLE
|
||
!EOC
|
||
!------------------------------------------------------------------------------
|
||
! Harvard University Atmospheric Chemistry Modeling Group !
|
||
!------------------------------------------------------------------------------
|
||
!BOP
|
||
!
|
||
! !IROUTINE: gfed3_compute_biomass
|
||
!
|
||
! !DESCRIPTION: Subroutine GFED3\_COMPUTE\_BIOMASS computes the monthly
|
||
! GFED3 biomass burning emissions for a given year and month.
|
||
!\\
|
||
!\\
|
||
! !INTERFACE:
|
||
!
|
||
SUBROUTINE GFED3_COMPUTE_BIOMASS( THIS_YYYY, THIS_MM, BIOM_OUT )
|
||
!
|
||
! !USES:
|
||
!
|
||
USE BPCH2_MOD, ONLY : GET_TAU0
|
||
USE DIRECTORY_MOD, ONLY : DATA_DIR_NATIVE => DATA_DIR_1x1
|
||
USE JULDAY_MOD, ONLY : JULDAY
|
||
USE JULDAY_MOD, ONLY : CALDATE
|
||
USE LOGICAL_MOD, ONLY : LFUTURE
|
||
USE LOGICAL_MOD, ONLY : LDAYBB3
|
||
USE LOGICAL_MOD, ONLY : L3HRBB3
|
||
USE LOGICAL_MOD, ONLY : LGFED3BB
|
||
USE TIME_MOD, ONLY : EXPAND_DATE
|
||
USE TIME_MOD, ONLY : TIMESTAMP_STRING
|
||
USE TIME_MOD, ONLY : GET_DIRECTION
|
||
USE TIME_MOD, ONLY : GET_DAY
|
||
USE TIME_MOD, ONLY : GET_HOUR
|
||
USE TIME_MOD, ONLY : GET_DAY_OF_YEAR
|
||
USE TIME_MOD, ONLY : ITS_A_LEAPYEAR
|
||
USE GRID_MOD, ONLY : GET_IIIPAR
|
||
USE GRID_MOD, ONLY : GET_JJJPAR
|
||
USE GRID_MOD, ONLY : GET_XEDGE_G
|
||
USE GRID_MOD, ONLY : GET_YEDGE_G
|
||
USE GRID_MOD, ONLY : GET_XOFFSET
|
||
USE GRID_MOD, ONLY : GET_YOFFSET
|
||
USE ERROR_MOD, ONLY : ALLOC_ERR
|
||
|
||
# include "CMN_SIZE" ! Size parameters
|
||
!
|
||
! !INPUT PARAMETERS:
|
||
!
|
||
INTEGER, INTENT(IN) :: THIS_YYYY ! Current year
|
||
INTEGER, INTENT(IN) :: THIS_MM ! Current month
|
||
!
|
||
! !OUTPUT PARAMETERS:
|
||
!
|
||
REAL*8, INTENT(INOUT) :: BIOM_OUT(IIPAR,JJPAR,N_SPEC) ! BB emissions
|
||
! [molec/cm2/s]
|
||
!
|
||
! !REMARKS:
|
||
! This routine has to be called on EVERY emissions-timestep if you use one
|
||
! of the GFED3 options.
|
||
!
|
||
!
|
||
! !REVISION HISTORY:
|
||
! 07 Sep 2011 - P. Kasibhatla - Initial version, based on GFED2
|
||
! 07 Sep 2011 - R. Yantosca - Added ProTeX headers
|
||
!EOP
|
||
!------------------------------------------------------------------------------
|
||
!BOC
|
||
!
|
||
! !LOCAL VARIABLES:
|
||
!
|
||
LOGICAL, SAVE :: FIRST = .TRUE.
|
||
INTEGER :: I, J, N, NF , IT3
|
||
INTEGER :: AS
|
||
INTEGER :: II, JJ
|
||
INTEGER :: I0, J0
|
||
INTEGER :: YYYY, MM, MM1, YYYY1
|
||
INTEGER :: YYYYMMDD, HHMMSS
|
||
REAL*8 :: GFED3_EMFACX
|
||
REAL*4 :: ARRAY_GFED3(IGFED3, JGFED3, 1)
|
||
REAL*4 :: FR_GFED3_DAY(IGFED3, JGFED3)
|
||
REAL*8 :: DM_GFED3(IGFED3, JGFED3, N_EMFAC)
|
||
REAL*8 :: BIOMASS_GFED3(IGFED3, JGFED3, N_SPEC)
|
||
REAL*8 :: TAU0, TAU1
|
||
REAL*4 :: TMP
|
||
CHARACTER(LEN=255) :: FILENAME1
|
||
CHARACTER(LEN=255) :: FILENAME2
|
||
CHARACTER(LEN=255) :: FILENAME3
|
||
CHARACTER(LEN=255) :: FILENAME4
|
||
CHARACTER(LEN=255) :: FILENAME5
|
||
CHARACTER(LEN=255) :: FILENAME6
|
||
CHARACTER(LEN=255) :: FILENAME7
|
||
CHARACTER(LEN=255) :: FILENAME8
|
||
CHARACTER(LEN=16 ) :: TIME_STR
|
||
INTEGER :: DD, HH, DOY
|
||
INTEGER :: IT3HR, IT3H
|
||
REAL*4 :: DEG2RAD
|
||
REAL*4, ALLOCATABLE :: bq1(:,:)
|
||
REAL*4, ALLOCATABLE :: bq2(:,:)
|
||
|
||
!=================================================================
|
||
! GFED3_COMPUTE_BIOMASS begins here!
|
||
!=================================================================
|
||
|
||
! First-time initialization
|
||
IF ( FIRST ) THEN
|
||
IIIPAR0 = GET_IIIPAR()
|
||
JJJPAR0 = GET_JJJPAR()
|
||
CALL INIT_GFED3_BIOMASS
|
||
|
||
DEG2RAD = (4. * ATAN(1.) ) /180.
|
||
|
||
! Define GFED3 grid box lat and lon edges
|
||
XEDGE_GFED3( 1 ) = -180.d0
|
||
DO I = 2,IGFED3+1
|
||
XEDGE_GFED3( I ) = XEDGE_GFED3( I-1 ) + 5.d-1
|
||
END DO
|
||
|
||
YEDGE_GFED3( 1 ) = -90.d0
|
||
DO J = 2, JGFED3+1
|
||
YEDGE_GFED3( J ) = YEDGE_GFED3( J-1 ) + 5.d-1
|
||
END DO
|
||
|
||
DO J = 1,JGFED3+1
|
||
YEDGE_GFED3( J ) = SIN( YEDGE_GFED3( J ) * DEG2RAD)
|
||
END DO
|
||
|
||
! Define global grid box lat and lon edges at model resolution
|
||
|
||
DO I = 1,IIIPAR0+1
|
||
XEDGE_MODELG( I ) = GET_XEDGE_G ( I )
|
||
END DO
|
||
|
||
DO J = 1,JJJPAR0+1
|
||
YEDGE_MODELG( J ) = GET_YEDGE_G ( J )
|
||
END DO
|
||
|
||
DO J = 1,JJJPAR0+1
|
||
YEDGE_MODELG( J ) = SIN( YEDGE_MODELG( J ) * DEG2RAD)
|
||
END DO
|
||
|
||
FIRST = .FALSE.
|
||
|
||
ENDIF
|
||
|
||
! Save in local variables
|
||
YYYY = THIS_YYYY
|
||
MM = THIS_MM
|
||
DD = GET_DAY()
|
||
HH = GET_HOUR()
|
||
DOY = GET_DAY_OF_YEAR()
|
||
|
||
! Check if we need to update GFED3
|
||
CALL CHECK_GFED3( DOY, HH )
|
||
|
||
! If no updating is needed, module variable BIOMASS_MODEL
|
||
! from last update can be used
|
||
IF ( .not. UPDATED ) THEN
|
||
!CALL REARRANGE_BIOM(BIOMASS_MODEL,BIOM_OUT)
|
||
BIOM_OUT = BIOMASS_MODEL
|
||
RETURN
|
||
ENDIF
|
||
|
||
! If within same month, no nead to reread emission file.
|
||
! But go to statement 999 to check if daily fractiions
|
||
! need to be read.
|
||
IF ( .not. UPDATED_MON ) THEN
|
||
go to 999
|
||
ENDIF
|
||
|
||
! Echo info
|
||
WRITE( 6, '(a)' ) REPEAT( '=', 79 )
|
||
WRITE( 6, '(a)' )
|
||
& 'G F E D 3 B I O M A S S B U R N I N G E M I S S I O N S'
|
||
|
||
|
||
!=================================================================
|
||
! Check GFED3 availability & get YYYYMMDD of data to read.
|
||
!=================================================================
|
||
|
||
! Availability of MONTHLY data
|
||
!-------------------------------
|
||
|
||
CALL GFED3_AVAILABLE( YYYY, 1997, 2011 )
|
||
|
||
! Create YYYYMMDD integer values
|
||
YYYYMMDD = YYYY*10000 + MM*100 + 01
|
||
|
||
!=================================================================
|
||
! Filename, TAU0 and number of seconds
|
||
!=================================================================
|
||
|
||
! for monthly data
|
||
!-------------------------------
|
||
! TAU value at start of YYYY/MM
|
||
TAU0 = GET_TAU0( MM, 1, YYYY )
|
||
|
||
! Get YYYY/MM value for next month
|
||
MM1 = MM + 1
|
||
YYYY1 = YYYY
|
||
|
||
! Increment year if necessary
|
||
IF ( MM1 == 13 ) THEN
|
||
MM1 = 1
|
||
YYYY1 = YYYY + 1
|
||
ENDIF
|
||
|
||
! TAU value at start of next month
|
||
TAU1 = GET_TAU0( MM1, 1, YYYY1 )
|
||
|
||
! Number of seconds in this month
|
||
! (NOTE: its value will be saved until the next month)
|
||
SECONDS = ( TAU1 - TAU0 ) * 3600d0
|
||
|
||
! File name with GFED3 DM emissions
|
||
FILENAME1 = TRIM( DATA_DIR_NATIVE ) //
|
||
& 'GFED3_201212/YYYY/Monthly/GFED3_DM_AGW_YYYYMM'
|
||
FILENAME2 = TRIM( DATA_DIR_NATIVE ) //
|
||
& 'GFED3_201212/YYYY/Monthly/GFED3_DM_DEF_YYYYMM'
|
||
FILENAME3 = TRIM( DATA_DIR_NATIVE ) //
|
||
& 'GFED3_201212/YYYY/Monthly/GFED3_DM_FOR_YYYYMM'
|
||
FILENAME4 = TRIM( DATA_DIR_NATIVE ) //
|
||
& 'GFED3_201212/YYYY/Monthly/GFED3_DM_PET_YYYYMM'
|
||
FILENAME5 = TRIM( DATA_DIR_NATIVE ) //
|
||
& 'GFED3_201212/YYYY/Monthly/GFED3_DM_SAV_YYYYMM'
|
||
FILENAME6 = TRIM( DATA_DIR_NATIVE ) //
|
||
& 'GFED3_201212/YYYY/Monthly/GFED3_DM_WDL_YYYYMM'
|
||
|
||
!=================================================================
|
||
! Read GFED3 DM burnt [g/m2/month]
|
||
!=================================================================
|
||
|
||
! Replace YYYY/MM in the file name
|
||
CALL EXPAND_DATE( FILENAME1, YYYYMMDD, 000000 )
|
||
CALL EXPAND_DATE( FILENAME2, YYYYMMDD, 000000 )
|
||
CALL EXPAND_DATE( FILENAME3, YYYYMMDD, 000000 )
|
||
CALL EXPAND_DATE( FILENAME4, YYYYMMDD, 000000 )
|
||
CALL EXPAND_DATE( FILENAME5, YYYYMMDD, 000000 )
|
||
CALL EXPAND_DATE( FILENAME6, YYYYMMDD, 000000 )
|
||
|
||
! Read GFED3 DM emissions [g DM/m2/month] in the following order
|
||
! AGW, DEF, FOR, PET, SAV, WDL
|
||
CALL READ_BPCH2_GFED3( FILENAME1, 'GFED3-BB', 91,
|
||
& TAU0, IGFED3, JGFED3,
|
||
& 1, ARRAY_GFED3, QUIET=.TRUE. )
|
||
|
||
DM_GFED3_MON(:,:,1) = ARRAY_GFED3(:,:,1)
|
||
|
||
CALL READ_BPCH2_GFED3( FILENAME2, 'GFED3-BB', 92,
|
||
& TAU0, IGFED3, JGFED3,
|
||
& 1, ARRAY_GFED3, QUIET=.TRUE. )
|
||
|
||
DM_GFED3_MON(:,:,2) = ARRAY_GFED3(:,:,1)
|
||
|
||
CALL READ_BPCH2_GFED3( FILENAME3, 'GFED3-BB', 93,
|
||
& TAU0, IGFED3, JGFED3,
|
||
& 1, ARRAY_GFED3, QUIET=.TRUE. )
|
||
|
||
DM_GFED3_MON(:,:,3) = ARRAY_GFED3(:,:,1)
|
||
|
||
CALL READ_BPCH2_GFED3( FILENAME4, 'GFED3-BB', 94,
|
||
& TAU0, IGFED3, JGFED3,
|
||
& 1, ARRAY_GFED3, QUIET=.TRUE. )
|
||
|
||
DM_GFED3_MON(:,:,4) = ARRAY_GFED3(:,:,1)
|
||
|
||
CALL READ_BPCH2_GFED3( FILENAME5, 'GFED3-BB', 95,
|
||
& TAU0, IGFED3, JGFED3,
|
||
& 1, ARRAY_GFED3, QUIET=.TRUE. )
|
||
|
||
DM_GFED3_MON(:,:,5) = ARRAY_GFED3(:,:,1)
|
||
|
||
CALL READ_BPCH2_GFED3( FILENAME6, 'GFED3-BB', 96,
|
||
& TAU0, IGFED3, JGFED3,
|
||
& 1, ARRAY_GFED3, QUIET=.TRUE. )
|
||
|
||
DM_GFED3_MON(:,:,6) = ARRAY_GFED3(:,:,1)
|
||
|
||
!=================================================================
|
||
! Convert [g DM/m2/month] to [kg DM/cm2/month]
|
||
!
|
||
! Unit Conversions:
|
||
! (1) g to kg --> Divide by 1000
|
||
! (2) 1/m2 to 1/cm2 --> Divide by 10000
|
||
!=================================================================
|
||
|
||
! Loop over GFED3 GRID
|
||
DO J = 1, JGFED3
|
||
DO I = 1, IGFED3
|
||
DO NF = 1, N_EMFAC
|
||
|
||
! Set negatives to zero
|
||
DM_GFED3_MON(I,J,NF) = MAX( DM_GFED3_MON(I,J,NF), 0e0 )
|
||
|
||
! Convert [g DM/m2/month] to [kg DM/cm2/month]
|
||
DM_GFED3_MON(I,J,NF) = DM_GFED3_MON(I,J,NF) * 1d-3 * 1d-4
|
||
|
||
ENDDO
|
||
ENDDO
|
||
ENDDO
|
||
|
||
! If 3-hourly emissions are used, read 3-hourly fractions
|
||
! at the same time that monthly emissions are read because
|
||
! these fractions are constant throughout the month
|
||
! - note that these should be applied after daily fractions
|
||
! are applied
|
||
|
||
IF ( L3HRBB3 ) THEN
|
||
|
||
DO IT3 = 1,8
|
||
|
||
IT3H = (IT3-1)*3
|
||
HHMMSS = IT3H*10000
|
||
TAU0 = GET_TAU0( MM, 01, YYYY, IT3H )
|
||
|
||
FILENAME7 = TRIM( DATA_DIR_NATIVE ) //
|
||
& 'GFED3_201212/YYYY/3hourly/GFED3_FR_3HR_YYYYMMDDhh'
|
||
|
||
! Replace YYYY/MM/HH in the file name
|
||
CALL EXPAND_DATE( FILENAME7, YYYYMMDD, HHMMSS )
|
||
|
||
CALL READ_BPCH2_GFED3( FILENAME7, 'GFED3-BB', 89,
|
||
& TAU0, IGFED3, JGFED3,
|
||
& 1, ARRAY_GFED3, QUIET=.TRUE.)
|
||
|
||
FR_GFED3_3HR(:,:,IT3) = ARRAY_GFED3(:,:,1)
|
||
|
||
END DO
|
||
|
||
ENDIF
|
||
|
||
999 CONTINUE
|
||
|
||
!=================================================================
|
||
! At this point in the code, the following cases are possible:
|
||
!
|
||
! UPDATED_MON=T, UPDATED_DAY=T, UPDATED_3HR=T
|
||
! UPDATED_MON=T, UPDATED_DAY=T, UODATED_3HR=F
|
||
! UPDATED_MON=F, UPDATED_DAY=T, UPDATED_3HR=T
|
||
! UPDATED_MON=F, UPDATED_DAY=T, UPDATED_3HR=F
|
||
! UPDATED_MON=F, UPDATED_DAY=F, UPDATED_3HR=T
|
||
!
|
||
! Note that the combination
|
||
! UPDATED_MON=F, UPDATED_DAY=F, UPDATED_3HR=F
|
||
! is not possible at this point in code because of the
|
||
! of the RETURN statement when UPDATED=F near the
|
||
! start of this subroutine
|
||
!
|
||
! Also note that the combinations
|
||
! UPDATED_MON=T, UPDATED_DAY=F, UPDATED_3HR=T
|
||
! UPDATED_MON=T, UPDATED_DAY=F, UODATED_3HR=F
|
||
! are not possible because UPDATED_DAY=T
|
||
! when UPDATED_MON=T
|
||
!
|
||
! In the following code, the module variables
|
||
! DM_GFED3_MON and DM_GFED3_DAY contain the
|
||
! latest updated monthly and daily (if applicable)
|
||
! emissions, respectively. Note that
|
||
! by making them module variables, it is ensured
|
||
! that the correct values are always available
|
||
! during repeated calls to this code.
|
||
!
|
||
! The local variable DM_GFED3 is updated appropriately
|
||
! based on the 5 allowable cases describe above and passed
|
||
! to the DO_REGRID_G2G_1x1 subroutine.
|
||
!
|
||
!=================================================================
|
||
|
||
! Read daily fractions
|
||
IF ( UPDATED_DAY) THEN
|
||
TAU0 = GET_TAU0( MM, DD, YYYY )
|
||
|
||
! Create YYYYMMDD integer value
|
||
YYYYMMDD = YYYY*10000 + MM*100 + DD
|
||
|
||
FILENAME8 = TRIM( DATA_DIR_NATIVE ) //
|
||
& 'GFED3_201212/YYYY/Daily/GFED3_FR_DAY_YYYYMMDD'
|
||
|
||
! Replace YYYY/MM in the file name
|
||
CALL EXPAND_DATE( FILENAME8, YYYYMMDD, 000000 )
|
||
|
||
CALL READ_BPCH2_GFED3( FILENAME8, 'GFED3-BB', 88,
|
||
& TAU0, IGFED3, JGFED3,
|
||
& 1, ARRAY_GFED3, QUIET=.TRUE. )
|
||
|
||
FR_GFED3_DAY(:,:) = ARRAY_GFED3(:,:,1)
|
||
|
||
ENDIF
|
||
|
||
! Convert DM burnt from kg/cm2/month to kg/cm2/day or
|
||
! kg/cm2/3hour if needed, and grid to model grid
|
||
DO NF = 1, N_EMFAC
|
||
|
||
DO J = 1, JGFED3
|
||
DO I = 1, IGFED3
|
||
DM_GFED3(I,J,NF)=DM_GFED3_MON(I,J,NF)
|
||
|
||
IF ( UPDATED_DAY ) THEN
|
||
DM_GFED3_DAY(I,J,NF)=DM_GFED3_MON(I,J,NF)
|
||
& *FR_GFED3_DAY(I,J)
|
||
DM_GFED3(I,J,NF)=DM_GFED3_DAY(I,J,NF)
|
||
SECONDS = 24 * 3600d0
|
||
END IF
|
||
|
||
IF ( UPDATED_3HR ) THEN
|
||
IT3HR=T3HR/3+1
|
||
DM_GFED3(I,J,NF)=DM_GFED3_DAY(I,J,NF)
|
||
& *FR_GFED3_3HR(I,J,IT3HR)
|
||
SECONDS = 3 * 3600d0
|
||
END IF
|
||
|
||
ENDDO
|
||
ENDDO
|
||
|
||
END DO
|
||
|
||
!=================================================================
|
||
! Calculate biomass species emissions on GFED3 grid
|
||
! and regrid to model grid
|
||
!
|
||
! Emission factors convert from [kg DM/cm2/timeperiod] to either
|
||
! [molec/cm2/timeperiod] or [atoms C/cm2/timeperiod]
|
||
!
|
||
! Units:
|
||
! [ molec/cm2/month] : NOx, CO, CH2O, SO2, NH3, CO2
|
||
! [atoms C/cm2/month] : ALK4, ACET, MEK, ALD2, PRPE, C3H8,
|
||
! C2H6, BC, OC
|
||
!=================================================================
|
||
|
||
! Loop over biomass species
|
||
DO N = 1, N_SPEC
|
||
|
||
DO J = 1, JGFED3
|
||
DO I = 1, IGFED3
|
||
BIOMASS_GFED3(I,J,N) = 0.0
|
||
DO NF = 1, N_EMFAC
|
||
GFED3_EMFACX=GFED3_EMFAC(N,NF)
|
||
|
||
! Use woodland emission factors for 'deforestation' outside
|
||
! humid tropical forest
|
||
IF(NF.EQ.2.AND.HUMTROP_GFED3(I,J).EQ.0)
|
||
& GFED3_EMFACX=GFED3_EMFAC(N,6)
|
||
BIOMASS_GFED3(I,J,N) = BIOMASS_GFED3(I,J,N) +
|
||
& DM_GFED3(I,J,NF) *
|
||
& GFED3_EMFACX
|
||
|
||
ENDDO
|
||
ENDDO
|
||
ENDDO
|
||
|
||
! Regrid emissions from GFED3 grid to model grid
|
||
ALLOCATE( bq1( IGFED3, JGFED3 ), STAT=AS )
|
||
IF ( AS /= 0 ) CALL ALLOC_ERR( 'bq1' )
|
||
ALLOCATE( bq2( IIIPAR0, JJJPAR0 ), STAT=AS )
|
||
IF ( AS /= 0 ) CALL ALLOC_ERR( 'bq2' )
|
||
|
||
bq1(:,:)=BIOMASS_GFED3(:,:,N)
|
||
CALL GRID_GFED3( IGFED3, JGFED3, XEDGE_GFED3,
|
||
& YEDGE_GFED3, bq1, IIIPAR0,
|
||
& JJJPAR0, XEDGE_MODELG, YEDGE_MODELG,
|
||
& bq2, 0, 0 )
|
||
|
||
I0 = GET_XOFFSET( GLOBAL=.TRUE. )
|
||
J0 = GET_YOFFSET( GLOBAL=.TRUE. )
|
||
|
||
DO JJ=1,JJPAR
|
||
DO II=1,IIPAR
|
||
BIOMASS_MODEL(II,JJ,N)=bq2(II+I0,JJ+J0)
|
||
END DO
|
||
END DO
|
||
|
||
DEALLOCATE( bq1 )
|
||
DEALLOCATE( bq2 )
|
||
|
||
END DO
|
||
|
||
! Compute future biomass emissions (if necessary)
|
||
IF ( LFUTURE ) THEN
|
||
CALL GFED3_SCALE_FUTURE( BIOMASS_MODEL )
|
||
ENDIF
|
||
|
||
! Print totals in Tg/time period
|
||
IF ( UPDATED_3HR ) THEN
|
||
WRITE( 6, 412 ) YYYY, MM, DD, T3HR
|
||
412 FORMAT( 'GFED3 3hourly emissions for year, month, day, 3hr: ',
|
||
& i4, '/', 3i2.2, / )
|
||
go to 998
|
||
ENDIF
|
||
IF ( UPDATED_DAY ) THEN
|
||
WRITE( 6, 411 ) YYYY, MM, DD
|
||
411 FORMAT( 'GFED3 daily emissions for year, month, day: ',
|
||
& i4, '/', 2i2.2, / )
|
||
go to 998
|
||
ENDIF
|
||
WRITE( 6, 410 ) YYYY, MM
|
||
410 FORMAT( 'GFED3 monthly emissions for year, month: ',
|
||
& i4, '/', i2.2, / )
|
||
998 CONTINUE
|
||
CALL GFED3_TOTAL_Tg
|
||
|
||
! Convert from [molec/cm2/month], [molec/cm2/day] or
|
||
! [molec/cm2/3hr] to [molec/cm2/s]
|
||
BIOMASS_MODEL = BIOMASS_MODEL / SECONDS
|
||
|
||
! Rearrange the species to the same order as in the IDBxxx (fp, 6/09)
|
||
! BIOMASS_MODEL is indexed as GFED3
|
||
! BIOM_OUT is indexed as IDBs
|
||
!CALL REARRANGE_BIOM( BIOMASS_MODEL, BIOM_OUT )
|
||
BIOM_OUT = BIOMASS_MODEL
|
||
|
||
! Echo info
|
||
WRITE( 6, '(a)' ) REPEAT( '=', 79 )
|
||
|
||
END SUBROUTINE GFED3_COMPUTE_BIOMASS
|
||
!EOC
|
||
!------------------------------------------------------------------------------
|
||
! Harvard University Atmospheric Chemistry Modeling Group !
|
||
!------------------------------------------------------------------------------
|
||
!BOP
|
||
!
|
||
! !IROUTINE: gfed3_scale_future
|
||
!
|
||
! !DESCRIPTION: Subroutine GFED3\_SCALE\_FUTURE applies the IPCC future
|
||
! emissions scale factors to the GFED3 biomass burning emisisons in order
|
||
! to compute the future emissions of biomass burning for NOx, CO, and VOC's.
|
||
!\\
|
||
!\\
|
||
! !INTERFACE:
|
||
!
|
||
SUBROUTINE GFED3_SCALE_FUTURE( BB )
|
||
!
|
||
! !USES:
|
||
!
|
||
USE FUTURE_EMISSIONS_MOD, ONLY : GET_FUTURE_SCALE_BCbb
|
||
USE FUTURE_EMISSIONS_MOD, ONLY : GET_FUTURE_SCALE_CObb
|
||
USE FUTURE_EMISSIONS_MOD, ONLY : GET_FUTURE_SCALE_NH3bb
|
||
USE FUTURE_EMISSIONS_MOD, ONLY : GET_FUTURE_SCALE_NOxbb
|
||
USE FUTURE_EMISSIONS_MOD, ONLY : GET_FUTURE_SCALE_OCbb
|
||
USE FUTURE_EMISSIONS_MOD, ONLY : GET_FUTURE_SCALE_SO2bb
|
||
USE FUTURE_EMISSIONS_MOD, ONLY : GET_FUTURE_SCALE_VOCbb
|
||
USE TRACER_MOD, ONLY : ITS_A_CO2_SIM
|
||
USE TRACER_MOD, ONLY : ITS_A_CH4_SIM
|
||
|
||
# include "CMN_SIZE" ! Size parameters
|
||
|
||
!
|
||
! !OUTPUT PARAMETERS:
|
||
!
|
||
! Array w/ biomass burning emisisons [molec/cm2]
|
||
REAL*8, INTENT(INOUT) :: BB(IIPAR,JJPAR,N_SPEC)
|
||
!
|
||
! !REVISION HISTORY:
|
||
! 07 Sep 2011 - P. Kasibhatla - Initial version, based on GFED2
|
||
! 07 Sep 2011 - R. Yantosca - Added ProTeX headers
|
||
!EOP
|
||
!------------------------------------------------------------------------------
|
||
!BOC
|
||
!
|
||
! !LOCAL VARIABLES:
|
||
!
|
||
LOGICAL :: ITS_CO2
|
||
LOGICAL :: ITS_CH4
|
||
INTEGER :: I, J, N
|
||
|
||
!=================================================================
|
||
! GFED3_SCALE_FUTURE begins here!
|
||
!=================================================================
|
||
|
||
! Test if it's a CO2 simulation outside of the loop
|
||
ITS_CO2 = ITS_A_CO2_SIM()
|
||
ITS_CH4 = ITS_A_CH4_SIM()
|
||
|
||
!$OMP PARALLEL DO
|
||
!$OMP+DEFAULT( SHARED )
|
||
!$OMP+PRIVATE( I, J, N )
|
||
|
||
! Loop over species and grid boxes
|
||
DO N = 1, N_SPEC
|
||
DO J = 1, JJPAR
|
||
DO I = 1, IIPAR
|
||
|
||
! Scale each species to IPCC future scenario
|
||
IF ( N == IDBNOx ) THEN
|
||
|
||
! Future biomass NOx [molec/cm2]
|
||
BB(I,J,N) = BB(I,J,N) * GET_FUTURE_SCALE_NOxbb( I, J )
|
||
|
||
ELSE IF ( N == IDBCO ) THEN
|
||
|
||
! Future biomass CO [molec/cm2]
|
||
BB(I,J,N) = BB(I,J,N) * GET_FUTURE_SCALE_CObb( I, J )
|
||
|
||
ELSE IF ( N == IDBSO2 ) THEN
|
||
|
||
! Future biomass SO2 [molec/cm2]
|
||
BB(I,J,N) = BB(I,J,N) * GET_FUTURE_SCALE_SO2bb( I, J )
|
||
|
||
ELSE IF ( N == IDBNH3 ) THEN
|
||
|
||
! Future biomass NH3 [molec/cm2]
|
||
BB(I,J,N) = BB(I,J,N) * GET_FUTURE_SCALE_NH3bb( I, J )
|
||
|
||
ELSE IF ( N == IDBBC ) THEN
|
||
|
||
! Future biomass BC [molec/cm2]
|
||
BB(I,J,N) = BB(I,J,N) * GET_FUTURE_SCALE_BCbb( I, J )
|
||
|
||
ELSE IF ( N == IDBOC ) THEN
|
||
|
||
! Future biomass OC [molec/cm2]
|
||
BB(I,J,N) = BB(I,J,N) * GET_FUTURE_SCALE_OCbb( I, J )
|
||
|
||
! Don't scale future emissions if CO2 or CH4
|
||
ELSE IF ( ITS_CO2 .OR. ITS_CH4 ) THEN
|
||
|
||
! Nothing
|
||
|
||
ELSE
|
||
|
||
! Future biomass Hydrocarbons [atoms C/cm2]
|
||
BB(I,J,N) = BB(I,J,N) * GET_FUTURE_SCALE_VOCbb( I, J )
|
||
|
||
ENDIF
|
||
|
||
ENDDO
|
||
ENDDO
|
||
ENDDO
|
||
!$OMP END PARALLEL DO
|
||
|
||
END SUBROUTINE GFED3_SCALE_FUTURE
|
||
!EOC
|
||
!------------------------------------------------------------------------------
|
||
! Harvard University Atmospheric Chemistry Modeling Group !
|
||
!------------------------------------------------------------------------------
|
||
!BOP
|
||
!
|
||
! !IROUTINE: gfed3_total_Tg
|
||
!
|
||
! !DESCRIPTION: Subroutine GFED3\_TOTAL\_Tg prints the amount of biomass
|
||
! burning emissions that are emitted each month/day/3-hr in Tg or Tg C.
|
||
!\\
|
||
!\\
|
||
! !INTERFACE:
|
||
!
|
||
SUBROUTINE GFED3_TOTAL_Tg
|
||
!
|
||
! !USES:
|
||
!
|
||
USE GRID_MOD, ONLY : GET_AREA_CM2
|
||
|
||
# include "CMN_SIZE" ! Size parameters
|
||
!
|
||
! !REVISION HISTORY:
|
||
! 07 Sep 2011 - P. Kasibhatla - Initial version, based on GFED2
|
||
! 07 Sep 2011 - R. Yantosca - Added ProTeX headers
|
||
!EOP
|
||
!------------------------------------------------------------------------------
|
||
!BOC
|
||
!
|
||
! !LOCAL VARIABLES:
|
||
!
|
||
INTEGER :: I, J, N
|
||
REAL*8 :: CONV, MOLWT, TOTAL
|
||
CHARACTER(LEN=4) :: NAME
|
||
CHARACTER(LEN=6) :: UNIT
|
||
|
||
!=================================================================
|
||
! GFED3_TOTAL_Tg begins here!
|
||
!=================================================================
|
||
|
||
! Loop over biomass species
|
||
DO N = 1, N_SPEC
|
||
|
||
! Initialize
|
||
NAME = GFED3_SPEC_NAME(N)
|
||
MOLWT = GFED3_SPEC_MOLWT(N)
|
||
UNIT = GFED3_SPEC_UNIT(N)
|
||
TOTAL = 0d0
|
||
|
||
! Loop over latitudes
|
||
DO J = 1, JJPAR
|
||
|
||
! Convert to [Tg/gfed-period] (or [Tg C/gfed-period] for HC's)
|
||
CONV = GET_AREA_CM2( J ) * ( MOLWT / 6.023d23 ) * 1d-9
|
||
|
||
! Loop over longitudes
|
||
DO I = 1, IIPAR
|
||
TOTAL = TOTAL + ( BIOMASS_MODEL(I,J,N) * CONV )
|
||
ENDDO
|
||
ENDDO
|
||
|
||
! Write totals
|
||
WRITE( 6, 110 ) NAME, TOTAL, UNIT
|
||
110 FORMAT( 'Sum Biomass ', a4, 1x, ': ', e12.5, 1x, a6 )
|
||
ENDDO
|
||
|
||
END SUBROUTINE GFED3_TOTAL_Tg
|
||
!EOC
|
||
!------------------------------------------------------------------------------
|
||
! Harvard University Atmospheric Chemistry Modeling Group !
|
||
!------------------------------------------------------------------------------
|
||
!BOP
|
||
!
|
||
! !IROUTINE: init_gfed3_biomass
|
||
!
|
||
! !DESCRIPTION: Subroutine INIT\_GFED3\_BIOMASS allocates all module arrays.
|
||
! It also reads the emission factors at the start of a GEOS-Chem
|
||
! simulation.
|
||
!\\
|
||
!\\
|
||
! !INTERFACE:
|
||
!
|
||
SUBROUTINE INIT_GFED3_BIOMASS
|
||
!
|
||
! !USES:
|
||
!
|
||
USE DIRECTORY_MOD, ONLY : DATA_DIR_NATIVE => DATA_DIR_1x1
|
||
USE ERROR_MOD, ONLY : ALLOC_ERR
|
||
USE FILE_MOD, ONLY : IOERROR
|
||
USE FILE_MOD, ONLY : IU_FILE
|
||
USE LOGICAL_MOD, ONLY : LDICARB
|
||
USE LOGICAL_MOD, ONLY : LDAYBB3
|
||
USE LOGICAL_MOD, ONLY : L3HRBB3
|
||
|
||
# include "CMN_SIZE" ! Size parameters
|
||
|
||
!
|
||
! !REVISION HISTORY:
|
||
! 07 Sep 2011 - P. Kasibhatla - Initial version, based on GFED2
|
||
! 07 Sep 2011 - R. Yantosca - Added ProTeX headers
|
||
!EOP
|
||
!------------------------------------------------------------------------------
|
||
!BOC
|
||
!
|
||
! !LOCAL VARIABLES:
|
||
!
|
||
INTEGER :: AS, IOS, M, N, NDUM
|
||
REAL*4 :: ARRAY_LANDMAP(IGFED3,JGFED3,1)
|
||
CHARACTER(LEN=255) :: FILENAME
|
||
|
||
!=================================================================
|
||
! INIT_GFED3_BIOMASS begins here!
|
||
!=================================================================
|
||
|
||
! Allocate array to hold GFED3 grid box lon edges
|
||
ALLOCATE( XEDGE_GFED3( IGFED3+1 ), STAT=AS )
|
||
IF ( AS /= 0 ) CALL ALLOC_ERR( 'XEDGE_GFED3' )
|
||
XEDGE_GFED3 = 0.d0
|
||
|
||
! Allocate array to hold GFED3 grid box lat edges
|
||
ALLOCATE( YEDGE_GFED3( JGFED3+1 ), STAT=AS )
|
||
IF ( AS /= 0 ) CALL ALLOC_ERR( 'YEDGE_GFED3' )
|
||
YEDGE_GFED3 = 0.d0
|
||
|
||
! Allocate array to hold GEOS-Chem grid box lon edges
|
||
ALLOCATE( XEDGE_MODELG( IIIPAR0+1 ), STAT=AS )
|
||
IF ( AS /= 0 ) CALL ALLOC_ERR( 'XEDGE_MODELG' )
|
||
XEDGE_MODELG = 0.d0
|
||
|
||
! Allocate array to hold GEOS-Chem grid box lat edges
|
||
ALLOCATE( YEDGE_MODELG( JJJPAR0+1 ), STAT=AS )
|
||
IF ( AS /= 0 ) CALL ALLOC_ERR( 'YEDGE_MODELG' )
|
||
YEDGE_MODELG = 0.d0
|
||
|
||
! Allocate array to hold GFED3 species emissions on model grid
|
||
ALLOCATE( BIOMASS_MODEL( IIPAR, JJPAR, N_SPEC ), STAT=AS )
|
||
IF ( AS /= 0 ) CALL ALLOC_ERR( 'BIOMASS_MODEL' )
|
||
BIOMASS_MODEL = 0d0
|
||
|
||
! Allocate array to hold monthly GFED3 DM burnt GFED3 grid
|
||
ALLOCATE( DM_GFED3_MON( IGFED3, JGFED3, N_SPEC ), STAT=AS )
|
||
IF ( AS /= 0 ) CALL ALLOC_ERR( 'DM_GFED3_MON' )
|
||
DM_GFED3_MON = 0d0
|
||
|
||
! Allocate array to hold daily GFED3 DM burnt GFED3 grid
|
||
IF ( LDAYBB3 ) THEN
|
||
ALLOCATE( DM_GFED3_DAY( IGFED3, JGFED3, N_SPEC ), STAT=AS )
|
||
IF ( AS /= 0 ) CALL ALLOC_ERR( 'DM_GFED3_DAY' )
|
||
DM_GFED3_DAY = 0d0
|
||
ENDIF
|
||
|
||
! Allocate array to hold 3hourly fractions on GFED3 grid
|
||
IF ( L3HRBB3 ) THEN
|
||
ALLOCATE( FR_GFED3_3HR( IGFED3,JGFED3, 8 ), STAT=AS )
|
||
IF ( AS /= 0 ) CALL ALLOC_ERR( 'FR_GFED3_3HR' )
|
||
FR_GFED3_3HR = 0d0
|
||
ENDIF
|
||
|
||
! Allocate array for emission factors
|
||
ALLOCATE( GFED3_EMFAC( N_SPEC, N_EMFAC ), STAT=AS )
|
||
IF ( AS /= 0 ) CALL ALLOC_ERR( 'GFED3_EMFAC' )
|
||
GFED3_EMFAC = 0d0
|
||
|
||
! Allocate array for species molecular weight
|
||
ALLOCATE( GFED3_SPEC_MOLWT( N_SPEC ), STAT=AS )
|
||
IF ( AS /= 0 ) CALL ALLOC_ERR( 'GFED3_SPEC_MOLWT' )
|
||
GFED3_SPEC_MOLWT = 0d0
|
||
|
||
! Allocate array for species name
|
||
ALLOCATE( GFED3_SPEC_NAME( N_SPEC ), STAT=AS )
|
||
IF ( AS /= 0 ) CALL ALLOC_ERR( 'GFED3_SPEC_NAME' )
|
||
GFED3_SPEC_NAME = ''
|
||
|
||
! Allocate array for GFED3 biomass buning species mass units
|
||
ALLOCATE( GFED3_SPEC_UNIT( N_SPEC ), STAT=AS )
|
||
IF ( AS /= 0 ) CALL ALLOC_ERR( 'GFED3_SPEC_UNIT' )
|
||
GFED3_SPEC_UNIT = ''
|
||
|
||
! Allocate array for vegetation map
|
||
ALLOCATE( HUMTROP_GFED3( IGFED3, JGFED3 ), STAT=AS )
|
||
IF ( AS /= 0 ) CALL ALLOC_ERR( 'HUMTROP_GFED3' )
|
||
|
||
!IDBs are now the same as the ones in TRACERID AND BIOMASS_MOD
|
||
!BIOSAVE INDEX IS THE LOCATION OF THE EMISSION IN THE GFED FILE
|
||
!(fp)
|
||
ALLOCATE( BIO_SAVE( N_SPEC ), STAT=AS )
|
||
IF ( AS /= 0 ) CALL ALLOC_ERR( 'BIO_SAVE' )
|
||
BIO_SAVE = 0
|
||
|
||
! Set default values for module variables
|
||
T3HR = -1
|
||
|
||
!=================================================================
|
||
! Read emission factors (which convert from kg DM to
|
||
! either [molec species] or [atoms C]) from bpch file
|
||
!=================================================================
|
||
|
||
! File name
|
||
FILENAME = TRIM( DATA_DIR_NATIVE) //
|
||
& 'GFED3_201212/GFED3_emission_factors.txt'
|
||
|
||
Print*, FILENAME
|
||
|
||
! Open emission factor file (ASCII format)
|
||
OPEN( IU_FILE, FILE=TRIM( FILENAME ), STATUS='OLD', IOSTAT=IOS )
|
||
IF ( IOS /= 0 ) CALL IOERROR( IOS, IU_FILE, 'init_gfed3:1' )
|
||
|
||
! Skip header lines
|
||
DO N = 1, 9
|
||
READ( IU_FILE, *, IOSTAT=IOS )
|
||
IF ( IOS /= 0 ) CALL IOERROR( IOS, IU_FILE, 'init_gfed3:2' )
|
||
ENDDO
|
||
|
||
! Read emission factors for each species
|
||
DO N = 1, N_SPEC
|
||
READ( IU_FILE, 100, IOSTAT=IOS )
|
||
& NDUM, GFED3_SPEC_NAME(N), ( GFED3_EMFAC(N,M), M=1,N_EMFAC )
|
||
IF ( IOS /= 0 ) CALL IOERROR( IOS, IU_FILE, 'init_gfed3:3' )
|
||
WRITE(6,100)NDUM,GFED3_SPEC_NAME(N),(GFED3_EMFAC(N,M),M=1,N_EMFAC)
|
||
ENDDO
|
||
|
||
! FORMAT string
|
||
100 FORMAT( 1x, i2, 1x, a4, 6(3x,es14.6) )
|
||
|
||
! Close file
|
||
CLOSE( IU_FILE )
|
||
|
||
!=================================================================
|
||
! Read GFED humid tropical forest map from bpch file
|
||
! This is used to assign emission factors for 'deforestation'
|
||
! 'Deforestation' occur outside of humid tropical forest
|
||
! is assigned a 'woodlands' emission factor'
|
||
!
|
||
! Values: 1 = humid tropical forest
|
||
! 0 = other
|
||
!=================================================================
|
||
|
||
! File name
|
||
FILENAME = TRIM( DATA_DIR_NATIVE ) //
|
||
& 'GFED3_201212/GFED3_humtropmap'
|
||
|
||
! Read GFED3 veg map
|
||
CALL READ_BPCH2_GFED3( FILENAME, 'LANDMAP', 1,
|
||
& 0d0, IGFED3, JGFED3,
|
||
& 1, ARRAY_LANDMAP, QUIET=.TRUE. )
|
||
|
||
! Cast from REAL*4 to INTEGER
|
||
HUMTROP_GFED3(:,:) = ARRAY_LANDMAP(:,:,1)
|
||
|
||
!=================================================================
|
||
! Define local ID flags and arrays for the names, units,
|
||
! and molecular weights of the GFED3 biomass species
|
||
!=================================================================
|
||
|
||
! Initialize
|
||
IDBNOx = 0
|
||
IDBCO = 0
|
||
IDBALK4 = 0
|
||
IDBACET = 0
|
||
IDBMEK = 0
|
||
IDBALD2 = 0
|
||
IDBPRPE = 0
|
||
IDBC3H8 = 0
|
||
IDBCH2O = 0
|
||
IDBC2H6 = 0
|
||
IDBBC = 0
|
||
IDBOC = 0
|
||
IDBSO2 = 0
|
||
IDBNH3 = 0
|
||
IDBCO2 = 0
|
||
IDBGLYX = 0
|
||
IDBMGLY = 0
|
||
IDBBENZ = 0
|
||
IDBTOLU = 0
|
||
IDBXYLE = 0
|
||
IDBC2H4 = 0
|
||
IDBC2H2 = 0
|
||
IDBGLYC = 0
|
||
IDBHAC = 0
|
||
IDBCH4 = 0
|
||
|
||
! Save correspondance between GFED3 species order (N) and
|
||
! species order of the simulation (IDBxxxs).(ccc, 2/4/10)
|
||
! and also initialize arrays for mol wts and units
|
||
DO N = 1, N_SPEC
|
||
SELECT CASE ( TRIM( GFED3_SPEC_NAME(N) ) )
|
||
CASE( 'NOx' )
|
||
IDBNOx = N
|
||
GFED3_SPEC_MOLWT(N) = 14d-3
|
||
GFED3_SPEC_UNIT(N) = '[Tg N]'
|
||
CASE( 'CO' )
|
||
IDBCO = N
|
||
GFED3_SPEC_MOLWT(N) = 28d-3
|
||
GFED3_SPEC_UNIT(N) = '[Tg ]'
|
||
CASE( 'ALK4' )
|
||
IDBALK4 = N
|
||
GFED3_SPEC_MOLWT(N) = 12d-3
|
||
GFED3_SPEC_UNIT(N) = '[Tg C]'
|
||
CASE( 'ACET' )
|
||
IDBACET = N
|
||
GFED3_SPEC_MOLWT(N) = 12d-3
|
||
GFED3_SPEC_UNIT(N) = '[Tg C]'
|
||
CASE( 'MEK' )
|
||
IDBMEK = N
|
||
GFED3_SPEC_MOLWT(N) = 12d-3
|
||
GFED3_SPEC_UNIT(N) = '[Tg C]'
|
||
CASE( 'ALD2' )
|
||
IDBALD2 = N
|
||
GFED3_SPEC_MOLWT(N) = 12d-3
|
||
GFED3_SPEC_UNIT(N) = '[Tg C]'
|
||
CASE( 'PRPE' )
|
||
IDBPRPE = N
|
||
GFED3_SPEC_MOLWT(N) = 12d-3
|
||
GFED3_SPEC_UNIT(N) = '[Tg C]'
|
||
CASE( 'C3H8' )
|
||
IDBC3H8 = N
|
||
GFED3_SPEC_MOLWT(N) = 12d-3
|
||
GFED3_SPEC_UNIT(N) = '[Tg C]'
|
||
CASE( 'CH2O' )
|
||
IDBCH2O = N
|
||
GFED3_SPEC_MOLWT(N) = 30d-3
|
||
GFED3_SPEC_UNIT(N) = '[Tg ]'
|
||
CASE( 'C2H6' )
|
||
IDBC2H6 = N
|
||
GFED3_SPEC_MOLWT(N) = 12d-3
|
||
GFED3_SPEC_UNIT(N) = '[Tg C]'
|
||
CASE( 'SO2' )
|
||
IDBSO2 = N
|
||
GFED3_SPEC_MOLWT(N) = 64d-3
|
||
GFED3_SPEC_UNIT(N) = '[Tg ]'
|
||
CASE( 'NH3' )
|
||
IDBNH3 = N
|
||
GFED3_SPEC_MOLWT(N) = 17d-3
|
||
GFED3_SPEC_UNIT(N) = '[Tg ]'
|
||
CASE( 'BC' )
|
||
IDBBC = N
|
||
GFED3_SPEC_MOLWT(N) = 12d-3
|
||
GFED3_SPEC_UNIT(N) = '[Tg C]'
|
||
CASE( 'OC' )
|
||
IDBOC = N
|
||
GFED3_SPEC_MOLWT(N) = 12d-3
|
||
GFED3_SPEC_UNIT(N) = '[Tg C]'
|
||
CASE( 'GLYX' )
|
||
IDBGLYX = N
|
||
GFED3_SPEC_MOLWT(N) = 58d-3
|
||
GFED3_SPEC_UNIT(N) = '[Tg ]'
|
||
CASE( 'MGLY' )
|
||
IDBMGLY = N
|
||
GFED3_SPEC_MOLWT(N) = 72d-3
|
||
GFED3_SPEC_UNIT(N) = '[Tg ]'
|
||
CASE( 'BENZ' )
|
||
IDBBENZ = N
|
||
GFED3_SPEC_MOLWT(N) = 12d-3
|
||
GFED3_SPEC_UNIT(N) = '[Tg C]'
|
||
CASE( 'TOLU' )
|
||
IDBTOLU = N
|
||
GFED3_SPEC_MOLWT(N) = 12d-3
|
||
GFED3_SPEC_UNIT(N) = '[Tg C]'
|
||
CASE( 'XYLE' )
|
||
IDBXYLE = N
|
||
GFED3_SPEC_MOLWT(N) = 12d-3
|
||
GFED3_SPEC_UNIT(N) = '[Tg C]'
|
||
CASE( 'C2H4' )
|
||
IDBC2H4 = N
|
||
GFED3_SPEC_MOLWT(N) = 12d-3
|
||
GFED3_SPEC_UNIT(N) = '[Tg C]'
|
||
CASE( 'C2H2' )
|
||
IDBC2H2 = N
|
||
GFED3_SPEC_MOLWT(N) = 12d-3
|
||
GFED3_SPEC_UNIT(N) = '[Tg C]'
|
||
CASE( 'GLYC' )
|
||
IDBGLYC = N
|
||
GFED3_SPEC_MOLWT(N) = 60d-3
|
||
GFED3_SPEC_UNIT(N) = '[Tg ]'
|
||
CASE( 'HAC' )
|
||
IDBHAC = N
|
||
GFED3_SPEC_MOLWT(N) = 74d-3
|
||
GFED3_SPEC_UNIT(N) = '[Tg ]'
|
||
CASE( 'CO2' )
|
||
IDBCO2 = N
|
||
GFED3_SPEC_MOLWT(N) = 44d-3
|
||
GFED3_SPEC_UNIT(N) = '[Tg ]'
|
||
CASE( 'CH4' )
|
||
IDBCH4 = N
|
||
GFED3_SPEC_MOLWT(N) = 16d-3
|
||
GFED3_SPEC_UNIT(N) = '[Tg ]'
|
||
CASE DEFAULT
|
||
! Nothing
|
||
|
||
WRITE(*,*) 'NAME',TRIM( GFED3_SPEC_NAME(N) )
|
||
END SELECT
|
||
ENDDO
|
||
|
||
END SUBROUTINE INIT_GFED3_BIOMASS
|
||
!EOC
|
||
!------------------------------------------------------------------------------
|
||
! Harvard University Atmospheric Chemistry Modeling Group !
|
||
!------------------------------------------------------------------------------
|
||
!BOP
|
||
!
|
||
! !IROUTINE: rearrange_biom
|
||
!
|
||
! !DESCRIPTION: Subroutine REARRANGE\_BIOM takes GFED3 emissions (which have
|
||
! their own, unique ID numbers and associates them with the IDBxxxs of
|
||
! tracerid\_mod.F.
|
||
!\\
|
||
!\\
|
||
! !INTERFACE:
|
||
!
|
||
SUBROUTINE REARRANGE_BIOM( BIOM_OUT, BIOM_OUTM )
|
||
|
||
!
|
||
! !USES:
|
||
!
|
||
# include "CMN_SIZE" ! Size parameters
|
||
!
|
||
! !INPUT PARAMETERS:
|
||
!
|
||
REAL*8, INTENT(IN) :: BIOM_OUT (IIPAR,JJPAR,N_SPEC)
|
||
!
|
||
! !OUTPUT PARAMETERS:
|
||
!
|
||
REAL*8, INTENT(OUT) :: BIOM_OUTM(IIPAR,JJPAR,N_SPEC) !+1 from CO2
|
||
!
|
||
! !REVISION HISTORY:
|
||
! 07 Sep 2011 - P. Kasibhatla - Initial version, based on GFED2
|
||
! 07 Sep 2011 - R. Yantosca - Added ProTeX headers
|
||
!EOP
|
||
!------------------------------------------------------------------------------
|
||
!BOC
|
||
!
|
||
! !LOCAL VARIABLES:
|
||
!
|
||
INTEGER :: N
|
||
|
||
! Loop over GFED3 species
|
||
DO N = 1, N_SPEC
|
||
|
||
! Save into array w/ proper ordering for GEOS-Chem
|
||
IF ( BIO_SAVE(N) .GT. 0 ) THEN
|
||
BIOM_OUTM(:,:,BIO_SAVE(N)) = BIOM_OUT(:,:,N)
|
||
ENDIF
|
||
|
||
ENDDO
|
||
|
||
END SUBROUTINE REARRANGE_BIOM
|
||
!EOC
|
||
!------------------------------------------------------------------------------
|
||
! Harvard University Atmospheric Chemistry Modeling Group !
|
||
!------------------------------------------------------------------------------
|
||
!BOP
|
||
!
|
||
! !IROUTINE: cleanup_gfed3_biomass
|
||
!
|
||
! !DESCRIPTION: Subroutine CLEANUP\_GFED3\_BIOMASS deallocates all module
|
||
! arrays.
|
||
!\\
|
||
!\\
|
||
! !INTERFACE:
|
||
!
|
||
SUBROUTINE CLEANUP_GFED3_BIOMASS
|
||
!
|
||
! !REVISION HISTORY:
|
||
! 07 Sep 2011 - P. Kasibhatla - Initial version, based on GFED2
|
||
! 07 Sep 2011 - R. Yantosca - Added ProTeX headers
|
||
!EOP
|
||
!------------------------------------------------------------------------------
|
||
!BOC
|
||
!=================================================================
|
||
! CLEANUP_GFED3_BIOMASS begins here!
|
||
!=================================================================
|
||
IF ( ALLOCATED( GFED3_EMFAC ) ) DEALLOCATE( GFED3_EMFAC )
|
||
IF ( ALLOCATED( GFED3_SPEC_MOLWT ) ) DEALLOCATE( GFED3_SPEC_MOLWT)
|
||
IF ( ALLOCATED( GFED3_SPEC_NAME ) ) DEALLOCATE( GFED3_SPEC_NAME )
|
||
IF ( ALLOCATED( HUMTROP_GFED3 ) ) DEALLOCATE( HUMTROP_GFED3 )
|
||
IF ( ALLOCATED( BIOMASS_MODEL ) ) DEALLOCATE( BIOMASS_MODEL )
|
||
|
||
END SUBROUTINE CLEANUP_GFED3_BIOMASS
|
||
!EOC
|
||
!------------------------------------------------------------------------------
|
||
! Prasad Kasibhatla, Duke University !
|
||
!------------------------------------------------------------------------------
|
||
!BOP
|
||
!
|
||
! !IROUTINE: GRID_GFED3
|
||
!
|
||
! !DESCRIPTION: Subroutine GRID\_GFED3 regrids 0.5x0.5 GFED3 emissions
|
||
! to GEOS-Chem grid at model resolutin - adapted from Map_A2A
|
||
! S-J Lin.
|
||
!\\
|
||
!\\
|
||
! !INTERFACE:
|
||
!
|
||
SUBROUTINE GRID_GFED3( im, jm, lon1, sin1, q1,
|
||
& in, jn, lon2, sin2, q2, ig, iv )
|
||
!
|
||
! !INPUT PARAMETERS:
|
||
!
|
||
|
||
! Longitude and Latitude dimensions of INPUT grid
|
||
INTEGER, INTENT(IN) :: im, jm
|
||
|
||
! Longitude and Latitude dimensions of OUTPUT grid
|
||
INTEGER, INTENT(IN) :: in, jn
|
||
|
||
! IG=0: pole to pole;
|
||
! IG=1 J=1 is half-dy north of south pole
|
||
INTEGER, INTENT(IN) :: ig
|
||
|
||
! IV=0: Regrid scalar quantity
|
||
! IV=1: Regrid vector quantity
|
||
INTEGER, INTENT(IN) :: iv
|
||
|
||
! Longitude edges (degrees) of INPUT and OUTPUT grids
|
||
REAL*8, INTENT(IN) :: lon1(im+1), lon2(in+1)
|
||
|
||
! Sine of Latitude Edges (radians) of INPUT and OUTPUT grids
|
||
REAL*8, INTENT(IN) :: sin1(jm+1), sin2(jn+1)
|
||
|
||
! Quantity on INPUT grid
|
||
REAL*4, INTENT(IN) :: q1(im,jm)
|
||
!
|
||
! !OUTPUT PARAMETERS:
|
||
|
||
! Regridded quantity on OUTPUT grid
|
||
REAL*4, INTENT(OUT) :: q2(in,jn)
|
||
!
|
||
! !AUTHOR:
|
||
! Original Map_A2A subroutine by S-J Lin (GSFC)
|
||
! Adapted by Prasad Kasibhatla (Duke University)
|
||
!
|
||
! !REVISION HISTORY:
|
||
! 06 Mar 2012 - Prasad Kasibhatla - added to code
|
||
!EOP
|
||
!------------------------------------------------------------------------------
|
||
!BOC
|
||
!
|
||
! !LOCAL VARIABLES:
|
||
!
|
||
INTEGER :: i,j,k
|
||
REAL*4 :: qtmp(in,jm)
|
||
|
||
!===================================================================
|
||
! GRID_GFED3 begins here!
|
||
!
|
||
! Mapping in the E-W direction
|
||
!===================================================================
|
||
CALL XMAP_GFED3(im, jm-ig, lon1,
|
||
& q1(1,1+ig),in, lon2, qtmp(1,1+ig) )
|
||
|
||
!===================================================================
|
||
! Mapping in the N-S direction
|
||
!===================================================================
|
||
CALL YMAP_GFED3(in, jm, sin1, qtmp(1,1+ig), jn, sin2,
|
||
& q2(1,1+ig), ig, iv)
|
||
|
||
END SUBROUTINE GRID_GFED3
|
||
!EOC
|
||
!------------------------------------------------------------------------------
|
||
! Prasad Kasibhatla - Duke University !
|
||
!------------------------------------------------------------------------------
|
||
!BOP
|
||
!
|
||
! !IROUTINE: YMAP_GFED3
|
||
!
|
||
! !DESCRIPTION: Subroutine YMAP_GFED3 performs area preserving mapping in N-S from
|
||
! an arbitrary resolution to another. NOTE - only works with lat-lon grids
|
||
!\\
|
||
!\\
|
||
! !INTERFACE:
|
||
!
|
||
SUBROUTINE YMAP_GFED3( im, jm, sin1, q1, jn, sin2, q2, ig, iv )
|
||
|
||
!
|
||
! !INPUT PARAMETERS:
|
||
!
|
||
|
||
! original E-W dimension
|
||
INTEGER, INTENT(IN) :: im
|
||
|
||
! original N-S dimension
|
||
INTEGER, INTENT(IN) :: jm
|
||
|
||
! Target N-S dimension
|
||
INTEGER, INTENT(IN) :: jn
|
||
|
||
! IG=0: scalars from SP to NP (D-grid v-wind is also IG=0)
|
||
! IG=1: D-grid u-wind
|
||
INTEGER, INTENT(IN) :: ig
|
||
|
||
! IV=0: scalar;
|
||
! IV=1: vector
|
||
INTEGER, INTENT(IN) :: iv
|
||
|
||
! Original southern edge of the cell sin(lat1)
|
||
REAL*8, INTENT(IN) :: sin1(jm+1-ig)
|
||
|
||
! Original data at center of the cell
|
||
REAL*4, INTENT(IN) :: q1(im,jm)
|
||
|
||
! Target cell's southern edge sin(lat2)
|
||
REAL*8, INTENT(IN) :: sin2(jn+1-ig)
|
||
!
|
||
! !OUTPUT PARAMETERS:
|
||
!
|
||
! Mapped data at the target resolution
|
||
REAL*4, INTENT(OUT) :: q2(im,jn)
|
||
!
|
||
! !REMARKS:
|
||
!
|
||
! sin1 (1) = -1 must be south pole; sin1(jm+1)=1 must be N pole.
|
||
!
|
||
! sin1(1) < sin1(2) < sin1(3) < ... < sin1(jm) < sin1(jm+1)
|
||
! sin2(1) < sin2(2) < sin2(3) < ... < sin2(jn) < sin2(jn+1)!
|
||
!
|
||
! !AUTHOR:
|
||
! Developer: Prasad Kasibhatla
|
||
! March 6, 2012
|
||
!EOP
|
||
!------------------------------------------------------------------------------
|
||
!BOC
|
||
!
|
||
! !LOCAL VARIABLES:
|
||
!
|
||
INTEGER :: i, j0, m, mm, j
|
||
REAL*8 :: dy1(jm)
|
||
REAL*8 :: dy
|
||
REAL*4 :: qsum, sum
|
||
|
||
! YMAP begins here!
|
||
do j=1,jm-ig
|
||
dy1(j) = sin1(j+1) - sin1(j)
|
||
enddo
|
||
|
||
!===============================================================
|
||
! Area preserving mapping
|
||
!===============================================================
|
||
|
||
do 1000 i=1,im
|
||
j0 = 1
|
||
do 555 j=1,jn-ig
|
||
do 100 m=j0,jm-ig
|
||
|
||
!=========================================================
|
||
! locate the southern edge: sin2(i)
|
||
!=========================================================
|
||
if(sin2(j) .ge. sin1(m) .and. sin2(j) .le. sin1(m+1)) then
|
||
|
||
if(sin2(j+1) .le. sin1(m+1)) then
|
||
|
||
! entire new cell is within the original cell
|
||
q2(i,j)=q1(i,m)
|
||
j0 = m
|
||
goto 555
|
||
else
|
||
|
||
! South most fractional area
|
||
qsum=(sin1(m+1)-sin2(j))*q1(i,m)
|
||
|
||
do mm=m+1,jm-ig
|
||
|
||
! locate the northern edge: sin2(j+1)
|
||
if(sin2(j+1) .gt. sin1(mm+1) ) then
|
||
|
||
! Whole layer
|
||
qsum = qsum + dy1(mm)*q1(i,mm)
|
||
else
|
||
|
||
! North most fractional area
|
||
dy = sin2(j+1)-sin1(mm)
|
||
qsum=qsum+dy*q1(i,mm)
|
||
j0 = mm
|
||
goto 123
|
||
endif
|
||
enddo
|
||
goto 123
|
||
endif
|
||
endif
|
||
100 continue
|
||
123 q2(i,j) = qsum / ( sin2(j+1) - sin2(j) )
|
||
555 continue
|
||
1000 continue
|
||
|
||
!===================================================================
|
||
! Final processing for poles
|
||
!===================================================================
|
||
if ( ig .eq. 0 .and. iv .eq. 0 ) then
|
||
|
||
! South pole
|
||
sum = 0.
|
||
do i=1,im
|
||
sum = sum + q2(i,1)
|
||
enddo
|
||
|
||
sum = sum / float(im)
|
||
do i=1,im
|
||
q2(i,1) = sum
|
||
enddo
|
||
|
||
! North pole:
|
||
sum = 0.
|
||
do i=1,im
|
||
sum = sum + q2(i,jn)
|
||
enddo
|
||
|
||
sum = sum / float(im)
|
||
do i=1,im
|
||
q2(i,jn) = sum
|
||
enddo
|
||
|
||
endif
|
||
|
||
END SUBROUTINE YMAP_GFED3
|
||
!EOC
|
||
!------------------------------------------------------------------------------
|
||
! Prasad Kasibhatla, Duke University !
|
||
!------------------------------------------------------------------------------
|
||
!BOP
|
||
!
|
||
! !IROUTINE: XMAP_GFED3
|
||
!
|
||
! !DESCRIPTION: Subroutine Xmap performs area preserving mapping in E-W
|
||
! from an arbitrary resolution to another. Periodic domain will be assumed,
|
||
! i.e., the eastern wall bounding cell im is $lon1(im+1) = lon1(1)$;
|
||
! Note the equal sign is true geophysically.
|
||
!\\
|
||
!\\
|
||
! !INTERFACE:
|
||
!
|
||
SUBROUTINE XMAP_GFED3( im, jm, lon1, q1, in, lon2, q2 )
|
||
!
|
||
! !INPUT PARAMETERS:
|
||
!
|
||
! Original E-W dimension
|
||
INTEGER, INTENT(IN) :: im
|
||
|
||
! Target E-W dimension
|
||
INTEGER, INTENT(IN) :: in
|
||
|
||
! Original N-S dimension
|
||
INTEGER, INTENT(IN) :: jm
|
||
|
||
! Original western edge of the cell
|
||
REAL*8, INTENT(IN) :: lon1(im+1)
|
||
|
||
! Original data at center of the cell
|
||
REAL*4, INTENT(IN) :: q1(im,jm)
|
||
|
||
! Target cell's western edge
|
||
REAL*8, INTENT(IN) :: lon2(in+1)
|
||
!
|
||
! !OUTPUT PARAMETERS:
|
||
!
|
||
! Mapped data at the target resolution
|
||
REAL*4, INTENT(OUT) :: q2(in,jm)
|
||
!
|
||
! !REMARKS:
|
||
! lon1(1) < lon1(2) < lon1(3) < ... < lon1(im) < lon1(im+1)
|
||
! lon2(1) < lon2(2) < lon2(3) < ... < lon2(in) < lon2(in+1)
|
||
!
|
||
! !AUTHOR:
|
||
! Developer: Prasad Kasibhatla
|
||
! March 6, 2012
|
||
!EOP
|
||
!------------------------------------------------------------------------------
|
||
!BOC
|
||
!
|
||
! !LOCAL VARIABLES:
|
||
!
|
||
INTEGER :: i1, i2, i, i0, m, mm, j
|
||
REAL*4 :: qtmp(-im:im+im)
|
||
REAL*8 :: x1(-im:im+im+1)
|
||
REAL*8 :: dx1(-im:im+im)
|
||
REAL*8 :: dx
|
||
REAL*4 :: qsum
|
||
LOGICAL :: found
|
||
!
|
||
|
||
! XMAP begins here!
|
||
do i=1,im+1
|
||
x1(i) = lon1(i)
|
||
enddo
|
||
|
||
do i=1,im
|
||
dx1(i) = x1(i+1) - x1(i)
|
||
enddo
|
||
|
||
!===================================================================
|
||
! check to see if ghosting is necessary
|
||
! Western edge:
|
||
!===================================================================
|
||
found = .false.
|
||
i1 = 1
|
||
do while ( .not. found )
|
||
if( lon2(1) .ge. x1(i1) ) then
|
||
found = .true.
|
||
else
|
||
i1 = i1 - 1
|
||
if (i1 .lt. -im) then
|
||
write(6,*) 'failed in xmap'
|
||
stop
|
||
else
|
||
x1(i1) = x1(i1+1) - dx1(im+i1)
|
||
dx1(i1) = dx1(im+i1)
|
||
endif
|
||
endif
|
||
enddo
|
||
|
||
!===================================================================
|
||
! Eastern edge:
|
||
!===================================================================
|
||
found = .false.
|
||
i2 = im+1
|
||
do while ( .not. found )
|
||
if( lon2(in+1) .le. x1(i2) ) then
|
||
found = .true.
|
||
else
|
||
i2 = i2 + 1
|
||
if (i2 .gt. 2*im) then
|
||
write(6,*) 'failed in xmap'
|
||
stop
|
||
else
|
||
dx1(i2-1) = dx1(i2-1-im)
|
||
x1(i2) = x1(i2-1) + dx1(i2-1)
|
||
endif
|
||
endif
|
||
enddo
|
||
|
||
do 1000 j=1,jm
|
||
|
||
!=================================================================
|
||
! Area preserving mapping
|
||
!================================================================
|
||
|
||
qtmp(0)=q1(im,j)
|
||
do i=1,im
|
||
qtmp(i)=q1(i,j)
|
||
enddo
|
||
qtmp(im+1)=q1(1,j)
|
||
|
||
! check to see if ghosting is necessary
|
||
! Western edge
|
||
if ( i1 .le. 0 ) then
|
||
do i=i1,0
|
||
qtmp(i) = qtmp(im+i)
|
||
enddo
|
||
endif
|
||
|
||
! Eastern edge:
|
||
if ( i2 .gt. im+1 ) then
|
||
do i=im+1,i2-1
|
||
qtmp(i) = qtmp(i-im)
|
||
enddo
|
||
endif
|
||
|
||
i0 = i1
|
||
|
||
do 555 i=1,in
|
||
do 100 m=i0,i2-1
|
||
|
||
!=============================================================
|
||
! locate the western edge: lon2(i)
|
||
!=============================================================
|
||
if(lon2(i) .ge. x1(m) .and. lon2(i) .le. x1(m+1)) then
|
||
|
||
if(lon2(i+1) .le. x1(m+1)) then
|
||
|
||
! entire new grid is within the original grid
|
||
q2(i,j)=qtmp(m)
|
||
i0 = m
|
||
goto 555
|
||
else
|
||
|
||
! Left most fractional area
|
||
qsum=(x1(m+1)-lon2(i))*qtmp(m)
|
||
do mm=m+1,i2-1
|
||
|
||
! locate the eastern edge: lon2(i+1)
|
||
if(lon2(i+1) .gt. x1(mm+1) ) then
|
||
|
||
! Whole layer
|
||
qsum = qsum + dx1(mm)*qtmp(mm)
|
||
|
||
else
|
||
! Right most fractional area
|
||
dx = lon2(i+1)-x1(mm)
|
||
qsum=qsum+dx*qtmp(mm)
|
||
i0 = mm
|
||
goto 123
|
||
endif
|
||
enddo
|
||
goto 123
|
||
endif
|
||
endif
|
||
100 continue
|
||
123 q2(i,j) = qsum / ( lon2(i+1) - lon2(i) )
|
||
555 continue
|
||
1000 continue
|
||
|
||
END SUBROUTINE XMAP_GFED3
|
||
!EOC
|
||
!------------------------------------------------------------------------------
|
||
! Prasad Kasibhatla - Duke University !
|
||
!------------------------------------------------------------------------------
|
||
!BOP
|
||
!
|
||
! !IROUTINE: read_bpch2_gfed3
|
||
!
|
||
! !DESCRIPTION: Subroutine READ\_BPCH2\_GFED3 reads GFED3 DM burnt and
|
||
! and humid tropical forest map files
|
||
!\\
|
||
!\\
|
||
! !INTERFACE:
|
||
!
|
||
SUBROUTINE READ_BPCH2_GFED3( FILENAME, CATEGORY_IN, TRACER_IN,
|
||
& TAU0_IN, IX, JX,
|
||
& LX, ARRAY, QUIET )
|
||
!
|
||
! !USES:
|
||
!
|
||
USE ERROR_MOD, ONLY : ERROR_STOP
|
||
USE FILE_MOD, ONLY : IU_FILE, IOERROR
|
||
USE BPCH2_MOD, ONLY : OPEN_BPCH2_FOR_READ
|
||
USE TIME_MOD, ONLY : GET_NYMD, GET_NHMS
|
||
|
||
# include "define.h"
|
||
!
|
||
! !INPUT PARAMETERS:
|
||
!
|
||
CHARACTER(LEN=*), INTENT(IN) :: FILENAME ! Bpch file to read
|
||
CHARACTER(LEN=*), INTENT(IN) :: CATEGORY_IN ! Diag. category name
|
||
INTEGER, INTENT(IN) :: TRACER_IN ! Tracer index #
|
||
REAL*8, INTENT(IN) :: TAU0_IN ! TAU timestamp
|
||
INTEGER, INTENT(IN) :: IX, JX, LX ! Dimensions of ARRAY
|
||
LOGICAL, OPTIONAL, INTENT(IN) :: QUIET ! Don't print output
|
||
!
|
||
! !OUTPUT PARAMETERS:
|
||
!
|
||
REAL*4, INTENT(OUT) :: ARRAY(IX,JX,LX) ! Data array from file
|
||
!
|
||
! !REVISION HISTORY:
|
||
! (1 ) Adapted from READ_BPCH2 to facilitate reading of 0.5x0.5 GFED3 files (psk, 2/7/12)
|
||
!EOP
|
||
!------------------------------------------------------------------------------
|
||
!BOC
|
||
!
|
||
! !LOCAL VARIABLES:
|
||
!
|
||
LOGICAL :: FOUND, TMP_QUIET
|
||
INTEGER :: I, J, L, N, IOS, M
|
||
INTEGER :: I1, I2, J1, J2, L1, L2
|
||
CHARACTER(LEN=255) :: MSG
|
||
|
||
! Make TEMPARRAY big enough for GFED3 files - 0.5x0.5 lat-lon grid
|
||
REAL*4 :: TEMPARRAY_GFED3(720,360,1)
|
||
|
||
! For binary punch file, version 2.0
|
||
INTEGER :: NTRACER, NSKIP
|
||
INTEGER :: HALFPOLAR, CENTER180
|
||
INTEGER :: NI, NJ, NL, IT3H
|
||
INTEGER :: IFIRST, JFIRST, LFIRST
|
||
REAL*4 :: LONRES, LATRES
|
||
REAL*8 :: ZTAU0, ZTAU1
|
||
CHARACTER(LEN=20) :: MODELNAME
|
||
CHARACTER(LEN=40) :: CATEGORY
|
||
CHARACTER(LEN=40) :: UNIT
|
||
CHARACTER(LEN=40) :: RESERVED
|
||
|
||
!=================================================================
|
||
! READ_BPCH2_GFED3 begins here!
|
||
!
|
||
! Initialize some variables
|
||
!=================================================================
|
||
FOUND = .FALSE.
|
||
ARRAY(:,:,:) = 0e0
|
||
TEMPARRAY_GFED3(:,:,:) = 0e0
|
||
|
||
! Define a temporary variable for QUIET
|
||
IF ( PRESENT( QUIET ) ) THEN
|
||
TMP_QUIET = QUIET
|
||
ELSE
|
||
TMP_QUIET = .FALSE.
|
||
ENDIF
|
||
|
||
!=================================================================
|
||
! Open binary punch file and read top-of-file header.
|
||
! Do some error checking to make sure the file is the right format.
|
||
!=================================================================
|
||
CALL OPEN_BPCH2_FOR_READ( IU_FILE, FILENAME )
|
||
|
||
!=================================================================
|
||
! Read data from the binary punch file
|
||
!
|
||
! NOTE: IOS < 0 is end-of-file, IOS > 0 is error condition
|
||
!=================================================================
|
||
DO
|
||
READ( IU_FILE, IOSTAT=IOS )
|
||
& MODELNAME, LONRES, LATRES, HALFPOLAR, CENTER180
|
||
|
||
IF ( IOS < 0 ) EXIT
|
||
IF ( IOS > 0 ) CALL IOERROR( IOS, IU_FILE, 'read_bpch2:4' )
|
||
|
||
READ( IU_FILE, IOSTAT=IOS )
|
||
& CATEGORY, NTRACER, UNIT, ZTAU0, ZTAU1, RESERVED,
|
||
& NI, NJ, NL, IFIRST, JFIRST, LFIRST,
|
||
& NSKIP
|
||
|
||
IF ( IOS /= 0 ) CALL IOERROR( IOS, IU_FILE, 'read_bpch2:5' )
|
||
|
||
READ( IU_FILE, IOSTAT=IOS )
|
||
& ( ( ( TEMPARRAY_GFED3(I,J,L), I=1,NI ), J=1,NJ ), L=1,NL )
|
||
|
||
IF ( IOS /= 0 ) CALL IOERROR( IOS, IU_FILE, 'read_bpch2:6' )
|
||
|
||
! Test for a match
|
||
IF ( TRIM( CATEGORY_IN ) == TRIM( CATEGORY ) .and.
|
||
& TRACER_IN == NTRACER .and.
|
||
& TAU0_IN == ZTAU0 ) THEN
|
||
FOUND = .TRUE.
|
||
EXIT
|
||
ENDIF
|
||
|
||
ENDDO
|
||
|
||
IF ( FOUND ) THEN
|
||
|
||
I1 = IFIRST
|
||
J1 = JFIRST
|
||
L1 = LFIRST
|
||
|
||
|
||
I2 = NI + I1 - 1
|
||
J2 = NJ + J1 - 1
|
||
L2 = NL + L1 - 1
|
||
|
||
ARRAY( I1:I2, J1:J2, L1:L2 )
|
||
& = TEMPARRAY_GFED3( 1:NI, 1:NJ, 1:NL )
|
||
|
||
! Flag to decide whether or not we will echo info (bmy, 3/14/03)
|
||
IF ( .not. TMP_QUIET ) THEN
|
||
WRITE( 6, 100 ) ZTAU0, NTRACER
|
||
100 FORMAT( 'READ_BPCH2_GFED3: Found data for TAU = ', f10.2,
|
||
& ' and tracer # ', i6 )
|
||
ENDIF
|
||
|
||
ELSE
|
||
MSG = 'No matches found for file ' // TRIM( FILENAME ) // '!'
|
||
CALL ERROR_STOP( MSG, 'READ_BPCH2_GFED3 (bpch2_mod.f)!' )
|
||
ENDIF
|
||
|
||
!=================================================================
|
||
! Close file and quit
|
||
!=================================================================
|
||
CLOSE( IU_FILE )
|
||
|
||
! Return to calling program
|
||
END SUBROUTINE READ_BPCH2_GFED3
|
||
!EOC
|
||
|
||
END MODULE GFED3_BIOMASS_MOD
|