1673 lines
57 KiB
Fortran
1673 lines
57 KiB
Fortran
!$Id: global_ch4_adj_mod.f,v 1.3 2012/03/02 06:10:57 daven Exp $
|
|
MODULE GLOBAL_CH4_ADJ_MOD
|
|
!
|
|
!******************************************************************************
|
|
! Module GLOBAL_CH4_ADJ_MOD contains variables and routines used for the
|
|
! adjoint CH4 simulation (adj_group, kjw, 2/22/10, adj32_023)
|
|
!
|
|
! To perform identical twin tests using TES pseudo-observations, I made some
|
|
! rather ugly work-arounds in the standard adjoint code distribution. These
|
|
! changes are not incorporated into the standard code because they would
|
|
! make the code messy and slower. If you want a copy of the v8 adjoint code
|
|
! used to perform identical twin tests, contact Kevin Wecht
|
|
! (wecht-at-fas.harvard.edu) (kjw, 7/06/11)
|
|
!
|
|
! Module Variables:
|
|
! ============================================================================
|
|
! (1 ) BOH : Array to hold monthly mean OH concentrations
|
|
! (2 ) CH4_EMIS_ADJ : Array to hold methane emissions
|
|
! (3 ) COPROD : Array to hold CH4 loss from stratosphere
|
|
! (4 ) TAVG_ADJ : Array to hold average daily temperature
|
|
! (5 ) BAIRDENS : Array to hold density of air
|
|
! (6 ) FMOL_CH4 : Molecular weight of CH4 [kg / mol]
|
|
! (7 ) XNUMOL_CH4 : molec CH4 / kg CH4
|
|
! (8 ) IU_A6_CH4_ADJ: file unit number
|
|
!
|
|
! Module Routines:
|
|
! ============================================================================
|
|
! (1 ) EMISSCH4_ADJ : Adjoint of CH4 emissions
|
|
! (2 ) CHEMCH4_ADJ : Adjoint of CH4 chemistry
|
|
! (3 ) CH4_DECAY_ADJ : Adjoint of decay rate of CH4 by OH.
|
|
! (4 ) CH4_STRAT_ADJ : Adjoint of loss of CH4 in the stratosphere
|
|
! (5 ) READ_COPROD : Reads prescribed zonal CH4 loss from stratosphere
|
|
! (6 ) CH4_AVGTP_AVG : Gets 24h avg temp and pressure for CHEMCH4_ADJ
|
|
! (7 ) OPEN_A6_CH4_ADJ : Opens A6 met files for use by CH4_AVGTP_ADJ
|
|
! (8 ) READ_A6_CH4_ADJ : Reads A6 met files for use by CH4_AVGTP_ADJ
|
|
! (9 ) FIND_CLOSEST_A6 : Finds date and time of nearest A6 met field
|
|
! (10) GET_SCALE_GROUP : Determines which temporal/spatial scaling index to use.
|
|
! (11) INIT_CH4_ADJ : Allocates and initializes module arrays
|
|
! (12) CLEANUP_CH4_ADJ : Deallocates module arrays
|
|
!
|
|
! GEOS-CHEM modules referenced by global_ch4_mod.f
|
|
! ============================================================================
|
|
! (1 ) biofuel_mod.f : Module w/ routines to read biofuel emissions
|
|
! (2 ) biomass_mod.f : Module w/ routines to read biomass emissions
|
|
! (3 ) bpch2_mod.f : Module w/ routines for binary punch file I/O
|
|
! (4 ) dao_mod.f : Module w/ arrays for DAO met fields
|
|
! (5 ) diag_mod.f : Module w/ GEOS-CHEM diagnostic arrays
|
|
! (6 ) diag_pl_mod.f : Module w/ routines for prod & loss diag's
|
|
! (7 ) directory_mod.f : Module w/ GEOS-CHEM data & met field dirs
|
|
! (8 ) error_mod.f : Module w/ I/O error and NaN check routines
|
|
! (9 ) geia_mod : Module w/ routines to read anthro emissions
|
|
! (10) global_oh_mod.f : Module w/ routines to read 3-D OH field
|
|
! (11) global_nox_mod.f : Module w/ routines to read 3-D NOx field
|
|
! (12) grid_mod.f : Module w/ horizontal grid information
|
|
! (13) logical_mod.f : Module w/ GEOS-CHEM logical switches
|
|
! (14) pressure_mod.f : Module w/ routines to compute P(I,J,L)
|
|
! (15) time_mod.f : Module w/ routines for computing time & date
|
|
! (16) tracer_mod.f : Module w/ GEOS-CHEM tracer array STT etc.
|
|
! (17) tropopause_mod.f : Module w/ routines to read ann mean tropopause
|
|
! (18) logical_adj_mod.f: Module w/ adj logical flags
|
|
!
|
|
! NOTES:
|
|
!******************************************************************************
|
|
!
|
|
IMPLICIT NONE
|
|
|
|
!=================================================================
|
|
! MODULE PRIVATE DECLARATIONS -- keep all variables and routines
|
|
! from being seen outside "global_ch4_adj_mod.f"
|
|
! Exceptions for those listed under "PUBLIC ROUTINES"
|
|
!=================================================================
|
|
|
|
! PRIVATE module variables
|
|
PRIVATE
|
|
|
|
! PUBLIC ROUTINES
|
|
PUBLIC :: CHEMCH4_ADJ
|
|
PUBLIC :: EMISSCH4_ADJ
|
|
PUBLIC :: CLEANUP_GLOBAL_CH4_ADJ
|
|
|
|
!=================================================================
|
|
! MODULE VARIABLES
|
|
!=================================================================
|
|
REAL*8, ALLOCATABLE :: CH4_EMIS_ADJ(:,:,:)
|
|
REAL*8, ALLOCATABLE :: BOH(:,:,:,:)
|
|
REAL*8, ALLOCATABLE :: CH4LOSS(:,:,:,:)
|
|
REAL*8, ALLOCATABLE :: COPROD(:,:,:)
|
|
REAL*8, ALLOCATABLE :: TAVG_ADJ(:,:,:)
|
|
REAL*8, ALLOCATABLE :: BAIRDENS(:,:,:)
|
|
|
|
! FMOL_CH4 - kg CH4 / mole CH4
|
|
! XNUMOL_CH4 - molecules CH4 / kg CH4
|
|
REAL*8, PARAMETER :: FMOL_CH4 = 16d-3
|
|
REAL*8, PARAMETER :: XNUMOL_CH4 = 6.022d+23/FMOL_CH4
|
|
INTEGER :: IU_A6_CH4_ADJ
|
|
|
|
!=================================================================
|
|
! MODULE ROUTINES -- follow below the "CONTAINS" statement
|
|
!=================================================================
|
|
CONTAINS
|
|
|
|
|
|
!------------------------------------------------------------------------------
|
|
|
|
SUBROUTINE EMISSCH4_ADJ
|
|
!
|
|
!******************************************************************************
|
|
! Subroutine EMISSCH4_ADJ does adjoint of CH4 emissions
|
|
! (adj_group, kjw, 2/22/10)
|
|
!
|
|
! NOTES:
|
|
!******************************************************************************
|
|
!
|
|
! References to F90 modules
|
|
USE ADJ_ARRAYS_MOD, ONLY : ADCH4EMS, EMS_SF_ADJ, STT_ADJ
|
|
USE GRID_MOD, ONLY : GET_XOFFSET, GET_YOFFSET
|
|
USE GRID_MOD, ONLY : GET_AREA_CM2
|
|
USE TIME_MOD, ONLY : GET_TS_EMIS
|
|
USE TIME_MOD, ONLY : GET_MONTH, GET_YEAR
|
|
USE TIME_MOD, ONLY : ITS_A_NEW_MONTH, ITS_A_NEW_YEAR
|
|
USE GLOBAL_CH4_MOD, ONLY : WETLAND_EMIS, BIOBURN_EMIS
|
|
USE GLOBAL_CH4_MOD, ONLY : RICE_EMIS!, BIOFUEL_EMIS
|
|
USE GLOBAL_CH4_MOD, ONLY : ASEASONAL_ANTHRO_EMIS
|
|
USE GLOBAL_CH4_MOD, ONLY : ASEASONAL_NATURAL_EMIS
|
|
USE TIME_MOD, ONLY : GET_NYMD, GET_NHMS
|
|
|
|
IMPLICIT NONE
|
|
|
|
# include "CMN_SIZE" ! Size parameters
|
|
|
|
! Local variables
|
|
!LOGICAL, SAVE :: FIRSTEMIS = .TRUE.
|
|
LOGICAL, SAVE :: LASTOFMONTH = .TRUE.
|
|
LOGICAL, SAVE :: LASTOFYEAR = .TRUE.
|
|
INTEGER :: I, J, I0, J0, M, IREF, JREF
|
|
|
|
! Local variables
|
|
REAL*8 :: E_CH4, DTSRCE, AREA_CM2
|
|
REAL*8 :: CH4_EMIS_for_SF(IIPAR,JJPAR)
|
|
|
|
|
|
!=================================================================
|
|
! EMISSCH4_ADJ begins here!
|
|
!=================================================================
|
|
|
|
WRITE(6,*) '% --- ENTERING EMISSCH4_ADJ! ---'
|
|
|
|
! Initialize GLOBAL_CH4_ADJ_MOD variables
|
|
! Do here because CHEMCH4 isn't called at first midnight
|
|
! NO. Initialize global_ch4_adj_mod variables in chemch4_adj
|
|
! because chemistry and emissions now have the same time step
|
|
! and chemistry is called first (kjw, 12/2/2011).
|
|
!IF ( FIRSTEMIS ) THEN
|
|
!CALL INIT_GLOBAL_CH4_ADJ
|
|
!FIRSTEMIS=.FALSE.
|
|
!ENDIF
|
|
|
|
! Determine group (temporal)
|
|
M = GET_SCALE_GROUP()
|
|
! Print out scaling info
|
|
WRITE(6,*) ' - READ / RESCALE CHEMISTRY:
|
|
& use SCALE_GROUP ', M
|
|
|
|
! Get nested-grid offsets
|
|
I0 = GET_XOFFSET()
|
|
J0 = GET_YOFFSET()
|
|
|
|
|
|
!===================================================================
|
|
! Emissions are read or calculated at the first of every:
|
|
! 1) Emission time step - Natural Wetlands (from J Kaplan)
|
|
! 2) Month - Biomass Burning and Rice
|
|
! 3) Year - All other sources
|
|
!
|
|
! Emissions are stored in CH4_EMIS_ADJ(IIPAR,JJPAR,N).
|
|
! Where N = 1:12
|
|
! 1. Total Emissions (including soil absorption, counted neg.)
|
|
! 2. Oil and Gas Processing
|
|
! 3. Coal Mining
|
|
! 4. Livestock
|
|
! 5. Waste
|
|
! 6. Biofuel
|
|
! 7. Rice
|
|
! 8. Other Anthropogenic
|
|
! 9. Biomass Burning
|
|
! 10. Wetlands
|
|
! 11. Soil Absorption
|
|
! 12. Other Natural
|
|
!
|
|
! Emissions are then summed
|
|
! (kjw, 6/4/09)
|
|
!===================================================================
|
|
|
|
! Do Adjoint CH4 emissions!
|
|
|
|
!4.1 Wetland Emissions (CH4_WTL, #10)
|
|
CALL WETLAND_EMIS( CH4_EMIS_ADJ )
|
|
|
|
|
|
IF ( LASTOFMONTH ) THEN
|
|
|
|
!4.2 Biomass Burning emissions (CH4_BBN, #9)
|
|
CALL BIOBURN_EMIS( CH4_EMIS_ADJ )
|
|
|
|
!4.3 Rice emissions (CH4_RIC, #7)
|
|
CALL RICE_EMIS( CH4_EMIS_ADJ )
|
|
|
|
ENDIF
|
|
|
|
|
|
IF ( LASTOFYEAR ) THEN
|
|
|
|
!4.4 Biofuel emissions (CH4_BFL, #6)
|
|
!kjw replace with EDGARv4 biofuels in ASEASONAL_ANTHRO_EMIS
|
|
! (kjw, 11/17/11)
|
|
!CALL BIOFUEL_EMIS( CH4_EMIS_ADJ )
|
|
|
|
!4.5 Aseasonal Anthropogenic emissions
|
|
! (CH4_OAG, #2; CH4_COL, #3; CH4_LIV, #4; CH4_WST, #5; CH4_OTA, #8)
|
|
CALL ASEASONAL_ANTHRO_EMIS( CH4_EMIS_ADJ )
|
|
|
|
!4.6 Aseasonal Natural emissions (CH4_SAB, #11; CH4_OTN, #12)
|
|
CALL ASEASONAL_NATURAL_EMIS( CH4_EMIS_ADJ )
|
|
|
|
ENDIF
|
|
|
|
|
|
! Total emission: sum of all emissions - (2*soil absorption)
|
|
! We have to substract soil absorption twice because it is added
|
|
! to other emissions in the SUM function. (ccc, 7/23/09)
|
|
CH4_EMIS_ADJ(:,:,1) = 0d0
|
|
CH4_EMIS_ADJ(:,:,1) = SUM(CH4_EMIS_ADJ, 3)
|
|
& - (2 * CH4_EMIS_ADJ(:,:,11))
|
|
|
|
! Select emissions to be optimized (all but soil absorption).
|
|
! Exclude soil abs to prevent having negative scaling factors.
|
|
! To do this, add the magnitude of soil absorption back to the total
|
|
CH4_EMIS_for_SF(:,:) = CH4_EMIS_ADJ(:,:,1)
|
|
& + CH4_EMIS_ADJ(:,:,11)
|
|
|
|
! DTSRCE is the number of seconds per emission timestep
|
|
DTSRCE = GET_TS_EMIS() * 60d0
|
|
|
|
! Accumulate gradients
|
|
DO J = 1, JJPAR
|
|
JREF = J + J0
|
|
|
|
! Get area [cm2] of each box for unit conversion
|
|
AREA_CM2 = GET_AREA_CM2( J )
|
|
|
|
DO I = 1, IIPAR
|
|
IREF = I + I0
|
|
|
|
! Convert from [molec cm-2 s-1] --> [kg CH4]
|
|
E_CH4 = CH4_EMIS_for_SF(I,J) * DTSRCE
|
|
& * AREA_CM2 / XNUMOL_CH4
|
|
|
|
! Calculate Gradients
|
|
EMS_SF_ADJ(I,J,M,ADCH4EMS) = EMS_SF_ADJ(I,J,M,ADCH4EMS) +
|
|
& STT_ADJ(I,J,1,1) * E_CH4
|
|
|
|
ENDDO
|
|
ENDDO
|
|
|
|
|
|
! RESET LASTOF logicals
|
|
! If 12am on Jan1, next time step in adjoint will be last of preceeding year
|
|
IF ( ITS_A_NEW_YEAR() ) THEN
|
|
LASTOFYEAR = .TRUE.
|
|
ELSE
|
|
LASTOFYEAR = .FALSE.
|
|
ENDIF
|
|
|
|
! If 12am on 1st of month, next time step in adjoint will be last of preceeding month
|
|
IF ( ITS_A_NEW_MONTH() ) THEN
|
|
LASTOFMONTH = .TRUE.
|
|
ELSE
|
|
LASTOFMONTH = .FALSE.
|
|
ENDIF
|
|
|
|
|
|
WRITE(6,'(a)') '% --- EXITING EMISSCH4_ADJ! ---'
|
|
|
|
! Return to calling program
|
|
END SUBROUTINE EMISSCH4_ADJ
|
|
|
|
|
|
|
|
!------------------------------------------------------------------------------
|
|
|
|
SUBROUTINE CHEMCH4_ADJ
|
|
!
|
|
!******************************************************************************
|
|
! Subroutine CHEMCH4_ADJ does adjoint of CH4 chemistry
|
|
! (adj_group, kjw, 2/22/10)
|
|
!
|
|
! NOTES:
|
|
!******************************************************************************
|
|
!
|
|
! References to F90 modules
|
|
USE DIRECTORY_MOD, ONLY : OH_DIR
|
|
USE BPCH2_MOD, ONLY : GET_TAU0, READ_BPCH2
|
|
USE BPCH2_MOD, ONLY : GET_NAME_EXT, GET_RES_EXT
|
|
USE TIME_MOD, ONLY : GET_MONTH
|
|
USE TRANSFER_MOD, ONLY : TRANSFER_2D, TRANSFER_3D
|
|
USE ERROR_MOD, ONLY : GEOS_CHEM_STOP
|
|
USE GLOBAL_OH_MOD, ONLY : GET_GLOBAL_OH, OH
|
|
USE GLOBAL_CH4_MOD, ONLY : CH4LOSS
|
|
|
|
IMPLICIT NONE
|
|
|
|
# include "CMN_SIZE" ! Size parameters
|
|
# include "CMN" ! LPAUSE
|
|
|
|
! Local variables
|
|
CHARACTER(LEN=255) :: FILENAME
|
|
LOGICAL, SAVE :: FIRSTCHEM = .TRUE.
|
|
INTEGER :: L, NOHDO, LMN, M, I, J
|
|
REAL*4 :: ARRAY(IIPAR,JJPAR,LGLOB)
|
|
REAL*8 :: XTAU
|
|
|
|
|
|
!=================================================================
|
|
! CHEMCH4_ADJ begins here!
|
|
!=================================================================
|
|
WRITE( 6, '(a)' ) '% --- ENTERING CHEMCH4_ADJ! ---'
|
|
|
|
|
|
! Initialize GLOBAL_CH4_ADJ_MOD variables
|
|
! Do here because chemistry called before emissions and both
|
|
! have the same time step (kjw, 12/2/2011)
|
|
IF ( FIRSTCHEM ) THEN
|
|
CALL INIT_GLOBAL_CH4_ADJ
|
|
|
|
! Read Stratospheric loss rates
|
|
CH4LOSS(:,:,:,:) = 0d0
|
|
CALL READ_CH4LOSS
|
|
|
|
ENDIF
|
|
|
|
|
|
! Get Average temp for the preceeding day
|
|
!CALL CH4_AVGTP_ADJ
|
|
|
|
!================================================================
|
|
! (1) get parameterized OH fields or monthly mean fields.
|
|
!
|
|
! Variables of note:
|
|
! ---------------------------------------------------------------
|
|
! (1) BOH = storage array for OH fields.
|
|
!
|
|
! (2) NOHDO = switch
|
|
! ONLY USE CASE 1 as of 5/28/08 (kjw)
|
|
! = 1 : Get GEOS-Chem OH (v5-07-08) (kjw, 5/28/08)
|
|
!
|
|
! (3) TROPP = the vertical level of the tropopause. Above this
|
|
! level, no [OH] is calculated. The user can feed this
|
|
! SR a high value for LPAUSE which effectively turns this
|
|
! option off (i.e., LPAUSE > MVRTBX). If the [OH] = -999
|
|
! then the [OH] was not calculated.
|
|
!================================================================
|
|
|
|
! 3D OH Field
|
|
BOH(:,:,:,:) = 0d0
|
|
|
|
|
|
! Change value of NOHDO as listed above
|
|
NOHDO = 1
|
|
|
|
SELECT CASE ( NOHDO )
|
|
|
|
! NOHDO = 1: GEOS-Chem OH v5-07-08
|
|
CASE ( 1 )
|
|
|
|
! If first of month, read monthly mean OH
|
|
IF ( FIRSTCHEM ) THEN
|
|
|
|
! Clear 3D OH field
|
|
BOH(:,:,:,:) = 0d0
|
|
LMN = GET_MONTH()
|
|
|
|
! Loop over each month, reading OH
|
|
DO M=1,12
|
|
|
|
! Global OH
|
|
CALL GET_GLOBAL_OH( M )
|
|
|
|
! Assign to module variable BOH
|
|
BOH(:,:,:,M) = OH(:,:,:)
|
|
|
|
ENDDO
|
|
|
|
ENDIF
|
|
|
|
CASE DEFAULT
|
|
WRITE( 6, '(a)' ) 'Invalid selection for NOHDO!'
|
|
WRITE( 6, '(a)' ) 'Halting execution in CHEMCH4!'
|
|
CALL GEOS_CHEM_STOP
|
|
|
|
END SELECT
|
|
|
|
|
|
!=================================================================
|
|
! (3) adjoint of CH4 chemistry in layers above tropopause.
|
|
!=================================================================
|
|
CALL CH4_STRAT_ADJ
|
|
|
|
!=================================================================
|
|
! (3) adjoint of rate of decay of CH4 by OH oxidation.
|
|
!=================================================================
|
|
CALL CH4_DECAY_ADJ
|
|
|
|
|
|
|
|
! Set FIRSTCHEM to FALSE
|
|
FIRSTCHEM = .FALSE.
|
|
|
|
|
|
! Return to calling program
|
|
END SUBROUTINE CHEMCH4_ADJ
|
|
|
|
|
|
!------------------------------------------------------------------------------
|
|
|
|
SUBROUTINE CH4_DECAY_ADJ
|
|
!
|
|
!******************************************************************************
|
|
! Subroutine CH4_DECAY_ADJ is the adjoint of decay rate of CH4 by OH. OH is the
|
|
! only sink for CH4 considered here. (jsw, bnd, bmy, 1/16/01, 7/20/04)
|
|
!
|
|
! The annual mean tropopause is stored in the LPAUSE array
|
|
! (from header file "CMN"). LPAUSE is defined such that:
|
|
!
|
|
! Levels 1 <= L <= LPAUSE(I,J) - 1 are tropospheric
|
|
! LPAUSE(I,J) <= L <= LLPAR are stratospheric
|
|
!
|
|
! We now use LPAUSE instead of NSKIPL to denote the strat/trop boundary.
|
|
! (bmy, 4/18/00)
|
|
!
|
|
! Monthly loss of CH4 is summed in TCH4(3)
|
|
! TCH4(3) = CH4 sink by OH
|
|
!
|
|
! Module Variables:
|
|
! ============================================================================
|
|
! (1) BOH (REAL*8) : Array holding global OH concentrations
|
|
! (2) XNUMOL_CH4 (REAL*8) : Molec CH4 / kg CH4
|
|
!
|
|
! NOTES:
|
|
! (1 ) Created by Bryan Duncan (1/99). Adapted for CH4 chemistry by
|
|
! James Wang (7/00). Inserted into module "global_ch4_mod.f"
|
|
! by Bob Yantosca. (bmy, 1/16/01)
|
|
! (2 ) CH4_DECAY is independent of "CMN_OH", "CMN_CO", and "CMN_CO_BUDGET".
|
|
! (bmy, 1/16/01)
|
|
! (3 ) Now use function GET_TS_CHEM from "time_mod.f" (bmy, 3/27/03)
|
|
! (4 ) Now references STT from "tracer_mod.f" (bmy, 7/20/04)
|
|
!******************************************************************************
|
|
!
|
|
! References to F90 modules
|
|
USE ADJ_ARRAYS_MOD, ONLY : ADCH4EMS, EMS_SF_ADJ, STT_ADJ
|
|
USE DAO_MOD, ONLY : AIRVOL, AD, CONVERT_UNITS, T
|
|
USE TIME_MOD, ONLY : GET_TS_CHEM, GET_NYMD, GET_NHMS
|
|
USE TRACER_MOD, ONLY : TCVV, N_TRACERS
|
|
USE TIME_MOD, ONLY : GET_MONTH
|
|
|
|
|
|
# include "CMN_SIZE" ! Size parameters
|
|
# include "CMN" ! LPAUSE
|
|
|
|
! Local variables
|
|
INTEGER :: I, J, L, LMN
|
|
REAL*8 :: DT, GCH4_ADJ, STT2GCH4, KRATE, TROPCH4
|
|
|
|
|
|
!=================================================================
|
|
! CH4_DECAY_ADJ begins here!
|
|
!=================================================================
|
|
|
|
! Chemistry timestep in seconds
|
|
DT = GET_TS_CHEM() * 60d0
|
|
|
|
! Current month
|
|
LMN = GET_MONTH()
|
|
|
|
!=================================================================
|
|
! Compute decay of CH4 by OH in the troposphere
|
|
!
|
|
! The decay for CH4 is calculated by:
|
|
! OH + CH4 -> CH3 + H2O
|
|
! k = 2.45E-12 exp(-1775/T)
|
|
!
|
|
! This is from JPL '97.
|
|
! JPL '00 & '06 do not revise '97 value. (jsw, kjw)
|
|
!=================================================================
|
|
|
|
! Convert STT_ADJ from [v/v] --> [kg]
|
|
CALL CONVERT_UNITS( 2, N_TRACERS, TCVV, AD, STT_ADJ )
|
|
|
|
|
|
TROPCH4 = 0d0
|
|
|
|
DO L = 1, MAXVAL( LPAUSE )
|
|
DO J = 1, JJPAR
|
|
DO I = 1, IIPAR
|
|
|
|
! Only consider tropospheric boxes
|
|
IF ( L < LPAUSE(I,J) ) THEN
|
|
|
|
! Use 24-hr avg temperature to calc. rate coeff.
|
|
! citation needed
|
|
KRATE = 2.45d-12 * EXP( -1775d0 / T(I,J,L) )
|
|
|
|
! Conversion from [kg/box] --> [molec/cm3]
|
|
! [kg CH4/box] * [box/cm3] * XNUMOL_CH4 [molec CH4/kg CH4]
|
|
STT2GCH4 = 1d0 / AIRVOL(I,J,L) / 1d6 * XNUMOL_CH4
|
|
|
|
! CH4 in [molec/cm3]
|
|
GCH4_ADJ = STT_ADJ(I,J,L,1) * STT2GCH4
|
|
|
|
! Calculate new CH4 value: [CH4]=[CH4](1-k*[OH]*delta)
|
|
GCH4_ADJ = GCH4_ADJ * ( 1d0 - KRATE * BOH(I,J,L,LMN) * DT )
|
|
|
|
! Convert back from [molec/cm3] --> [kg/box]
|
|
STT_ADJ(I,J,L,1) = GCH4_ADJ / STT2GCH4
|
|
|
|
ENDIF
|
|
ENDDO
|
|
ENDDO
|
|
ENDDO
|
|
|
|
! Convert STT_ADJ back from [kg] --> [v/v]
|
|
CALL CONVERT_UNITS( 1, N_TRACERS, TCVV, AD, STT_ADJ )
|
|
|
|
|
|
! Return to calling program
|
|
END SUBROUTINE CH4_DECAY_ADJ
|
|
|
|
!------------------------------------------------------------------------------
|
|
|
|
SUBROUTINE READ_CH4LOSS
|
|
!
|
|
!*****************************************************************************
|
|
! Subroutine READ_CH4LOSS reads CH4 loss frequencies in the stratosphere.
|
|
! These values constitute a linearized stratospheric CH4 chemistry scheme.
|
|
! Loss frequencies from 4x5 degree output from the GMI model. Thanks to Lee
|
|
! Murray for the ch4 loss frequencies. (kjw, 11/19/2011)
|
|
!
|
|
! Module Variables:
|
|
! ===========================================================================
|
|
! (1) CH4LOSS (REAL*8) : Array containing ch4 loss frequencies for all 12 months [1/s]
|
|
!
|
|
! NOTES:
|
|
! (1 ) Created by Bryan Duncan (1/99). Adapted for CH4 chemistry by
|
|
! James Wang (6/8/00). Inserted into module "global_ch4_mod.f"
|
|
! by Bob Yantosca. (bmy, 1/16/01)
|
|
! (2 ) READ_CH4LOSS is independent of "F77_CMN_OH", "F77_CMN_CO", and "F77_CMN_CO_BUDGET".
|
|
! (bmy, 1/16/01)
|
|
! (3 ) ARRAY needs to be dimensioned (1,JJPAR,LGLOB) (bmy, 9/26/01)
|
|
! (4 ) Remove obsolete code from 9/01 (bmy, 10/24/01)
|
|
! (5 ) Now reference DATA_DIR from "directory_mod.f" (bmy, 7/20/04)
|
|
! (6 ) Now reads data for both GEOS and GCAP grids (bmy, 8/16/05)
|
|
! (7 ) Now make sure all USE statements are USE, ONLY (bmy, 10/3/05)
|
|
! (8 ) Treat MERRA in the same way as for GEOS-5 (bmy, 8/13/10)
|
|
!*****************************************************************************
|
|
!
|
|
! References to F90 modules
|
|
USE BPCH2_MOD, ONLY : GET_NAME_EXT_2D, GET_RES_EXT
|
|
USE BPCH2_MOD, ONLY : GET_TAU0, READ_BPCH2
|
|
USE BPCH2_MOD, ONLY : GET_NAME_EXT, GET_MODELNAME
|
|
USE DIRECTORY_MOD, ONLY : DATA_DIR
|
|
USE TRANSFER_MOD, ONLY : TRANSFER_3D
|
|
|
|
IMPLICIT NONE
|
|
# include "define.h"
|
|
# include "CMN_SIZE"
|
|
|
|
! Local variables
|
|
INTEGER :: I, J, L, M
|
|
REAL*4 :: ARRAY(IIPAR,JJPAR,LLPAR)
|
|
REAL*8 :: XTAU
|
|
CHARACTER(LEN=255) :: FILENAME
|
|
|
|
!=================================================================
|
|
! READ_CH4LOSS begins here!
|
|
!
|
|
! Read P(CO) for all 12 months
|
|
!=================================================================
|
|
! Construct filename
|
|
FILENAME = TRIM( DATA_DIR ) // 'CH4/gmi.ch4loss.' //
|
|
& 'geos5_47L.' // get_res_ext() // '.bpch'
|
|
#if defined( GRID05x0666 ) && defined( NESTED_NA )
|
|
FILENAME = '/met/gc/CH4/gmi.ch4loss.' //
|
|
& 'geos5_47L.05x0666_NA.bpch'
|
|
#endif
|
|
|
|
WRITE( 6, 93 ) TRIM ( FILENAME )
|
|
93 FORMAT( ' - READ_CH4LOSS: Reading Ch4loss: ', a )
|
|
CALL FLUSH( 6 )
|
|
|
|
! Read data for each month
|
|
DO M = 1, 12
|
|
|
|
! TAU value at the start of month M -- Use "generic" year 1985
|
|
XTAU = GET_TAU0( M, 1, 1985 )
|
|
|
|
! Read Loss frequencies in units of [1/s]. drevet.
|
|
CALL READ_BPCH2( FILENAME, 'IJ-AVG-$', 1,
|
|
& XTAU, IIPAR, JJPAR,
|
|
& LLPAR, ARRAY, QUIET=.TRUE. )
|
|
|
|
! Place array into CH4LOSS module variable
|
|
CH4LOSS(:,:,:,M) = ARRAY(:,:,:)
|
|
|
|
ENDDO
|
|
|
|
! Return to calling program
|
|
END SUBROUTINE READ_CH4LOSS
|
|
|
|
!------------------------------------------------------------------------------
|
|
|
|
SUBROUTINE CH4_STRAT_ADJ
|
|
!
|
|
!*****************************************************************************
|
|
! Subroutine CH4_STRAT_ADJ is adjonit of loss of CH4 above tropopause.
|
|
!
|
|
! Production (mixing ratio/sec) rate provided by Dylan Jones.
|
|
! Only production by CH4 + OH is considered.
|
|
!
|
|
! The annual mean tropopause is stored in the LPAUSE array
|
|
! (from header file "CMN"). LPAUSE is defined such that:
|
|
!
|
|
! Levels 1 <= L <= LPAUSE(I,J) - 1 are tropospheric
|
|
! LPAUSE(I,J) <= L <= LLPAR are stratospheric (bmy, 4/18/00)
|
|
!
|
|
! NOTES:
|
|
! (1 ) Created by Bryan Duncan (1/99). Adapted for CH4 chemistry by
|
|
! James Wang (7/00). Inserted into module "global_ch4_mod.f"
|
|
! by Bob Yantosca. (bmy, 1/16/01)
|
|
! (2 ) CH4_STRAT is independent of "CMN_OH", "CMN_CO", and "CMN_CO_BUDGET".
|
|
! (bmy, 1/16/01)
|
|
! (3 ) Removed LMN from the arg list and made it a local variable. Now use
|
|
! functions GET_MONTH and GET_TS_CHEM from "time_mod.f" (bmy, 3/27/03)
|
|
! (4 ) Now references STT from "tracer_mod.f" (bmy, 7/20/04)
|
|
!*****************************************************************************
|
|
!
|
|
! References to F90 modules
|
|
USE DAO_MOD, ONLY : AIRVOL
|
|
USE TIME_MOD, ONLY : GET_MONTH, GET_TS_CHEM
|
|
USE TRACER_MOD, ONLY : STT
|
|
USE ADJ_ARRAYS_MOD, ONLY : STT_ADJ
|
|
|
|
# include "CMN_SIZE" ! Size parameters
|
|
# include "CMN" ! STT, LPAUSE
|
|
|
|
! Local variables
|
|
INTEGER :: I, J, L, LMN
|
|
REAL*8 :: DT, GCH4, STT2GCH4, LRATE
|
|
CHARACTER*20 :: STT_TEST
|
|
CHARACTER*20 :: STT2GCH4_CHAR
|
|
|
|
! External functions
|
|
REAL*8, EXTERNAL :: BOXVL
|
|
|
|
!=================================================================
|
|
! CH4_STRAT_ADJ begins here!
|
|
!=================================================================
|
|
|
|
! Chemistry timestep [s]
|
|
DT = GET_TS_CHEM() * 60d0
|
|
|
|
! Current month
|
|
LMN = GET_MONTH()
|
|
|
|
!=================================================================
|
|
! Loop over stratospheric boxes only
|
|
!=================================================================
|
|
DO L = MINVAL( LPAUSE ), LLPAR
|
|
DO J = 1, JJPAR
|
|
DO I = 1, IIPAR
|
|
IF ( L >= LPAUSE(I,J) ) THEN
|
|
|
|
! Conversion factor [kg/box] --> [molec/cm3]
|
|
! [kg/box] / [AIRVOL * 1e6 cm3] * [XNUMOL_CH4 molec/mole]
|
|
STT2GCH4 = 1d0 / AIRVOL(I,J,L) / 1d6 * XNUMOL_CH4
|
|
|
|
! CH4 in [molec/cm3]
|
|
GCH4 = STT_ADJ(I,J,L,1) * STT2GCH4
|
|
|
|
! Loss rate [molec/cm3/s]
|
|
LRATE = GCH4 * CH4LOSS( I,J,L,LMN )
|
|
|
|
! CH4 in [molec/cm3]
|
|
GCH4 = GCH4 - ( LRATE * DT )
|
|
|
|
!kjw. Update stratospheric chem to use linearized CH4 loss frequencies
|
|
! (kjw, 11/19/11)
|
|
! ! Sum loss in TCH4(3) [molec CH4/box] in the stratosphere
|
|
! ! [molec/cm3] * [v/v/s] * [s] * [cm3/box] = [molec CH4/box]
|
|
! TCH4(I,J,L,3) = TCH4(I,J,L,3) +
|
|
! & ( BAIRDENS(I,J,L) * COPROD(J,L,LMN) *
|
|
! & DT * BOXVL(I,J,L) )
|
|
!
|
|
! ! Calculate new CH4 value [molec CH4/cm3] in the stratosphere
|
|
! ! [v/v/s] * [s] * [molec/cm3] = [molec CH4/cm3]
|
|
! GCH4 = GCH4 - ( COPROD(J,L,LMN) * DT * BAIRDENS(I,J,L) )
|
|
!kjw
|
|
|
|
! Convert back from [molec CH4/cm3] --> [kg/box]
|
|
STT_ADJ(I,J,L,1) = GCH4 / STT2GCH4
|
|
|
|
|
|
!kjw. With new linearized chemistry, STT should never be negative
|
|
! (kjw, 11/19/11)
|
|
! IF ( STT(I,J,L,1) < 0 ) THEN
|
|
! STT(I,J,L,1)=0
|
|
! ENDIF
|
|
!kjw
|
|
|
|
ENDIF
|
|
ENDDO
|
|
ENDDO
|
|
ENDDO
|
|
|
|
! Return to calling program
|
|
END SUBROUTINE CH4_STRAT_ADJ
|
|
|
|
!------------------------------------------------------------------------------
|
|
|
|
! SUBROUTINE CH4_STRAT
|
|
!!
|
|
!!*****************************************************************************
|
|
!! Subroutine CH4_STRAT calculates uses production rates for CH4 to
|
|
!! calculate loss of CH4 in above the tropopause.
|
|
!! (jsw, bnd, bmy, 1/16/01, 7/20/04)
|
|
!! DO NOT CALL IN ADJOINT SIMULATION (kjw, 7/6/11)
|
|
!!
|
|
!! Production (mixing ratio/sec) rate provided by Dylan Jones.
|
|
!! Only production by CH4 + OH is considered.
|
|
!!
|
|
!! The annual mean tropopause is stored in the LPAUSE array
|
|
!! (from header file "CMN"). LPAUSE is defined such that:
|
|
!!
|
|
!! Levels 1 <= L < LPAUSE(I,J) - 1 are tropospheric
|
|
!! LPAUSE(I,J) <= L <= LLPAR are stratospheric (bmy, 4/18/00)
|
|
!!
|
|
!! NOTES:
|
|
!! (1 ) Created by Bryan Duncan (1/99). Adapted for CH4 chemistry by
|
|
!! James Wang (7/00). Inserted into module "global_ch4_mod.f"
|
|
!! by Bob Yantosca. (bmy, 1/16/01)
|
|
!! (2 ) CH4_STRAT is independent of "CMN_OH", "CMN_CO", and "CMN_CO_BUDGET".
|
|
!! (bmy, 1/16/01)
|
|
!! (3 ) Removed LMN from the arg list and made it a local variable. Now use
|
|
!! functions GET_MONTH and GET_TS_CHEM from "time_mod.f" (bmy, 3/27/03)
|
|
!! (4 ) Now references STT from "tracer_mod.f" (bmy, 7/20/04)
|
|
!!*****************************************************************************
|
|
!!
|
|
! ! References to F90 modules
|
|
! USE ADJ_ARRAYS_MOD, ONLY : ADCH4EMS, EMS_SF_ADJ, STT_ADJ
|
|
! USE DAO_MOD, ONLY : AIRVOL, AD
|
|
! USE TIME_MOD, ONLY : GET_MONTH, GET_TS_CHEM
|
|
!
|
|
!# include "CMN_SIZE" ! Size parameters
|
|
!# include "CMN" ! LPAUSE
|
|
!
|
|
! ! Local variables
|
|
! LOGICAL, SAVE :: FIRSTCHEM
|
|
! INTEGER :: I, J, L, LMN
|
|
! REAL*8 :: DT, GCH4_ADJ, STT2GCH4
|
|
! REAL*8, PARAMETER :: WTAIR = 28.966d0
|
|
!
|
|
! ! External functions
|
|
! REAL*8, EXTERNAL :: BOXVL
|
|
!
|
|
! !=================================================================
|
|
! ! CH4_STRAT begins here!
|
|
! !=================================================================
|
|
!
|
|
! !=================================================================
|
|
! ! (1) If first time step, read LCO data
|
|
! !=================================================================
|
|
! IF ( FIRSTCHEM ) THEN
|
|
!
|
|
! ! Zero CO Production array
|
|
! COPROD(:,:,:) = 0d0
|
|
!
|
|
! ! Read zonally-averaged CO production [v/v/s]
|
|
! CALL READ_COPROD
|
|
!
|
|
! ENDIF
|
|
!
|
|
! ! Chemistry timestep [s]
|
|
! DT = GET_TS_CHEM() * 60d0
|
|
!
|
|
! ! Current month
|
|
! LMN = GET_MONTH()
|
|
!
|
|
!
|
|
! !=================================================================
|
|
! ! (2) Calculate each box's air density [molec/cm3]
|
|
! !=================================================================
|
|
!
|
|
! DO L = 1, LLPAR
|
|
! DO J = 1, JJPAR
|
|
! DO I = 1, IIPAR
|
|
! BAIRDENS(I,J,L) = AD(I,J,L) * 1000d0 / BOXVL(I,J,L) *
|
|
! & 6.023D23 / WTAIR
|
|
! ENDDO
|
|
! ENDDO
|
|
! ENDDO
|
|
!
|
|
!
|
|
! !=================================================================
|
|
! ! (3) Calculate stratospheric CH4 loss from COPRODuction
|
|
! ! Loop over stratospheric boxes only
|
|
! !=================================================================
|
|
! DO L = MINVAL( LPAUSE ), LLPAR
|
|
! DO J = 1, JJPAR
|
|
! DO I = 1, IIPAR
|
|
! IF ( L >= LPAUSE(I,J) ) THEN
|
|
!
|
|
! ! Conversion factor [kg/box] --> [molec/cm3]
|
|
! ! [kg/box] / [AIRVOL * 1e6 cm3] * [XNUMOL_CH4 molec/mole]
|
|
! STT2GCH4 = 1d0 / AIRVOL(I,J,L) / 1d6 * XNUMOL_CH4
|
|
!
|
|
! ! CH4 in [molec/cm3]
|
|
! GCH4_ADJ = STT_ADJ(I,J,L,1) * STT2GCH4
|
|
!
|
|
! ! Calculate new CH4 value [molec CH4/cm3] in the stratosphere
|
|
! ! [v/v/s] * [s] * [molec/cm3] = [molec CH4/cm3]
|
|
! GCH4_ADJ = GCH4_ADJ -
|
|
! & ( COPROD(J,L,LMN) * DT * BAIRDENS(I,J,L) )
|
|
!
|
|
! ! Convert back from [molec CH4/cm3] --> [kg/box]
|
|
! STT_ADJ(I,J,L,1) = GCH4_ADJ / STT2GCH4
|
|
!
|
|
! ENDIF
|
|
! ENDDO
|
|
! ENDDO
|
|
! ENDDO
|
|
!
|
|
! ! Set FIRSTCHEM to FALSE
|
|
! FIRSTCHEM = .FALSE.
|
|
!
|
|
! ! Return to calling program
|
|
! END SUBROUTINE CH4_STRAT
|
|
!
|
|
!
|
|
!
|
|
!------------------------------------------------------------------------------
|
|
|
|
SUBROUTINE READ_COPROD
|
|
!
|
|
!*****************************************************************************
|
|
! Subroutine READ_COPROD reads production and destruction rates for CO in
|
|
! the stratosphere. (bnd, bmy, 1/17/01, 10/3/05)
|
|
!
|
|
! Module Variables:
|
|
! ===========================================================================
|
|
! (1) COPROD (REAL*8) : Array containing P(CO) for all 12 months [v/v/s]
|
|
!
|
|
! NOTES:
|
|
! (1 ) Created by Bryan Duncan (1/99). Adapted for CH4 chemistry by
|
|
! James Wang (6/8/00). Inserted into module "global_ch4_mod.f"
|
|
! by Bob Yantosca. (bmy, 1/16/01)
|
|
! (2 ) READ_COPROD is independent of "CMN_OH", "CMN_CO", and "CMN_CO_BUDGET".
|
|
! (bmy, 1/16/01)
|
|
! (3 ) ARRAY needs to be dimensioned (1,JGLOB,LGLOB) (bmy, 9/26/01)
|
|
! (4 ) Remove obsolete code from 9/01 (bmy, 10/24/01)
|
|
! (5 ) Now reference DATA_DIR from "directory_mod.f" (bmy, 7/20/04)
|
|
! (6 ) Now reads data for both GEOS and GCAP grids (bmy, 8/16/05)
|
|
! (7 ) Now make sure all USE statements are USE, ONLY (bmy, 10/3/05)
|
|
!*****************************************************************************
|
|
!
|
|
! References to F90 modules
|
|
USE BPCH2_MOD, ONLY : GET_NAME_EXT_2D, GET_RES_EXT
|
|
USE BPCH2_MOD, ONLY : GET_TAU0, READ_BPCH2
|
|
USE BPCH2_MOD, ONLY : GET_NAME_EXT, GET_MODELNAME
|
|
USE DIRECTORY_MOD, ONLY : DATA_DIR
|
|
USE TRANSFER_MOD, ONLY : TRANSFER_ZONAL
|
|
|
|
IMPLICIT NONE
|
|
|
|
# include "CMN_SIZE" ! Size parameters
|
|
|
|
|
|
! Local variables
|
|
CHARACTER(LEN=255) :: FILENAME
|
|
INTEGER :: M
|
|
REAL*4 :: ARRAY(1,JGLOB,LGLOB)
|
|
REAL*4 :: DUMMY_IN(JGLOB,LGLOB)
|
|
REAL*8 :: XTAU
|
|
REAL*8 :: DUMMY_OUT(JGLOB,LGLOB)
|
|
|
|
|
|
!=================================================================
|
|
! READ_COPROD begins here!
|
|
!
|
|
! Read P(CO) for all 12 months
|
|
!=================================================================
|
|
DO M = 1, 12
|
|
|
|
! TAU value at the start of month M -- Use "generic" year 1985
|
|
XTAU = GET_TAU0( M, 1, 1985 )
|
|
|
|
! Construct filename
|
|
FILENAME = TRIM( DATA_DIR ) // 'pco_lco_200203/' //
|
|
& 'COprod.' // GET_NAME_EXT() // '.' // GET_RES_EXT()
|
|
|
|
|
|
WRITE( 6, 93 ) TRIM ( FILENAME )
|
|
93 FORMAT( ' - READ_COPROD: Reading COprod: ', a )
|
|
CALL FLUSH( 6 )
|
|
|
|
|
|
cdrevet
|
|
! Read P(CO) in units of [v/v/s]
|
|
CALL READ_BPCH2( FILENAME, 'PORL-L=$', 9,
|
|
& XTAU, 1, JGLOB,
|
|
& LGLOB, ARRAY, QUIET=.TRUE. )
|
|
cdrevet
|
|
|
|
! use 2D arrays for TRANSFER ZONAL
|
|
DUMMY_IN(:,:) = ARRAY(1,:,:)
|
|
|
|
! Copy REAL*4 to REAL*8 data, and resize from (JGLOB,LGLOB)
|
|
! to (JJPAR,LLPAR) -- vertically regrid if necessary
|
|
CALL TRANSFER_ZONAL( DUMMY_IN, DUMMY_OUT )
|
|
|
|
COPROD(:,:,M) = DUMMY_OUT(:,:)
|
|
|
|
ENDDO
|
|
|
|
|
|
! Return to calling program
|
|
END SUBROUTINE READ_COPROD
|
|
|
|
|
|
!------------------------------------------------------------------------------
|
|
|
|
SUBROUTINE CH4_AVGTP_ADJ
|
|
!
|
|
!******************************************************************************
|
|
! Subroutine CH4_AVGTP gets the 24-h average surface pressure and temperature
|
|
! needed for the CH4 simulation. (jsw, bnd, bmy, 1/16/01, 7/20/04)
|
|
!
|
|
! NOTES:
|
|
! (1 ) Created by Bryan Duncan (1/99). Adapted for CH4 chemistry and
|
|
! placed into module "global_ch4_mod.f" by Bob Yantosca. (bmy, 1/16/01)
|
|
! (2 ) CH4_AVGTP is independent of "CMN_OH", "CMN_CO", and "CMN_CO_BUDGET".
|
|
! (bmy, 1/16/01)
|
|
! (3 ) Removed duplicate definition for NTDT, NMIN (bmy, 11/15/01)
|
|
! (4 ) Removed PS from argument list. Now use P(I,J)+PTOP instead of
|
|
! PS, this ensures that we have consistency between P and AD.
|
|
! (bmy, 4/11/02)
|
|
! (5 ) Removed obsolete code (bmy, 6/27/02)
|
|
! (6 ) Now uses GET_PCENTER from "pressure_mod.f" to return the pressure
|
|
! at the midpoint of the box (I,J,L). Also added parallel DO-loops.
|
|
! Updated comments. (dsa, bdf, bmy, 8/21/02)
|
|
! (7 ) Now reference T from "dao_mod.f". Now reference GEOS_CHEM_STOP from
|
|
! "error_mod.f" (bmy, 10/15/02)
|
|
! (8 ) Removed NTDT, NMIN from the arg list. Now uses functions GET_TS_DYN,
|
|
! GET_TS_CHEM, and GET_ELAPSED_MIN from "time_mod.f" (bmy, 3/27/03)
|
|
! (9 ) Remove reference to CMN, it's not needed (bmy, 7/20/04)
|
|
! (10) Modify from CH4_AVGTP_ADJ for compatability with the adjoint (kjw, 2/22/10)
|
|
!******************************************************************************
|
|
!
|
|
! References to F90 modules
|
|
USE TIME_MOD, ONLY : GET_TS_DYN, GET_TS_CHEM
|
|
USE TIME_MOD, ONLY : GET_NYMD, GET_NYMDe, GET_NYMDb
|
|
USE TIME_MOD, ONLY : GET_NHMS, GET_TIME_BEHIND_ADJ
|
|
USE DAO_MOD, ONLY : T
|
|
|
|
# include "CMN_SIZE" ! Size parameters
|
|
|
|
! Local variables
|
|
CHARACTER(LEN=255) :: PATH
|
|
INTEGER :: I, NYMD, NHMS, NDYN, TAG, INFO(3)
|
|
INTEGER :: NYMDp, NHMSp, countit
|
|
REAL*8 :: Temp(IIPAR, JJPAR, LLPAR)
|
|
REAL*8 :: result(2)
|
|
|
|
!=================================================================
|
|
! CH4_AVGTP_ADJ begins here!
|
|
!=================================================================
|
|
|
|
WRITE(6,'(a)') ' % CH4_AVGTP_ADJ begins'
|
|
|
|
! Initialize Tavg_adj for the current time step
|
|
Tavg_adj(:,:,:) = 0d0
|
|
|
|
! NDYN = # of dynamics time steps in each chemical time step
|
|
NDYN = GET_TS_CHEM() / GET_TS_DYN()
|
|
|
|
! If 1 day from beginning of the simulation
|
|
IF ( GET_NYMD() .EQ. GET_NYMDb()+1 ) NDYN = NDYN + 1
|
|
|
|
countit=0
|
|
|
|
DO I = 1,NDYN
|
|
|
|
! Initialize T
|
|
!T(:,:,:) = 0d0
|
|
|
|
! Get time stamps at current and every dyn time step during the day
|
|
result = GET_TIME_BEHIND_ADJ( GET_TS_DYN()*(I-1) )
|
|
|
|
! NYMD, NHMS, TAG
|
|
NYMD = result(1)
|
|
NHMS = result(2)
|
|
|
|
! Get file unit number for A6 file to be opened
|
|
! Such that 20 <= IU_NUM <= 64 .OR. IU_NUM => 100 (kjw, 2/23/10)
|
|
! Check available unit numbers in file_mod.f
|
|
! IU_NUM = 52
|
|
|
|
! Find date of closest A-6 file to open and which occurence of Temp to use
|
|
INFO = FIND_CLOSEST_A6( NYMD, NHMS )
|
|
NYMDp = INFO(1)
|
|
NHMSp = INFO(2)
|
|
TAG = INFO(3)
|
|
|
|
|
|
! Open A6 file to read Temperature data
|
|
CALL OPEN_A6_CH4_ADJ( NYMDp, NHMSp )
|
|
|
|
|
|
! If the desired A-6 file is already in use, use DAO_MOD, ONLY : T
|
|
IF ( IU_A6_CH4_ADJ == 72 ) THEN
|
|
|
|
Tavg_adj(:,:,:) = Tavg_adj(:,:,:) + T(:,:,:)
|
|
countit=countit+1
|
|
|
|
ELSE IF ( IU_A6_CH4_ADJ == 52 ) THEN
|
|
|
|
! READ A6 fields with temp data
|
|
CALL READ_A6_CH4_ADJ( NYMDp, NHMSp, TAG, Temp )
|
|
|
|
! Collect temperature data
|
|
Tavg_adj(:,:,:) = Tavg_adj(:,:,:) + Temp(:,:,:)
|
|
countit=countit+1
|
|
|
|
! Close file we just opened
|
|
CLOSE( IU_A6_CH4_ADJ )
|
|
|
|
ENDIF
|
|
|
|
ENDDO
|
|
|
|
! Average Temperature information
|
|
Tavg_adj(:,:,:) = Tavg_adj(:,:,:) / NDYN
|
|
|
|
|
|
WRITE(6,'(a)') ' % CH4_AVGTP_ADJ ends'
|
|
|
|
! Return to calling program
|
|
END SUBROUTINE CH4_AVGTP_ADJ
|
|
|
|
|
|
|
|
!------------------------------------------------------------------------------
|
|
|
|
! SUBROUTINE UPDATE_LASTOF
|
|
!
|
|
!********************************************************************************
|
|
|
|
! Subroutine UPDATE_LASTOF determines whether the next time step will be the last
|
|
! of a month (kjw, 2/22/10)
|
|
!
|
|
! NOTES
|
|
!
|
|
!********************************************************************************
|
|
|
|
|
|
! If 12am on Jan1, next time step in adjoint will be last of preceeding year
|
|
! IF ( ITS_A_NEW_YEAR() ) THEN
|
|
! LASTOFYEAR = .TRUE.
|
|
! ELSE
|
|
! LASTOFYEAR = .FALSE.
|
|
! ENDIF
|
|
|
|
! If 12am on 1st of month, next time step in adjoint will be last of preceeding month
|
|
! IF ( TIS_A_NEW_MONTH() ) THEN
|
|
! LASTOFMONTH = .TRUE.
|
|
! ELSE
|
|
! LASTOFMONTH = .TRUE.
|
|
! ENDIF
|
|
|
|
|
|
|
|
! Return to calling program
|
|
! END SUBROUTINE UPDATE_LASTOF
|
|
|
|
|
|
|
|
|
|
!------------------------------------------------------------------------------
|
|
|
|
SUBROUTINE OPEN_A6_CH4_ADJ( NYMDp, NHMSp )
|
|
!
|
|
!******************************************************************************
|
|
! Subroutine OPEN_A6_CH4_ADJ opens the A-6 met fields file for date NYMD and
|
|
! time NHMS for use by CH4 adjoint simulation. Based on GET_A6_FIELDS.
|
|
! (bmy, bdf, 6/15/98, 2/12/09), (kjw, 2/23/10)
|
|
!
|
|
! Difference with OPEN_A6_FIELDS is that this uses a different file unit
|
|
! number than IU_A6. File unit # is a parameter, IU_A6_CH4_ADJ
|
|
!
|
|
! Arguments as input:
|
|
! ===========================================================================
|
|
! (1 ) NYMD (INTEGER) : Current value of YYYYMMDD
|
|
! (2 ) NHMS (INTEGER) : Current value of HHMMSS
|
|
!
|
|
! NOTES:
|
|
! (1 ) Adapted from OPEN_MET_FIELDS of "dao_read_mod.f" (bmy, 6/19/03)
|
|
! (2 ) Now opens either zipped or unzipped files (bmy, 12/11/03)
|
|
! (3 ) Now skips past the GEOS-4 ident string (bmy, 12/12/03)
|
|
! (4 ) Now references "directory_mod.f" instead of CMN_SETUP. Also now
|
|
! references LUNZIP from "logical_mod.f". Also now prevents EXPAND_DATE
|
|
! from overwriting Y/M/D tokens in directory paths. (bmy, 7/20/04)
|
|
! (5 ) Now use FILE_EXISTS from "file_mod.f" to determine if file unit IU_A6
|
|
! refers to a valid file on disk (bmy, 3/23/05)
|
|
! (6 ) Now modified for GEOS-5 and GCAP met fields (swu, bmy, 5/25/05)
|
|
! (7 ) Now make sure all USE statements are USE, ONLY (bmy, 10/3/05)
|
|
! (8 ) Remove support for GEOS-1 and GEOS-STRAT met fields (bmy, 8/4/06)
|
|
! (9 ) Now get the # of A-3 fields from the file ident string (bmy, 10/7/08)
|
|
! (10) Set N_A6_FIELDS=21 for GEOS-5 and IN_CLOUD_OD (jmao, bmy, 2/12/09)
|
|
!******************************************************************************
|
|
|
|
|
|
! References to F90 modules
|
|
USE BPCH2_MOD, ONLY : GET_RES_EXT
|
|
USE DIRECTORY_MOD, ONLY : DATA_DIR
|
|
USE DIRECTORY_MOD, ONLY : GEOS_4_DIR, GEOS_5_DIR, TEMP_DIR
|
|
USE DIRECTORY_MOD, ONLY : GEOS_FP_DIR !! (lzh, 07/10/2014) geos-fp
|
|
USE ERROR_MOD, ONLY : ERROR_STOP
|
|
USE LOGICAL_MOD, ONLY : LUNZIP
|
|
USE FILE_MOD, ONLY : IOERROR, FILE_EXISTS
|
|
USE TIME_MOD, ONLY : EXPAND_DATE, GET_NYMD, GET_NHMS
|
|
|
|
# include "CMN_SIZE" ! Size parameters
|
|
|
|
! Arguments
|
|
INTEGER, INTENT(IN) :: NYMDp, NHMSp
|
|
|
|
! Local variables
|
|
INTEGER :: IOS
|
|
CHARACTER(LEN=8) :: IDENT
|
|
CHARACTER(LEN=255) :: A6_FILE
|
|
CHARACTER(LEN=255) :: A6_NOW
|
|
CHARACTER(LEN=255) :: GEOS_DIR
|
|
CHARACTER(LEN=255) :: PATH
|
|
|
|
!=================================================================
|
|
! OPEN_A6_FIELDS begins here!
|
|
!=================================================================
|
|
|
|
|
|
! Get Filename
|
|
! ----------------------------------------------------------------
|
|
#if defined( GEOS_4 )
|
|
|
|
! Strings for directory & filename
|
|
GEOS_DIR = TRIM( GEOS_4_DIR )
|
|
A6_FILE = 'YYYYMMDD.a6.' // GET_RES_EXT()
|
|
A6_NOW = 'YYYYMMDD.a6.' // GET_RES_EXT()
|
|
|
|
#elif defined( GEOS_5 )
|
|
|
|
! Strings for directory & filename
|
|
GEOS_DIR = TRIM( GEOS_5_DIR )
|
|
A6_FILE = 'YYYYMMDD.a6.' // GET_RES_EXT()
|
|
A6_NOW = 'YYYYMMDD.a6.' // GET_RES_EXT()
|
|
|
|
#endif
|
|
|
|
! Replace date tokens
|
|
CALL EXPAND_DATE( GEOS_DIR, NYMDp, NHMSp )
|
|
CALL EXPAND_DATE( A6_FILE, NYMDp, NHMSp )
|
|
CALL EXPAND_DATE( A6_NOW, GET_NYMD(), GET_NHMS() )
|
|
|
|
print*,'NYMD and NHMS right now ',GET_NYMD(),GET_NHMS()
|
|
print*,'NYMDp and NHMSp of file to open ', NYMDp,NHMSp
|
|
|
|
! If the A-6 file is already open, return to calling program
|
|
IF ( TRIM( A6_FILE ) == TRIM( A6_NOW ) ) THEN
|
|
print*,'This file is already open',TRIM(A6_NOW)
|
|
print*,'Using previously opened A-6 file...'
|
|
IU_A6_CH4_ADJ = 72
|
|
RETURN
|
|
ELSE
|
|
print*,'We have to open a new A-6 file: ',TRIM(A6_NOW)
|
|
IU_A6_CH4_ADJ = 52
|
|
ENDIF
|
|
|
|
! If unzipping, open GEOS-1 file in TEMP dir
|
|
! If not unzipping, open GEOS-1 file in DATA dir
|
|
IF ( LUNZIP ) THEN
|
|
PATH = TRIM( TEMP_DIR ) // TRIM( A6_FILE )
|
|
ELSE
|
|
PATH = TRIM( DATA_DIR ) //
|
|
& TRIM( GEOS_DIR ) // TRIM( A6_FILE )
|
|
ENDIF
|
|
|
|
! Make sure the file unit is valid before we open the file
|
|
IF ( .not. FILE_EXISTS( IU_A6_CH4_ADJ ) ) THEN
|
|
CALL ERROR_STOP( 'Could not find file!',
|
|
& 'OPEN_A6_FIELDS (a6_read_mod.f)' )
|
|
ENDIF
|
|
|
|
! Open the file
|
|
! ----------------------------------------------------------------
|
|
! Hardwire unit number to not conflict with current IU_A6 (kjw, 2/23/10)
|
|
OPEN( UNIT = IU_A6_CH4_ADJ, FILE = TRIM( PATH ),
|
|
& STATUS = 'OLD', ACCESS = 'SEQUENTIAL',
|
|
& FORM = 'UNFORMATTED', IOSTAT = IOS )
|
|
|
|
IF ( IOS /= 0 ) THEN
|
|
CALL IOERROR( IOS, IU_A6_CH4_ADJ, 'open_a6_fields:1' )
|
|
ENDIF
|
|
|
|
! Skip past the ident string
|
|
READ( IU_A6_CH4_ADJ, IOSTAT=IOS ) IDENT
|
|
|
|
! Echo info
|
|
WRITE( 6, 100 ) TRIM( PATH )
|
|
100 FORMAT( ' - Opening: ', a )
|
|
|
|
|
|
! Return to calling program
|
|
END SUBROUTINE OPEN_A6_CH4_ADJ
|
|
|
|
|
|
!-----------------------------------------------------------------------------
|
|
|
|
SUBROUTINE READ_A6_CH4_ADJ( NYMDp, NHMSp, TAG, Temp )
|
|
!
|
|
!******************************************************************************
|
|
! Subroutine READ_A6_CH4_ADJ reads A-6 (avg 6-hr) met fields from disk.
|
|
! (bmy, 6/5/98, 3/28/08)
|
|
!
|
|
! For CH4 adjoint simulation, hardwire file unit # as a parameter
|
|
!
|
|
! Arguments as input:
|
|
! ===========================================================================
|
|
! (1 ) NYMD : YYYYMMDD
|
|
! (2 ) NHMS : and HHMMSS of A-6 met fields to be accessed
|
|
!
|
|
! A-6 Met Fields as Output (Optional Arguments):
|
|
! ============================================================================
|
|
! (1) T : (3-D) Temperature [K]
|
|
!
|
|
! NOTES:
|
|
! (1 ) Adapted from READ_A6 of "dao_read_mod.f" (bmy, 6/19/03)
|
|
! (2 ) Now use function TIMESTAMP_STRING from "time_mod.f" for formatted
|
|
! date/time output. (bmy, 10/28/03)
|
|
! (3 ) Now compute CLDTOPS using ZMMU for GEOS-4 (bmy, 3/4/04)
|
|
! (4 ) Now modified for GEOS-5 and GCAP fields. Added DETRAINE,
|
|
! DETRAINN, DNDE, DNDN, ENTRAIN, UPDE, UPDN as optional arguments.
|
|
! Now references "CMN_DIAG". (swu, bmy, 5/25/05)
|
|
! (5 ) Bug fix in ND66 diagnostic for GEOS-4 (bmy, 2/1/06)
|
|
! (6 ) Remove support for GEOS-1 and GEOS-STRAT met fields (bmy, 8/4/06)
|
|
! (7 ) Now set negative SPHU to a small positive # (1d-32) instead of zero,
|
|
! so as not to blow up logarithms (bmy, 9/8/06)
|
|
! (8 ) Add CMFMC, DQIDTMST, DQLDTMST, DQRCON, DQRLSC, DQVDTMST, MFXC, MFYC,
|
|
! MFZ, PLE, PV, RH, TAUCLI, and TAUCLW as optional arguments. Also
|
|
! update the CASE statement accordingly for GEOS-5 met fields.
|
|
! Now reference TRANSFER_3D_Lp1 from "transfer_mod.f". Now convert
|
|
! GEOS-5 specific humidity from [kg/kg] to [g/kg] for compatibility
|
|
! with existing routines. Also recognize EPV, which is an alternate
|
|
! name for PV. Bug fix: convert GEOS-5 RH from unitless to %.
|
|
! (phs, bmy, 3/28/08)
|
|
! (8 ) Now get the # of A-6 fields from the file ident string (bmy, 10/7/08)
|
|
!******************************************************************************
|
|
!
|
|
! References to F90 modules
|
|
USE DIAG_MOD, ONLY : AD66, AD67
|
|
USE FILE_MOD, ONLY : IOERROR
|
|
USE TIME_MOD, ONLY : SET_CT_A6, TIMESTAMP_STRING
|
|
USE TRANSFER_MOD, ONLY : TRANSFER_A6, TRANSFER_3D_Lp1
|
|
USE TRANSFER_MOD, ONLY : TRANSFER_3D, TRANSFER_G5_PLE
|
|
|
|
# include "CMN_SIZE" ! Size parameters
|
|
# include "CMN_DIAG" ! ND66, ND67
|
|
# include "CMN_GCTM" ! g0
|
|
|
|
! Arguments
|
|
INTEGER, INTENT(IN) :: NYMDp, NHMSp, TAG
|
|
REAL*8, INTENT(OUT) :: Temp(IIPAR,JJPAR,LLPAR)
|
|
|
|
! Local variables
|
|
INTEGER :: IOS
|
|
REAL*4 :: D(IGLOB,JGLOB,LGLOB)
|
|
CHARACTER(LEN=8) :: NAME
|
|
INTEGER :: XYMD, XHMS, NFOUND
|
|
|
|
!=================================================================
|
|
! READ_A6 begins here!
|
|
!=================================================================
|
|
|
|
! Number of A-6 fields.
|
|
! We only want 1: temperature
|
|
!N_A6 = 1 DON'T NEED
|
|
|
|
! Zero number of fields that we have found
|
|
!NFOUND = 0 DON'T NEED
|
|
|
|
!=================================================================
|
|
! Read the A-6 fields from disk
|
|
!=================================================================
|
|
|
|
! Count # of times we find temperature
|
|
NFOUND = 0
|
|
|
|
! Read each available data set in the file, but only save Temperature
|
|
DO
|
|
|
|
! Read A-6 field name
|
|
READ( IU_A6_CH4_ADJ, IOSTAT=IOS ) NAME
|
|
!print*, 'A6 NAME : ', NAME
|
|
|
|
! IOS < 0: End-of-file; make sure we've found
|
|
! all the A-6 fields before exiting this loop
|
|
IF ( IOS < 0 ) EXIT
|
|
|
|
! IOS > 0: True I/O Error, stop w/ error msg
|
|
IF ( IOS > 0 ) CALL IOERROR( IOS, IU_A6_CH4_ADJ,
|
|
& 'read_a6_ch4_adj:1' )
|
|
|
|
! Examine the name of field
|
|
SELECT CASE ( TRIM( NAME ) )
|
|
|
|
! If we've found temperature
|
|
CASE( 'T' )
|
|
|
|
! Increase count
|
|
NFOUND = NFOUND + 1
|
|
|
|
IF ( NFOUND == TAG ) THEN
|
|
|
|
print*,'% --- READ_A6_CH4_ADJ : Found T field desired'
|
|
|
|
! Read into array
|
|
READ( IU_A6_CH4_ADJ, IOSTAT=IOS ) XYMD, XHMS, D
|
|
IF ( IOS /= 0 ) CALL IOERROR( IOS, IU_A6_CH4_ADJ,
|
|
& 'read_a6_ch4_adj:29' )
|
|
|
|
!IF ( CHECK_TIME( XYMD, XHMS, NYMD, NHMS ) ) THEN
|
|
! IF ( PRESENT( T ) ) CALL TRANSFER_3D( D, T )
|
|
CALL TRANSFER_3D( D, Temp )
|
|
!ENDIF
|
|
|
|
! Return to Calling Program
|
|
RETURN
|
|
|
|
ELSE
|
|
|
|
print*,' % --- READ_A6_CH4_ADJ : Not Correct T field'
|
|
|
|
! Read into array
|
|
READ( IU_A6_CH4_ADJ, IOSTAT=IOS ) XYMD, XHMS, D
|
|
IF ( IOS /= 0 ) CALL IOERROR( IOS, IU_A6_CH4_ADJ,
|
|
& 'read_a6_ch4_adj:29' )
|
|
|
|
ENDIF
|
|
|
|
! If field is not temperature -- skip over
|
|
CASE DEFAULT
|
|
!WRITE( 6, '(a)' ) 'Searching for next A-6 field!'
|
|
!WRITE( 6, '(2a)' ) 'THIS name = ',TRIM(NAME)
|
|
!print*,'LLPAR = ',LLPAR
|
|
!print*,'LGLOB = ',LGLOB
|
|
READ( IU_A6_CH4_ADJ, IOSTAT=IOS ) XYMD, XHMS, D
|
|
IF ( IOS /= 0 ) CALL IOERROR( IOS, IU_A6_CH4_ADJ,
|
|
& 'read_a6_ch4_adj:41' )
|
|
|
|
END SELECT
|
|
|
|
ENDDO
|
|
|
|
! Return to calling program
|
|
END SUBROUTINE READ_A6_CH4_ADJ
|
|
|
|
|
|
|
|
!------------------------------------------------------------------------------
|
|
|
|
FUNCTION FIND_CLOSEST_A6( NYMD, NHMS ) RESULT( INFO )
|
|
!
|
|
!********************************************************************************
|
|
! Subroutine FIND_CLOSEST_A6 finds the date and time of the nearest A-6 met field
|
|
! (kjw, 2/24/10)
|
|
!
|
|
! NOTES
|
|
! time tag, A6_TIME(3), tells us which occurence of A-6 Temperature we want (1st-4th)
|
|
!
|
|
!********************************************************************************
|
|
|
|
! Reference to f90 modules
|
|
USE TIME_MOD, ONLY : GET_NYMD, GET_NHMS
|
|
|
|
|
|
# include "CMN_SIZE" ! Size
|
|
|
|
! Arguments
|
|
INTEGER, INTENT(IN) :: NYMD, NHMS
|
|
|
|
! Output
|
|
INTEGER :: INFO(3)
|
|
|
|
! Local Variables
|
|
CHARACTER(LEN=6) :: CNHMS
|
|
! CHARACTER(LEN=2) :: CHH
|
|
! CHARACTER(LEN=2) :: CMM
|
|
! INTEGER :: HH,MM,NMIN
|
|
|
|
|
|
!============================================================
|
|
! FIND_CLOSEST_A6 begins here!
|
|
!============================================================
|
|
|
|
! If 12-2:59am
|
|
IF ( ( NHMS >= 000000 ) .AND. ( NHMS <= 025959 ) ) THEN
|
|
|
|
! NYMD remains the same
|
|
INFO(1) = NYMD
|
|
|
|
! NHMS = 6am
|
|
INFO(2) = 000000
|
|
|
|
! Set time tag
|
|
INFO(3) = 1
|
|
|
|
! If 3-8:59am
|
|
ELSE IF ( ( NHMS >= 030000 ) .AND. ( NHMS <= 085959 ) ) THEN
|
|
|
|
! NYMD remains the same
|
|
INFO(1) = NYMD
|
|
|
|
! NHMS = 6am
|
|
INFO(2) = 060000
|
|
|
|
! Set time tag
|
|
INFO(3) = 2
|
|
|
|
! If 9am-2:59pm
|
|
ELSE IF ( ( NHMS >= 090000 ) .AND. ( NHMS <= 145959 ) ) THEN
|
|
|
|
! NYMD remains the same
|
|
INFO(1) = NYMD
|
|
|
|
! NHMS = 12pm
|
|
INFO(2) = 120000
|
|
|
|
! Set time tag
|
|
INFO(3) = 3
|
|
|
|
! If 3pm-8:59pm
|
|
ELSE IF ( ( NHMS >= 150000 ) .AND. ( NHMS <= 205959 ) ) THEN
|
|
|
|
! NYMD remains the same
|
|
INFO(1) = NYMD
|
|
|
|
! NHMS = 12pm
|
|
INFO(2) = 180000
|
|
|
|
! Set time tag
|
|
INFO(3) = 4
|
|
|
|
! If 9pm-11:59pm
|
|
ELSE IF ( ( NHMS >= 210000 ) .AND. ( NHMS <= 235959 ) ) THEN
|
|
|
|
! Since calling at midnight, these values should be current time
|
|
INFO(1) = GET_NYMD()
|
|
INFO(2) = GET_NHMS()
|
|
|
|
! Set time tag
|
|
INFO(3) = 1
|
|
|
|
! We should find how many minutes behind current time is NYMD and NHMS
|
|
! Turn NHMS into a string
|
|
!WRITE( CNHMS, '(i6)' ) NHMS
|
|
|
|
! Get Hour and Minute values from this
|
|
!CHH = CNHMS(1:2)
|
|
!CMM = CNHMS(3:4)
|
|
!READ( CHH, * ) HH
|
|
!READ( CMM, * ) MM
|
|
|
|
! Get number of minutes from midnight
|
|
!NMIN = 60 * (24 - HH) + (60 - MM) - 60
|
|
|
|
! Get proper date stamp for midnight on the next day
|
|
!INFO = GET_TIME_AHEAD( NMIN )
|
|
|
|
ENDIF
|
|
RETURN
|
|
|
|
|
|
! Return to calling program
|
|
END FUNCTION FIND_CLOSEST_A6
|
|
|
|
|
|
!------------------------------------------------------------------------------
|
|
|
|
FUNCTION GET_SCALE_GROUP( ) RESULT( CURRENT_GROUP )
|
|
!
|
|
!********************************************************************************
|
|
! Subroutine GET_SCALE_GROUP determines which predifined scaling index corresponds
|
|
! to the current time and location (dkh, 12/02/04)
|
|
!
|
|
! NOTES
|
|
! (1 ) CURRENT_GROUP is currently only a function of TAU
|
|
! (2 ) Get rid of I,J as argument. (dkh, 03/28/05)
|
|
!
|
|
!********************************************************************************
|
|
|
|
! Reference to f90 modules
|
|
USE TIME_MOD, ONLY : GET_TAU, GET_TAUe, GET_TAUb, GET_MONTH
|
|
USE ADJ_ARRAYS_MOD, ONLY: MMSCL
|
|
|
|
# include "CMN_SIZE" ! Size stuff
|
|
|
|
! Arguments
|
|
INTEGER :: I, J
|
|
|
|
! Local Variables
|
|
REAL*8 :: TOTAL_HR, CURRENT_HR, GROUP_LENGTH
|
|
REAL*8 :: TAU, TAUe, TAUb
|
|
|
|
! Function variable
|
|
INTEGER :: CURRENT_GROUP
|
|
LOGICAL, SAVE :: MONTHLY = .TRUE.
|
|
INTEGER, SAVE :: MONTH_SAVE
|
|
INTEGER, SAVE :: GROUP_SAVE
|
|
LOGICAL, SAVE :: FIRST = .TRUE.
|
|
|
|
!============================================================
|
|
! GET_SCALE_GROUP begins here!
|
|
!============================================================
|
|
|
|
! Currently there is no spatial grouping
|
|
|
|
! Determine temporal grouping
|
|
IF ( MMSCL == 1 ) THEN
|
|
CURRENT_GROUP = 1
|
|
RETURN
|
|
ENDIF
|
|
|
|
IF ( MONTHLY ) THEN
|
|
IF (FIRST) THEN
|
|
MONTH_SAVE = GET_MONTH()
|
|
CURRENT_GROUP = MMSCL
|
|
GROUP_SAVE = MMSCL
|
|
FIRST = .FALSE.
|
|
ENDIF
|
|
IF ( MONTH_SAVE /= GET_MONTH() ) THEN
|
|
MONTH_SAVE = GET_MONTH()
|
|
GROUP_SAVE = GROUP_SAVE - 1
|
|
CURRENT_GROUP = GROUP_SAVE
|
|
ELSE
|
|
CURRENT_GROUP = GROUP_SAVE
|
|
ENDIF
|
|
|
|
ELSE
|
|
! Retrieve time parameters
|
|
TAUe = GET_TAUe()
|
|
TAUb = GET_TAUb()
|
|
TAU = GET_TAU()
|
|
TOTAL_HR = TAUe - TAUb
|
|
CURRENT_HR = TAU - TAUb
|
|
|
|
|
|
! The last time step always belongs to the last group
|
|
IF ( TAU == TAUe ) THEN
|
|
CURRENT_GROUP = MMSCL
|
|
RETURN
|
|
ELSE
|
|
|
|
! Determine the length of each group
|
|
GROUP_LENGTH = REAL( TOTAL_HR / MMSCL )
|
|
|
|
! Index is the current time divided by the group length, plus one
|
|
CURRENT_GROUP = SNGL( CURRENT_HR / GROUP_LENGTH ) + 1
|
|
|
|
ENDIF
|
|
|
|
ENDIF
|
|
|
|
END FUNCTION GET_SCALE_GROUP
|
|
|
|
|
|
!------------------------------------------------------------------------------
|
|
|
|
SUBROUTINE INIT_GLOBAL_CH4_ADJ
|
|
!
|
|
!******************************************************************************
|
|
! Subroutine INIT_GLOBAL_CH4 allocates and zeroes module arrays.
|
|
! (bmy, 1/16/01, 10/15/02)
|
|
!
|
|
! NOTES:
|
|
! (1 ) Now references ALLOC_ERR from "error_mod.f" (bmy, 10/15/02)
|
|
!******************************************************************************
|
|
!
|
|
! References to F90 modules
|
|
USE ERROR_MOD, ONLY : ALLOC_ERR
|
|
|
|
# include "CMN_SIZE"
|
|
# include "CMN_DIAG"
|
|
|
|
! Local variables
|
|
INTEGER :: AS
|
|
LOGICAL, SAVE :: FIRST = .TRUE.
|
|
|
|
|
|
! If NOT first, return
|
|
IF ( FIRST==.FALSE. ) RETURN
|
|
|
|
|
|
ALLOCATE( BAIRDENS( IIPAR, JJPAR, LLPAR ), STAT=AS )
|
|
IF ( AS /= 0 ) CALL ALLOC_ERR( 'BAIRDENS' )
|
|
BAIRDENS = 0d0
|
|
|
|
ALLOCATE( BOH( IIPAR, JJPAR, LLPAR, 12 ), STAT=AS )
|
|
IF ( AS /= 0 ) CALL ALLOC_ERR( 'BOH' )
|
|
BOH = 0d0
|
|
|
|
ALLOCATE( CH4LOSS( IIPAR, JJPAR, LLPAR, 12 ), STAT=AS )
|
|
IF ( AS /= 0 ) CALL ALLOC_ERR( 'CH4LOSS' )
|
|
CH4LOSS = 0d0
|
|
|
|
ALLOCATE( COPROD( JJPAR, LLPAR, 12 ), STAT=AS )
|
|
IF ( AS /= 0 ) CALL ALLOC_ERR( 'COPROD' )
|
|
COPROD = 0d0
|
|
|
|
ALLOCATE( TAVG_ADJ( IIPAR, JJPAR, LLPAR ), STAT=AS )
|
|
IF ( AS /= 0 ) CALL ALLOC_ERR( 'TAVG_ADJ' )
|
|
TAVG_ADJ = 0d0
|
|
|
|
ALLOCATE( CH4_EMIS_ADJ( IIPAR, JJPAR, PD58), STAT=AS )
|
|
IF ( AS /= 0 ) CALL ALLOC_ERR( 'CH4_EMIS_ADJ' )
|
|
CH4_EMIS_ADJ = 0d0
|
|
|
|
|
|
! We've now initialized, do not attempt again!
|
|
FIRST = .FALSE.
|
|
|
|
! Return to calling program
|
|
END SUBROUTINE INIT_GLOBAL_CH4_ADJ
|
|
|
|
!------------------------------------------------------------------------------
|
|
|
|
SUBROUTINE CLEANUP_GLOBAL_CH4_ADJ
|
|
!
|
|
!******************************************************************************
|
|
! Subroutine CLEANUP_GLOBAL_CH4 deallocates module arrays. (bmy, 1/16/01)
|
|
!******************************************************************************
|
|
|
|
|
|
IF ( ALLOCATED( BAIRDENS ) ) DEALLOCATE( BAIRDENS )
|
|
IF ( ALLOCATED( BOH ) ) DEALLOCATE( BOH )
|
|
IF ( ALLOCATED( CH4LOSS ) ) DEALLOCATE( CH4LOSS )
|
|
IF ( ALLOCATED( COPROD ) ) DEALLOCATE( COPROD )
|
|
IF ( ALLOCATED( Tavg_adj ) ) DEALLOCATE( Tavg_adj )
|
|
IF ( ALLOCATED( CH4_EMIS_ADJ ) ) DEALLOCATE( CH4_EMIS_ADJ )
|
|
|
|
|
|
END SUBROUTINE CLEANUP_GLOBAL_CH4_ADJ
|
|
|
|
!------------------------------------------------------------------------------
|
|
|
|
|
|
! End of module
|
|
END MODULE GLOBAL_CH4_ADJ_MOD
|