LCOV - code coverage report
Current view: top level - hemco/HEMCO/src/Extensions - hcox_gc_RnPbBe_mod.F90 (source / functions) Hit Total Coverage
Test: coverage.info Lines: 0 387 0.0 %
Date: 2025-03-13 18:42:46 Functions: 0 10 0.0 %

          Line data    Source code
       1             : !------------------------------------------------------------------------------
       2             : !                   Harmonized Emissions Component (HEMCO)                    !
       3             : !------------------------------------------------------------------------------
       4             : !BOP
       5             : !
       6             : ! !MODULE: hcox_gc_RnPbBe_mod.F90
       7             : !
       8             : ! !DESCRIPTION: Defines the HEMCO extension for the GEOS-Chem Rn-Pb-Be
       9             : !  specialty simulation.
      10             : !\\
      11             : !\\
      12             : !  This extension parameterizes emissions of Rn and/or Pb based upon the
      13             : !  literature given below. The emission fields become automatically added
      14             : !  to the HEMCO emission array of the given species. It is possible to
      15             : !  select only one of the two species (Rn or Pb) in the HEMCO configuration
      16             : !  file. This may be useful if a gridded data inventory shall be applied to
      17             : !  one of the species (through the standard HEMCO interface).
      18             : !\\
      19             : !\\
      20             : ! !INTERFACE:
      21             : !
      22             : MODULE HCOX_GC_RnPbBe_Mod
      23             : !
      24             : ! !USES:
      25             : !
      26             :   USE HCO_Error_Mod
      27             :   USE HCO_Diagn_Mod
      28             :   USE HCO_State_Mod,  ONLY : HCO_State   ! Derived type for HEMCO state
      29             :   USE HCOX_State_Mod, ONLY : Ext_State   ! Derived type for External state
      30             : 
      31             :   IMPLICIT NONE
      32             :   PRIVATE
      33             : !
      34             : ! !PUBLIC MEMBER FUNCTIONS:
      35             : !
      36             :   PUBLIC  :: HcoX_GC_RnPbBe_Run
      37             :   PUBLIC  :: HcoX_GC_RnPbBe_Init
      38             :   PUBLIC  :: HcoX_Gc_RnPbBe_Final
      39             : !
      40             : ! !PRIVATE MEMBER FUNCTIONS:
      41             : !
      42             :   PRIVATE :: Init_7Be_Emissions
      43             : !
      44             : ! !REMARKS:
      45             : !  References:
      46             : !  ============================================================================
      47             : !  (1 ) Liu,H., D.Jacob, I.Bey, and R.M.Yantosca, Constraints from 210Pb
      48             : !        and 7Be on wet deposition and transport in a global three-dimensional
      49             : !        chemical tracer model driven by assimilated meteorological fields,
      50             : !        JGR, 106, D11, 12,109-12,128, 2001.
      51             : !  (2 ) Jacob et al.,Evaluation and intercomparison of global atmospheric
      52             : !        transport models using Rn-222 and other short-lived tracers,
      53             : !        JGR, 1997 (102):5953-5970
      54             : !  (3 ) Dorothy Koch, JGR 101, D13, 18651, 1996.
      55             : !  (4 ) Lal, D., and B. Peters, Cosmic ray produced radioactivity on the
      56             : !        Earth. Handbuch der Physik, 46/2, 551-612, edited by K. Sitte,
      57             : !        Springer-Verlag, New York, 1967.
      58             : !  (5 ) Koch and Rind, Beryllium 10/beryllium 7 as a tracer of stratospheric
      59             : !        transport, JGR, 103, D4, 3907-3917, 1998.
      60             : !
      61             : ! !REVISION HISTORY:
      62             : !  07 Jul 2014 - R. Yantosca - Initial version
      63             : !  See https://github.com/geoschem/hemco for complete history
      64             : !EOP
      65             : !------------------------------------------------------------------------------
      66             : !BOC
      67             : !
      68             : ! !PRIVATE TYPES:
      69             : !
      70             :   TYPE :: MyInst
      71             : 
      72             :    ! Emissions indices etc.
      73             :    INTEGER               :: Instance
      74             :    INTEGER               :: ExtNr         ! Main Extension number
      75             :    INTEGER               :: ExtNrZhang    ! ZHANG_Rn222 extension number
      76             :    INTEGER               :: IDTRn222      ! Index # for Rn222
      77             :    INTEGER               :: IDTBe7        ! Index # for Be7
      78             :    INTEGER               :: IDTBe7Strat   ! Index # for Be7Strat
      79             :    INTEGER               :: IDTBe10       ! Index # for Be10
      80             :    INTEGER               :: IDTBe10Strat  ! Index # for Be10Strat
      81             : 
      82             :    ! For tracking Rn222, Be7, and Be10 emissions
      83             :    REAL(hp), POINTER     :: EmissRn222    (:,:  )
      84             :    REAL(hp), POINTER     :: EmissBe7      (:,:,:)
      85             :    REAL(hp), POINTER     :: EmissBe7Strat (:,:,:)
      86             :    REAL(hp), POINTER     :: EmissBe10     (:,:,:)
      87             :    REAL(hp), POINTER     :: EmissBe10Strat(:,:,:)
      88             : 
      89             :    ! For Lal & Peters 7Be emissions input data
      90             :    REAL(hp), POINTER     :: LATSOU(:    ) ! Array for latitudes
      91             :    REAL(hp), POINTER     :: PRESOU(:    ) ! Array for pressures
      92             :    REAL(hp), POINTER     :: BESOU (:,:  ) ! Array for 7Be emissions
      93             : 
      94             :    TYPE(MyInst), POINTER :: NextInst => NULL()
      95             :   END TYPE MyInst
      96             : 
      97             :   ! Pointer to instances
      98             :   TYPE(MyInst), POINTER  :: AllInst => NULL()
      99             : !
     100             : ! !DEFINED PARAMETERS:
     101             : !
     102             :   ! To convert kg to atoms
     103             :   REAL*8,  PARAMETER     :: XNUMOL_Rn   = ( 6.022140857d23 / 222.0d-3 )
     104             :   REAL*8,  PARAMETER     :: XNUMOL_Be7  = ( 6.022140857d23 /   7.0d-3 )
     105             :   REAL*8,  PARAMETER     :: XNUMOL_Be10 = ( 6.022140857d23 /  10.0d-3 )
     106             : 
     107             : CONTAINS
     108             : !EOC
     109             : !------------------------------------------------------------------------------
     110             : !                   Harmonized Emissions Component (HEMCO)                    !
     111             : !------------------------------------------------------------------------------
     112             : !BOP
     113             : !
     114             : ! !IROUTINE: HCOX_Gc_RnPbBe_run
     115             : !
     116             : ! !DESCRIPTION: Subroutine HcoX\_Gc\_RnPbBe\_Run computes emissions of 222Rn,
     117             : !  7Be, and 10Be for the GEOS-Chem Rn-Pb-Be specialty simulation.
     118             : !\\
     119             : !\\
     120             : ! !INTERFACE:
     121             : !
     122           0 :   SUBROUTINE HCOX_Gc_RnPbBe_Run( ExtState, HcoState, RC )
     123             : !
     124             : ! !USES:
     125             : !
     126             :     USE HCO_Calc_Mod,    ONLY : HCO_EvalFld
     127             :     USE HCO_FluxArr_Mod, ONLY : HCO_EmisAdd
     128             : !
     129             : ! !INPUT PARAMETERS:
     130             : !
     131             :     TYPE(Ext_State),  POINTER       :: ExtState    ! Options for Rn-Pb-Be sim
     132             :     TYPE(HCO_State),  POINTER       :: HcoState    ! HEMCO state
     133             : !
     134             : ! !INPUT/OUTPUT PARAMETERS:
     135             : !
     136             :     INTEGER,          INTENT(INOUT) :: RC          ! Success or failure?
     137             : !
     138             : ! !REMARKS:
     139             : !  This code is based on routine EMISSRnPbBe in prior versions of GEOS-Chem.
     140             : !
     141             : ! !REVISION HISTORY:
     142             : !  07 Jul 2014 - R. Yantosca - Initial version
     143             : !  See https://github.com/geoschem/hemco for complete history
     144             : !EOP
     145             : !------------------------------------------------------------------------------
     146             : !BOC
     147             : !
     148             : ! !LOCAL VARIABLES:
     149             : !
     150             : 
     151             :     ! Scalars
     152             :     INTEGER           :: I,        J,          L,          N
     153             :     INTEGER           :: HcoID
     154             :     REAL*8            :: A_CM2,    ADD_Rn,     Add_Be7,    Add_Be10
     155             :     REAL*8            :: Rn_LAND,  Rn_WATER,   DTSRCE
     156             :     REAL*8            :: Rn_TMP,   LAT,        F_LAND
     157             :     REAL*8            :: F_WATER,  F_BELOW_70, F_BELOW_60, F_ABOVE_60
     158             :     REAL*8            :: DENOM
     159             :     REAL(hp)          :: LAT_TMP,  P_TMP,      Be_TMP
     160             :     CHARACTER(LEN=255):: MSG, LOC
     161             : 
     162             :     ! Pointers
     163             :     TYPE(MyInst), POINTER :: Inst
     164           0 :     REAL(hp),     POINTER :: Arr2D(:,:  )
     165           0 :     REAL(hp),     POINTER :: Arr3D(:,:,:)
     166             : 
     167             :     !=======================================================================
     168             :     ! HCOX_GC_RnPbBe_RUN begins here!
     169             :     !=======================================================================
     170           0 :     LOC = 'HCOX_GC_RnPbBe_RUN (HCOX_GC_RNPBBE_MOD.F90)'
     171             : 
     172             :     ! Return if extension not turned on
     173           0 :     IF ( ExtState%GC_RnPbBe <= 0 ) RETURN
     174             : 
     175             :     ! Enter
     176           0 :     CALL HCO_ENTER( HcoState%Config%Err, LOC, RC )
     177           0 :     IF ( RC /= HCO_SUCCESS ) THEN
     178           0 :         CALL HCO_ERROR( 'ERROR 0', RC, THISLOC=LOC )
     179           0 :         RETURN
     180             :     ENDIF
     181             : 
     182             :     ! Set error flag
     183             :     !ERR = .FALSE.
     184             : 
     185             :     ! Get instance
     186           0 :     Inst   => NULL()
     187           0 :     CALL InstGet ( ExtState%GC_RnPbBe, Inst, RC )
     188           0 :     IF ( RC /= HCO_SUCCESS ) THEN
     189           0 :        WRITE(MSG,*) 'Cannot find GC_RnPbBe instance Nr. ', ExtState%GC_RnPbBe
     190           0 :        CALL HCO_ERROR(MSG,RC)
     191           0 :        RETURN
     192             :     ENDIF
     193             : 
     194             :     ! Emission timestep [s]
     195           0 :     DTSRCE = HcoState%TS_EMIS
     196             : 
     197             :     ! Nullify
     198           0 :     Arr2D => NULL()
     199           0 :     Arr3D => NULL()
     200             : 
     201             :     !=======================================================================
     202             :     ! Compute 222Rn emissions [kg/m2/s], according to the following:
     203             :     !
     204             :     ! (1) 222Rn emission poleward of 70 degrees = 0.0 [atoms/cm2/s]
     205             :     !
     206             :     ! (2) For latitudes 70S-60S and 60N-70N (both land & ocean),
     207             :     !     222Rn emission is 0.005 [atoms/cm2/s]
     208             :     !
     209             :     ! (3) For latitudes between 60S and 60N,
     210             :     !     222Rn emission is 1     [atoms/cm2/s] over land or
     211             :     !                       0.005 [atoms/cm2/s] over oceans
     212             :     !
     213             :     ! (4) For grid boxes where the surface temperature is below
     214             :     !     0 deg Celsius, reduce 222Rn emissions by a factor of 3.
     215             :     !
     216             :     ! Reference: Jacob et al.,Evaluation and intercomparison of
     217             :     !  global atmospheric transport models using Rn-222 and other
     218             :     !  short-lived tracers, JGR, 1997 (102):5953-5970
     219             :     !=======================================================================
     220           0 :     IF ( Inst%IDTRn222 > 0 ) THEN
     221             : 
     222           0 :        IF ( Inst%ExtNrZhang > 0 ) THEN
     223             : 
     224             :           !------------------------------------------------------------------
     225             :           ! Use Zhang et al Rn222 emissions
     226             :           ! cf https://doi.org/10.5194/acp-21-1861-2021
     227             :           !------------------------------------------------------------------
     228             :           CALL HCO_EvalFld( HcoState,       'ZHANG_Rn222_EMIS',              &
     229           0 :                             Inst%EmissRn222, RC                             )
     230           0 :           IF ( RC /= HCO_SUCCESS ) THEN
     231           0 :              CALL HCO_Error( 'Could not read ZHANG_Rn222_EMIS!', RC )
     232           0 :              RETURN
     233             :           ENDIF
     234             : 
     235             :        ELSE
     236             : 
     237             :           !------------------------------------------------------------------
     238             :           ! Use default Rn222 emissions, based on Jacob et al 1997
     239             :           !------------------------------------------------------------------
     240             :           !$OMP PARALLEL DO                                                  &
     241             :           !$OMP DEFAULT( SHARED )                                            &
     242             :           !$OMP PRIVATE( I,          J,          LAT,        DENOM         ) &
     243             :           !$OMP PRIVATE( F_BELOW_70, F_BELOW_60, F_ABOVE_60, Rn_LAND       ) &
     244             :           !$OMP PRIVATE( Rn_WATER,   F_LAND,     F_WATER,    ADD_Rn        ) &
     245             :           !$OMP SCHEDULE( DYNAMIC )
     246           0 :           DO J = 1, HcoState%Ny
     247           0 :           DO I = 1, HcoState%Nx
     248             : 
     249             :              ! Get ABS( latitude ) of the grid box
     250           0 :              LAT           = ABS( HcoState%Grid%YMID%Val( I, J ) )
     251             : 
     252             :              ! Zero for safety's sake
     253           0 :              F_BELOW_70    = 0d0
     254           0 :              F_BELOW_60    = 0d0
     255           0 :              F_ABOVE_60    = 0d0
     256             : 
     257             :              ! Baseline 222Rn emissions
     258             :              ! Rn_LAND [kg/m2/s] = [1 atom 222Rn/cm2/s] / [atoms/kg]
     259             :              !                   * [1d4 cm2/m2]
     260           0 :              Rn_LAND       = ( 1d0 / XNUMOL_Rn ) * 1d4
     261             : 
     262             :              ! Baseline 222Rn emissions over water or ice [kg]
     263           0 :              Rn_WATER      = Rn_LAND * 0.005d0
     264             : 
     265             :              ! Fraction of grid box that is land
     266           0 :              F_LAND        = ExtState%FRCLND%Arr%Val(I,J)
     267             : 
     268             :              ! Fraction of grid box that is water
     269           0 :              F_WATER       = 1d0 - F_LAND
     270             : 
     271             :              !--------------------
     272             :              ! 90S-70S or 70N-90N
     273             :              !--------------------
     274           0 :              IF ( LAT >= 70d0 ) THEN
     275             : 
     276             :                 ! 222Rn emissions are shut off poleward of 70 degrees
     277             :                 ADD_Rn = 0.0d0
     278             : 
     279             :              !--------------------
     280             :              ! 70S-60S or 60N-70N
     281             :              !--------------------
     282           0 :              ELSE IF ( LAT >= 60d0 ) THEN
     283             : 
     284           0 :                 IF ( LAT <= 70d0 ) THEN
     285             : 
     286             :                    ! If the entire grid box lies equatorward of 70 deg,
     287             :                    ! then 222Rn emissions here are 0.005 [atoms/cm2/s]
     288             :                    ADD_Rn = Rn_WATER
     289             : 
     290             :                 ELSE
     291             : 
     292             :                    ! N-S extent of grid box [degrees]
     293           0 :                    DENOM = HcoState%Grid%YMID%Val( I, J+1 )                  &
     294           0 :                         - HcoState%Grid%YMID%Val( I, J   )
     295             : 
     296             :                    ! Compute the fraction of the grid box below 70 degrees
     297           0 :                    F_BELOW_70 = ( 70.0d0 - LAT ) / DENOM
     298             : 
     299             :                    ! If the grid box straddles the 70S or 70N latitude
     300             :                    ! line, then only count 222Rn emissions equatorward of
     301             :                    ! 70 degrees.  222Rn emissions here are 0.005
     302             :                    ! [atoms/cm2/s].
     303           0 :                    ADD_Rn = F_BELOW_70 * Rn_WATER
     304             : 
     305             :                 ENDIF
     306             : 
     307             :              ELSE
     308             : 
     309             :                 !--------------------
     310             :                 ! 70S-60S or 60N-70N
     311             :                 !--------------------
     312           0 :                 IF ( LAT > 60d0 ) THEN
     313             : 
     314             :                    ! N-S extent of grid box [degrees]
     315           0 :                    DENOM  = HcoState%Grid%YMID%Val( I, J+1 )                 &
     316           0 :                           - HcoState%Grid%YMID%Val( I, J   )
     317             : 
     318             :                    ! Fraction of grid box with ABS( lat ) below 60 degrees
     319           0 :                    F_BELOW_60 = ( 60.0d0 - LAT ) / DENOM
     320             : 
     321             :                    ! Fraction of grid box with ABS( lat ) above 60 degrees
     322           0 :                    F_ABOVE_60 = F_BELOW_60
     323             : 
     324             :                    ADD_Rn =                                                  &
     325             :                         ! Consider 222Rn emissions equatorward of
     326             :                         ! 60 degrees for both land (1.0 [atoms/cm2/s])
     327             :                         ! and water (0.005 [atoms/cm2/s])
     328             :                         F_BELOW_60 *                                         &
     329             :                         ( Rn_LAND  * F_LAND  ) +                             &
     330             :                         ( Rn_WATER * F_WATER ) +                             &
     331             : 
     332             :                         ! If the grid box straddles the 60 degree boundary
     333             :                         ! then also consider the emissions poleward of 60
     334             :                         ! degrees.  222Rn emissions here are 0.005
     335             :                         ! [atoms/cm2/s].
     336           0 :                         F_ABOVE_60 * Rn_WATER
     337             : 
     338             :                 !--------------------
     339             :                 ! 60S-60N
     340             :                 !--------------------
     341             :                 ELSE
     342             : 
     343             :                    ! Consider 222Rn emissions equatorward of 60 deg for
     344             :                    ! land (1.0 [atoms/cm2/s]) and water (0.005 [atoms/cm2/s])
     345           0 :                    ADD_Rn = ( Rn_LAND * F_LAND ) + ( Rn_WATER * F_WATER )
     346             : 
     347             :                 ENDIF
     348             :              ENDIF
     349             : 
     350             :              ! For boxes below freezing, reduce 222Rn emissions by 3x
     351           0 :              IF ( ExtState%T2M%Arr%Val(I,J) < 273.15 ) THEN
     352           0 :                 ADD_Rn = ADD_Rn / 3d0
     353             :              ENDIF
     354             : 
     355             :              ! Save 222Rn emissions into an array [kg/m2/s]
     356           0 :              Inst%EmissRn222(I,J) = ADD_Rn
     357             :           ENDDO
     358             :           ENDDO
     359             :           !$OMP END PARALLEL DO
     360             : 
     361             :        ENDIF
     362             : 
     363             :        !------------------------------------------------------------------------
     364             :        ! Add 222Rn emissions to HEMCO data structure & diagnostics
     365             :        !------------------------------------------------------------------------
     366             : 
     367             :        ! Add emissions
     368           0 :        Arr2D => Inst%EmissRn222(:,:)
     369             :        CALL HCO_EmisAdd( HcoState, Arr2D, Inst%IDTRn222, &
     370           0 :                          RC,       ExtNr=Inst%ExtNr )
     371           0 :        Arr2D => NULL()
     372           0 :        IF ( RC /= HCO_SUCCESS ) THEN
     373             :           CALL HCO_ERROR( &
     374           0 :                           'HCO_EmisAdd error: EmissRn222', RC )
     375           0 :           RETURN
     376             :        ENDIF
     377             : 
     378             :     ENDIF ! IDTRn222 > 0
     379             : 
     380             :     !=======================================================================
     381             :     ! Compute 7Be and 10Be emissions [kg/m2/s]
     382             :     !
     383             :     ! Original units of 7Be and 10Be emissions are [stars/g air/sec],
     384             :     ! where "stars" = # of nuclear disintegrations of cosmic rays
     385             :     !
     386             :     ! Now interpolate from 33 std levels onto GEOS-CHEM levels
     387             :     !
     388             :     ! 7Be and 10Be have identical source distributions (Koch and Rind, 1998)
     389             :     !=======================================================================
     390           0 :     IF ( Inst%IDTBe7 > 0 .or. Inst%IDTBe10 > 0 ) THEN
     391             : !$OMP PARALLEL DO                                                   &
     392             : !$OMP DEFAULT( SHARED )                                             &
     393             : !$OMP PRIVATE( I, J, L, LAT_TMP, P_TMP, Be_TMP, ADD_Be7, ADD_Be10 ) &
     394             : !$OMP SCHEDULE( DYNAMIC )
     395           0 :        DO L = 1, HcoState%Nz
     396           0 :        DO J = 1, HcoState%Ny
     397           0 :        DO I = 1, HcoState%Nx
     398             : 
     399             :           ! Get absolute value of latitude, since we will assume that
     400             :           ! the 7Be distribution is symmetric about the equator
     401           0 :           LAT_TMP = ABS( HcoState%Grid%YMID%Val( I, J ) )
     402             : 
     403             :           ! Pressure at (I,J,L) [hPa]
     404             :           ! Now calculate from edge points (ckeller, 10/06/1014)
     405           0 :           P_TMP = ( HcoState%Grid%PEDGE%Val(I,J,L) + &
     406           0 :                     HcoState%Grid%PEDGE%Val(I,J,L+1) ) / 200.0_hp
     407             : 
     408             :           ! Interpolate 7Be [stars/g air/sec] to GEOS-Chem levels
     409             :           CALL SLQ( Inst%LATSOU, Inst%PRESOU, Inst%BESOU, 10, 33, &
     410           0 :                     LAT_TMP,     P_TMP,       Be_TMP )
     411             : 
     412             :           ! Be_TMP = [stars/g air/s] * [0.045 atom/star] *
     413             :           !          [kg air] * [1e3 g/kg] = 7Be/10Be emissions [atoms/s]
     414           0 :           Be_TMP  = Be_TMP * 0.045e+0_hp * ExtState%AIR%Arr%Val(I,J,L) * 1.e+3_hp
     415             : 
     416             :           ! ADD_Be = [atoms/s] / [atom/kg] / [m2] = 7Be/10Be emissions [kg/m2/s]
     417           0 :           ADD_Be7  = ( Be_TMP / XNUMOL_Be7  ) / HcoState%Grid%AREA_M2%Val(I,J)
     418           0 :           ADD_Be10 = ( Be_TMP / XNUMOL_Be10 ) / HcoState%Grid%AREA_M2%Val(I,J)
     419             : 
     420             :           ! Save emissions into an array for use below
     421           0 :           Inst%EmissBe7 (I,J,L) = ADD_Be7
     422           0 :           Inst%EmissBe10(I,J,L) = ADD_Be10
     423           0 :           IF ( L > ExtState%TropLev%Arr%Val(I,J) ) THEN
     424           0 :              IF ( Inst%IDTBe7Strat > 0 ) THEN
     425           0 :                 Inst%EmissBe7Strat (I,J,L) = Add_Be7
     426             :              ENDIF
     427           0 :              IF ( Inst%IDTBe10Strat > 0 ) THEN
     428           0 :                 Inst%EmissBe10Strat(I,J,L) = Add_Be10
     429             :              ENDIF
     430             :           ELSE
     431           0 :              IF ( Inst%IDTBe7Strat > 0 ) THEN
     432           0 :                 Inst%EmissBe7Strat (I,J,L) = 0d0
     433             :              ENDIF
     434           0 :              IF ( Inst%IDTBe10Strat > 0 ) THEN
     435           0 :                 Inst%EmissBe10Strat(I,J,L) = 0d0
     436             :              ENDIF
     437             :           ENDIF
     438             : 
     439             :        ENDDO
     440             :        ENDDO
     441             :        ENDDO
     442             : !$OMP END PARALLEL DO
     443             : 
     444             :        !------------------------------------------------------------------------
     445             :        ! Add Be7 and Be10 emissions to HEMCO data structure & diagnostics
     446             :        !------------------------------------------------------------------------
     447             : 
     448             :        ! Add emissions
     449           0 :        IF ( Inst%IDTBe7 > 0 ) THEN
     450           0 :           Arr3D => Inst%EmissBe7(:,:,:)
     451             :           CALL HCO_EmisAdd( HcoState, Arr3D, Inst%IDTBe7, &
     452           0 :                             RC,       ExtNr=Inst%ExtNr )
     453           0 :           Arr3D => NULL()
     454           0 :           IF ( RC /= HCO_SUCCESS ) THEN
     455             :              CALL HCO_ERROR( &
     456           0 :                              'HCO_EmisAdd error: EmissBe7', RC )
     457           0 :              RETURN
     458             :           ENDIF
     459             :        ENDIF
     460             : 
     461             :        ! Add emissions
     462           0 :        IF ( Inst%IDTBe7Strat > 0 ) THEN
     463           0 :           Arr3D => Inst%EmissBe7Strat(:,:,:)
     464             :           CALL HCO_EmisAdd( HcoState, Arr3D, Inst%IDTBe7Strat, &
     465           0 :                             RC,       ExtNr=Inst%ExtNr )
     466           0 :           Arr3D => NULL()
     467           0 :           IF ( RC /= HCO_SUCCESS ) THEN
     468             :              CALL HCO_ERROR( &
     469           0 :                              'HCO_EmisAdd error: EmissBe7Strat', RC )
     470           0 :              RETURN
     471             :           ENDIF
     472             :        ENDIF
     473             : 
     474             :        ! Add emissions
     475           0 :        IF ( Inst%IDTBe10 > 0 ) THEN
     476           0 :           Arr3D => Inst%EmissBe10(:,:,:)
     477             :           CALL HCO_EmisAdd( HcoState, Arr3D, Inst%IDTBe10, &
     478           0 :                             RC,       ExtNr=Inst%ExtNr )
     479           0 :           Arr3D => NULL()
     480           0 :           IF ( RC /= HCO_SUCCESS ) THEN
     481             :              CALL HCO_ERROR( &
     482           0 :                              'HCO_EmisAdd error: EmissBe10', RC )
     483           0 :              RETURN
     484             :           ENDIF
     485             :        ENDIF
     486             : 
     487             :        ! Add emissions
     488           0 :        IF ( Inst%IDTBe10Strat > 0 ) THEN
     489           0 :           Arr3D => Inst%EmissBe10Strat(:,:,:)
     490             :           CALL HCO_EmisAdd( HcoState, Arr3D, Inst%IDTBe10Strat, &
     491           0 :                             RC,       ExtNr=Inst%ExtNr )
     492           0 :           Arr3D => NULL()
     493           0 :           IF ( RC /= HCO_SUCCESS ) THEN
     494             :              CALL HCO_ERROR( &
     495           0 :                              'HCO_EmisAdd error: EmissBe10Strat', RC )
     496           0 :              RETURN
     497             :           ENDIF
     498             :        ENDIF
     499             : 
     500             :     ENDIF !IDTBe7 > 0 or IDTBe10 > 0
     501             : 
     502             :     !=======================================================================
     503             :     ! Cleanup & quit
     504             :     !=======================================================================
     505             : 
     506             :     ! Nullify pointers
     507           0 :     Inst    => NULL()
     508             : 
     509             :     ! Return w/ success
     510           0 :     CALL HCO_LEAVE( HcoState%Config%Err,RC )
     511             : 
     512           0 :   END SUBROUTINE HCOX_Gc_RnPbBe_Run
     513             : !EOC
     514             : !------------------------------------------------------------------------------
     515             : !                   Harmonized Emissions Component (HEMCO)                    !
     516             : !------------------------------------------------------------------------------
     517             : !BOP
     518             : !
     519             : ! !IROUTINE: HCOX_Gc_RnPbBe_Init
     520             : !
     521             : ! !DESCRIPTION: Subroutine HcoX\_Gc\_RnPbBe\_Init initializes the HEMCO
     522             : ! GC\_Rn-Pb-Be extension.
     523             : !\\
     524             : !\\
     525             : ! !INTERFACE:
     526             : !
     527           0 :   SUBROUTINE HCOX_Gc_RnPbBe_Init( HcoState, ExtName, ExtState, RC )
     528             : !
     529             : ! !USES:
     530             : !
     531             :     USE HCO_ExtList_Mod, ONLY : GetExtNr
     532             :     USE HCO_ExtList_Mod, ONLY : GetExtOpt
     533             :     USE HCO_State_Mod,   ONLY : HCO_GetExtHcoID
     534             : !
     535             : ! !INPUT PARAMETERS:
     536             : !
     537             :     CHARACTER(LEN=*), INTENT(IN   )  :: ExtName     ! Extension name
     538             :     TYPE(Ext_State),  POINTER        :: ExtState    ! Module options
     539             : !
     540             : ! !INPUT/OUTPUT PARAMETERS:
     541             : !
     542             :     TYPE(HCO_State),  POINTER        :: HcoState    ! Hemco state
     543             :     INTEGER,          INTENT(INOUT)  :: RC
     544             : 
     545             : ! !REVISION HISTORY:
     546             : !  07 Jul 2014 - R. Yantosca - Initial version
     547             : !  See https://github.com/geoschem/hemco for complete history
     548             : !EOP
     549             : !------------------------------------------------------------------------------
     550             : !BOC
     551             : !
     552             : ! !LOCAL VARIABLES:
     553             : !
     554             :     ! Scalars
     555             :     INTEGER                        :: N, nSpc, ExtNr, ExtNrZhang
     556             :     CHARACTER(LEN=255)             :: MSG, LOC
     557             : 
     558             :     ! Arrays
     559           0 :     INTEGER,           ALLOCATABLE :: HcoIDs(:)
     560           0 :     CHARACTER(LEN=31), ALLOCATABLE :: SpcNames(:)
     561             : 
     562             :     ! Pointers
     563             :     TYPE(MyInst), POINTER          :: Inst
     564             : 
     565             :     !=======================================================================
     566             :     ! HCOX_GC_RnPbBe_INIT begins here!
     567             :     !=======================================================================
     568           0 :     LOC = 'HCOX_GC_RNPBBE_INIT (HCOX_GC_RNPBBE_MOD.F90)'
     569             : 
     570             :     ! Get the main extension number
     571           0 :     ExtNr = GetExtNr( HcoState%Config%ExtList, TRIM(ExtName) )
     572           0 :     IF ( ExtNr <= 0 ) RETURN
     573             : 
     574             :     ! Get the extension number for Zhang et al [2021] emissions
     575           0 :     ExtNrZhang = GetExtNr( HcoState%Config%ExtList, 'ZHANG_Rn222' )
     576             : 
     577             :     ! Enter
     578           0 :     CALL HCO_ENTER( HcoState%Config%Err, LOC, RC )
     579           0 :     IF ( RC /= HCO_SUCCESS ) THEN
     580           0 :         CALL HCO_ERROR( 'ERROR 1', RC, THISLOC=LOC )
     581           0 :         RETURN
     582             :     ENDIF
     583             : 
     584             :     ! Create Instance
     585           0 :     Inst => NULL()
     586           0 :     CALL InstCreate ( ExtNr, ExtState%GC_RnPbBe, Inst, RC )
     587           0 :     IF ( RC /= HCO_SUCCESS ) THEN
     588           0 :        CALL HCO_ERROR ( 'Cannot create GC_RnPbBe instance', RC )
     589           0 :        RETURN
     590             :     ENDIF
     591             :     ! Also fill the extension numbers in the Instance object
     592           0 :     Inst%ExtNr      = ExtNr
     593           0 :     Inst%ExtNrZhang = ExtNrZhang
     594             : 
     595             :     ! Set HEMCO species IDs
     596           0 :     CALL HCO_GetExtHcoID( HcoState, Inst%ExtNr, HcoIDs, SpcNames, nSpc, RC )
     597           0 :     IF ( RC /= HCO_SUCCESS ) THEN
     598           0 :        CALL HCO_ERROR( 'Could not set HEMCO species IDs', RC )
     599           0 :        RETURN
     600             :     ENDIF
     601             : 
     602             :     ! Verbose mode
     603           0 :     IF ( HcoState%amIRoot ) THEN
     604           0 :        MSG = 'Use gc_RnPbBe emissions module (extension module)'
     605           0 :        CALL HCO_MSG(HcoState%Config%Err,MSG )
     606             : 
     607           0 :        MSG = 'Use the following species (Name: HcoID):'
     608           0 :        CALL HCO_MSG(HcoState%Config%Err,MSG)
     609           0 :        DO N = 1, nSpc
     610           0 :           WRITE(MSG,*) TRIM(SpcNames(N)), ':', HcoIDs(N)
     611           0 :           CALL HCO_MSG(HcoState%Config%Err,MSG)
     612             :        ENDDO
     613             :     ENDIF
     614             : 
     615             :     ! Set up tracer and HEMCO indices
     616           0 :     DO N = 1, nSpc
     617           0 :        SELECT CASE( TRIM( SpcNames(N) ) )
     618             :           CASE( 'Rn', 'Rn222', '222Rn' )
     619           0 :              Inst%IDTRn222     = HcoIDs(N)
     620             :           CASE( 'Be', 'Be7', '7Be' )
     621           0 :              Inst%IDTBe7       = HcoIDs(N)
     622             :           CASE( 'Be7Strat', '7BeStrat' )
     623           0 :              Inst%IDTBe7Strat  = HcoIDs(N)
     624             :           CASE( 'Be10', '10Be' )
     625           0 :              Inst%IDTBe10      = HcoIDs(N)
     626             :           CASE( 'Be10Strat', '10BeStrat' )
     627           0 :              Inst%IDTBe10Strat = HcoIDs(N)
     628             :           CASE DEFAULT
     629             :              ! Do nothing
     630             :        END SELECT
     631             :     ENDDO
     632             : 
     633             :     ! WARNING: Rn tracer is not found!
     634           0 :     IF ( Inst%IDTRn222 <= 0 .AND. HcoState%amIRoot ) THEN
     635             :        CALL HCO_WARNING( HcoState%Config%Err, &
     636           0 :                          'Cannot find Rn222 tracer in list of species!', RC )
     637             :     ENDIF
     638             : 
     639             :     ! WARNING: Be7 tracer is not found
     640           0 :     IF ( Inst%IDTBe7 <= 0 .AND. HcoState%amIRoot ) THEN
     641             :        CALL HCO_WARNING( HcoState%Config%Err, &
     642           0 :                          'Cannot find Be7 tracer in list of species!', RC )
     643             :     ENDIF
     644             : 
     645             :     ! WARNING: Be10 tracer is not found
     646           0 :     IF ( Inst%IDTBe10 <= 0 .AND. HcoState%amIRoot ) THEN
     647             :        CALL HCO_WARNING( HcoState%Config%Err, &
     648           0 :                         'Cannot find Be10 tracer in list of species!', RC )
     649             :     ENDIF
     650             : 
     651             :     ! ERROR: No tracer defined
     652           0 :     IF ( Inst%IDTRn222 <= 0 .AND. Inst%IDTBe7 <= 0 .AND. Inst%IDTBe10 <= 0) THEN
     653             :        CALL HCO_ERROR( &
     654           0 :                        'Cannot use RnPbBe extension: no valid species!', RC )
     655             :     ENDIF
     656             : 
     657             :     ! Activate met fields required by this extension
     658           0 :     ExtState%FRCLND%DoUse  = .TRUE.
     659           0 :     ExtState%T2M%DoUse     = .TRUE.
     660           0 :     ExtState%AIR%DoUse     = .TRUE.
     661           0 :     ExtState%TropLev%DoUse = .TRUE.
     662             : 
     663             :     !=======================================================================
     664             :     ! Initialize data arrays
     665             :     !=======================================================================
     666             : 
     667           0 :     IF ( Inst%IDTRn222 > 0 ) THEN
     668           0 :        ALLOCATE( Inst%EmissRn222( HcoState%Nx, HcoState%NY ), STAT=RC )
     669           0 :        IF ( RC /= 0 ) THEN
     670             :           CALL HCO_ERROR ( &
     671           0 :                            'Cannot allocate EmissRn222', RC )
     672           0 :           RETURN
     673             :        ENDIF
     674             :     ENDIF
     675             : 
     676           0 :     IF ( Inst%IDTBe7 > 0 ) THEN
     677             :        ALLOCATE( Inst%EmissBe7( HcoState%Nx, HcoState%NY, HcoState%NZ ), &
     678           0 :                  STAT=RC )
     679           0 :        IF ( RC /= 0 ) THEN
     680             :           CALL HCO_ERROR ( &
     681           0 :                            'Cannot allocate EmissBe7', RC )
     682           0 :           RETURN
     683             :        ENDIF
     684             :        IF ( RC /= 0 ) RETURN
     685             : 
     686             :        ! Array for latitudes (Lal & Peters data)
     687           0 :        ALLOCATE( Inst%LATSOU( 10 ), STAT=RC )
     688           0 :        IF ( RC /= 0 ) THEN
     689             :           CALL HCO_ERROR ( &
     690           0 :                            'Cannot allocate LATSOU', RC )
     691           0 :           RETURN
     692             :        ENDIF
     693             : 
     694             :        ! Array for pressures (Lal & Peters data)
     695           0 :        ALLOCATE( Inst%PRESOU( 33 ), STAT=RC )
     696           0 :        IF ( RC /= 0 ) THEN
     697             :           CALL HCO_ERROR ( &
     698           0 :                            'Cannot allocate PRESOU', RC )
     699           0 :           RETURN
     700             :        ENDIF
     701             : 
     702             :        ! Array for 7Be emissions ( Lal & Peters data)
     703           0 :        ALLOCATE( Inst%BESOU( 10, 33 ), STAT=RC )
     704           0 :        IF ( RC /= 0 ) THEN
     705             :           CALL HCO_ERROR ( &
     706           0 :                            'Cannot allocate BESOU', RC )
     707           0 :           RETURN
     708             :        ENDIF
     709             : 
     710             :        ! Initialize the 7Be emisisons data arrays
     711           0 :        CALL Init_7Be_Emissions( Inst )
     712             :     ENDIF
     713             : 
     714           0 :     IF ( Inst%IDTBe7Strat > 0 ) THEN
     715             :        ALLOCATE( Inst%EmissBe7Strat( HcoState%Nx, HcoState%NY, HcoState%NZ ), &
     716           0 :                  STAT=RC )
     717           0 :        IF ( RC /= 0 ) THEN
     718             :           CALL HCO_ERROR ( &
     719           0 :                            'Cannot allocate EmissBe7Strat', RC )
     720           0 :           RETURN
     721             :        ENDIF
     722           0 :        Inst%EmissBe7Strat = 0.0_hp
     723             :     ENDIF
     724             : 
     725           0 :     IF ( Inst%IDTBe10 > 0 ) THEN
     726             :        ALLOCATE( Inst%EmissBe10( HcoState%Nx, HcoState%NY, HcoState%NZ ), &
     727           0 :                  STAT=RC )
     728           0 :        IF ( RC /= 0 ) THEN
     729             :           CALL HCO_ERROR ( &
     730           0 :                            'Cannot allocate EmissBe10', RC )
     731           0 :           RETURN
     732             :        ENDIF
     733             :     ENDIF
     734             : 
     735           0 :     IF ( Inst%IDTBe10Strat > 0 ) THEN
     736             :        ALLOCATE( Inst%EmissBe10Strat( HcoState%Nx, HcoState%NY, HcoState%NZ ), &
     737           0 :                  STAT=RC )
     738           0 :        IF ( RC /= 0 ) THEN
     739             :           CALL HCO_ERROR ( &
     740           0 :                            'Cannot allocate EmissBe10Strat', RC )
     741           0 :           RETURN
     742             :        ENDIF
     743           0 :        Inst%EmissBe10Strat = 0.0_hp
     744             :     ENDIF
     745             : 
     746             :     !=======================================================================
     747             :     ! Leave w/ success
     748             :     !=======================================================================
     749           0 :     IF ( ALLOCATED( HcoIDs   ) ) DEALLOCATE( HcoIDs   )
     750           0 :     IF ( ALLOCATED( SpcNames ) ) DEALLOCATE( SpcNames )
     751             : 
     752             :     ! Nullify pointers
     753           0 :     Inst    => NULL()
     754             : 
     755           0 :     CALL HCO_LEAVE( HcoState%Config%Err,RC )
     756             : 
     757           0 :   END SUBROUTINE HCOX_Gc_RnPbBe_Init
     758             : !EOC
     759             : !------------------------------------------------------------------------------
     760             : !                   Harmonized Emissions Component (HEMCO)                    !
     761             : !------------------------------------------------------------------------------
     762             : !BOP
     763             : !
     764             : ! !IROUTINE: HCOX_Gc_RnPbBe_Final
     765             : !
     766             : ! !DESCRIPTION: Subroutine HcoX\_Gc\_RnPbBe\_Final finalizes the HEMCO
     767             : !  extension for the GEOS-Chem Rn-Pb-Be specialty simulation.  All module
     768             : !  arrays will be deallocated.
     769             : !\\
     770             : !\\
     771             : ! !INTERFACE:
     772             : !
     773           0 :   SUBROUTINE HCOX_Gc_RnPbBe_Final( ExtState )
     774             : !
     775             : ! !INPUT PARAMETERS:
     776             : !
     777             :     TYPE(Ext_State),  POINTER       :: ExtState   ! Module options
     778             : !
     779             : ! !REVISION HISTORY:
     780             : !  13 Dec 2013 - C. Keller   - Now a HEMCO extension
     781             : !  See https://github.com/geoschem/hemco for complete history
     782             : !EOP
     783             : !------------------------------------------------------------------------------
     784             : !BOC
     785             : 
     786             :     !=======================================================================
     787             :     ! HCOX_GC_RNPBBE_FINAL begins here!
     788             :     !=======================================================================
     789             : 
     790           0 :     CALL InstRemove ( ExtState%GC_RnPbBe )
     791             : 
     792           0 :   END SUBROUTINE HCOX_Gc_RnPbBe_Final
     793             : !EOC
     794             : !------------------------------------------------------------------------------
     795             : !                   Harmonized Emissions Component (HEMCO)                    !
     796             : !------------------------------------------------------------------------------
     797             : !BOP
     798             : !
     799             : ! !IROUTINE: Init_7Be_Emissions
     800             : !
     801             : ! !DESCRIPTION: Subroutine Init\_7Be\_Emissions initializes the 7Be emissions
     802             : !  from Lal \& Peters on 33 pressure levels.  This data used to be read from
     803             : !  a file, but we have now hardwired it to facilitate I/O in the ESMF
     804             : !  environment.
     805             : !\\
     806             : !\\
     807             : ! !INTERFACE:
     808             : !
     809           0 :   SUBROUTINE Init_7Be_Emissions( Inst )
     810             : !
     811             : ! !INPUT PARAMETERS:
     812             : !
     813             :     TYPE(MyInst),    POINTER        :: Inst      ! Instance
     814             : !
     815             : ! !REMARKS:
     816             : !  (1) Reference: Lal, D., and B. Peters, Cosmic ray produced radioactivity
     817             : !       on the Earth. Handbuch der Physik, 46/2, 551-612, edited by K. Sitte,
     818             : !        Springer-Verlag, New York, 1967.
     819             : !                                                                             .
     820             : !  (2) In prior versions of GEOS-Chem, this routine was named READ_7BE, and
     821             : !      it read the ASCII file "7Be.Lal".   Because this data set is not placed
     822             : !      on a lat/lon grid, ESMF cannot regrid it.  To work around this, we now
     823             : !      hardwire this data in module arrays rather than read it from disk.
     824             : !                                                                             .
     825             : !  (3) Units of 7Be emissions are [stars/g air/s].
     826             : !      Here, "stars" = # of nuclear disintegrations of cosmic rays
     827             : !                                                                             .
     828             : !  (4) Original data from Lal & Peters (1967), w/ these modifications:
     829             : !      (a) Replace data at (0hPa, 70S) following Koch 1996:
     830             : !          (i ) old value = 3000
     831             : !          (ii) new value = 1900
     832             : !      (b) Copy data from 70S to 80S and 90S at all levels
     833             : !                                                                             .
     834             : ! !REVISION HISTORY:
     835             : !  07 Aug 2002 - H. Liu - Initial version
     836             : !  See https://github.com/geoschem/hemco for complete history
     837             : !EOP
     838             : !------------------------------------------------------------------------------
     839             : !BOC
     840             : 
     841             :     ! Define latitudes [degrees North]
     842             :     Inst%LATSOU      = (/     0.0_hp,     10.0_hp,     20.0_hp,    30.0_hp,  &
     843             :                              40.0_hp,     50.0_hp,     60.0_hp,    70.0_hp,  &
     844           0 :                              80.0_hp,     90.0_hp  /)
     845             : 
     846             :     ! Define pressures [hPa]
     847             :     Inst%PRESOU      = (/     0.0_hp,     50.0_hp,     70.0_hp,    90.0_hp,  &
     848             :                             110.0_hp,    130.0_hp,    150.0_hp,   170.0_hp,  &
     849             :                             190.0_hp,    210.0_hp,    230.0_hp,   250.0_hp,  &
     850             :                             270.0_hp,    290.0_hp,    313.0_hp,   338.0_hp,  &
     851             :                             364.0_hp,    392.0_hp,    420.0_hp,   451.0_hp,  &
     852             :                             485.0_hp,    518.0_hp,    555.0_hp,   592.0_hp,  &
     853             :                             633.0_hp,    680.0_hp,    725.0_hp,   772.0_hp,  &
     854             :                             822.0_hp,    875.0_hp,    930.0_hp,   985.0_hp,  &
     855           0 :                            1030.0_hp  /)
     856             : 
     857             :     ! Define 7Be emissions [stars/g air/s]
     858             :     ! 1 "star" = 1 nuclear disintegration via cosmic rays
     859             :     !
     860             :     ! NOTE: These statements were defined from printout of the file
     861             :     ! and need to be multiplied by 1d-5 below.
     862           0 :     Inst%BESOU(:,1)  = (/   150.0_hp,    156.0_hp,    188.0_hp,   285.0_hp,  &
     863             :                             500.0_hp,    910.0_hp,   1700.0_hp,  1900.0_hp,  &
     864           0 :                            1900.0_hp,   1900.0_hp  /)
     865             : 
     866           0 :     Inst%BESOU(:,2)  = (/   280.0_hp,    310.0_hp,    390.0_hp,   590.0_hp,  &
     867             :                             880.0_hp,   1390.0_hp,   1800.0_hp,  1800.0_hp,  &
     868           0 :                            1800.0_hp,   1800.0_hp  /)
     869             : 
     870           0 :     Inst%BESOU(:,3)  = (/   310.0_hp,    330.0_hp,    400.0_hp,   620.0_hp,  &
     871             :                             880.0_hp,   1280.0_hp,   1450.0_hp,  1450.0_hp,  &
     872           0 :                            1450.0_hp,   1450.0_hp  /)
     873             : 
     874           0 :     Inst%BESOU(:,4)  = (/   285.0_hp,    310.0_hp,    375.0_hp,   570.0_hp,  &
     875             :                             780.0_hp,   1100.0_hp,   1180.0_hp,  1180.0_hp,  &
     876           0 :                            1180.0_hp,   1180.0_hp  /)
     877             : 
     878           0 :     Inst%BESOU(:,5)  = (/   255.0_hp,    275.0_hp,    330.0_hp,   510.0_hp,  &
     879             :                             680.0_hp,    950.0_hp,   1000.0_hp,  1000.0_hp,  &
     880           0 :                            1000.0_hp,   1000.0_hp  /)
     881             : 
     882           0 :     Inst%BESOU(:,6)  = (/   230.0_hp,    245.0_hp,    292.0_hp,   450.0_hp,  &
     883             :                             600.0_hp,    820.0_hp,    875.0_hp,   875.0_hp,  &
     884           0 :                             875.0_hp,    875.0_hp  /)
     885             : 
     886           0 :     Inst%BESOU(:,7)  = (/   205.0_hp,    215.0_hp,    260.0_hp,   400.0_hp,  &
     887             :                             530.0_hp,    730.0_hp,    750.0_hp,   750.0_hp,  &
     888           0 :                             750.0_hp,    750.0_hp  /)
     889             : 
     890           0 :     Inst%BESOU(:,8)  = (/   182.0_hp,    195.0_hp,    235.0_hp,   355.0_hp,  &
     891             :                             480.0_hp,    630.0_hp,    650.0_hp,   650.0_hp,  &
     892           0 :                             650.0_hp,    650.0_hp  /)
     893             : 
     894           0 :     Inst%BESOU(:,9)  = (/   160.0_hp,    173.0_hp,    208.0_hp,   315.0_hp,  &
     895             :                             410.0_hp,    543.0_hp,    550.0_hp,   550.0_hp,  &
     896           0 :                             550.0_hp,    550.0_hp  /)
     897             : 
     898           0 :     Inst%BESOU(:,10) = (/   148.0_hp,    152.0_hp,    185.0_hp,   280.0_hp,  &
     899             :                             370.0_hp,    480.0_hp,    500.0_hp,   500.0_hp,  &
     900           0 :                             500.0_hp,    500.0_hp  /)
     901             : 
     902           0 :     Inst%BESOU(:,11) = (/   130.0_hp,    139.0_hp,    167.0_hp,   250.0_hp,  &
     903             :                             320.0_hp,    425.0_hp,    430.0_hp,   430.0_hp,  &
     904           0 :                             430.0_hp,    430.0_hp  /)
     905             : 
     906           0 :     Inst%BESOU(:,12) = (/   116.0_hp,    123.0_hp,    148.0_hp,   215.0_hp,  &
     907             :                             285.0_hp,    365.0_hp,    375.0_hp,   375.0_hp,  &
     908           0 :                             375.0_hp,    375.0_hp  /)
     909             : 
     910           0 :     Inst%BESOU(:,13) = (/   104.0_hp,    110.0_hp,    130.0_hp,   198.0_hp,  &
     911             :                             250.0_hp,    320.0_hp,    330.0_hp,   330.0_hp,  &
     912           0 :                             330.0_hp,    330.0_hp  /)
     913             : 
     914           0 :     Inst%BESOU(:,14) = (/    93.0_hp,     99.0_hp,    118.0_hp,   170.0_hp,  &
     915             :                             222.0_hp,    280.0_hp,    288.0_hp,   288.0_hp,  &
     916           0 :                             288.0_hp,    288.0_hp  /)
     917             : 
     918           0 :     Inst%BESOU(:,15) = (/    80.0_hp,     84.0_hp,    100.0_hp,   145.0_hp,  &
     919             :                             190.0_hp,    235.0_hp,    250.0_hp,   250.0_hp,  &
     920           0 :                             250.0_hp,    250.0_hp  /)
     921             : 
     922           0 :     Inst%BESOU(:,16) = (/    72.0_hp,     74.0_hp,     88.0_hp,   129.0_hp,  &
     923             :                             168.0_hp,    210.0_hp,    218.0_hp,   218.0_hp,  &
     924           0 :                             218.0_hp,    218.0_hp  /)
     925             : 
     926           0 :     Inst%BESOU(:,17) = (/    59.5_hp,     62.5_hp,     73.5_hp,   108.0_hp,  &
     927             :                             138.0_hp,    171.0_hp,    178.0_hp,   178.0_hp,  &
     928           0 :                             178.0_hp,    178.0_hp  /)
     929             : 
     930           0 :     Inst%BESOU(:,18) = (/    50.0_hp,     53.0_hp,     64.0_hp,    90.0_hp,  &
     931             :                             115.0_hp,    148.0_hp,    150.0_hp,   150.0_hp,  &
     932           0 :                             150.0_hp,    150.0_hp  /)
     933             : 
     934           0 :     Inst%BESOU(:,19) = (/    45.0_hp,     46.5_hp,     52.5_hp,    76.0_hp,  &
     935             :                              98.0_hp,    122.0_hp,    128.0_hp,   128.0_hp,  &
     936           0 :                             128.0_hp,    128.0_hp  /)
     937             : 
     938           0 :     Inst%BESOU(:,20) = (/    36.5_hp,     37.5_hp,     45.0_hp,    61.0_hp,  &
     939             :                              77.0_hp,     98.0_hp,    102.0_hp,   102.0_hp,  &
     940           0 :                             102.0_hp,    102.0_hp  /)
     941             : 
     942           0 :     Inst%BESOU(:,21) = (/    30.8_hp,     32.0_hp,     37.5_hp,    51.5_hp,  &
     943             :                              65.0_hp,     81.0_hp,     85.0_hp,    85.0_hp,  &
     944           0 :                              85.0_hp,     85.0_hp  /)
     945             : 
     946           0 :     Inst%BESOU(:,22) = (/    25.5_hp,     26.5_hp,     32.0_hp,    40.5_hp,  &
     947             :                              54.0_hp,     67.5_hp,     69.5_hp,    69.5_hp,  &
     948           0 :                              69.5_hp,     69.5_hp  /)
     949             : 
     950           0 :     Inst%BESOU(:,23) = (/    20.5_hp,     21.6_hp,     25.5_hp,    33.0_hp,  &
     951             :                              42.0_hp,     53.5_hp,     55.0_hp,    55.0_hp,  &
     952           0 :                              55.0_hp,     55.0_hp  /)
     953             : 
     954           0 :     Inst%BESOU(:,24) = (/    16.8_hp,     17.3_hp,     20.0_hp,    26.0_hp,  &
     955             :                              33.5_hp,     41.0_hp,     43.0_hp,    43.0_hp,  &
     956           0 :                              43.0_hp,     43.0_hp  /)
     957             : 
     958           0 :     Inst%BESOU(:,25) = (/    13.0_hp,     13.8_hp,     15.3_hp,    20.5_hp,  &
     959             :                              26.8_hp,     32.5_hp,     33.5_hp,    33.5_hp,  &
     960           0 :                              33.5_hp,     33.5_hp  /)
     961             : 
     962           0 :     Inst%BESOU(:,26) = (/    10.1_hp,     10.6_hp,     12.6_hp,    15.8_hp,  &
     963             :                              20.0_hp,     24.5_hp,     25.8_hp,    25.8_hp,  &
     964           0 :                              25.8_hp,     25.8_hp  /)
     965             : 
     966           0 :     Inst%BESOU(:,27) = (/     7.7_hp,     8.15_hp,      9.4_hp,    11.6_hp,  &
     967             :                              14.8_hp,     17.8_hp,     18.5_hp,    18.5_hp,  &
     968           0 :                              18.5_hp,     18.5_hp  /)
     969             : 
     970           0 :     Inst%BESOU(:,28) = (/     5.7_hp,     5.85_hp,     6.85_hp,    8.22_hp,  &
     971             :                              11.0_hp,     13.1_hp,     13.2_hp,    13.2_hp,  &
     972           0 :                              13.2_hp,     13.2_hp  /)
     973             : 
     974           0 :     Inst%BESOU(:,29) = (/     3.9_hp,      4.2_hp,     4.85_hp,     6.0_hp,  &
     975             :                               7.6_hp,      9.0_hp,      9.2_hp,     9.2_hp,  &
     976           0 :                               9.2_hp,      9.2_hp  /)
     977             : 
     978           0 :     Inst%BESOU(:,30) = (/     3.0_hp,     3.05_hp,     3.35_hp,     4.2_hp,  &
     979             :                               5.3_hp,      5.9_hp,     6.25_hp,    6.25_hp,  &
     980           0 :                              6.25_hp,     6.25_hp  /)
     981             : 
     982           0 :     Inst%BESOU(:,31) = (/    2.05_hp,      2.1_hp,     2.32_hp,     2.9_hp,  &
     983             :                               3.4_hp,      3.9_hp,      4.1_hp,     4.1_hp,  &
     984           0 :                               4.1_hp,      4.1_hp  /)
     985             : 
     986           0 :     Inst%BESOU(:,32) = (/    1.45_hp,     1.43_hp,     1.65_hp,    2.03_hp,  &
     987             :                               2.4_hp,     2.75_hp,     2.65_hp,    2.65_hp,  &
     988           0 :                              2.65_hp,     2.65_hp  /)
     989             : 
     990           0 :     Inst%BESOU(:,33) = (/    1.04_hp,     1.08_hp,     1.21_hp,     1.5_hp,  &
     991             :                              1.68_hp,      1.8_hp,      1.8_hp,     1.8_hp,  &
     992           0 :                               1.8_hp,      1.8_hp  /)
     993             : 
     994             :     ! All the numbers of BESOU need to be multiplied by 1e-5 in order to put
     995             :     ! them into the correct data range.  NOTE: This multiplication statement
     996             :     ! needs to be preserved here in order to  ensure identical output to the
     997             :     ! prior code! (bmy, 7/7/14)
     998           0 :     Inst%BESOU = Inst%BESOU * 1.e-5_hp
     999             : 
    1000           0 :   END SUBROUTINE Init_7Be_Emissions
    1001             : !EOC
    1002             : !------------------------------------------------------------------------------
    1003             : !                   Harmonized Emissions Component (HEMCO)                    !
    1004             : !------------------------------------------------------------------------------
    1005             : !BOP
    1006             : !
    1007             : ! !IROUTINE: SLQ
    1008             : !
    1009             : ! !DESCRIPTION: Subroutine SLQ is an interpolation subroutine from a
    1010             : !  Chinese reference book (says Hongyu Liu).
    1011             : !\\
    1012             : !\\
    1013             : ! !INTERFACE:
    1014             : !
    1015           0 :   SUBROUTINE SLQ( X, Y, Z, N, M, U, V, W )
    1016             : !
    1017             : ! !INPUT PARAMETERS:
    1018             : !
    1019             :     INTEGER :: N        ! First dimension of Z
    1020             :     INTEGER :: M        ! Second dimension of Z
    1021             :     REAL(hp)  :: X(N)     ! X-axis coordinate on original grid
    1022             :     REAL(hp)  :: Y(M)     ! Y-axis coordinate on original grid
    1023             :     REAL(hp)  :: Z(N,M)   ! Array of data on original grid
    1024             :     REAL(hp)  :: U        ! X-axis coordinate for desired interpolated value
    1025             :     REAL(hp)  :: V        ! Y-axis coordinate for desired interpolated value
    1026             : !
    1027             : ! !OUTPUT PARAMETERS:
    1028             : !
    1029             :     REAL(hp)  :: W        ! Interpolated value of Z array, at coords (U,V)
    1030             : !
    1031             : ! !REMARKS:
    1032             : !  This routine was taken from the old RnPbBe_mod.F.
    1033             : !
    1034             : ! !REVISION HISTORY:
    1035             : !  17 Mar 1998 - H. Liu      - Initial version
    1036             : !  See https://github.com/geoschem/hemco for complete history
    1037             : !EOP
    1038             : !------------------------------------------------------------------------------
    1039             : !BOC
    1040             : !
    1041             : ! !LOCAL VARIABLES:
    1042             : !
    1043             :     REAL(hp)  :: B(3), HH
    1044             :     INTEGER :: NN,   IP, I, J, L, IQ, K, MM
    1045             : 
    1046             :     !=======================================================================
    1047             :     ! SLQ begins here!
    1048             :     !=======================================================================
    1049           0 :     NN=3
    1050           0 :     IF(N.LE.3) THEN
    1051             :        IP=1
    1052             :        NN=N
    1053           0 :     ELSE IF (U.LE.X(2)) THEN
    1054             :        IP=1
    1055           0 :     ELSE IF (U.GE.X(N-1)) THEN
    1056           0 :        IP=N-2
    1057             :     ELSE
    1058             :        I=1
    1059             :        J=N
    1060           0 : 10     IF (IABS(I-J).NE.1) THEN
    1061           0 :           L=(I+J)/2
    1062           0 :           IF (U.LT.X(L)) THEN
    1063             :              J=L
    1064             :           ELSE
    1065           0 :              I=L
    1066             :           END IF
    1067             :           GOTO 10
    1068             :        END IF
    1069           0 :        IF (ABS(U-X(I)).LT.ABS(U-X(J))) THEN
    1070           0 :           IP=I-1
    1071             :        ELSE
    1072             :           IP=I
    1073             :        END IF
    1074             :     END IF
    1075           0 :     MM=3
    1076           0 :     IF (M.LE.3) THEN
    1077             :        IQ=1
    1078             :        MM=N
    1079           0 :     ELSE IF (V.LE.Y(2)) THEN
    1080             :        IQ=1
    1081           0 :     ELSE IF (V.GE.Y(M-1)) THEN
    1082           0 :        IQ=M-2
    1083             :     ELSE
    1084             :        I=1
    1085             :        J=M
    1086           0 : 20     IF (IABS(J-I).NE.1) THEN
    1087           0 :           L=(I+J)/2
    1088           0 :           IF (V.LT.Y(L)) THEN
    1089             :              J=L
    1090             :           ELSE
    1091           0 :              I=L
    1092             :           END IF
    1093             :           GOTO 20
    1094             :        END IF
    1095           0 :        IF (ABS(V-Y(I)).LT.ABS(V-Y(J))) THEN
    1096           0 :           IQ=I-1
    1097             :        ELSE
    1098             :           IQ=I
    1099             :        END IF
    1100             :     END IF
    1101           0 :     DO 50 I=1,NN
    1102           0 :        B(I)=0.0
    1103           0 :        DO 40 J=1,MM
    1104           0 :           HH=Z(IP+I-1,IQ+J-1)
    1105           0 :           DO 30 K=1,MM
    1106           0 :              IF (K.NE.J) THEN
    1107           0 :                 HH=HH*(V-Y(IQ+K-1))/(Y(IQ+J-1)-Y(IQ+K-1))
    1108             :              END IF
    1109           0 : 30        CONTINUE
    1110           0 :           B(I)=B(I)+HH
    1111           0 : 40     CONTINUE
    1112           0 : 50  CONTINUE
    1113           0 :     W=0.0
    1114           0 :     DO 70 I=1,NN
    1115           0 :        HH=B(I)
    1116           0 :        DO 60 J=1,NN
    1117           0 :           IF (J.NE.I) THEN
    1118           0 :              HH=HH*(U-X(IP+J-1))/(X(IP+I-1)-X(IP+J-1))
    1119             :           END IF
    1120           0 : 60     CONTINUE
    1121           0 :         W=W+HH
    1122           0 : 70   CONTINUE
    1123             : 
    1124           0 :   END SUBROUTINE SLQ
    1125             : !EOC
    1126             : !------------------------------------------------------------------------------
    1127             : !                   Harmonized Emissions Component (HEMCO)                    !
    1128             : !------------------------------------------------------------------------------
    1129             : !BOP
    1130             : !
    1131             : ! !IROUTINE: InstGet
    1132             : !
    1133             : ! !DESCRIPTION: Subroutine InstGet returns a poiner to the desired instance.
    1134             : !\\
    1135             : !\\
    1136             : ! !INTERFACE:
    1137             : !
    1138           0 :   SUBROUTINE InstGet ( Instance, Inst, RC, PrevInst )
    1139             : !
    1140             : ! !INPUT PARAMETERS:
    1141             : !
    1142             :     INTEGER                             :: Instance
    1143             :     TYPE(MyInst),     POINTER           :: Inst
    1144             :     INTEGER                             :: RC
    1145             :     TYPE(MyInst),     POINTER, OPTIONAL :: PrevInst
    1146             : !
    1147             : ! !REVISION HISTORY:
    1148             : !  18 Feb 2016 - C. Keller   - Initial version
    1149             : !  See https://github.com/geoschem/hemco for complete history
    1150             : !EOP
    1151             : !------------------------------------------------------------------------------
    1152             : !BOC
    1153             :     TYPE(MyInst),     POINTER    :: PrvInst
    1154             : 
    1155             :     !=================================================================
    1156             :     ! InstGet begins here!
    1157             :     !=================================================================
    1158             : 
    1159             :     ! Get instance. Also archive previous instance.
    1160           0 :     PrvInst => NULL()
    1161           0 :     Inst    => AllInst
    1162           0 :     DO WHILE ( ASSOCIATED(Inst) )
    1163           0 :        IF ( Inst%Instance == Instance ) EXIT
    1164           0 :        PrvInst => Inst
    1165           0 :        Inst    => Inst%NextInst
    1166             :     END DO
    1167           0 :     IF ( .NOT. ASSOCIATED( Inst ) ) THEN
    1168           0 :        RC = HCO_FAIL
    1169           0 :        RETURN
    1170             :     ENDIF
    1171             : 
    1172             :     ! Pass output arguments
    1173           0 :     IF ( PRESENT(PrevInst) ) PrevInst => PrvInst
    1174             : 
    1175             :     ! Cleanup & Return
    1176           0 :     PrvInst => NULL()
    1177           0 :     RC = HCO_SUCCESS
    1178             : 
    1179             :   END SUBROUTINE InstGet
    1180             : !EOC
    1181             : !------------------------------------------------------------------------------
    1182             : !                   Harmonized Emissions Component (HEMCO)                    !
    1183             : !------------------------------------------------------------------------------
    1184             : !BOP
    1185             : !
    1186             : ! !IROUTINE: InstCreate
    1187             : !
    1188             : ! !DESCRIPTION: Subroutine InstCreate creates a new instance.
    1189             : !\\
    1190             : !\\
    1191             : ! !INTERFACE:
    1192             : !
    1193           0 :   SUBROUTINE InstCreate ( ExtNr, Instance, Inst, RC )
    1194             : !
    1195             : ! !INPUT PARAMETERS:
    1196             : !
    1197             :     INTEGER,       INTENT(IN)       :: ExtNr
    1198             : !
    1199             : ! !OUTPUT PARAMETERS:
    1200             : !
    1201             :     INTEGER,       INTENT(  OUT)    :: Instance
    1202             :     TYPE(MyInst),  POINTER          :: Inst
    1203             : !
    1204             : ! !INPUT/OUTPUT PARAMETERS:
    1205             : !
    1206             :     INTEGER,       INTENT(INOUT)    :: RC
    1207             : !
    1208             : ! !REVISION HISTORY:
    1209             : !  18 Feb 2016 - C. Keller   - Initial version
    1210             : !  See https://github.com/geoschem/hemco for complete history
    1211             : !EOP
    1212             : !------------------------------------------------------------------------------
    1213             : !BOC
    1214             :     TYPE(MyInst), POINTER          :: TmpInst
    1215             :     INTEGER                        :: nnInst
    1216             : 
    1217             :     !=================================================================
    1218             :     ! InstCreate begins here!
    1219             :     !=================================================================
    1220             : 
    1221             :     ! ----------------------------------------------------------------
    1222             :     ! Generic instance initialization
    1223             :     ! ----------------------------------------------------------------
    1224             : 
    1225             :     ! Initialize
    1226           0 :     Inst => NULL()
    1227             : 
    1228             :     ! Get number of already existing instances
    1229           0 :     TmpInst => AllInst
    1230           0 :     nnInst = 0
    1231           0 :     DO WHILE ( ASSOCIATED(TmpInst) )
    1232           0 :        nnInst  =  nnInst + 1
    1233           0 :        TmpInst => TmpInst%NextInst
    1234             :     END DO
    1235             : 
    1236             :     ! Create new instance
    1237           0 :     ALLOCATE(Inst)
    1238           0 :     Inst%Instance = nnInst + 1
    1239           0 :     Inst%ExtNr    = ExtNr
    1240             : 
    1241             :     ! Attach to instance list
    1242           0 :     Inst%NextInst => AllInst
    1243           0 :     AllInst       => Inst
    1244             : 
    1245             :     ! Update output instance
    1246           0 :     Instance = Inst%Instance
    1247             : 
    1248             :     ! ----------------------------------------------------------------
    1249             :     ! Type specific initialization statements follow below
    1250             :     ! ----------------------------------------------------------------
    1251             : 
    1252             :     ! Return w/ success
    1253           0 :     RC = HCO_SUCCESS
    1254             : 
    1255           0 :   END SUBROUTINE InstCreate
    1256             : !EOC
    1257             : !------------------------------------------------------------------------------
    1258             : !                   Harmonized Emissions Component (HEMCO)                    !
    1259             : !------------------------------------------------------------------------------
    1260             : !BOP
    1261             : !BOP
    1262             : !
    1263             : ! !IROUTINE: InstRemove
    1264             : !
    1265             : ! !DESCRIPTION: Subroutine InstRemove creates a new instance.
    1266             : !\\
    1267             : !\\
    1268             : ! !INTERFACE:
    1269             : !
    1270           0 :   SUBROUTINE InstRemove ( Instance )
    1271             : !
    1272             : ! !INPUT PARAMETERS:
    1273             : !
    1274             :     INTEGER                         :: Instance
    1275             : !
    1276             : ! !REVISION HISTORY:
    1277             : !  18 Feb 2016 - C. Keller   - Initial version
    1278             : !  See https://github.com/geoschem/hemco for complete history
    1279             : !EOP
    1280             : !------------------------------------------------------------------------------
    1281             : !BOC
    1282             :     INTEGER                     :: RC
    1283             :     TYPE(MyInst), POINTER       :: PrevInst
    1284             :     TYPE(MyInst), POINTER       :: Inst
    1285             : 
    1286             :     !=================================================================
    1287             :     ! InstRemove begins here!
    1288             :     !=================================================================
    1289             : 
    1290             :     ! Init
    1291           0 :     PrevInst => NULL()
    1292           0 :     Inst     => NULL()
    1293             : 
    1294             :     ! Get instance. Also archive previous instance.
    1295           0 :     CALL InstGet ( Instance, Inst, RC, PrevInst=PrevInst )
    1296             : 
    1297             :     ! Instance-specific deallocation
    1298           0 :     IF ( ASSOCIATED(Inst) ) THEN
    1299             : 
    1300             :        !---------------------------------------------------------------------
    1301             :        ! Deallocate fields of Inst before popping Inst off the list
    1302             :        ! in order to avoid memory leaks (Bob Yantosca, 17 Aug 2020)
    1303             :        !---------------------------------------------------------------------
    1304           0 :        IF ( ASSOCIATED( Inst%EmissRn222 ) ) THEN
    1305           0 :           DEALLOCATE( Inst%EmissRn222 )
    1306             :        ENDIF
    1307           0 :        Inst%EmissRn222 => NULL()
    1308             : 
    1309           0 :        IF ( ASSOCIATED( Inst%EmissBe7 ) ) THEN
    1310           0 :           DEALLOCATE( Inst%EmissBe7 )
    1311             :        ENDIF
    1312           0 :        Inst%EmissBe7 => NULL()
    1313             : 
    1314           0 :        IF ( ASSOCIATED( Inst%EmissBe7Strat  ) ) THEN
    1315           0 :           DEALLOCATE( Inst%EmissBe7Strat )
    1316             :        ENDIF
    1317           0 :        Inst%EmissBe7Strat  => NULL()
    1318             : 
    1319           0 :        IF ( ASSOCIATED( Inst%EmissBe10 ) ) THEN
    1320           0 :           DEALLOCATE(Inst%EmissBe10 )
    1321             :        ENDIF
    1322           0 :        Inst%EmissBe10  => NULL()
    1323             : 
    1324           0 :        IF ( ASSOCIATED( Inst%EmissBe10Strat ) ) THEN
    1325           0 :           DEALLOCATE( Inst%EmissBe10Strat )
    1326             :        ENDIF
    1327           0 :        Inst%EmissBe10Strat => NULL()
    1328             : 
    1329           0 :        IF ( ASSOCIATED( Inst%LATSOU ) ) THEN
    1330           0 :           DEALLOCATE( Inst%LATSOU  )
    1331             :        ENDIF
    1332           0 :        Inst%LATSOU => NULL()
    1333             : 
    1334           0 :        IF ( ASSOCIATED( Inst%PRESOU ) ) THEN
    1335           0 :           DEALLOCATE(Inst%PRESOU )
    1336             :        ENDIF
    1337           0 :        Inst%PRESOU => NULL()
    1338             : 
    1339           0 :        IF ( ASSOCIATED( Inst%BESOU ) ) THEN
    1340           0 :           DEALLOCATE( Inst%BESOU )
    1341             :        ENDIF
    1342           0 :        Inst%BESOU => NULL()
    1343             : 
    1344             :        !---------------------------------------------------------------------
    1345             :        ! Pop off instance from list
    1346             :        !---------------------------------------------------------------------
    1347           0 :        IF ( ASSOCIATED(PrevInst) ) THEN
    1348           0 :           PrevInst%NextInst => Inst%NextInst
    1349             :        ELSE
    1350           0 :           AllInst => Inst%NextInst
    1351             :        ENDIF
    1352           0 :        DEALLOCATE(Inst)
    1353             : 
    1354             :     ENDIF
    1355             : 
    1356             :     ! Free pointers before exiting
    1357           0 :     PrevInst => NULL()
    1358           0 :     Inst     => NULL()
    1359             : 
    1360           0 :   END SUBROUTINE InstRemove
    1361             : !EOC
    1362           0 : END MODULE HCOX_GC_RnPbBe_Mod

Generated by: LCOV version 1.14