677 lines
20 KiB
Fortran
677 lines
20 KiB
Fortran
! $Id: bravo_mod.f,v 1.1 2009/06/09 21:51:53 daven Exp $
|
|
!------------------------------------------------------------------------------
|
|
! Harvard University Atmospheric Chemistry Modeling Group !
|
|
!------------------------------------------------------------------------------
|
|
!BOP
|
|
!
|
|
! !MODULE: BRAVO_MOD
|
|
!
|
|
! !DESCRIPTION: \subsection*{Overview}
|
|
! Module BRAVO\_MOD contains variables and routines to read the BRAVO
|
|
! Mexican anthropogenic emission inventory for NOx, CO, and SO2.
|
|
! (rjp, kfb, bmy, 6/22/06, 1/30/09)
|
|
!
|
|
! \subsection*{References}
|
|
! \begin{enumerate}
|
|
! \item Kuhns, H., M. Green, and Etyemezian, V, \emph{Big Bend Regional
|
|
! Aerosol and Visibility Observational (BRAVO) Study Emissions
|
|
! Inventory}, Desert Research Institute, 2003.
|
|
! \end{enumerate}
|
|
!
|
|
! !INTERFACE:
|
|
!
|
|
MODULE BRAVO_MOD
|
|
!
|
|
! !USES:
|
|
!
|
|
IMPLICIT NONE
|
|
PRIVATE
|
|
!
|
|
! !PUBLIC MEMBER FUNCTIONS:
|
|
!
|
|
PUBLIC :: CLEANUP_BRAVO
|
|
PUBLIC :: EMISS_BRAVO
|
|
PUBLIC :: GET_BRAVO_MASK
|
|
PUBLIC :: GET_BRAVO_ANTHRO
|
|
!
|
|
! !PRIVATE MEMBER FUNCTIONS:
|
|
!
|
|
PRIVATE :: BRAVO_SCALE_FUTURE
|
|
PRIVATE :: INIT_BRAVO
|
|
PRIVATE :: READ_BRAVO_MASK
|
|
!
|
|
! !REVISION HISTORY:
|
|
! (1 ) Now pass the unit string to DO_REGRID_G2G_1x1 (bmy, 8/9/06)
|
|
! (2 ) Now scale emissions using int-annual scale factors (amv, 08/24/07)
|
|
! (3 ) Now accounts for FSCLYR (phs, 3/17/08)
|
|
! (4 ) Added ProTeX headers (bmy, 1/30/09)
|
|
!EOP
|
|
!------------------------------------------------------------------------------
|
|
!
|
|
! !PRIVATE DATA MEMBERS:
|
|
!
|
|
! Arrays
|
|
REAL*8, ALLOCATABLE :: BRAVO_MASK(:,:)
|
|
REAL*8, ALLOCATABLE :: BRAVO_NOx(:,:)
|
|
REAL*8, ALLOCATABLE :: BRAVO_CO(:,:)
|
|
REAL*8, ALLOCATABLE :: BRAVO_SO2(:,:)
|
|
|
|
CONTAINS
|
|
|
|
!------------------------------------------------------------------------------
|
|
! Harvard University Atmospheric Chemistry Modeling Group !
|
|
!------------------------------------------------------------------------------
|
|
!BOP
|
|
!
|
|
! !IROUTINE: GET_BRAVO_MASK
|
|
!
|
|
! !DESCRIPTION: Function GET\_BRAVO\_MASK returns the value of the Mexico
|
|
! mask for BRAVO emissions at grid box (I,J). MASK=1 if (I,J) is in the
|
|
! BRAVO Mexican region, or MASK=0 otherwise. (rjp, kfb, bmy, 6/22/06)
|
|
!\\
|
|
!\\
|
|
! !INTERFACE:
|
|
!
|
|
FUNCTION GET_BRAVO_MASK( I, J ) RESULT( MASK )
|
|
!
|
|
! !INPUT PARAMETERS:
|
|
!
|
|
INTEGER, INTENT(IN) :: I ! Longitude index
|
|
INTEGER, INTENT(IN) :: J ! Latitude index
|
|
!
|
|
! !RETURN VALUE:
|
|
!
|
|
REAL*8 :: MASK ! Returns the mask value @ (I,J)
|
|
!
|
|
! !REVISION HISTORY:
|
|
! 22 Jun 2006 - R. Yantosca - Initial version
|
|
!EOP
|
|
!------------------------------------------------------------------------------
|
|
!BOC
|
|
!=================================================================
|
|
! GET_BRAVO_MASK begins here!
|
|
!=================================================================
|
|
MASK = BRAVO_MASK(I,J)
|
|
|
|
! Return to calling program
|
|
END FUNCTION GET_BRAVO_MASK
|
|
!EOC
|
|
!------------------------------------------------------------------------------
|
|
! Harvard University Atmospheric Chemistry Modeling Group !
|
|
!------------------------------------------------------------------------------
|
|
!BOP
|
|
!
|
|
! !IROUTINE: GET_BRAVO_ANTHRO
|
|
!
|
|
! !DESCRIPTION: Function GET\_BRAVO\_ANTHRO returns the BRAVO emission
|
|
! for GEOS-Chem grid box (I,J) and tracer N. Units are [molec/cm2/s].
|
|
! (rjp, kfb, bmy, 6/22/06)
|
|
!\\
|
|
!\\
|
|
! !INTERFACE:
|
|
!
|
|
FUNCTION GET_BRAVO_ANTHRO( I, J, N ) RESULT( BRAVO )
|
|
!
|
|
! !USES:
|
|
!
|
|
USE TRACERID_MOD, ONLY : IDTNOX, IDTCO, IDTSO2
|
|
!
|
|
! !INPUT PARAMETERS:
|
|
!
|
|
INTEGER, INTENT(IN) :: I ! Longitude index
|
|
INTEGER, INTENT(IN) :: J ! Latitude index
|
|
INTEGER, INTENT(IN) :: N ! Tracer number
|
|
!
|
|
! RETURN VALUE:
|
|
!
|
|
REAL*8 :: BRAVO ! Returns emissions at (I,J)
|
|
!
|
|
! !REVISION HISTORY:
|
|
! (1 ) added SOx, SOx ship and NH3 emissions, plus optional kg/s output
|
|
! (amv, 06/2008)
|
|
! (2 ) Now returns ship emissions if requested (phs, 6/08)
|
|
! (3 ) Added checks to avoid calling unavailable ship emissions (phs, 6/08)
|
|
!EOP
|
|
!------------------------------------------------------------------------------
|
|
!BOC
|
|
!=================================================================
|
|
! GET_BRAVO_ANTHRO begins here!
|
|
!=================================================================
|
|
|
|
! NOx
|
|
IF ( N == IDTNOX ) THEN
|
|
BRAVO = BRAVO_NOx(I,J)
|
|
|
|
! CO
|
|
ELSE IF ( N == IDTCO ) THEN
|
|
BRAVO = BRAVO_CO(I,J)
|
|
|
|
! SO2
|
|
ELSE IF ( N == IDTSO2 ) THEN
|
|
BRAVO = BRAVO_SO2(I,J)
|
|
|
|
! Otherwise return a negative value to indicate
|
|
! that there are no BRAVO emissions for tracer N
|
|
ELSE
|
|
BRAVO = -1d0
|
|
|
|
ENDIF
|
|
|
|
! Return to calling program
|
|
END FUNCTION GET_BRAVO_ANTHRO
|
|
!EOC
|
|
!------------------------------------------------------------------------------
|
|
! Harvard University Atmospheric Chemistry Modeling Group !
|
|
!------------------------------------------------------------------------------
|
|
!BOP
|
|
!
|
|
! !IROUTINE: EMISS_BRAVO
|
|
!
|
|
! !DESCRIPTION: Subroutine EMISS\_BRAVO reads the BRAVO emission fields at 1x1
|
|
! resolution and regrids them to the current model resolution.
|
|
! (rjp, kfb, bmy, 6/22/06, 8/9/06)
|
|
!\\
|
|
!\\
|
|
! !INTERFACE:
|
|
!
|
|
SUBROUTINE EMISS_BRAVO
|
|
!
|
|
! !USES:
|
|
!
|
|
USE BPCH2_MOD, ONLY : GET_TAU0, READ_BPCH2
|
|
USE DIRECTORY_MOD, ONLY : DATA_DIR_1x1
|
|
USE LOGICAL_MOD, ONLY : LFUTURE
|
|
USE REGRID_1x1_MOD, ONLY : DO_REGRID_1x1, DO_REGRID_G2G_1x1
|
|
USE SCALE_ANTHRO_MOD, ONLY : GET_ANNUAL_SCALAR_1x1
|
|
USE TIME_MOD, ONLY : GET_YEAR
|
|
|
|
# include "CMN_SIZE" ! Size parameters
|
|
# include "CMN_O3" !
|
|
!
|
|
! !REVISION HISTORY:
|
|
! (1 ) Now pass the unit string to DO_REGRID_G2G_1x1 (bmy, 8/9/06)
|
|
!EOP
|
|
!------------------------------------------------------------------------------
|
|
!BOC
|
|
!
|
|
! !LOCAL VARIABLES:
|
|
!
|
|
LOGICAL, SAVE :: FIRST = .TRUE.
|
|
INTEGER :: SCALEYEAR
|
|
REAL*4 :: ARRAY(I1x1,J1x1-1,1)
|
|
REAL*8 :: GEN_1x1(I1x1,J1x1-1)
|
|
REAL*8 :: GEOS_1x1(I1x1,J1x1,1)
|
|
REAL*8 :: SC_1x1(I1x1,J1x1)
|
|
REAL*8 :: TAU0
|
|
CHARACTER(LEN=255) :: FILENAME
|
|
|
|
!=================================================================
|
|
! EMISS_BRAVO begins here!
|
|
!=================================================================
|
|
|
|
! First-time initialization
|
|
IF ( FIRST ) THEN
|
|
CALL INIT_BRAVO
|
|
FIRST = .FALSE.
|
|
ENDIF
|
|
|
|
!=================================================================
|
|
! Read data from disk
|
|
!=================================================================
|
|
|
|
! Use 1999 for BRAVO emission files (BASE YEAR)
|
|
TAU0 = GET_TAU0( 1, 1, 1999 )
|
|
|
|
! Get emissions year
|
|
IF ( FSCALYR < 0 ) THEN
|
|
SCALEYEAR = GET_YEAR()
|
|
ELSE
|
|
SCALEYEAR = FSCALYR
|
|
ENDIF
|
|
|
|
!---------------------
|
|
! Read and regrid NOx
|
|
!---------------------
|
|
|
|
! 1x1 file name
|
|
FILENAME = TRIM( DATA_DIR_1x1 ) //
|
|
& 'BRAVO_200607/BRAVO.NOx.generic.1x1'
|
|
|
|
! Echo info
|
|
WRITE( 6, 100 ) TRIM( FILENAME )
|
|
100 FORMAT( ' - EMISS_BRAVO: Reading ', a )
|
|
|
|
! Read NOx [molec/cm2/s] on GENERIC 1x1 GRID
|
|
CALL READ_BPCH2( FILENAME, 'ANTHSRCE', 1,
|
|
& TAU0, I1x1, J1x1-1,
|
|
& 1, ARRAY, QUIET=.TRUE. )
|
|
|
|
! Cast from REAL*4 to REAL*8
|
|
GEN_1x1(:,:) = ARRAY(:,:,1)
|
|
|
|
! Regrid NOx [molec/cm2/s] to GEOS 1x1 GRID
|
|
CALL DO_REGRID_G2G_1x1( 'molec/cm2/s', GEN_1x1, GEOS_1x1(:,:,1) )
|
|
|
|
! Get/Apply annual scalar factor (amv 08/21/2007)
|
|
CALL GET_ANNUAL_SCALAR_1x1( 71, 1999, SCALEYEAR, SC_1x1 )
|
|
GEOS_1x1(:,:,1) = GEOS_1x1(:,:,1) * SC_1x1(:,:)
|
|
|
|
! Regrid NOx [molec/cm2/s] to current model resolution
|
|
CALL DO_REGRID_1x1( 'molec/cm2/s', GEOS_1x1, BRAVO_NOx )
|
|
|
|
!---------------------
|
|
! Read and regrid CO
|
|
!---------------------
|
|
|
|
! 1x1 file name
|
|
FILENAME = TRIM( DATA_DIR_1x1 ) //
|
|
& 'BRAVO_200607/BRAVO.CO.generic.1x1'
|
|
|
|
! Echo info
|
|
WRITE( 6, 100 ) TRIM( FILENAME )
|
|
|
|
! Read CO [molec/cm2/s] on GENERIC 1x1 GRID
|
|
CALL READ_BPCH2( FILENAME, 'ANTHSRCE', 4,
|
|
& TAU0, I1x1, J1x1-1,
|
|
& 1, ARRAY, QUIET=.TRUE. )
|
|
|
|
! Cast from REAL*4 to REAL*8
|
|
GEN_1x1(:,:) = ARRAY(:,:,1)
|
|
|
|
! Regrid CO [molec/cm2/s] to GEOS 1x1 GRID
|
|
CALL DO_REGRID_G2G_1x1( 'molec/cm2/s', GEN_1x1, GEOS_1x1(:,:,1) )
|
|
|
|
! Get/Apply annual scalar factor (amv 08/21/2007)
|
|
CALL GET_ANNUAL_SCALAR_1x1( 72, 1999, SCALEYEAR, SC_1x1 )
|
|
GEOS_1x1(:,:,1) = GEOS_1x1(:,:,1) * SC_1x1(:,:)
|
|
|
|
! Regrid CO [molec/cm2/s] to current model resolution
|
|
CALL DO_REGRID_1x1( 'molec/cm2/s', GEOS_1x1, BRAVO_CO )
|
|
|
|
!---------------------
|
|
! Read and regrid SO2
|
|
!---------------------
|
|
|
|
! 1x1 file name
|
|
FILENAME = TRIM( DATA_DIR_1x1 ) //
|
|
& 'BRAVO_200607/BRAVO.SO2.generic.1x1'
|
|
|
|
! Echo info
|
|
WRITE( 6, 100 ) TRIM( FILENAME )
|
|
|
|
! Read SO2 [molec/cm2/s] on GENERIC 1x1 GRID
|
|
CALL READ_BPCH2( FILENAME, 'ANTHSRCE', 26,
|
|
& TAU0, I1x1, J1x1-1,
|
|
& 1, ARRAY, QUIET=.TRUE. )
|
|
|
|
! Cast from REAL*4 to REAL*8
|
|
GEN_1x1(:,:) = ARRAY(:,:,1)
|
|
|
|
! Regrid SO2 [molec/cm2/s] to GEOS 1x1 GRID
|
|
CALL DO_REGRID_G2G_1x1( 'molec/cm2/s', GEN_1x1, GEOS_1x1(:,:,1) )
|
|
|
|
! Get/Apply annual scalar factor (amv 08/21/2007)
|
|
CALL GET_ANNUAL_SCALAR_1x1( 73, 1999, SCALEYEAR, SC_1x1 )
|
|
GEOS_1x1(:,:,1) = GEOS_1x1(:,:,1) * SC_1x1(:,:)
|
|
|
|
! Regrid SO2 [molec/cm2/s] to current model resolution
|
|
CALL DO_REGRID_1x1( 'molec/cm2/s', GEOS_1x1, BRAVO_SO2 )
|
|
|
|
!=================================================================
|
|
! Compute IPCC future emissions (if necessary)
|
|
!=================================================================
|
|
IF ( LFUTURE ) THEN
|
|
CALL BRAVO_SCALE_FUTURE
|
|
ENDIF
|
|
|
|
!=================================================================
|
|
! Print emission totals
|
|
!=================================================================
|
|
CALL TOTAL_ANTHRO_TG( SCALEYEAR )
|
|
|
|
! Return to calling program
|
|
END SUBROUTINE EMISS_BRAVO
|
|
!EOC
|
|
!------------------------------------------------------------------------------
|
|
! Harvard University Atmospheric Chemistry Modeling Group !
|
|
!------------------------------------------------------------------------------
|
|
!BOP
|
|
!
|
|
! !IROUTINE: BRAVO_SCALE_FUTURE
|
|
!
|
|
! !DESCRIPTION: Subroutine BRAVO\_SCALE\_FUTURE applies the IPCC future
|
|
! scale factors to the BRAVO anthropogenic emissions. (swu, bmy, 5/30/06)
|
|
!\\
|
|
!\\
|
|
! !INTERFACE:
|
|
!
|
|
SUBROUTINE BRAVO_SCALE_FUTURE
|
|
!
|
|
! !USES:
|
|
!
|
|
USE FUTURE_EMISSIONS_MOD, ONLY : GET_FUTURE_SCALE_COff
|
|
USE FUTURE_EMISSIONS_MOD, ONLY : GET_FUTURE_SCALE_NOxff
|
|
USE FUTURE_EMISSIONS_MOD, ONLY : GET_FUTURE_SCALE_SO2ff
|
|
|
|
# include "CMN_SIZE" ! Size parameters
|
|
!
|
|
! !REVISION HISTORY:
|
|
! 30 May 2006 - S. Wu & R. Yantosca - Initial version
|
|
!EOP
|
|
!------------------------------------------------------------------------------
|
|
!BOC
|
|
!
|
|
! !LOCAL VARIABLES:
|
|
!
|
|
INTEGER :: I, J
|
|
|
|
!=================================================================
|
|
! BRAVO_SCALE_FUTURE begins here!
|
|
!=================================================================
|
|
|
|
!$OMP PARALLEL DO
|
|
!$OMP+DEFAULT( SHARED )
|
|
!$OMP+PRIVATE( I, J )
|
|
DO J = 1, JJPAR
|
|
DO I = 1, IIPAR
|
|
|
|
! Future NOx [molec/cm2/s]
|
|
BRAVO_NOx(I,J) = BRAVO_NOx(I,J) *
|
|
& GET_FUTURE_SCALE_NOxff( I, J )
|
|
|
|
! Future CO [molec/cm2/s]
|
|
BRAVO_CO(I,J) = BRAVO_CO(I,J) *
|
|
& GET_FUTURE_SCALE_COff( I, J )
|
|
|
|
! Future ALK4 [atoms C/cm2/s]
|
|
BRAVO_SO2(I,J) = BRAVO_SO2(I,J) *
|
|
& GET_FUTURE_SCALE_SO2ff( I, J )
|
|
|
|
ENDDO
|
|
ENDDO
|
|
!$OMP END PARALLEL DO
|
|
|
|
! Return to calling program
|
|
END SUBROUTINE BRAVO_SCALE_FUTURE
|
|
!EOC
|
|
!------------------------------------------------------------------------------
|
|
! Harvard University Atmospheric Chemistry Modeling Group !
|
|
!------------------------------------------------------------------------------
|
|
!BOP
|
|
!
|
|
! !IROUTINE: TOTAL_ANTHRO_TG
|
|
!
|
|
! !DESCRIPTION: Subroutine TOTAL\_ANTHRO\_TG prints the amount of BRAVO
|
|
! anthropogenic emissions that are emitted each year.
|
|
! (rjp, kfb, bmy, 6/26/06)
|
|
!\\
|
|
!\\
|
|
! !INTERFACE:
|
|
!
|
|
SUBROUTINE TOTAL_ANTHRO_TG( YEAR )
|
|
!
|
|
! !USES:
|
|
!
|
|
! References to F90 modules
|
|
USE GRID_MOD, ONLY : GET_AREA_CM2
|
|
USE TRACERID_MOD, ONLY : IDTNOX, IDTCO, IDTSO2
|
|
|
|
# include "CMN_SIZE" ! Size parameters
|
|
!
|
|
! !INPUT PARAMETERS:
|
|
!
|
|
INTEGER, INTENT(IN) :: YEAR
|
|
!
|
|
! !REVISION HISTORY:
|
|
! (1 ) Now YEAR is input to reflect scaling factors applied (phs, 3/17/08)
|
|
!EOP
|
|
!------------------------------------------------------------------------------
|
|
!BOC
|
|
!
|
|
! !LOCAL VARIABLES:
|
|
!
|
|
INTEGER :: I, J
|
|
REAL*8 :: A, B(3), NOx, CO, SO2
|
|
CHARACTER(LEN=3) :: UNIT
|
|
|
|
!=================================================================
|
|
! TOTAL_ANTHRO_TG begins here!
|
|
!=================================================================
|
|
|
|
! Fancy output
|
|
WRITE( 6, '(a)' ) REPEAT( '=', 79 )
|
|
WRITE( 6, 100 )
|
|
100 FORMAT( 'B R A V O M E X I C A N E M I S S I O N S', /,
|
|
& 'Base year : 1999' )
|
|
|
|
!----------------
|
|
! Sum emissions
|
|
!----------------
|
|
|
|
! Define conversion factors for kg/molec
|
|
! (Undefined tracers will be zero)
|
|
B(:) = 0d0
|
|
IF ( IDTNOx > 0 ) B(1) = 1d0 / ( 6.0225d23 / 14d-3 ) ! Tg N
|
|
IF ( IDTCO > 0 ) B(2) = 1d0 / ( 6.0225d23 / 28d-3 ) ! Tg CO
|
|
IF ( IDTSO2 > 0 ) B(3) = 1d0 / ( 6.0225d23 / 32d-3 ) ! Tg S
|
|
|
|
! Summing variables
|
|
NOX = 0d0
|
|
CO = 0d0
|
|
SO2 = 0d0
|
|
|
|
! Loop over latitudes
|
|
DO J = 1, JJPAR
|
|
|
|
! Convert [molec/cm2/s] to [Tg]
|
|
! (Multiply by 1d-9 to convert from [kg] to [Tg])
|
|
A = GET_AREA_CM2( J ) * 365.25d0 * 86400d0 * 1d-9
|
|
|
|
! Loop over longitudes
|
|
DO I = 1, IIPAR
|
|
|
|
! Sum emissions (list NOx as Tg N)
|
|
NOX = NOX + ( BRAVO_NOX(I,J) * A * B(1) )
|
|
CO = CO + ( BRAVO_CO (I,J) * A * B(2) )
|
|
SO2 = SO2 + ( BRAVO_SO2(I,J) * A * B(3) )
|
|
ENDDO
|
|
ENDDO
|
|
|
|
!----------------
|
|
! Print sums
|
|
!----------------
|
|
|
|
! Print totals in [kg]
|
|
WRITE( 6, 110 ) 'NOx ', YEAR, NOx, ' N'
|
|
WRITE( 6, 110 ) 'CO ', YEAR, CO, ' '
|
|
WRITE( 6, 110 ) 'SO2 ', YEAR, SO2, ' S'
|
|
|
|
110 FORMAT( 'BRAVO anthropogenic ', a4,
|
|
& 'for year ', i4, ': ', f9.4, ' Tg', a2 )
|
|
|
|
! Fancy output
|
|
WRITE( 6, '(a)' ) REPEAT( '=', 79 )
|
|
|
|
! Return to calling program
|
|
END SUBROUTINE TOTAL_ANTHRO_TG
|
|
!EOC
|
|
!------------------------------------------------------------------------------
|
|
! Harvard University Atmospheric Chemistry Modeling Group !
|
|
!------------------------------------------------------------------------------
|
|
!BOP
|
|
!
|
|
! !IROUTINE: READ_BRAVO_MASK
|
|
!
|
|
! !DESCRIPTION: Subroutine READ\_BRAVO\_MASK reads the Mexico mask from
|
|
! disk. The Mexico mask is the fraction of the grid box (I,J) which lies
|
|
! w/in the BRAVO Mexican emissions region. (rjp, kfb, bmy, 6/22/06, 8/9/06)
|
|
!\\
|
|
!\\
|
|
! !INTERFACE:
|
|
!
|
|
SUBROUTINE READ_BRAVO_MASK
|
|
!
|
|
! !USES:
|
|
!
|
|
USE BPCH2_MOD, ONLY : GET_NAME_EXT_2D, GET_RES_EXT
|
|
USE BPCH2_MOD, ONLY : GET_TAU0, READ_BPCH2
|
|
USE DIRECTORY_MOD, ONLY : DATA_DIR_1x1
|
|
USE REGRID_1x1_MOD, ONLY : DO_REGRID_1x1, DO_REGRID_G2G_1x1
|
|
USE TRANSFER_MOD, ONLY : TRANSFER_2D
|
|
|
|
# include "CMN_SIZE" ! Size parameters
|
|
!
|
|
! !REVISION HISTORY:
|
|
! (1 ) Now pass UNIT to DO_REGRID_G2G_1x1 (bmy, 8/9/06)
|
|
!EOP
|
|
!------------------------------------------------------------------------------
|
|
!BOC
|
|
!
|
|
! !LOCAL VARIABLES:
|
|
!
|
|
REAL*4 :: ARRAY(I1x1,J1x1-1,1)
|
|
REAL*8 :: GEN_1x1(I1x1,J1x1-1)
|
|
REAL*8 :: GEOS_1x1(I1x1,J1x1,1)
|
|
REAL*8 :: XTAU
|
|
CHARACTER(LEN=255) :: FILENAME
|
|
|
|
!=================================================================
|
|
! READ_BRAVO_MASK begins here!
|
|
!=================================================================
|
|
|
|
! File name
|
|
FILENAME = TRIM( DATA_DIR_1x1 ) //
|
|
& 'BRAVO_200607/BRAVO.MexicoMask.generic.1x1'
|
|
|
|
! Echo info
|
|
WRITE( 6, 100 ) TRIM( FILENAME )
|
|
100 FORMAT( ' - READ_MEXICO_MASK: Reading ', a )
|
|
|
|
! Get TAU0 for Jan 1985
|
|
XTAU = GET_TAU0( 1, 1, 1999 )
|
|
|
|
! Mask is stored in the bpch file as #2
|
|
CALL READ_BPCH2( FILENAME, 'LANDMAP', 2,
|
|
& XTAU, I1x1, J1x1-1,
|
|
& 1, ARRAY, QUIET=.TRUE. )
|
|
|
|
! Cast from REAL*4 to REAL*8
|
|
GEN_1x1(:,:) = ARRAY(:,:,1)
|
|
|
|
! Regrid from GENERIC 1x1 GRID to GEOS 1x1 GRID
|
|
CALL DO_REGRID_G2G_1x1( 'unitless', GEN_1x1, GEOS_1x1(:,:,1) )
|
|
|
|
! Regrid from GEOS 1x1 GRID to current model resolution
|
|
CALL DO_REGRID_1x1( 'unitless', GEOS_1x1, BRAVO_MASK )
|
|
|
|
! Return to calling program
|
|
END SUBROUTINE READ_BRAVO_MASK
|
|
!EOC
|
|
!------------------------------------------------------------------------------
|
|
! Harvard University Atmospheric Chemistry Modeling Group !
|
|
!------------------------------------------------------------------------------
|
|
!BOP
|
|
!
|
|
! !IROUTINE: INIT_BRAVO
|
|
!
|
|
! !DESCRIPTION: Subroutine INIT\_BRAVO allocates and zeroes BRAVO module
|
|
! arrays, and also creates the mask which defines the Mexico region
|
|
! (rjp, kfb, bmy, 6/26/06)
|
|
!\\
|
|
!\\
|
|
! !INTERFACE:
|
|
!
|
|
SUBROUTINE INIT_BRAVO
|
|
!
|
|
! !USES:
|
|
!
|
|
USE ERROR_MOD, ONLY : ALLOC_ERR
|
|
USE GRID_MOD, ONLY : GET_XMID, GET_YMID
|
|
USE LOGICAL_MOD, ONLY : LBRAVO
|
|
|
|
# include "CMN_SIZE" ! Size parameters
|
|
!
|
|
! !REVISION HISTORY:
|
|
! 18 Oct 2006 - R. Yantosca - Initial version
|
|
!EOP
|
|
!------------------------------------------------------------------------------
|
|
!BOC
|
|
!
|
|
! !LOCAL VARIABLES:
|
|
!
|
|
INTEGER :: AS
|
|
|
|
!=================================================================
|
|
! INIT_BRAVO begins here!
|
|
!=================================================================
|
|
|
|
! Return if LBRAVO is false
|
|
IF ( .not. LBRAVO ) RETURN
|
|
|
|
!--------------------------
|
|
! Allocate and zero arrays
|
|
!--------------------------
|
|
|
|
ALLOCATE( BRAVO_NOx( IIPAR, JJPAR ), STAT=AS )
|
|
IF ( AS /= 0 ) CALL ALLOC_ERR( 'BRAVO_NOx' )
|
|
BRAVO_NOx = 0d0
|
|
|
|
ALLOCATE( BRAVO_CO( IIPAR, JJPAR ), STAT=AS )
|
|
IF ( AS /= 0 ) CALL ALLOC_ERR( 'BRAVO_CO' )
|
|
BRAVO_CO = 0d0
|
|
|
|
ALLOCATE( BRAVO_SO2( IIPAR, JJPAR ), STAT=AS )
|
|
IF ( AS /= 0 ) CALL ALLOC_ERR( 'BRAVO_SO2' )
|
|
BRAVO_SO2 = 0d0
|
|
|
|
!--------------------------
|
|
! Read Mexico mask
|
|
!--------------------------
|
|
|
|
ALLOCATE( BRAVO_MASK( IIPAR, JJPAR ), STAT=AS )
|
|
IF ( AS /= 0 ) CALL ALLOC_ERR( 'BRAVO_MASK' )
|
|
BRAVO_MASK = 0d0
|
|
|
|
! Read the mask
|
|
CALL READ_BRAVO_MASK
|
|
|
|
! Return to calling program
|
|
END SUBROUTINE INIT_BRAVO
|
|
!EOC
|
|
!------------------------------------------------------------------------------
|
|
! Harvard University Atmospheric Chemistry Modeling Group !
|
|
!------------------------------------------------------------------------------
|
|
!BOP
|
|
!
|
|
! !IROUTINE: CLEANUP_BRAVO
|
|
!
|
|
! !DESCRIPTION: Subroutine CLEANUP\_BRAVO deallocates all BRAVO module arrays.
|
|
! (rjp, kfb, bmy, 6/26/06)
|
|
!\\
|
|
!\\
|
|
! !INTERFACE:
|
|
!
|
|
SUBROUTINE CLEANUP_BRAVO
|
|
!
|
|
! !REVISION HISTORY:
|
|
! 1 Nov 2005 - R. Yantosca - Initial Version
|
|
!EOP
|
|
!------------------------------------------------------------------------------
|
|
!BOC
|
|
!=================================================================
|
|
! CLEANUP_BRAVO begins here!
|
|
!=================================================================
|
|
IF ( ALLOCATED( BRAVO_NOx ) ) DEALLOCATE( BRAVO_NOx )
|
|
IF ( ALLOCATED( BRAVO_CO ) ) DEALLOCATE( BRAVO_CO )
|
|
IF ( ALLOCATED( BRAVO_SO2 ) ) DEALLOCATE( BRAVO_SO2 )
|
|
IF ( ALLOCATED( BRAVO_MASK ) ) DEALLOCATE( BRAVO_MASK )
|
|
|
|
! Return to calling program
|
|
END SUBROUTINE CLEANUP_BRAVO
|
|
|
|
!------------------------------------------------------------------------------
|
|
|
|
! End of module
|
|
END MODULE BRAVO_MOD
|
|
!EOC
|