800 lines
29 KiB
Fortran
800 lines
29 KiB
Fortran
! $Id: RnPbBe_mod.f,v 1.1 2009/06/09 21:51:53 daven Exp $
|
|
MODULE RnPbBe_MOD
|
|
!
|
|
!******************************************************************************
|
|
! Module RnPbBe_MOD contains variables and routines used for the
|
|
! 222Rn-210Pb-7Be simulation. (hyl, swu, bmy, 6/14/01, 8/4/06)
|
|
!
|
|
! Module Variables:
|
|
! ============================================================================
|
|
! (1 ) LATSOU : Array holding 10 latitudes for 7Be emissions
|
|
! (2 ) PRESOU : Array holding 33 pressure levels for 7Be emissions
|
|
! (3 ) BESOU : Array holding 7Be emissions for 10 lat x 33 prs levs
|
|
! (4 ) XNUMOL_Rn : Atoms 222Rn per kg 222Rn
|
|
! (5 ) XNUMOL_Pb : Atoms 210Pb per kg 210Pb
|
|
! (6 ) XNUMOL_Be : Atoms 7Be per kg 7Be
|
|
!
|
|
! Module Procedures:
|
|
! ============================================================================
|
|
! (1 ) READ_7BE : Reads Lal & Peters 7Be emissions from a file
|
|
! (2 ) CORRECT_STE : Corrects S-T exchange for 210Pb and 7Be
|
|
! (3 ) EMISSRnPbBe : Adds emissions of Rn, 210Pb, 7Be, to tracer array
|
|
! (4 ) CHEMRnPbBe : Performs radioactive decay for Rn, 210Pb, 7Be
|
|
! (5 ) SLQ : Interpolation subroutine (cf. Numerical Recpies)
|
|
!
|
|
! GEOS-CHEM modules referenced by RnPbBe_mod.f
|
|
! ============================================================================
|
|
! (1 ) dao_mod.f : Module w/ arrays for DAO met fields
|
|
! (2 ) diag_mod.f : Module w/ GEOS-CHEM diagnostic arrays
|
|
! (3 ) directory_mod.f : Module w/ GEOS-CHEM data & met field dires
|
|
! (4 ) file_mod.f : Module w/ file unit numbers and error checks
|
|
! (5 ) logical_mod.f : Module w/ GEOS-CHEM logical switches
|
|
! (6 ) tracer_mod.f : Module w/ GEOS-CHEM tracer array STT etc.
|
|
! (7 ) tropopause_mod.f : Module w/ routines to read in ann mean tropopause
|
|
!
|
|
! References:
|
|
! ============================================================================
|
|
! (1 ) Liu,H., D.Jacob, I.Bey, and R.M.Yantosca, Constraints from 210Pb
|
|
! and 7Be on wet deposition and transport in a global three-dimensional
|
|
! chemical tracer model driven by assimilated meteorological fields,
|
|
! JGR, 106, D11, 12,109-12,128, 2001.
|
|
! (2 ) Jacob et al.,Evaluation and intercomparison of global atmospheric
|
|
! transport models using Rn-222 and other short-lived tracers,
|
|
! JGR, 1997 (102):5953-5970
|
|
! (3 ) Dorothy Koch, JGR 101, D13, 18651, 1996.
|
|
! (4 ) Lal, D., and B. Peters, Cosmic ray produced radioactivity on the
|
|
! Earth. Handbuch der Physik, 46/2, 551-612, edited by K. Sitte,
|
|
! Springer-Verlag, New York, 1967.
|
|
!
|
|
! NOTES:
|
|
! (1 ) Added existing routines to this module (bmy, 6/14/01)
|
|
! (2 ) Updated comments (bmy, 9/4/01)
|
|
! (3 ) Eliminate AVGF; redimensioned XTRA2 (bmy, 9/25/01)
|
|
! (4 ) Replace references to PW(I,J) with P(I,J) (bmy, 10/3/01)
|
|
! (5 ) Remove obsolete code from 9/01 and 10/01 (bmy, 10/23/01)
|
|
! (6 ) Removed duplicate variable declarations (bmy, 11/15/01)
|
|
! (7 ) Now read files from DATA_DIR/RnPbBe_200203/ directory.
|
|
! Also updated comments. (bmy, 3/29/02)
|
|
! (8 ) Incorporated latest changes from Hongyu Liu. Also split off the
|
|
! code to read in the 7Be emissions into a separate routine.
|
|
! Add parallel DO-loops in several places. Cleaned up DRYFLXRnPbBe,
|
|
! and now make sure ND44 accurately represents the drydep fluxes
|
|
! of 210Pb and 7Be. (hyl, bmy, 8/7/02)
|
|
! (9 ) Now reference AD from "dao_mod.f". Now references "error_mod.f".
|
|
! Moved routine DRYFLXRnPbBe into "drydep_mod.f". (bmy, 1/27/03)
|
|
! (10) Now references the new "time_mod.f" (bmy, 2/11/03)
|
|
! (11) Bug fix in EMISSRnPbBe -- take abs( lat) for 7Be emiss. (bmy, 6/10/03)
|
|
! (12) Bug fix in EMISSRnPbBe -- shut off 222Rn emissions in polar regions
|
|
! (swu, bmy, 10/28/03)
|
|
! (13) Now references "directory_mod.f", "logical_mod.f", and "tracer_mod.f"
|
|
! (bmy, 7/20/04)
|
|
! (14) Now modified for GCAP and GEOS-5 met fields (swu, bmy, 5/24/05)
|
|
! (15) Now references "tropopause_mod.f"
|
|
! (16) Remove support for GEOS-1 and GEOS-STRAT met fields (bmy, 8/4/06)
|
|
!******************************************************************************
|
|
!
|
|
IMPLICIT NONE
|
|
|
|
!=================================================================
|
|
! MODULE PRIVATE DECLARATIONS -- keep certain internal variables
|
|
! and routines from being seen outside "RnPbBe_mod.f"
|
|
!=================================================================
|
|
|
|
! Make everything PRIVATE ...
|
|
PRIVATE
|
|
|
|
! ... except these routines
|
|
PUBLIC :: EMISSRnPbBe
|
|
PUBLIC :: CHEMRnPbBe
|
|
|
|
!=================================================================
|
|
! MODULE VARIABLES
|
|
!=================================================================
|
|
REAL*8 :: LATSOU(10), PRESOU(33), BESOU(10,33)
|
|
REAL*8, PARAMETER :: XNUMOL_Rn = ( 6.0225d23 / 222.0d-3 )
|
|
REAL*8, PARAMETER :: XNUMOL_Pb = ( 6.0225d23 / 210.0d-3 )
|
|
REAL*8, PARAMETER :: XNUMOL_Be = ( 6.0225d23 / 7.0d-3 )
|
|
|
|
!=================================================================
|
|
! MODULE ROUTINES -- follow below the "CONTAINS" statement
|
|
!=================================================================
|
|
CONTAINS
|
|
|
|
!------------------------------------------------------------------------------
|
|
|
|
SUBROUTINE READ_7BE
|
|
!
|
|
!******************************************************************************
|
|
! Subroutine READ_7BE reads the 7Be emissions from Lal & Peters on 33
|
|
! pressure levels. This only needs to be done on the very first timestep.
|
|
! (hyl, bmy, 8/7/02, 7/19/04)
|
|
!
|
|
! NOTES:
|
|
! (1 ) This code was split off from routine EMISSRnPbBe below. (bmy, 8/7/02)
|
|
! (2 ) Now reference DATA_DIR from "directory_mod.f" (bmy, 7/19/04)
|
|
!******************************************************************************
|
|
!
|
|
! References to F90 modules
|
|
USE DIRECTORY_MOD, ONLY : DATA_DIR
|
|
USE FILE_MOD, ONLY : IU_FILE, IOERROR
|
|
|
|
# include "CMN_SIZE" ! Size parameters
|
|
|
|
! Local variables
|
|
INTEGER :: IOS, J, L
|
|
CHARACTER(LEN=255) :: FILENAME
|
|
|
|
!==============================================================
|
|
! READ_7BE begins here!
|
|
!
|
|
! Units of 7Be emissions are [stars/g air/s].
|
|
! Here, "stars" = # of nuclear disintegrations of cosmic rays
|
|
!==============================================================
|
|
|
|
! Define the file name
|
|
FILENAME = TRIM( DATA_DIR ) // 'RnPbBe_200203/7Be.Lal'
|
|
|
|
! Open the 7Be file
|
|
OPEN( IU_FILE, FILE=TRIM( FILENAME ),
|
|
& STATUS='OLD', IOSTAT=IOS )
|
|
|
|
! Error check
|
|
IF ( IOS /= 0 ) CALL IOERROR( IOS, IU_FILE, 'emissRnPbBe:1' )
|
|
|
|
! Read latitudes in southern hemisphere
|
|
READ ( IU_FILE, '(13X,F5.0,7F8.0)', IOSTAT=IOS )
|
|
& ( LATSOU(J), J=1,8 )
|
|
|
|
! Error check
|
|
IF ( IOS /= 0 ) CALL IOERROR( IOS, IU_FILE, 'emissRnPbBe:2' )
|
|
|
|
! Add latitudes for 80S and 90S
|
|
LATSOU(9) = 80d0
|
|
LATSOU(10) = 90d0
|
|
|
|
! For 33 levels read the pressure and the Be concentration
|
|
! at each of the above-defined southern latitudes
|
|
DO L = 1, 33
|
|
READ( IU_FILE, '(F5.0,8X,8F8.2)', IOSTAT=IOS )
|
|
& PRESOU(L), ( BESOU(J,L), J=1,8 )
|
|
|
|
! Error check
|
|
IF ( IOS /= 0 ) THEN
|
|
CALL IOERROR( IOS, IU_FILE, 'emissRnPbBe:3' )
|
|
ENDIF
|
|
ENDDO
|
|
|
|
! Overwrite 70S at the top (as recommended by Koch 1996)
|
|
BESOU(8,1) = 1900d0
|
|
|
|
! Copy value from 70S into 80S and 90S at all levels
|
|
DO L = 1, 33
|
|
BESOU(9,L) = BESOU(8,L)
|
|
BESOU(10,L) = BESOU(8,L)
|
|
ENDDO
|
|
|
|
! All the numbers in the file need to be multiplied by 1e-5
|
|
! in order to put them into the correct data range.
|
|
BESOU = BESOU * 1d-5
|
|
|
|
! Close the file
|
|
CLOSE( IU_FILE )
|
|
|
|
! Return to calling program
|
|
END SUBROUTINE READ_7BE
|
|
|
|
!------------------------------------------------------------------------------
|
|
|
|
SUBROUTINE CORRECT_STE( EMISSION )
|
|
!
|
|
!******************************************************************************
|
|
! Subroutine CORRECT_STE reduces the emission of 210Pb and/or 7Be in the
|
|
! stratosphere, to correct for too fast STE in the GEOS-CHEM model.
|
|
! (hyl, bmy, 8/7/02, 8/4/06)
|
|
!
|
|
! Arguments as Input/Output:
|
|
! ============================================================================
|
|
! (1 ) EMISSION (REAL*8) : Emissions to be corrected [kg]
|
|
!
|
|
! NOTES:
|
|
! (1 ) Now updated for GCAP met fields (swu, bmy, 5/24/05)
|
|
! (2 ) Remove support for GEOS-1 and GEOS-STRAT met fields (bmy, 8/4/06)
|
|
!******************************************************************************
|
|
!
|
|
# include "define.h" ! Switches
|
|
|
|
! Arguments
|
|
REAL*8, INTENT(INOUT) :: EMISSION
|
|
|
|
!=================================================================
|
|
! CORRECT_STE begins here!
|
|
!
|
|
! Correction factors were computed by Hongyu Liu (hyl, 8/6/02)
|
|
!=================================================================
|
|
#if defined( GEOS_3 )
|
|
EMISSION = EMISSION / 3.5d0
|
|
|
|
#elif defined( GEOS_4 )
|
|
!EMISSION = 0d0 ! to be determined later
|
|
|
|
#elif defined( GEOS_5 )
|
|
!EMISSION = 0d0 ! to be determined later
|
|
|
|
#elif defined( GCAP )
|
|
EMISSION = EMISSION / 3.5d0
|
|
|
|
#endif
|
|
|
|
! Return to calling program
|
|
END SUBROUTINE CORRECT_STE
|
|
|
|
!------------------------------------------------------------------------------
|
|
|
|
SUBROUTINE EMISSRnPbBe
|
|
!
|
|
!******************************************************************************
|
|
! Subroutine EMISSRnPbBe emits 222Rn and 7Be into the tracer array STT.
|
|
! (hyl, bey, bmy, 5/28/99, 10/28/03)
|
|
!
|
|
! NOTES:
|
|
! (1 ) Also added Hongyu's code for emission of Be7 (bmy, 3/22/99)
|
|
! (2 ) Now trap I/O errors with subroutine IOERROR (bmy, 5/28/99)
|
|
! (3 ) Eliminate obsolete code and ND63 diagnostic (bmy, 4/12/00)
|
|
! (4 ) Now reference TS from "dao_mod.f" instead of from common block
|
|
! header file "CMN_TS". (bmy, 6/23/00)
|
|
! (5 ) Cosmetic changes (bmy, 7/12/00)
|
|
! (6 ) Now use IOS /= 0 criterion to trap both I/O errors and EOF
|
|
! condition. (bmy, 9/13/00)
|
|
! (7 ) Added to module "RnPbBe_mod.f". Also updated comments and made
|
|
! cosmetic changes. (bmy, 6/14/01)
|
|
! (8 ) Replace PW(I,J) with P(I,J) (bmy, 10/3/01)
|
|
! (9 ) Now reference DATA_DIR from "CMN_SETUP". Added FILENAME variable.
|
|
! Now read "7Be.Lal" file from DATA_DIR/RnPbBe_200203/ directory.
|
|
! (bmy, 3/29/02)
|
|
! (10) Add diagnostics for Rn/Be emissions. Also cleaned up some old code
|
|
! and added parallel DO-loops. Correct for S-T exchange for 7Be
|
|
! emissions. Updated comments, cosmetic changes. (hyl, 8/6/02)
|
|
! (11) Now reference routine GET_PCENTER from "pressure_mod.f", which
|
|
! returns the correct "floating" pressure. (dsa, bdf, bmy, 8/20/02)
|
|
! (12) Now reference AD from "dao_mod.f". Now make FIRSTEMISS a local SAVEd
|
|
! variable instead of an argument. (bmy, 1/27/03)
|
|
! (13) Now use routine GET_YMID from "grid_mod.f" instead of common block
|
|
! variable YLMID. Now replace DXYP(JREF)*1d4 with routine GET_AREA_CM2
|
|
! of "grid_mod.f". Now use routine GET_TS_EMIS from time_mod.
|
|
! (bmy, 2/11/03)
|
|
! (14) Bug fix: take the absolute value of latitude -- this was a bug when
|
|
! implementing the GET_YMID function from v5-04. (bmy, 6/10/03)
|
|
! (15) Now reference GET_YEDGE from "grid_mod.f".
|
|
! (16) Bug fix: the Rn emission in antarctic area in the original code would
|
|
! lead to enormously hight Rn concentrations there, esp. after boundary
|
|
! layer mixing. Now apply different emissions over land and water,
|
|
! and also shut off emissions poleward of 70 deg. (swu, bmy, 10/28/03)
|
|
! (17) Now reference LEMIS from "logical_mod.f". Now reference STT and
|
|
! N_TRACERS from "tracer_mod.f" (bmy, 7/20/04)
|
|
! (18) Remove reference to CMN; it's obsolete. Now use inquiry functions
|
|
! from "tropopause_mod.f" to diagnose strat boxes. (bmy, 8/15/05)
|
|
!******************************************************************************
|
|
!
|
|
! References to F90 modules
|
|
USE DAO_MOD, ONLY : AD, TS
|
|
USE DIAG_MOD, ONLY : AD01
|
|
USE GRID_MOD, ONLY : GET_AREA_CM2, GET_YMID, GET_YEDGE
|
|
USE LOGICAL_MOD, ONLY : LEMIS
|
|
USE TIME_MOD, ONLY : GET_TS_EMIS
|
|
USE TRACER_MOD, ONLY : STT, N_TRACERS
|
|
USE TROPOPAUSE_MOD, ONLY : ITS_IN_THE_STRAT
|
|
USE PRESSURE_MOD, ONLY : GET_PCENTER
|
|
|
|
# include "CMN_SIZE" ! Size parameters
|
|
# include "CMN_DIAG" ! ND02
|
|
# include "CMN_DEP" ! FRCLND
|
|
|
|
! Local variables
|
|
LOGICAL, SAVE :: FIRSTEMISS = .TRUE.
|
|
INTEGER :: I, J, L, N
|
|
REAL*8 :: A_CM2, ADD_Be, ADD_Rn, Rn_LAND
|
|
REAL*8 :: Rn_WATER, DTSRCE, LAT_TMP, P_TMP
|
|
REAL*8 :: Be_TMP, Rn_TMP, LAT_S, LAT_N
|
|
REAL*8 :: LAT_H, LAT_L, F_LAND, F_WATER
|
|
REAL*8 :: F_BELOW_70, F_BELOW_60, F_ABOVE_60
|
|
|
|
!=================================================================
|
|
! EMISSRnPbBe begins here!
|
|
!=================================================================
|
|
|
|
! Return if we are not doing emissions!
|
|
IF ( .not. LEMIS ) RETURN
|
|
|
|
! Emission timestep [s]
|
|
DTSRCE = GET_TS_EMIS() * 60d0
|
|
|
|
!=================================================================
|
|
! Add 222Rn emissions into tracer #1 according to the following:
|
|
!
|
|
! (1) 222Rn emission poleward of 70 degrees = 0.0 [atoms/cm2/s]
|
|
!
|
|
! (2) For latitudes 70S-60S and 60N-70N (both land & ocean),
|
|
! 222Rn emission is 0.005 [atoms/cm2/s]
|
|
!
|
|
! (3) For latitudes between 60S and 60N,
|
|
! 222Rn emission is 1 [atoms/cm2/s] over land or
|
|
! 0.005 [atoms/cm2/s] over oceans
|
|
!
|
|
! (4) For grid boxes where the surface temperature is below
|
|
! 0 deg Celsius, reduce 222Rn emissions by a factor of 3.
|
|
!
|
|
! Reference: Jacob et al.,Evaluation and intercomparison of
|
|
! global atmospheric transport models using Rn-222 and other
|
|
! short-lived tracers, JGR, 1997 (102):5953-5970
|
|
!=================================================================
|
|
|
|
! Loop over latitudes
|
|
!$OMP PARALLEL DO
|
|
!$OMP+DEFAULT( SHARED )
|
|
!$OMP+PRIVATE( I, J, LAT_S, LAT_N, LAT_H, LAT_L, F_BELOW_70 )
|
|
!$OMP+PRIVATE( F_BELOW_60, F_ABOVE_60, A_CM2, Rn_LAND, Rn_WATER )
|
|
!$OMP+PRIVATE( F_LAND, F_WATER, ADD_Rn )
|
|
DO J = 1, JJPAR
|
|
|
|
! Get ABS( latitude ) at S and N edges of grid box
|
|
LAT_S = ABS( GET_YEDGE(J) )
|
|
LAT_N = ABS( GET_YEDGE(J+1) )
|
|
LAT_H = MAX( LAT_S, LAT_N )
|
|
LAT_L = MIN( LAT_S, LAT_N )
|
|
|
|
! Fraction of grid box w/ ABS( latitude ) less than 70 degrees
|
|
F_BELOW_70 = ( 70.0d0 - LAT_L ) / ( LAT_H - LAT_L )
|
|
|
|
! Fraction of grid box w/ ABS( latitude ) less than 60 degrees
|
|
F_BELOW_60 = ( 60.0d0 - LAT_L ) / ( LAT_H - LAT_L )
|
|
|
|
! Fraction of grid box w/ ABS( latitude ) greater than 60 degrees
|
|
F_ABOVE_60 = 1d0 - F_BELOW_60
|
|
|
|
! Grid box surface area [cm2]
|
|
A_CM2 = GET_AREA_CM2( J )
|
|
|
|
! Baseline 222Rn emissions over land [kg]
|
|
! Rn_LAND [kg] = [1 atom 222Rn/cm2/s] / [atoms/kg] * [s] * [cm2]
|
|
Rn_LAND = 1d0 / XNUMOL_Rn * DTSRCE * A_CM2
|
|
|
|
! Baseline 222Rn emissions over water or ice [kg]
|
|
Rn_WATER = Rn_LAND * 0.005d0
|
|
|
|
! Loop over longitudes
|
|
DO I = 1, IIPAR
|
|
|
|
! Fraction of grid box that is land
|
|
F_LAND = FRCLND(I,J)
|
|
|
|
! Fraction of grid box that is water
|
|
F_WATER = 1d0 - F_LAND
|
|
|
|
!--------------------
|
|
! 90S-70S or 70N-90N
|
|
!--------------------
|
|
IF ( LAT_L >= 70d0 ) THEN
|
|
|
|
! 222Rn emissions are shut off poleward of 70 degrees
|
|
ADD_Rn = 0.0d0
|
|
|
|
!--------------------
|
|
! 70S-60S or 60N-70N
|
|
!--------------------
|
|
ELSE IF ( LAT_L >= 60d0 ) THEN
|
|
|
|
IF ( LAT_H <= 70d0 ) THEN
|
|
|
|
! If the entire grid box lies equatorward of 70 deg,
|
|
! then 222Rn emissions here are 0.005 [atoms/cm2/s]
|
|
ADD_Rn = Rn_WATER
|
|
|
|
ELSE
|
|
|
|
! If the grid box straddles the 70S or 70N latitude line,
|
|
! then only count 222Rn emissions equatorward of 70 degrees.
|
|
! 222Rn emissions here are 0.005 [atoms/cm2/s].
|
|
ADD_Rn = F_BELOW_70 * Rn_WATER
|
|
|
|
ENDIF
|
|
|
|
ELSE
|
|
|
|
!--------------------
|
|
! 70S-60S or 60N-70N
|
|
!--------------------
|
|
IF ( LAT_H > 60d0 ) THEN
|
|
|
|
ADD_Rn =
|
|
! Consider 222Rn emissions equatorward of
|
|
! 60 degrees for both land (1.0 [atoms/cm2/s])
|
|
! and water (0.005 [atoms/cm2/s])
|
|
& F_BELOW_60 *
|
|
& ( Rn_LAND * F_LAND ) +
|
|
& ( Rn_WATER * F_WATER ) +
|
|
|
|
! If the grid box straddles the 60 degree boundary
|
|
! then also consider the emissions poleward of 60
|
|
! degrees. 222Rn emissions here are 0.005 [at/cm2/s].
|
|
& F_ABOVE_60 * Rn_WATER
|
|
|
|
|
|
!--------------------
|
|
! 60S-60N
|
|
!--------------------
|
|
ELSE
|
|
|
|
! Consider 222Rn emissions equatorward of 60 deg for
|
|
! land (1.0 [atoms/cm2/s]) and water (0.005 [atoms/cm2/s])
|
|
ADD_Rn = ( Rn_LAND * F_LAND ) + ( Rn_WATER * F_WATER )
|
|
|
|
ENDIF
|
|
ENDIF
|
|
|
|
! For boxes below freezing, reduce 222Rn emissions by 3x
|
|
IF ( TS(I,J) < 273.15 ) ADD_Rn = ADD_Rn / 3d0
|
|
|
|
! Save 222Rn into STT array [kg]
|
|
STT(I,J,1,1) = STT(I,J,1,1) + ADD_Rn
|
|
|
|
! ND01 diag: 222Rn emission [kg/s]
|
|
IF ( ND01 > 0 ) THEN
|
|
AD01(I,J,1,1) = AD01(I,J,1,1) + ( ADD_Rn / DTSRCE )
|
|
ENDIF
|
|
ENDDO
|
|
ENDDO
|
|
!$OMP END PARALLEL DO
|
|
|
|
!=================================================================
|
|
! Add 7Be emissions into tracer #3 (if necessary)
|
|
!
|
|
! Original units of 7Be emissions are [stars/g air/sec],
|
|
! where "stars" = # of nuclear disintegrations of cosmic rays
|
|
!=================================================================
|
|
IF ( N_TRACERS >= 3 ) THEN
|
|
|
|
! Read 7Be emissions on the first timestep only
|
|
IF ( FIRSTEMISS ) CALL READ_7BE
|
|
|
|
!==============================================================
|
|
! Now interpolate from 33 std levels onto GEOS-CHEM levels
|
|
!==============================================================
|
|
!$OMP PARALLEL DO
|
|
!$OMP+DEFAULT( SHARED )
|
|
!$OMP+PRIVATE( I, J, L, LAT_TMP, P_TMP, Be_TMP, ADD_Be )
|
|
!$OMP+SCHEDULE( DYNAMIC )
|
|
DO L = 1, LLPAR
|
|
DO J = 1, JJPAR
|
|
DO I = 1, IIPAR
|
|
|
|
! Get absolute value of latitude, since we will assume that
|
|
! the 7Be distribution is symmetric about the equator
|
|
LAT_TMP = ABS( GET_YMID( J ) )
|
|
|
|
! Pressure at (I,J,L) -- need to change for fvDAS!
|
|
P_TMP = GET_PCENTER( I, J, L )
|
|
|
|
! Interpolate 7Be [stars/g air/sec] to GEOS-CHEM levels
|
|
CALL SLQ( LATSOU,PRESOU,BESOU,10,33,LAT_TMP,P_TMP,Be_TMP)
|
|
|
|
! Be_TMP = [stars/g air/s] * [0.045 atom/star] *
|
|
! [kg air] * [1e3 g/kg] = 7Be emissions [atoms/s]
|
|
Be_TMP = Be_TMP * 0.045d0 * AD(I,J,L) * 1.d3
|
|
|
|
! ADD_Be = [atoms/s] * [s] / [atom/kg] = 7Be emissions [kg]
|
|
ADD_Be = Be_TMP * DTSRCE / XNUMOL_Be
|
|
|
|
! Correct the strat-trop exchange of 7Be
|
|
IF ( ITS_IN_THE_STRAT( I, J, L ) ) THEN
|
|
CALL CORRECT_STE( ADD_Be )
|
|
ENDIF
|
|
|
|
! Add 7Be into STT tracer array [kg]
|
|
STT(I,J,L,3) = STT(I,J,L,3) + ADD_Be
|
|
|
|
! ND01 diag: 7Be emission [kg/s]
|
|
IF ( ND01 > 0 ) THEN
|
|
AD01(I,J,L,3) = AD01(I,J,L,3) + ( ADD_Be / DTSRCE )
|
|
ENDIF
|
|
ENDDO
|
|
ENDDO
|
|
ENDDO
|
|
!$OMP END PARALLEL DO
|
|
ENDIF
|
|
|
|
! Reset FIRSTEMISS
|
|
FIRSTEMISS = .FALSE.
|
|
|
|
! Return to calling program
|
|
END SUBROUTINE EMISSRnPbBe
|
|
|
|
!------------------------------------------------------------------------------
|
|
|
|
SUBROUTINE CHEMRnPbBe
|
|
!
|
|
!******************************************************************************
|
|
! Subroutine CHEMRnPbBe performs loss chemistry on 222Rn, 210Pb, and 7Be.
|
|
! (hyl, amf, bey, bmy, 10/13/99, 8/15/05)
|
|
!
|
|
! NOTES:
|
|
! (1 ) Now use F90 syntax (bmy, hyl, 3/22/99)
|
|
! (2 ) Add FIRSTCHEM as an argument. Only compute the exponential terms
|
|
! when FIRSTCHEM = .TRUE., and save the values for later use
|
|
! (bmy, 3/24/99)
|
|
! (3 ) Cosmetic changes (bmy, 10/13/99)
|
|
! (4 ) Eliminate obsolete code and ND63 diagnostic (bmy, 4/12/00)
|
|
! (5 ) Cosmetic changes (bmy, 7/12/00)
|
|
! (6 ) Added to module "RnPbBe_mod.f". Also updated comments
|
|
! and made cosmetic changes. (bmy, 6/14/01)
|
|
! (7 ) Add diagnostics for Rn/Be emissions. Also cleaned up some old code
|
|
! and added parallel DO-loops. Updated comments. (hyl, 8/6/02)
|
|
! (8 ) Now make FIRSTCHEM a local SAVEd variable. (bmy, 1/27/03)
|
|
! (9 ) Now use function GET_TS_CHEM from "time_mod.f" (bmy, 2/11/03)
|
|
! (10) Now references STT and N_TRACERS from "tracer_mod.f" (bmy, 7/20/04)
|
|
! (11) Remove reference to CMN; it's obsolete. Now use inquiry functions
|
|
! from "tropopause_mod.f" to diagnose strat boxes. (bmy, 8/15/05)
|
|
!******************************************************************************
|
|
!
|
|
! References to F90 modules
|
|
USE DIAG_MOD, ONLY : AD01, AD02
|
|
USE TIME_MOD, ONLY : GET_TS_CHEM
|
|
USE TRACER_MOD, ONLY : STT, N_TRACERS
|
|
USE TROPOPAUSE_MOD, ONLY : ITS_IN_THE_STRAT
|
|
|
|
# include "CMN_SIZE" ! Size parameters
|
|
# include "CMN_DIAG" ! ND01, ND02
|
|
|
|
! Local variables
|
|
LOGICAL, SAVE :: FIRSTCHEM = .TRUE.
|
|
INTEGER :: I, J, L, N
|
|
REAL*8 :: ADD_Pb, Be_LOST ,DTCHEM, Pb_LOST
|
|
REAL*8 :: Rn_LOST(IIPAR,JJPAR,LLPAR)
|
|
|
|
! Static variables
|
|
REAL*8, SAVE :: EXP_Rn, EXP_Pb, EXP_Be
|
|
|
|
! Ratio of molecular weights of 210Pb/222Rn
|
|
REAL*8, PARAMETER :: Pb_Rn_RATIO = 210d0 / 222d0
|
|
|
|
!=================================================================
|
|
! CHEMRnPbBe begins here!
|
|
!=================================================================
|
|
|
|
! Chemistry timestep [s]
|
|
DTCHEM = GET_TS_CHEM() * 60d0
|
|
|
|
! Pre-compute exponential terms only on first timestep
|
|
IF ( FIRSTCHEM ) THEN
|
|
|
|
! Fraction of (222Rn, 210Pb, 7Be) left after radioactive decay
|
|
EXP_Rn = EXP( -DTCHEM * 2.097d-6 )
|
|
EXP_Pb = EXP( -DTCHEM * 9.725d-10 )
|
|
EXP_Be = EXP( -DTCHEM * 1.506d-7 )
|
|
|
|
! Reset FIRSTCHEM flag
|
|
FIRSTCHEM = .FALSE.
|
|
ENDIF
|
|
|
|
!=================================================================
|
|
! Radioactive decay of 222Rn (tracer #1)
|
|
!=================================================================
|
|
!$OMP PARALLEL DO
|
|
!$OMP+DEFAULT( SHARED )
|
|
!$OMP+PRIVATE( I, J, L )
|
|
DO L = 1, LLPAR
|
|
DO J = 1, JJPAR
|
|
DO I = 1, IIPAR
|
|
|
|
! Rn_LOST = amount of 222Rn lost to decay [kg]
|
|
Rn_LOST(I,J,L) = STT(I,J,L,1) * ( 1d0 - EXP_Rn )
|
|
|
|
! ND02 diag: 222Rn lost to decay [kg/s]
|
|
IF ( ND02 > 0 ) THEN
|
|
AD02(I,J,L,1) = AD02(I,J,L,1) + ( Rn_LOST(I,J,L) / DTCHEM )
|
|
ENDIF
|
|
|
|
! Subtract Rn_LOST from STT [kg]
|
|
STT(I,J,L,1) = STT(I,J,L,1) - Rn_LOST(I,J,L)
|
|
ENDDO
|
|
ENDDO
|
|
ENDDO
|
|
!$OMP END PARALLEL DO
|
|
|
|
!=================================================================
|
|
! Radioactive decay of 210Pb (tracer #2)
|
|
!=================================================================
|
|
IF ( N_TRACERS >= 2 ) THEN
|
|
|
|
!$OMP PARALLEL DO
|
|
!$OMP+DEFAULT( SHARED )
|
|
!$OMP+PRIVATE( I, J, L, ADD_Pb, Pb_LOST )
|
|
DO L = 1, LLPAR
|
|
DO J = 1, JJPAR
|
|
DO I = 1, IIPAR
|
|
|
|
! ADD_Pb = Amount of 210Pb gained by decay from 222Rn [kg]
|
|
ADD_Pb = Rn_LOST(I,J,L) * Pb_Rn_RATIO
|
|
|
|
! Correct strat-trop exchange of 210Pb in stratosphere
|
|
IF ( ITS_IN_THE_STRAT( I, J, L ) ) THEN
|
|
CALL CORRECT_STE( ADD_Pb )
|
|
ENDIF
|
|
|
|
! ND01 diag: 210Pb emission from 222Rn decay [kg/s]
|
|
IF ( ND01 > 0 ) THEN
|
|
AD01(I,J,L,2) = AD01(I,J,L,2) + ( ADD_Pb / DTCHEM )
|
|
ENDIF
|
|
|
|
! Add 210Pb gained by decay from 222Rn into STT [kg]
|
|
STT(I,J,L,2) = STT(I,J,L,2) + ADD_Pb
|
|
|
|
! Amount of 210Pb lost to radioactive decay [kg]
|
|
! NOTE: we've already added in the 210Pb gained from 222Rn
|
|
Pb_LOST = STT(I,J,L,2) * ( 1d0 - EXP_Pb )
|
|
|
|
! ND02 diag: 210Pb lost to decay [kg/s]
|
|
IF ( ND02 > 0 ) THEN
|
|
AD02(I,J,L,2) = AD02(I,J,L,2) + ( Pb_LOST / DTCHEM )
|
|
ENDIF
|
|
|
|
! Subtract 210Pb lost to decay from STT [kg]
|
|
STT(I,J,L,2) = STT(I,J,L,2) - Pb_LOST
|
|
ENDDO
|
|
ENDDO
|
|
ENDDO
|
|
!$OMP END PARALLEL DO
|
|
ENDIF
|
|
|
|
!=================================================================
|
|
! Radioactive decay of 7Be (tracer #3)
|
|
!=================================================================
|
|
IF ( N_TRACERS >= 3 ) THEN
|
|
|
|
!$OMP PARALLEL DO
|
|
!$OMP+DEFAULT( SHARED )
|
|
!$OMP+PRIVATE( I, J, L, Be_LOST )
|
|
DO L = 1, LLPAR
|
|
DO J = 1, JJPAR
|
|
DO I = 1, IIPAR
|
|
|
|
! Amount of 7Be lost to decay [kg]
|
|
Be_LOST = STT(I,J,L,3) * ( 1d0 - EXP_Be )
|
|
|
|
! ND02 diag: 7Be lost to decay [kg/s]
|
|
IF ( ND02 > 0 ) THEN
|
|
AD02(I,J,L,3) = AD02(I,J,L,3) + ( Be_LOST / DTCHEM )
|
|
ENDIF
|
|
|
|
! Subtract amount of 7Be lost to decay from STT [kg]
|
|
STT(I,J,L,3) = STT(I,J,L,3) - Be_LOST
|
|
ENDDO
|
|
ENDDO
|
|
ENDDO
|
|
!$OMP END PARALLEL DO
|
|
ENDIF
|
|
|
|
! Return to calling program
|
|
END SUBROUTINE CHEMRnPbBe
|
|
|
|
!------------------------------------------------------------------------------
|
|
|
|
SUBROUTINE SLQ( X, Y, Z, N, M, U, V, W )
|
|
!
|
|
!******************************************************************************
|
|
! Subroutine SLQ is an interpolation subroutine from a Chinese
|
|
! reference book (says Hongyu). (hyl, bmy, 3/17/98, 11/15/01)
|
|
!
|
|
! Arguments as Input:
|
|
! ============================================================================
|
|
! (1 ) X (REAL*8) : X-axis coordinate on original grid
|
|
! (2 ) Y (REAL*8) : Y-axis coordinate on original grid
|
|
! (3 ) Z (REAL*8) : Array of data on original grid
|
|
! (4 ) N (REAL*8) : First dimension of Z
|
|
! (5 ) M (REAL*8) : Second dimension of Z
|
|
! (6 ) U (REAL*8) : X-axis coordinate for desired interpolated value
|
|
! (7 ) V (REAL*8) : Y-axis coordinate for desired interpolated value
|
|
!
|
|
! Arguments as Output:
|
|
! ============================================================================
|
|
! (8 ) W (REAL*8) : Interpolated value of Z array, at coordinates (U,V)
|
|
!
|
|
! NOTES:
|
|
! (1 ) Added to "RnPbBe_mod.f" (bmy, 7/16/01)
|
|
! (2 ) Removed duplicate definition of IQ. Added comments. (bmy, 11/15/01)
|
|
!******************************************************************************
|
|
!
|
|
! Arguments
|
|
INTEGER :: N, M
|
|
REAL*8 :: X, Y, Z, U, V, W, B, HH
|
|
DIMENSION :: X(N), Y(M), Z(N,M), B(3)
|
|
|
|
! Local variables
|
|
INTEGER NN, IP, I, J, L, IQ, K, MM
|
|
|
|
!=================================================================
|
|
! SLQ begins here!
|
|
!=================================================================
|
|
NN=3
|
|
IF(N.LE.3) THEN
|
|
IP=1
|
|
NN=N
|
|
ELSE IF (U.LE.X(2)) THEN
|
|
IP=1
|
|
ELSE IF (U.GE.X(N-1)) THEN
|
|
IP=N-2
|
|
ELSE
|
|
I=1
|
|
J=N
|
|
10 IF (IABS(I-J).NE.1) THEN
|
|
L=(I+J)/2
|
|
IF (U.LT.X(L)) THEN
|
|
J=L
|
|
ELSE
|
|
I=L
|
|
END IF
|
|
GOTO 10
|
|
END IF
|
|
IF (ABS(U-X(I)).LT.ABS(U-X(J))) THEN
|
|
IP=I-1
|
|
ELSE
|
|
IP=I
|
|
END IF
|
|
END IF
|
|
MM=3
|
|
IF (M.LE.3) THEN
|
|
IQ=1
|
|
MM=N
|
|
ELSE IF (V.LE.Y(2)) THEN
|
|
IQ=1
|
|
ELSE IF (V.GE.Y(M-1)) THEN
|
|
IQ=M-2
|
|
ELSE
|
|
I=1
|
|
J=M
|
|
20 IF (IABS(J-I).NE.1) THEN
|
|
L=(I+J)/2
|
|
IF (V.LT.Y(L)) THEN
|
|
J=L
|
|
ELSE
|
|
I=L
|
|
END IF
|
|
GOTO 20
|
|
END IF
|
|
IF (ABS(V-Y(I)).LT.ABS(V-Y(J))) THEN
|
|
IQ=I-1
|
|
ELSE
|
|
IQ=I
|
|
END IF
|
|
END IF
|
|
DO 50 I=1,NN
|
|
B(I)=0.0
|
|
DO 40 J=1,MM
|
|
HH=Z(IP+I-1,IQ+J-1)
|
|
DO 30 K=1,MM
|
|
IF (K.NE.J) THEN
|
|
HH=HH*(V-Y(IQ+K-1))/(Y(IQ+J-1)-Y(IQ+K-1))
|
|
END IF
|
|
30 CONTINUE
|
|
B(I)=B(I)+HH
|
|
40 CONTINUE
|
|
50 CONTINUE
|
|
W=0.0
|
|
DO 70 I=1,NN
|
|
HH=B(I)
|
|
DO 60 J=1,NN
|
|
IF (J.NE.I) THEN
|
|
HH=HH*(U-X(IP+J-1))/(X(IP+I-1)-X(IP+J-1))
|
|
END IF
|
|
60 CONTINUE
|
|
W=W+HH
|
|
70 CONTINUE
|
|
|
|
! Return to calling program
|
|
END SUBROUTINE SLQ
|
|
|
|
!------------------------------------------------------------------------------
|
|
|
|
END MODULE RnPbBe_MOD
|
|
|
|
|