Sola/GEOS-Chem-adjoint-v35-note
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Add files via upload

Browse Source
This commit is contained in:
Xuesong (Steve)
2018-08-28 00:46:26 -04:00
committed by GitHub
parent e17feeaad3
commit fa691eb0aa
98 changed files with 54210 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

799
code/RnPbBe_mod.f Normal file
View File

@ -0,0 +1,799 @@
! $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