Add files via upload
This commit is contained in:
Xuesong (Steve)
676
code/bravo_mod.f
Normal file
676
code/bravo_mod.f
Normal file
@ -0,0 +1,676 @@
|
||||
! $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
|
||||
Reference in New Issue
Block a user