LCOV - code coverage report
Current view: | top level - hemco/HEMCO/src/Extensions - hcox_seasalt_mod.F90 (source / functions) |  |  | Hit | Total | Coverage
Test: | coverage.info |  | Lines: | 0 | 680 | 0.0 %
Date: | 2025-01-13 21:54:50 |  | Functions: | 0 | 8 | 0.0 %

              Line data    Source code
           1             : !------------------------------------------------------------------------------
           2             : !                   Harmonized Emissions Component (HEMCO)                    !
           3             : !------------------------------------------------------------------------------
           4             : !BOP
           5             : !
           6             : ! !MODULE: hcox_seasalt_mod.F90
           7             : !
           8             : ! !DESCRIPTION: Module HCOX\_SeaSalt\_Mod contains routines to calculate
           9             : ! sea salt aerosol emissions, following the implementation in GEOS-Chem.
          10             : ! Emission number densities of the fine and coarse mode sea salt aerosols
          11             : ! are written into diagnostic containers `SEASALT\_DENS\_FINE` and
          12             : ! `SEASALT\_DENS\_COARSE`, respectively.
          13             : !\\
          14             : !\\
          15             : ! This is a HEMCO extension module that uses many of the HEMCO core
          16             : ! utilities.
          17             : !\\
          18             : !\\
          19             : ! !INTERFACE:
          20             : !
          21             : MODULE HCOX_SeaSalt_Mod
          22             : !
          23             : ! !USES:
          24             : !
          25             :   USE HCO_Error_Mod
          26             :   USE HCO_Diagn_Mod
          27             :   USE HCO_State_Mod,  ONLY : HCO_State
          28             :   USE HCOX_State_Mod, ONLY : Ext_State
          29             :
          30             :   IMPLICIT NONE
          31             :   PRIVATE
          32             : !
          33             : ! !PUBLIC MEMBER FUNCTIONS:
          34             : !
          35             :   PUBLIC :: HCOX_SeaSalt_Init
          36             :   PUBLIC :: HCOX_SeaSalt_Run
          37             :   PUBLIC :: HCOX_SeaSalt_Final
          38             : !
          39             : ! !REVISION HISTORY:
          40             : !  15 Dec 2013 - C. Keller   - Now a HEMCO extension module
          41             : !  See https://github.com/geoschem/hemco for complete history
          42             : !EOP
          43             : !------------------------------------------------------------------------------
          44             : !
          45             : ! !PRIVATE TYPES:
          46             : !
          47             :   TYPE :: MyInst
          48             :    ! Tracer IDs
          49             :    INTEGER                :: Instance
          50             :    INTEGER                :: ExtNr
          51             :
          52             :    ! Tracer IDs
          53             :    INTEGER             :: ExtNrSS           ! Extension number for seasalt
          54             :    INTEGER             :: IDTSALA           ! Fine aerosol model species ID
          55             :    INTEGER             :: IDTSALC           ! Coarse aerosol model species ID
          56             :    INTEGER             :: IDTMOPO           ! marine organic aerosol - phobic
          57             :    INTEGER             :: IDTMOPI           ! marine organic aerosol - philic
          58             :    INTEGER             :: IDTBrSALA         ! Br- in accum. sea salt aerosol
          59             :    INTEGER             :: IDTBrSALC         ! Br- in coarse sea salt aerosol
          60             :    LOGICAL             :: CalcBrSalt        ! Calculate Br- content?
          61             :    LOGICAL             :: EmitSnowSS        ! Calculate sea salt emission blowing snow
          62             :    LOGICAL             :: ColdSST           ! Flag to correct SSA emissions over cold waters
          63             :    INTEGER             :: IDTSALACL         ! Fine aerosol Chloride species ID
          64             :    INTEGER             :: IDTSALCCL         ! Coarse aerosol Chloride species ID
          65             :    INTEGER             :: IDTSALAAL         ! Fine SSA Alkalinity species ID
          66             :    INTEGER             :: IDTSALCAL         ! Coarse SSA Alkalinity species ID
          67             :
          68             :    ! Scale factors
          69             :    REAL*8              :: BrContent         ! Ratio of Br- to dry SSA (mass)
          70             :    REAL*8              :: WindScale         ! Wind adjustment factor
          71             :    REAL*8              :: NSLNT_FYI         ! North Hemisphere snow salinity on first year ice (FYI) (psu)
          72             :    REAL*8              :: NSLNT_MYI         ! North Hemisphere snow salinity on multiyear ice (MYI) (psu)
          73             :    REAL*8              :: SSLNT_FYI         ! South Hemisphere snow salinity on FYI (psu)
          74             :    REAL*8              :: SSLNT_MYI         ! South Hemisphere snow salinity on MYI (psu)
          75             :    REAL*8              :: NAGE              ! North Hemisphere snow age (days)
          76             :    REAL*8              :: SAGE              ! South Hemisphere snow age (days)
          77             :    REAL*8              :: NumP                ! number of particle per snowflake
          78             :
          79             :    ! Module variables
          80             :    INTEGER              :: NSALT             ! # of seasalt tracers
          81             :    INTEGER, POINTER     :: NR(:)             ! Size bin information
          82             :    REAL*8,  POINTER     :: SRRC  (:,:)
          83             :    REAL*8,  POINTER     :: SRRC_N(:,:)
          84             :    REAL*8,  POINTER     :: RREDGE(:,:)
          85             :    REAL*8,  POINTER     :: RRMID (:,:)
          86             :    REAL*8,  POINTER     :: SS_DEN(:)         ! densities
          87             :    REAL*8,  POINTER     :: F_DI_N_FYI(:,:)   ! add for blowing snow for NH
          88             :    REAL*8,  POINTER     :: F_DI_N_MYI(:,:)   ! add for blowing snow for NH
          89             :    REAL*8,  POINTER     :: F_DI_S_FYI(:,:)   ! add for blowing snow for SH
          90             :    REAL*8,  POINTER     :: F_DI_S_MYI(:,:)   ! add for blowing snow for SH
          91             :    REAL*8,  POINTER     :: F_DN_N_FYI(:,:)   ! add for blowing snow for NH
          92             :    REAL*8,  POINTER     :: F_DN_N_MYI(:,:)   ! add for blowing snow for NH
          93             :    REAL*8,  POINTER     :: F_DN_S_FYI(:,:)   ! add for blowing snow for SH
          94             :    REAL*8,  POINTER     :: F_DN_S_MYI(:,:)   ! add for blowing snow for SH
          95             :
          96             :
          97             :    ! Number densities
          98             :    REAL(sp), POINTER   :: NDENS_SALA(:,:) => NULL()
          99             :    REAL(sp), POINTER   :: NDENS_SALC(:,:) => NULL()
         100             :    REAL(sp), POINTER   :: NDENS_MOPO(:,:) => NULL()
         101             :    REAL(sp), POINTER   :: NDENS_MOPI(:,:) => NULL()
         102             :    REAL(sp), POINTER   :: MULTIICE(:,:)   => NULL() ! add for blowing snow
         103             :
         104             :    ! MODIS Chlorophyll-A
         105             :    REAL(hp), POINTER   :: CHLR(:,:)       => NULL()
         106             :
         107             :    TYPE(MyInst), POINTER  :: NextInst => NULL()
         108             :   END TYPE MyInst
         109             :
         110             :   ! Pointer to instances
         111             :   TYPE(MyInst), POINTER   :: AllInst => NULL()
         112             : !
         113             : ! !DEFINED PARAMETERS:
         114             : !
         115             :   INTEGER, PARAMETER  :: NR_MAX = 200  ! max. # of bins per mode
         116             :
         117             :   ! Increment of radius for Emission integration (um)
         118             :   REAL*8, PARAMETER   :: DR    = 5.d-2
         119             :   REAL*8, PARAMETER   :: BETHA = 2.d0
         120             :
         121             : CONTAINS
         122             : !EOC
         123             : !-------------------------------------------------------------------------------
         124             : !                   Harmonized Emissions Component (HEMCO)                    !
         125             : !------------------------------------------------------------------------------
         126             : !BOP
         127             : !
         128             : ! !IROUTINE: HCOX_SeaSalt_Run
         129             : !
         130             : ! !DESCRIPTION: Subroutine HcoX\_SeaSalt\_Run is the driver run routine to
         131             : ! calculate SeaSalt emissions in HEMCO.
         132             : !\\
         133             : !\\
         134             : ! !INTERFACE:
         135             : !
         136           0 :   SUBROUTINE HCOX_SeaSalt_Run( ExtState, HcoState, RC )
         137             : !
         138             : ! !USES:
         139             : !
         140             :     USE HCO_Calc_Mod,         ONLY : HCO_EvalFld
         141             :     USE HCO_FluxArr_Mod,      ONLY : HCO_EmisAdd
         142             : !
         143             : ! !INPUT PARAMETERS:
         144             : !
         145             :     TYPE(HCO_State), POINTER       :: HcoState   ! Output obj
         146             :     TYPE(Ext_State), POINTER       :: ExtState  ! Module options
         147             : !
         148             : ! !INPUT/OUTPUT PARAMETERS:
         149             : !
         150             :     INTEGER,         INTENT(INOUT) :: RC         ! Success or failure?
         151             : !
         152             : ! !REMARKS:
         153             : !  References:
         154             : !  ============================================================================
         155             : !  (1 ) Chin, M., P. Ginoux, S. Kinne, B. Holben, B. Duncan, R. Martin,
         156             : !        J. Logan, A. Higurashi, and T. Nakajima, "Tropospheric aerosol
         157             : !        optical thickness from the GOCART model and comparisons with
         158             : !        satellite and sunphotometers measurements", J. Atmos Sci., 2001.
         159             : !  (2 ) Gong, S., L. Barrie, and J.-P. Blanchet, "Modeling sea-salt
         160             : !        aerosols in the atmosphere. 1. Model development", J. Geophys. Res.,
         161             : !        v. 102, 3805-3818, 1997.
         162             : !  (3 ) Gong, S. L., "A parameterization of sea-salt aerosol source function
         163             : !        for sub- and super-micron particles", Global Biogeochem.  Cy., 17(4),
         164             : !        1097, doi:10.1029/2003GB002079, 2003.
         165             : !  (4 ) Jaegle, L., P.K. Quinn, T.S. Bates, B. Alexander, J.-T. Lin, "Global
         166             : !        distribution of sea salt aerosols: New constraints from in situ and
         167             : !        remote sensing observations", Atmos. Chem. Phys., 11, 3137-3157,
         168             : !        doi:10.5194/acp-11-3137-2011.
         169             : !  (5 ) Huang, J., Jaeglé, L., "Wintertime enhancements of sea salt aerosol in
         170             : !        polar regions consistent with a sea ice source from blowing snow."
         171             : !        Atmos. Chem. Phys. 17, 3699–3712. https://doi.org/10.5194/acp-17-3699-2017, 2017.
         172             : !  (6 ) Huang, J., Jaeglé, L., Chen, Q., Alexander, B., Sherwen, T.,
         173             : !        Evans, M. J., Theys, N., and Choi, S. "Evaluating the impact of
         174             : !        blowing snow sea salt aerosol on springtime BrO and O3 in the Arctic,
         175             : !        Atmos. Chem. Phys. Discuss., https://doi.org/10.5194/acp-2019-1094, 2020.
         176             : !  (7 ) Tschudi, M., W. N. Meier, J. S. Stewart, C. Fowler, and J. Maslanik.
         177             : !        "EASE-Grid Sea Ice Age, Version 4." NASA National Snow and Ice Data Center
         178             : !        Distributed Active Archive Center. doi: https://doi.org/10.5067/UTAV7490FEPB., 2019.
         179             : !
         180             : ! !REVISION HISTORY:
         181             : !  See https://github.com/geoschem/hemco for complete history
         182             : !EOP
         183             : !------------------------------------------------------------------------------
         184             : !BOC
         185             : !
         186             : ! !LOCAL VARIABLES:
         187             : !
         188             :     TYPE(MyInst), POINTER  :: Inst
         189             :     INTEGER                :: I, J, N, R
         190             :     REAL*8                 :: SALT, SALT_N, CHLR
         191             :     REAL*8                 :: A_M2
         192             :     REAL*8                 :: W10M
         193             :     REAL                   :: FLUX
         194           0 :     REAL(hp), TARGET       :: FLUXSALA  (HcoState%NX,HcoState%NY)
         195           0 :     REAL(hp), TARGET       :: FLUXSALC  (HcoState%NX,HcoState%NY)
         196           0 :     REAL(hp), TARGET       :: FLUXBrSalA(HcoState%NX,HcoState%NY)
         197           0 :     REAL(hp), TARGET       :: FLUXBrSalC(HcoState%NX,HcoState%NY)
         198           0 :     REAL(hp), TARGET       :: FLUXMOPO  (HcoState%NX,HcoState%NY)
         199           0 :     REAL(hp), TARGET       :: FLUXMOPI  (HcoState%NX,HcoState%NY)
         200           0 :     REAL(hp), TARGET       :: FLUXSALACL(HcoState%NX,HcoState%NY)
         201           0 :     REAL(hp), TARGET       :: FLUXSALCCL(HcoState%NX,HcoState%NY)
         202           0 :     REAL(hp), TARGET       :: FLUXSALAAL(HcoState%NX,HcoState%NY)
         203           0 :     REAL(hp), TARGET       :: FLUXSALCAL(HcoState%NX,HcoState%NY)
         204             :
         205             :     ! New variables (jaegle 5/11/11)
         206             :     REAL*8                 :: SST, SCALE
         207             :     ! jpp, 3/2/10
         208             :     REAL*8                 :: SALT_NR
         209             :     ! B. Gantt, M. Johnson (7,9/15)
         210             :     REAL*8                 :: OMSS1, OMSS2
         211             :
         212             :    ! New variables for blowing snow (huang, 04/09/20)
         213             :     REAL*8                 :: SNOWSALT
         214             :     REAL*8                 :: FROPEN, FRFIRST
         215             :     REAL*8                 :: FRICTVEL, WVMR, TEMP
         216             :     REAL*8                 :: PRESS, P_ICE, RH_ICE
         217             :     REAL*8                 :: D, FK, FD
         218             :     REAL*8                 :: PSI, QSPRIME, UT, APRIM
         219             :     REAL*8                 :: QS, QSNOWICE_FYI, QSNOWICE_MYI,QBSALT, QB0
         220             :     REAL*8                 :: SLNT, SLNT_FYI, SLNT_MYI
         221             :     REAL*8                 :: AGE, ISFROST
         222             :
         223             :     ! New parameters for blowiung snow (huang, 04/09/20)
         224             :     REAL*8, PARAMETER      :: LS = 2839d3    ! Latent heat of sublimation @ T=-30C (J/kg).
         225             :                                              ! Varies very little with Temperature
         226             :     REAL*8, PARAMETER      :: RV = 461.5d0   !J kg-1 K-1
         227             :     REAL*8, PARAMETER      :: RHONACL = 2160.0d0    !kg/m3
         228             :     REAL*8, PARAMETER      :: RHOICE  = 900.0d0     !kg/m3
         229             :     REAL*8, PARAMETER      :: K  = 2.16d-2          !J m-1 s-1 K-1
         230             :     REAL*8, PARAMETER      :: A0 = 3.78407d-1
         231             :     REAL*8, PARAMETER      :: A1 = -8.64089d-2
         232             :     REAL*8, PARAMETER      :: A2 = -1.60570d-2
         233             :     REAL*8, PARAMETER      :: A3 = 7.25516d-4
         234             :     REAL*8, PARAMETER      :: A4 = -1.25650d-1
         235             :     REAL*8, PARAMETER      :: A5 = 2.48430d-2
         236             :     REAL*8, PARAMETER      :: A6 = -9.56871d-4
         237             :     REAL*8, PARAMETER      :: A7 = 1.24600d-2
         238             :     REAL*8, PARAMETER      :: A8 = 1.56862d-3
         239             :     REAL*8, PARAMETER      :: A9 = -2.93002d-4
         240             :     REAL*8, PARAMETER      :: A_SALT = 2.0d0  !from Mann et al. 2000
         241             :     REAL*8, PARAMETER      :: B_SALT = 37.5d0 !in um
         242             :     REAL*8, PARAMETER      :: DDSNOW = 2.0d0  !in um for snow particle interval
         243             :     LOGICAL, SAVE          :: FIRST = .TRUE.
         244             :     LOGICAL, SAVE          :: FIRSTSAL = .TRUE.
         245             :     CHARACTER(LEN=31)      :: FLDNME
         246             :     INTEGER                :: NDAYS!, cYYYY, cMM, cDD
         247           0 :     REAL(hp), TARGET       :: MULTI(HcoState%NX,HcoState%NY)
         248           0 :     REAL(hp), TARGET       :: SNOWSALA  (HcoState%NX,HcoState%NY)
         249           0 :     REAL(hp), TARGET       :: SNOWSALC  (HcoState%NX,HcoState%NY)
         250             :
         251             :     ! Error handling
         252             :     LOGICAL                :: ERR
         253             :     CHARACTER(LEN=255)     :: MSG, LOC
         254             :
         255             :     !=================================================================
         256             :     ! HCOX_SeaSalt_Run begins here!
         257             :     !=================================================================
         258           0 :     LOC = 'HCOX_SeaSalt_Run (HCOX_SEASALT_MOD.F90)'
         259             :
         260             :     ! Return if extension disabled
         261           0 :     IF ( ExtState%SeaSalt <= 0 ) RETURN
         262             :
         263             :     ! Enter
         264           0 :     CALL HCO_ENTER( HcoState%Config%Err, LOC, RC )
         265           0 :     IF ( RC /= HCO_SUCCESS ) THEN
         266           0 :         CALL HCO_ERROR( 'ERROR 0', RC, THISLOC=LOC )
         267           0 :         RETURN
         268             :     ENDIF
         269             :
         270             :     ! Exit status
         271           0 :     ERR = .FALSE.
         272             :
         273             :     ! Get instance
         274           0 :     Inst   => NULL()
         275           0 :     CALL InstGet ( ExtState%SeaSalt, Inst, RC )
         276           0 :     IF ( RC /= HCO_SUCCESS ) THEN
         277           0 :        WRITE(MSG,*) 'Cannot find SeaSalt instance Nr. ', ExtState%SeaSalt
         278           0 :        CALL HCO_ERROR(MSG,RC)
         279           0 :        RETURN
         280             :     ENDIF
         281             :
         282             :     ! Init values
         283           0 :     FLUXSALA   = 0.0_hp
         284           0 :     FLUXSALC   = 0.0_hp
         285           0 :     FLUXBrSalA = 0.0_hp
         286           0 :     FLUXBrSalC = 0.0_hp
         287           0 :     FLUXMOPO   = 0.0_hp
         288           0 :     FLUXMOPI   = 0.0_hp
         289           0 :     FLUXSALACL = 0.0_hp
         290           0 :     FLUXSALCCL = 0.0_hp
         291           0 :     FLUXSALAAL = 0.0_hp
         292           0 :     FLUXSALCAL = 0.0_hp
         293           0 :     SNOWSALA   = 0.0_hp
         294           0 :     SNOWSALC   = 0.0_hp
         295             :
         296             :     ! If the marine POA option is on, get the HEMCO pointer to MODIS CHLR
         297           0 :     IF ( HcoState%MarinePOA ) THEN
         298           0 :        CALL HCO_EvalFld ( HcoState, 'MODIS_CHLR', Inst%CHLR, RC )
         299           0 :        IF ( RC /= HCO_SUCCESS ) THEN
         300           0 :           WRITE(MSG,*) 'Cannot find MODIS CHLR data for marine POA'
         301           0 :           CALL HCO_ERROR(MSG, RC)
         302           0 :           RETURN
         303             :        ENDIF
         304             :     ENDIF
         305             :
         306           0 :     IF ( Inst%EmitSnowSS ) THEN
         307             :       ! Read in distribution of multi-year sea ice from
         308             :       ! remotely sensed observations of sea ice motion and sea
         309             :       ! ice extent for the Arctic (Tschudi et al., 2019). For the
         310             :       ! Antarctic, the multi year sea ice extent is based on the minimum
         311             :       ! MERRA-2 sea ice extent of the previous summer.
         312           0 :       CALL HCO_EvalFld ( HcoState, 'MULTISEAICE', MULTI, RC )
         313           0 :       IF ( RC /= HCO_SUCCESS ) THEN
         314           0 :           WRITE(MSG,*) 'Cannot find MULTISEAICE data for blowing snow'
         315           0 :           CALL HCO_ERROR(MSG, RC)
         316           0 :           RETURN
         317             :       ENDIF
         318             :     ENDIF
         319             :
         320             :     !=================================================================
         321             :     ! Emission is integrated over a given size range for each bin
         322             :     !=================================================================
         323             : !$OMP PARALLEL DO                                                      &
         324             : !$OMP DEFAULT( SHARED )                                                &
         325             : !$OMP PRIVATE( I, J, A_M2, W10M, SST, SCALE, N                       ) &
         326             : !$OMP PRIVATE( SALT, SALT_N, R, SALT_NR, RC                          ) &
         327             : !$OMP PRIVATE( OMSS1, OMSS2, CHLR                                    ) &
         328             : !$OMP PRIVATE( FROPEN, SNOWSALT, AGE                                 ) &
         329             : !$OMP PRIVATE( FRICTVEL, WVMR, TEMP, PRESS, P_ICE, RH_ICE            ) &
         330             : !$OMP PRIVATE( D, FK, FD, PSI, QSPRIME, APRIM, UT, FRFIRST           ) &
         331             : !$OMP PRIVATE( SLNT, SLNT_FYI, SLNT_MYI                              ) &
         332             : !$OMP PRIVATE( QBSALT, QB0, QS, QSNOWICE_FYI, QSNOWICE_MYI           ) &
         333             : !$OMP SCHEDULE( DYNAMIC )
         334             :
         335             :     ! Loop over surface boxes
         336           0 :     DO J = 1, HcoState%NY
         337           0 :     DO I = 1, HcoState%NX
         338             :
         339             :        ! Grid box surface area on simulation grid [m2]
         340           0 :        A_M2 = HcoState%Grid%AREA_M2%Val( I, J )
         341             :
         342             :        ! Advance to next grid box if it's not over water or sea ice
         343           0 :        IF ( ExtState%FROCEAN%Arr%Val(I,J)  <= 0d0  .and. &
         344             :             ExtState%FRSEAICE%Arr%Val(I,J) <= 0d0 ) CYCLE
         345             :
         346             :        ! Wind speed at 10 m altitude [m/s]
         347           0 :        W10M = SQRT( ExtState%U10M%Arr%Val(I,J)**2 &
         348           0 :                   + ExtState%V10M%Arr%Val(I,J)**2 )
         349             :
         350             :        ! Sea surface temperature in Celcius (jaegle 5/11/11)
         351           0 :        SST = ExtState%TSKIN%Arr%Val(I,J) - 273.15d0
         352             :
         353             :        ! Limit SST to 0-30C range
         354           0 :        SST = MAX( SST , 0d0 )  ! limit to  0C
         355           0 :        SST = MIN( SST , 30d0 ) ! limit to 30C
         356             :
         357             :        ! Empirical SST scaling factor (jaegle 5/11/11)
         358             :        SCALE = 0.329d0 + 0.0904d0*SST - &
         359           0 :                0.00717d0*SST**2d0 + 0.000207d0*SST**3d0
         360             :
         361             :        ! Limit the SST scaling factor to 0.25 over cold SST (below 5C)
         362           0 :        IF ( Inst%ColdSST .and. SST<= 5.0d0 ) SCALE = 0.25d0
         363             :
         364             :        ! Reset to using original Gong (2003) emissions (jaegle 6/30/11)
         365             :        !SCALE = 1.0d0
         366             :
         367             :        ! Apply to only the open ocean fraction of the gridbox (Huang 06/12/20)
         368           0 :        FROPEN = ExtState%FROCEAN%Arr%Val(I,J)-ExtState%FRSEAICE%Arr%Val(I,J)
         369           0 :        IF ( FROPEN < 0d0 ) FROPEN = 0d0
         370             :
         371             :        ! Eventually apply wind scaling factor.
         372           0 :        SCALE = SCALE * Inst%WindScale * FROPEN
         373             :
         374             :        !----------------------------------------------------------------
         375             :        ! huang, 04/09/20: Add blowing snow emissions over sea ice
         376             :        !----------------------------------------------------------------
         377           0 :        IF ( Inst%EmitSnowSS ) THEN
         378           0 :          IF ( ExtState%FRSEAICE%Arr%Val(I,J) > 0d0 )THEN
         379             :           ! Friction velocity [m/s]
         380           0 :           FRICTVEL = ExtState%USTAR%Arr%Val(I,J)
         381             :           ! Convert specific humidity [g H2O/kg air] to water vapor mixing ratio [v/v]
         382             :           ! QV2m is in kg H2O/kg air
         383           0 :           WVMR = ExtState%QV2M%Arr%Val(I,J) * 28.973d0 / 18.0d0
         384             :           ! Temperature at 2M in grid box (I,J) [K]
         385           0 :           TEMP = ExtState%T2M%Arr%Val(I,J)
         386             :           ! Surface pressure at grid box (I,J). Convert from [Pa] to [hPa]
         387           0 :           PRESS = HcoState%Grid%PSFC%Val( I, J ) /100d0
         388             :           ! Calculate saturation vapor pressure over ice [in Pa] at temperature
         389             :           ! TS [K]
         390           0 :           P_ICE = 10d0**(-2663.5d0/TEMP+12.537d0)
         391             :           ! Calculate relative humidity with respect to ice [%]
         392           0 :           RH_ICE = PRESS * WVMR / (P_ICE*0.01d0) *100.0d0
         393             :           ! Limit RH to 100%
         394           0 :           IF (RH_ICE > 100d0) RH_ICE =100.0d0
         395             :           ! Coefficient of Diffusion of water vapor in air [m2/s]
         396             :           ! Parameterization of Massman, W.J. "A review of teh molecular diffusivities of
         397             :           ! H2O, CO2, CH4... in air, O2 and N2 near STP" Atmos. Env., 32, 6, 1111-1127, 1998.
         398           0 :           D = 2.178d-5*(1000d0/PRESS)*(TEMP/273.15d0)**1.81
         399             :           ! Heat conductivity and vapor diffusion terms [m s/kg]
         400             :           ! Rogers and Yau "A short course in cloud physics", 1989, Eqn 9.4, with
         401             :           !   RV =   461.5     [J/kg/K] Individual gas constant for water vapor
         402             :           !   LS =  2839.0*1d3 [J/kg  ] Latent heat of sublimation @ T=-30C
         403             :           !   K  =  2.16d-2    [J/(m s K)] Coeff of thermal conductivity of Air [Table 7.1 Rogers and Yau]
         404           0 :           FK = ( LS / (RV * TEMP ) -1d0 ) * LS / (K * TEMP)
         405           0 :           FD = ( RV * TEMP ) / (D * P_ICE)
         406             :           ! Variable PSI [m2/s] Equation 11 from Dery and Yau (2001)
         407             :           !  RHOICE = 900 kg/m3 Density of ice
         408           0 :           PSI = (RH_ICE/100.d0 - 1d0)/(2d0 * RHOICE * (FK + FD))
         409             :           ! Convert PSI from m2/s to units of -1x10d-12 m2/s
         410           0 :           PSI = PSI * (-1.0d12)
         411             :           ! Qs prime [mm/day snow water equivalent] Equation 11 Dery and Yau (2001)
         412             :           QSPRIME = A0 + A1*PSI + A2*PSI**2d0 + A3*PSI**3d0 &
         413             :                      + A4* W10M    + A5*PSI*W10M &
         414             :                      + A6*W10M*PSI**2d0 + A7*W10M**2d0 &
         415           0 :                      +  A8*PSI*W10M**2d0 + A9*W10M**3d0
         416           0 :           IF ( QSPRIME < 0.0d0 ) QSPRIME = 0.0d0
         417             :           !APRIM
         418           0 :           IF ( HcoState%Grid%YEDGE%Val(I,J) .lt. 0 ) AGE = Inst%SAGE*24.0d0
         419           0 :           IF ( HcoState%Grid%YEDGE%Val(I,J) .ge. 0 ) AGE = Inst%NAGE*24.0d0
         420             :           APRIM = (1.038d0+0.03758d0*AGE-0.00014349d0*AGE**2d0 &
         421           0 :                  + (1.911315d-7*AGE**3d0) )**(-1d0)
         422             :           ! Threshold wind speed [m/s]
         423           0 :           UT = 6.975d0 +  0.0033d0 * (TEMP - 273.15d0 + 27.27d0 )**2.0d0
         424             :                !IF (W10M > UT) THEN
         425             :                ! add RH<100 too
         426             :
         427           0 :           IF (W10M > UT .and. RH_ICE<100d0) THEN
         428           0 :             QBSALT = 0.385d0*(1.0d0-Ut/W10M)**2.59d0/FRICTVEL
         429           0 :             QB0 = 0.385d0*(1d0-6.975d0/W10M)**2.59d0/FRICTVEL
         430             :             ! Snow sublimation rate [kg/m2/s] Equation 1 in Yang et al. (2008)
         431             :             ! The constant 1.1574d-5 converts mm/day column integrated sublimation rate to kg m-2 s-1
         432           0 :             QS = 1.1574d-5*APRIM*QSPRIME*QBSALT/QB0
         433             :           ELSE
         434             :             QS = 0d0
         435             :           ENDIF
         436             :           !set up the snow salinity
         437           0 :           IF ( HcoState%Grid%YEDGE%Val(I,J) .lt. 0 ) SLNT_FYI = Inst%SSLNT_FYI
         438           0 :           IF ( HcoState%Grid%YEDGE%Val(I,J) .lt. 0 ) SLNT_MYI = Inst%SSLNT_MYI
         439           0 :           IF ( HcoState%Grid%YEDGE%Val(I,J) .ge. 0 ) SLNT_FYI = Inst%NSLNT_FYI
         440           0 :           IF ( HcoState%Grid%YEDGE%Val(I,J) .ge. 0 ) SLNT_MYI = Inst%NSLNT_MYI
         441             :           ! Sea ice fraction that is first year
         442           0 :           FRFIRST = ExtState%FRSEAICE%Arr%Val(I,J) - MULTI(I,J)
         443           0 :           IF ( FRFIRST < 0d0 ) FRFIRST = 0d0
         444             :           ! Apply FYI salinity to FYI seaice fraction and MYI salinity to MYI fraction
         445             :           !SLNT =  SLNT_FYI * FRFIRST + SLNT_MYI * MULTI(I,J)
         446             :           ! Assume MYI salinity is 50% of FYI
         447             :           !SLNT =  SLNT * FRFIRST  + SLNT * 0.5 * MULTI(I,J)
         448             :           ! Convert snow sublimation rate to sea salt production rate [kg/m2/s]
         449             :           ! Calculate it separately for FYI and MYI, scaled by their respective sea ice fraction
         450           0 :           QSNOWICE_FYI = QS * SLNT_FYI * FRFIRST / 1000d0
         451           0 :           QSNOWICE_MYI = QS * SLNT_MYI * MULTI(I,J) / 1000d0
         452             :          ELSE
         453             :           QSNOWICE_FYI = 0.0d0
         454             :           QSNOWICE_MYI = 0.0d0
         455             :          ENDIF
         456             :        ENDIF
         457             :        ! End of added blowing snow section
         458             :        !-----------------------------------------------------------------
         459             :
         460             :        ! Do for accumulation and coarse mode, and Marine POA if enabled
         461           0 :        DO N = 1,Inst%NSALT
         462             :
         463             :           ! Reset values for SALT, SALT_N, and SNOWSALT
         464           0 :           SALT   = 0d0
         465           0 :           SALT_N = 0d0
         466           0 :           SNOWSALT = 0d0
         467             :
         468             :           ! update seasalt from blowing snow - huang 1/4/18
         469           0 :           IF (( Inst%EmitSnowSS ) .and. ( N .LT.3 )) THEN
         470           0 :              IF ( HcoState%Grid%YEDGE%Val(I,J) .lt. 0 ) THEN
         471             :                 ! Southern Hemisphere
         472             :                 SALT = SALT + HcoState%TS_EMIS * A_M2 &
         473           0 :                      * ( QSNOWICE_FYI * SUM( Inst%F_DI_S_FYI(:,N) ) +  &
         474           0 :                          QSNOWICE_MYI * SUM( Inst%F_DI_S_MYI(:,N) ) ) * DDSNOW
         475             :
         476             :                 SNOWSALT = SNOWSALT + HcoState%TS_EMIS * A_M2 &
         477             :                      * ( QSNOWICE_FYI * SUM( Inst%F_DI_S_FYI(:,N) ) + &
         478           0 :                          QSNOWICE_MYI * SUM( Inst%F_DI_S_MYI(:,N) ) ) * DDSNOW
         479             :
         480             :                 SALT_N = SALT_N + HcoState%TS_EMIS * A_M2 &
         481           0 :                      * ( QSNOWICE_FYI * SUM( Inst%F_DN_S_FYI(:,N) ) + &
         482           0 :                          QSNOWICE_MYI * SUM( Inst%F_DN_S_MYI(:,N) ) ) * DDSNOW
         483             :               ELSE
         484             :                 ! Northern Hemisphere
         485             :                 SALT = SALT + HcoState%TS_EMIS * A_M2 &
         486           0 :                     * ( QSNOWICE_FYI * SUM( Inst%F_DI_N_FYI(:,N) ) + &
         487           0 :                         QSNOWICE_MYI * SUM( Inst%F_DI_N_MYI(:,N) ) ) * DDSNOW
         488             :
         489             :                 SNOWSALT = SNOWSALT + HcoState%TS_EMIS * A_M2 &
         490             :                     * ( QSNOWICE_FYI * SUM( Inst%F_DI_N_FYI(:,N) ) + &
         491           0 :                         QSNOWICE_MYI * SUM( Inst%F_DI_N_MYI(:,N) ) ) * DDSNOW
         492             :
         493             :                 SALT_N = SALT_N + HcoState%TS_EMIS * A_M2 &
         494           0 :                      * ( QSNOWICE_FYI * SUM( Inst%F_DN_N_FYI(:,N) ) + &
         495           0 :                          QSNOWICE_MYI * SUM( Inst%F_DN_N_MYI(:,N) ) ) * DDSNOW
         496             :               ENDIF
         497             : ! ewl: comment out for blowing snow since calcbr2 retired
         498             : !              ! add bromine blowing snow
         499             : !              IF ( Inst%CalcBr2 ) THEN
         500             : !                IF ( HcoState%Grid%YEDGE%Val(I,J) .lt. 0 ) THEN
         501             : !                SSA_Br2 =  SSA_Br2 + HcoState%TS_EMIS * A_M2 &
         502             : !                        * (QSNOWICE_FYI * SUM( Inst%F_DI_S_FYI(:,N) ) + &
         503             : !                           QSNOWICE_MYI * SUM( Inst%F_DI_S_MYI(:,N) ) ) * DDSNOW &
         504             : !                        * 0.00223d0 * 0.7d0 / 2.0d0
         505             : !                ELSE
         506             : !                SSA_Br2 =  SSA_Br2 + HcoState%TS_EMIS * A_M2 &
         507             : !                        * (QSNOWICE_FYI * SUM( Inst%F_DI_N_FYI(:,N) ) + &
         508             : !                           QSNOWICE_MYI * SUM( Inst%F_DI_N_MYI(:,N) ) ) * DDSNOW &
         509             : !                        * 0.00223d0 * 0.7d0 / 2.0d0
         510             : !                ENDIF
         511             : !              ENDIF
         512             :           ENDIF
         513             :
         514             :           ! Loop over size bins
         515           0 :           DO R = 1, Inst%NR(N)
         516             :
         517             :              ! Coarse and accumulation modes
         518           0 :              IF ( N .LT. 3 ) THEN
         519             :
         520             :                 ! Update SeaSalt source into SALT [kg]
         521             :                 SALT   = SALT +                                   &
         522           0 :                          ( SCALE * Inst%SRRC(R,N) * A_M2 * W10M**3.41d0 )
         523             :
         524             :                 ! Update SeaSalt source into SALT_N [#]
         525             :                 ! (bec, bmy, 4/13/05)
         526             :                 SALT_N = SALT_N +                               &
         527           0 :                          ( SCALE * Inst%SRRC_N(R,N) * A_M2 * W10M**3.41d0 )
         528             :
         529             :              ENDIF
         530             :
         531             :              ! Marine organic aerosols (M. Johnson, B. Gantt)
         532           0 :              IF ( N .EQ. 3 ) THEN
         533             :
         534             :                 ! Get MODIS Chlorophyll-a
         535           0 :                 CHLR = Inst%CHLR(I,J)
         536             :
         537             :                 ! Calculate organic mass fraction of SSA
         538             :                 OMSS1 = 1.0 / ( 1.0 + EXP( -2.63 * 3.0 * CHLR         &
         539           0 :                         + 0.18 * 3.0 * W10M ) )
         540             :
         541             :                 OMSS2 = ( OMSS1 ) / (1.0 + 0.03                       &
         542           0 :                         * EXP( 6.81 * ( Inst%RRMID(R,N) * 2.0 ) ) )        &
         543           0 :                         + 0.03 * ( OMSS1 )
         544             :
         545             :                 ! Update seasalt source into SALT [kg]
         546           0 :                 SALT  = SALT + 6.0 * ( ( Inst%SRRC(R,N) * SCALE * A_M2     &
         547             :                                * W10M**3.41d0 * OMSS2 )               &
         548             :                                * ( 1.0 / ( 2.2 / ( 1.0 - OMSS2        &
         549           0 :                                * (1.0 - 2200.0 / 1000.0 ) ) ) ) )
         550             :
         551           0 :                 SALT_N = SALT_N +  6.0 * ( Inst%SRRC_N(R,N) * SCALE * A_M2 &
         552           0 :                                    * W10M**3.41d0 * OMSS2 )
         553             :
         554             :              ENDIF
         555             :
         556             :           ENDDO !R
         557             :
         558             :           ! ----------------------------------------------------------------
         559             :           ! Pass sea salt emissions do emission array [kg/m2/s]
         560             :           ! ----------------------------------------------------------------
         561             :           ! kg --> kg/m2/s
         562           0 :           IF     ( N == 1 ) THEN
         563           0 :              FLUXSALA(I,J) = SALT / A_M2 / HcoState%TS_EMIS
         564           0 :              SNOWSALA(I,J) = SNOWSALT / A_M2 / HcoState%TS_EMIS
         565           0 :           ELSEIF ( N == 2 ) THEN
         566           0 :              FLUXSALC(I,J) = SALT / A_M2 / HcoState%TS_EMIS
         567           0 :              SNOWSALC(I,J) = SNOWSALT / A_M2 / HcoState%TS_EMIS
         568           0 :           ELSEIF ( N == 3 ) THEN
         569           0 :              FLUXMOPO(I,J) = SALT / A_M2 / HcoState%TS_EMIS
         570           0 :           ELSEIF ( N == 4 ) THEN
         571           0 :              FLUXMOPI(I,J) = SALT / A_M2 / HcoState%TS_EMIS
         572             :           ENDIF
         573             :
         574             :           ! ----------------------------------------------------------------
         575             :           ! Write out number density for diagnostics [#]
         576             :           ! ----------------------------------------------------------------
         577           0 :           IF     ( N == 1 ) THEN
         578           0 :              Inst%NDENS_SALA(I,J) = SALT_N
         579           0 :           ELSEIF ( N == 2 ) THEN
         580           0 :              Inst%NDENS_SALC(I,J) = SALT_N
         581           0 :           ELSEIF ( N == 3 ) THEN
         582           0 :              Inst%NDENS_MOPO(I,J) = SALT_N
         583           0 :           ELSEIF ( N == 4 ) THEN
         584           0 :              Inst%NDENS_MOPI(I,J) = SALT_N
         585             :           ENDIF
         586             :
         587             :        ENDDO !N
         588             :
         589             :     ENDDO !I
         590             :     ENDDO !J
         591             : !$OMP END PARALLEL DO
         592             :
         593             :     ! Check exit status
         594             :     IF ( ERR ) THEN
         595             :        RC = HCO_FAIL
         596             :        RETURN
         597             :     ENDIF
         598             :
         599             :     !=================================================================
         600             :     ! PASS TO HEMCO STATE AND UPDATE DIAGNOSTICS
         601             :     !=================================================================
         602             :
         603             :     ! SALA
         604           0 :     IF ( Inst%IDTSALA > 0 ) THEN
         605             :
         606             :        ! Add flux to emission array
         607             :        CALL HCO_EmisAdd( HcoState, FLUXSALA, Inst%IDTSALA, &
         608           0 :                          RC,       ExtNr=Inst%ExtNrSS )
         609           0 :        IF ( RC /= HCO_SUCCESS ) THEN
         610           0 :           CALL HCO_ERROR( 'HCO_EmisAdd error: FLUXSALA', RC )
         611           0 :           RETURN
         612             :        ENDIF
         613             :     ENDIF
         614             :
         615             :     ! SALC
         616           0 :     IF ( Inst%IDTSALC > 0 ) THEN
         617             :
         618             :        ! Add flux to emission array
         619             :        CALL HCO_EmisAdd( HcoState, FLUXSALC, Inst%IDTSALC, &
         620           0 :                          RC,       ExtNr=Inst%ExtNrSS )
         621           0 :        IF ( RC /= HCO_SUCCESS ) THEN
         622           0 :           CALL HCO_ERROR( 'HCO_EmisAdd error: FLUXSALC', RC )
         623           0 :           RETURN
         624             :        ENDIF
         625             :
         626             :     ENDIF
         627             :
         628             :     ! SALA Chloride, xnw 10/13/17
         629           0 :     IF ( Inst%IDTSALACL > 0 ) THEN
         630           0 :        FLUXSALACL = ( FLUXSALA + SNOWSALA ) * 0.5504d0
         631             :        ! Add flux to emission array
         632             :        CALL HCO_EmisAdd( HcoState, FLUXSALACL, Inst%IDTSALACL, &
         633           0 :                          RC,        ExtNr=Inst%ExtNrSS )
         634           0 :        IF ( RC /= HCO_SUCCESS ) THEN
         635           0 :           CALL HCO_ERROR( 'HCO_EmisAdd error: FLUXSALACL', RC)
         636           0 :           RETURN
         637             :        ENDIF
         638             :     ENDIF
         639             :
         640             :     ! SALC Chloride, xnw 11/17/17
         641           0 :     IF ( Inst%IDTSALCCL > 0 ) THEN
         642           0 :         FLUXSALCCL = ( FLUXSALC + SNOWSALC ) * 0.5504d0
         643             :        ! Add flux to emission array
         644             :        CALL HCO_EmisAdd( HcoState, FLUXSALCCL, Inst%IDTSALCCL, &
         645           0 :                          RC,        ExtNr=Inst%ExtNrSS )
         646           0 :        IF ( RC /= HCO_SUCCESS ) THEN
         647           0 :           CALL HCO_ERROR( 'HCO_EmisAdd error: FLUXSALCCL', RC)
         648           0 :           RETURN
         649             :        ENDIF
         650             :     ENDIF
         651             :
         652             :     ! SALA Alkalinity, xnw 11/30/17
         653           0 :     IF ( Inst%IDTSALAAL > 0 ) THEN
         654           0 :        FLUXSALAAL = FLUXSALA
         655             :        ! Add flux to emission array
         656             :        CALL HCO_EmisAdd( HcoState, FLUXSALAAL, Inst%IDTSALAAL, &
         657           0 :                          RC,        ExtNr=Inst%ExtNrSS )
         658           0 :        IF ( RC /= HCO_SUCCESS ) THEN
         659           0 :           CALL HCO_ERROR( 'HCO_EmisAdd error: FLUXSALAAL', RC)
         660           0 :           RETURN
         661             :        ENDIF
         662             :     ENDIF
         663             :
         664             :     ! SALC Alkalinity, xnw 11/30/17
         665           0 :     IF ( Inst%IDTSALCAL > 0 ) THEN
         666           0 :         FLUXSALCAL = FLUXSALC
         667             :        ! Add flux to emission array
         668             :        CALL HCO_EmisAdd( HcoState, FLUXSALCAL, Inst%IDTSALCAL, &
         669           0 :                          RC,        ExtNr=Inst%ExtNrSS )
         670           0 :        IF ( RC /= HCO_SUCCESS ) THEN
         671           0 :           CALL HCO_ERROR( 'HCO_EmisAdd error: FLUXSALCAL', RC)
         672           0 :           RETURN
         673             :        ENDIF
         674             :     ENDIF
         675             :
         676             :     ! Bromine incorporated into sea salt
         677           0 :     IF ( Inst%CalcBrSalt ) THEN
         678             :
         679             :        ! Scale BrSalX emissions to SalX.
         680             :        ! Also add blowing snow Br emissions assuming a factor of 5 enrichment
         681             :        ! factor relative to seawater
         682           0 :        FluxBrSalA = Inst%BrContent * (FluxSalA + SNOWSALA * 5.0d0)
         683           0 :        FluxBrSalC = Inst%BrContent * (FluxSalC + SNOWSALC * 5.0d0)
         684             :
         685             :        ! Add flux to emission array
         686             :        CALL HCO_EmisAdd( HcoState, FLUXBrSalA, Inst%IDTBrSalA, &
         687           0 :                          RC,       ExtNr=Inst%ExtNrSS )
         688           0 :        IF ( RC /= HCO_SUCCESS ) THEN
         689           0 :           CALL HCO_ERROR( 'HCO_EmisAdd error: FLUXBrSalA', RC )
         690           0 :           RETURN
         691             :        ENDIF
         692             :
         693             :        ! Add flux to emission array
         694             :        CALL HCO_EmisAdd( HcoState, FLUXBrSalC, Inst%IDTBrSalC, &
         695           0 :                          RC,       ExtNr=Inst%ExtNrSS )
         696           0 :        IF ( RC /= HCO_SUCCESS ) THEN
         697           0 :           CALL HCO_ERROR( 'HCO_EmisAdd error: FLUXBrSalC', RC )
         698           0 :           RETURN
         699             :        ENDIF
         700             :
         701             :     ENDIF
         702             :
         703             :     ! MOPO
         704           0 :     IF ( Inst%IDTMOPO > 0 ) THEN
         705             :
         706             :        ! Add flux to emission array
         707             :        CALL HCO_EmisAdd( HcoState, FLUXMOPO, Inst%IDTMOPO, &
         708           0 :                          RC,       ExtNr=Inst%ExtNrSS )
         709           0 :        IF ( RC /= HCO_SUCCESS ) THEN
         710           0 :           CALL HCO_ERROR( 'HCO_EmisAdd error: FLUXMOPO', RC )
         711           0 :           RETURN
         712             :        ENDIF
         713             :
         714             :     ENDIF
         715             :
         716             :     ! MOPI
         717           0 :     IF ( Inst%IDTMOPI > 0 ) THEN
         718             :
         719             :        ! Add flux to emission array
         720             :        CALL HCO_EmisAdd( HcoState, FLUXMOPI, Inst%IDTMOPI, &
         721           0 :                          RC,       ExtNr=Inst%ExtNrSS )
         722           0 :        IF ( RC /= HCO_SUCCESS ) THEN
         723           0 :           CALL HCO_ERROR( 'HCO_EmisAdd error: FLUXMOPI', RC )
         724           0 :           RETURN
         725             :        ENDIF
         726             :
         727             :     ENDIF
         728             :
         729             :     ! Cleanup
         730           0 :     Inst => NULL()
         731             :
         732             :     ! Leave w/ success
         733           0 :     CALL HCO_LEAVE( HcoState%Config%Err,RC )
         734             :
         735             :   END SUBROUTINE HCOX_SeaSalt_Run
         736             : !EOC
         737             : !------------------------------------------------------------------------------
         738             : !                   Harmonized Emissions Component (HEMCO)                    !
         739             : !------------------------------------------------------------------------------
         740             : !BOP
         741             : !
         742             : ! !IROUTINE: HCOX_SeaSalt_Init
         743             : !
         744             : ! !DESCRIPTION: Subroutine HcoX\_SeaSalt\_Init initializes all
         745             : !  extension variables.
         746             : !\\
         747             : !\\
         748             : ! !INTERFACE:
         749             : !
         750           0 :   SUBROUTINE HCOX_SeaSalt_Init( HcoState, ExtName, ExtState, RC )
         751             : !
         752             : ! !USES:
         753             : !
         754             :     USE HCO_State_Mod,          ONLY : HCO_GetHcoID
         755             :     USE HCO_STATE_MOD,          ONLY : HCO_GetExtHcoID
         756             :     USE HCO_ExtList_Mod,        ONLY : GetExtNr
         757             :     USE HCO_ExtList_Mod,        ONLY : GetExtOpt
         758             : !
         759             : ! !INPUT PARAMETERS:
         760             : !
         761             :     TYPE(HCO_State),  POINTER        :: HcoState    ! HEMCO state object
         762             :     CHARACTER(LEN=*), INTENT(IN   )  :: ExtName     ! Extension name
         763             :     TYPE(Ext_State),  POINTER        :: ExtState    ! Options object
         764             : !
         765             : ! !INPUT/OUTPUT PARAMETERS:
         766             : !
         767             :     INTEGER,          INTENT(INOUT)  :: RC          ! Return status
         768             : !
         769             : ! !REVISION HISTORY:
         770             : !  15 Dec 2013 - C. Keller   - Initial version
         771             : !  See https://github.com/geoschem/hemco for complete history
         772             : !EOP
         773             : !------------------------------------------------------------------------------
         774             : !BOC
         775             : !
         776             : ! !LOCAL VARIABLES:
         777             : !
         778             :     INTEGER                        :: ExtNrSS
         779             :     INTEGER                        :: N, R, AS
         780             :     REAL*8                         :: A, B, R0, R1
         781             :     REAL*8                         :: CONST_N
         782             :     CHARACTER(LEN=255)             :: MSG, LOC
         783             :     INTEGER                        :: nSpcSS, minLen
         784             :     REAL*8                         :: SALA_REDGE_um(2), SALC_REDGE_um(2)
         785             :     REAL(dp)                       :: tmpScale
         786             :     LOGICAL                        :: FOUND
         787           0 :     INTEGER, ALLOCATABLE           :: HcoIDsSS(:)
         788           0 :     CHARACTER(LEN=31), ALLOCATABLE :: SpcNamesSS(:)
         789             :     TYPE(MyInst), POINTER          :: Inst
         790             :
         791             :     ! Local variables for blowing snow
         792             :     INTEGER                :: ND, IH !IH for different hemisphere
         793             :     REAL*8                 :: D_SNOW, D_DRY
         794             :     REAL*8, PARAMETER      :: A_SALT = 2.0d0  !from Mann et al. 2000
         795             :     REAL*8, PARAMETER      :: B_SALT = 37.5d0 !in um
         796             :     REAL*8, PARAMETER      :: DDSNOW = 2.0d0  !in um for snow particle interval
         797             :     REAL*8, PARAMETER      :: RHONACL = 2160.0d0    !kg/m3
         798             :     REAL*8, PARAMETER      :: RHOICE  = 900.0d0     !kg/m3
         799             :
         800             :     !=================================================================
         801             :     ! HCOX_SeaSalt_Init begins here!
         802             :     !=================================================================
         803           0 :     LOC = 'HCOX_SeaSalt_Init (HCOX_SEASALT_MOD.F90)'
         804             :
         805             :     ! Extension number for seasalt
         806           0 :     ExtNrSS = GetExtNr( HcoState%Config%ExtList, TRIM(ExtName) )
         807           0 :     IF ( ExtNrSS <= 0 ) RETURN
         808             :
         809             :     ! Enter
         810           0 :     CALL HCO_ENTER( HcoState%Config%Err, LOC, RC )
         811           0 :     IF ( RC /= HCO_SUCCESS ) THEN
         812           0 :         CALL HCO_ERROR( 'ERROR 1', RC, THISLOC=LOC )
         813           0 :         RETURN
         814             :     ENDIF
         815             :
         816             :     ! Create Instance
         817           0 :     Inst => NULL()
         818           0 :     CALL InstCreate ( ExtNrSS, ExtState%SeaSalt, Inst, RC )
         819           0 :     IF ( RC /= HCO_SUCCESS ) THEN
         820           0 :        CALL HCO_ERROR ( 'Cannot create SeaSalt instance', RC )
         821           0 :        RETURN
         822             :     ENDIF
         823             :     ! Also fill ExtNrSS - this is the same as the parent ExtNr
         824           0 :     Inst%ExtNrSS = ExtNrSS
         825             :
         826             :     ! ----------------------------------------------------------------------
         827             :     ! Get species IDs and settings
         828             :     ! ----------------------------------------------------------------------
         829             :
         830             :     ! Read settings specified in configuration file
         831             :     ! Note: the specified strings have to match those in
         832             :     !       the config. file!
         833             :     Call GetExtOpt ( HcoState%Config, Inst%ExtNrSS, 'Model sea salt Br-', &
         834           0 :                      OptValBool=Inst%CalcBrSalt, RC=RC )
         835           0 :     IF ( Inst%CalcBrSalt ) THEN
         836           0 :        minLen = 4
         837             :        CALL GetExtOpt( HcoState%Config, Inst%ExtNrSS, 'Br- mass ratio', &
         838           0 :             OptValDp=Inst%BrContent, RC=RC )
         839           0 :        IF ( RC /= HCO_SUCCESS ) THEN
         840           0 :            CALL HCO_ERROR( 'ERROR 2', RC, THISLOC=LOC )
         841           0 :            RETURN
         842             :        ENDIF
         843             :     ELSE
         844           0 :        minLen = 2
         845           0 :        Inst%IDTBrSALA = -1
         846           0 :        Inst%IDTBrSALC = -1
         847           0 :        Inst%BrContent = 0.0d0
         848             :     ENDIF
         849             :
         850             :     ! Get HEMCO species IDs
         851             :     CALL HCO_GetExtHcoID( HcoState,   Inst%ExtNrSS, HcoIDsSS,     &
         852           0 :                           SpcNamesSS, nSpcSS,  RC           )
         853           0 :     IF ( RC /= HCO_SUCCESS ) THEN
         854           0 :         CALL HCO_ERROR( 'ERROR 3', RC, THISLOC=LOC )
         855           0 :         RETURN
         856             :     ENDIF
         857           0 :     IF ( nSpcSS < minLen ) THEN
         858           0 :        MSG = 'Not enough sea salt emission species set'
         859           0 :        CALL HCO_ERROR(MSG, RC )
         860           0 :        RETURN
         861             :     ENDIF
         862           0 :     Inst%IDTSALA = HcoIDsSS(1)
         863           0 :     Inst%IDTSALC = HcoIDsSS(2)
         864           0 :     Inst%IDTSALACL = HcoIDsSS(3)
         865           0 :     Inst%IDTSALCCL = HcoIDsSS(4)
         866           0 :     Inst%IDTSALAAL = HcoIDsSS(5)
         867           0 :     Inst%IDTSALCAL = HcoIDsSS(6)
         868           0 :     IF ( Inst%CalcBrSalt ) Inst%IDTBrSALA = HcoIDsSS(7)
         869           0 :     IF ( Inst%CalcBrSalt ) Inst%IDTBrSALC = HcoIDsSS(8)
         870           0 :     IF ( HcoState%MarinePOA ) THEN
         871           0 :        Inst%IDTMOPO = HcoIDsSS(9)
         872           0 :        Inst%IDTMOPI = HcoIDsSS(10)
         873             :     ENDIF
         874             :
         875             :     ! Get aerosol radius'
         876           0 :     SALA_REDGE_um(:) = 0.0d0
         877           0 :     SALC_REDGE_um(:) = 0.0d0
         878             :     CALL GetExtOpt( HcoState%Config, Inst%ExtNrSS, 'SALA lower radius', &
         879           0 :                     OptValDp=SALA_REDGE_um(1), RC=RC )
         880           0 :     IF ( RC /= HCO_SUCCESS ) THEN
         881           0 :         CALL HCO_ERROR( 'ERROR 4', RC, THISLOC=LOC )
         882           0 :         RETURN
         883             :     ENDIF
         884             :     CALL GetExtOpt( HcoState%Config, Inst%ExtNrSS, 'SALA upper radius', &
         885           0 :                     OptValDp=SALA_REDGE_um(2), RC=RC )
         886           0 :     IF ( RC /= HCO_SUCCESS ) THEN
         887           0 :         CALL HCO_ERROR( 'ERROR 5', RC, THISLOC=LOC )
         888           0 :         RETURN
         889             :     ENDIF
         890             :     CALL GetExtOpt( HcoState%Config, Inst%ExtNrSS, 'SALC lower radius', &
         891           0 :                     OptValDp=SALC_REDGE_um(1), RC=RC )
         892           0 :     IF ( RC /= HCO_SUCCESS ) THEN
         893           0 :         CALL HCO_ERROR( 'ERROR 6', RC, THISLOC=LOC )
         894           0 :         RETURN
         895             :     ENDIF
         896             :     CALL GetExtOpt( HcoState%Config, Inst%ExtNrSS, 'SALC upper radius', &
         897           0 :                     OptValDp=SALC_REDGE_um(2), RC=RC )
         898           0 :     IF ( RC /= HCO_SUCCESS ) THEN
         899           0 :         CALL HCO_ERROR( 'ERROR 7', RC, THISLOC=LOC )
         900           0 :         RETURN
         901             :     ENDIF
         902             :
         903             :     ! fix scaling factor over cold water SST (<5 degC)
         904             :     CALL GetExtOpt ( HcoState%Config, Inst%ExtNrSS, 'Reduce SS cold water', &
         905           0 :                      OptValBool=Inst%ColdSST, RC=RC )
         906           0 :     IF ( RC /= HCO_SUCCESS ) THEN
         907           0 :         CALL HCO_ERROR( 'ERROR 8', RC, THISLOC=LOC )
         908           0 :         RETURN
         909             :     ENDIF
         910             :
         911             :     ! Add a SSA source from blowing snow (by J. Huang)
         912             :     CALL GetExtOpt ( HcoState%Config, Inst%ExtNrSS, 'Blowing Snow SS', &
         913           0 :                      OptValBool=Inst%EmitSnowSS, RC=RC )
         914           0 :     IF ( RC /= HCO_SUCCESS ) THEN
         915           0 :         CALL HCO_ERROR( 'ERROR 9', RC, THISLOC=LOC )
         916           0 :         RETURN
         917             :     ENDIF
         918             :
         919             :     ! Whether or not differentiate snow salinity on FYI and MYI (by J. Huang)
         920             :     !CALL GetExtOpt ( HcoState%Config, Inst%ExtNrSS, 'Diff salinity on ice', &
         921             :     !                 OptValBool=Inst%FYIsnow, RC=RC )
         922             :     !IF ( RC /= HCO_SUCCESS ) RETURN
         923             :
         924             :     ! Add snow salinity (NH and SH), snow age and number of particles
         925             :     ! per snowflake as external factor from configuration file
         926           0 :     IF ( Inst%EmitSnowSS ) THEN
         927             :        CALL GetExtOpt( HcoState%Config, Inst%ExtNrSS, 'NH FYI snow salinity', &
         928           0 :                     OptValDp=Inst%NSLNT_FYI, RC=RC )
         929           0 :        IF ( RC /= HCO_SUCCESS ) THEN
         930           0 :            CALL HCO_ERROR( 'ERROR 10', RC, THISLOC=LOC )
         931           0 :            RETURN
         932             :        ENDIF
         933             :        CALL GetExtOpt( HcoState%Config, Inst%ExtNrSS, 'NH MYI snow salinity', &
         934           0 :                     OptValDp=Inst%NSLNT_MYI, RC=RC )
         935           0 :        IF ( RC /= HCO_SUCCESS ) THEN
         936           0 :            CALL HCO_ERROR( 'ERROR 11', RC, THISLOC=LOC )
         937           0 :            RETURN
         938             :        ENDIF
         939             :        CALL GetExtOpt( HcoState%Config, Inst%ExtNrSS, 'SH FYI snow salinity', &
         940           0 :                     OptValDp=Inst%SSLNT_FYI, RC=RC )
         941           0 :        IF ( RC /= HCO_SUCCESS ) THEN
         942           0 :            CALL HCO_ERROR( 'ERROR 12', RC, THISLOC=LOC )
         943           0 :            RETURN
         944             :        ENDIF
         945             :        CALL GetExtOpt( HcoState%Config, Inst%ExtNrSS, 'SH MYI snow salinity', &
         946           0 :                     OptValDp=Inst%SSLNT_MYI, RC=RC )
         947           0 :        IF ( RC /= HCO_SUCCESS ) THEN
         948           0 :            CALL HCO_ERROR( 'ERROR 13', RC, THISLOC=LOC )
         949           0 :            RETURN
         950             :        ENDIF
         951             :        CALL GetExtOpt( HcoState%Config, Inst%ExtNrSS, 'NH snow age', &
         952           0 :                     OptValDp=Inst%NAGE, RC=RC )
         953           0 :        IF ( RC /= HCO_SUCCESS ) THEN
         954           0 :            CALL HCO_ERROR( 'ERROR 14', RC, THISLOC=LOC )
         955           0 :            RETURN
         956             :        ENDIF
         957             :        CALL GetExtOpt( HcoState%Config, Inst%ExtNrSS, 'SH snow age', &
         958           0 :                     OptValDp=Inst%SAGE, RC=RC )
         959           0 :        IF ( RC /= HCO_SUCCESS ) THEN
         960           0 :            CALL HCO_ERROR( 'ERROR 15', RC, THISLOC=LOC )
         961           0 :            RETURN
         962             :        ENDIF
         963             :        CALL GetExtOpt( HcoState%Config, Inst%ExtNrSS, 'N per snowflake', &
         964           0 :                     OptValDp=Inst%NumP, RC=RC )
         965           0 :        IF ( RC /= HCO_SUCCESS ) THEN
         966           0 :            CALL HCO_ERROR( 'ERROR 16', RC, THISLOC=LOC )
         967           0 :            RETURN
         968             :        ENDIF
         969             :     ELSE
         970           0 :        Inst%NSLNT_FYI = 0.1d0   ! default value 0.1 psu for NH FYI snow
         971           0 :        Inst%NSLNT_MYI = 0.05d0  ! default value 0.05 psu for NH MYI snow
         972           0 :        Inst%SSLNT_FYI = 0.03d0  ! default value 0.03 psu for SH FYI snow
         973           0 :        Inst%SSLNT_FYI = 0.015d0 ! default value 0.015 psu for SH MYI snow
         974           0 :        Inst%NAGE = 3.0d0   ! default value 3 days snow age in NH
         975           0 :        Inst%SAGE = 1.5d0   ! default value 1.5 days snow age in SH
         976           0 :        Inst%NumP = 5.0d0     ! default value of 5 particles per snowflake
         977             :     ENDIF
         978             :
         979             :     ! Final BrSalt flag
         980           0 :     Inst%CalcBrSalt = ( Inst%CalcBrSalt .and. Inst%IDTBrSALA > 0 .and. Inst%IDTBrSALC > 0 )
         981             :
         982             :     ! The source function calculated with GEOS-4 2x2.5 wind speeds
         983             :     ! is too high compared to GEOS-5 at the same resolution. The 10m
         984             :     ! winds in GEOS-4 are too rapid. To correct this, apply a global
         985             :     ! scaling factor of 0.72 (jaegle 5/11/11)
         986             :     ! Now check first if this factor is specified in configuration file
         987             :     CALL GetExtOpt( HcoState%Config, Inst%ExtNrSS, 'Wind scale factor', &
         988           0 :                     OptValDp=tmpScale, FOUND=FOUND, RC=RC )
         989           0 :     IF ( RC /= HCO_SUCCESS ) THEN
         990           0 :         CALL HCO_ERROR( 'ERROR 17', RC, THISLOC=LOC )
         991           0 :         RETURN
         992             :     ENDIF
         993           0 :     IF ( .NOT. FOUND ) THEN
         994           0 :        tmpScale = 1.0d0
         995             :     ENDIF
         996           0 :     Inst%WindScale = tmpScale
         997             :
         998             :     ! Verbose mode
         999           0 :     IF ( HcoState%amIRoot ) THEN
        1000             :
        1001             :        ! Write the name of the extension regardless of the verbose setting
        1002           0 :        msg = 'Using HEMCO extension: SeaSalt (sea salt aerosol emissions)'
        1003           0 :        IF ( HCO_IsVerb( HcoState%Config%Err ) ) THEN
        1004           0 :           CALL HCO_Msg( HcoState%Config%Err, msg, sep1='-' ) ! with separator
        1005             :        ELSE
        1006           0 :           CALL HCO_Msg( msg, verb=.TRUE.                   ) ! w/o separator
        1007             :        ENDIF
        1008             :
        1009             :        ! Write all other messages as debug printout only
        1010           0 :        IF ( HcoState%MarinePOA ) THEN
        1011           0 :           MSG = 'Use marine organic aerosols option'
        1012           0 :           CALL HCO_MSG(HcoState%Config%Err,MSG, SEP1='-' )
        1013             :        ENDIF
        1014             :
        1015           0 :        WRITE(MSG,*) 'Accumulation aerosol: ', TRIM(SpcNamesSS(1)),  &
        1016           0 :                     ':', Inst%IDTSALA
        1017           0 :        CALL HCO_MSG(HcoState%Config%Err,MSG)
        1018           0 :        WRITE(MSG,*) ' - size range       : ', SALA_REDGE_um
        1019           0 :        CALL HCO_MSG(HcoState%Config%Err,MSG)
        1020           0 :        WRITE(MSG,*) 'Coarse aerosol      : ', TRIM(SpcNamesSS(2)),  &
        1021           0 :                      ':', Inst%IDTSALC
        1022           0 :        CALL HCO_MSG(HcoState%Config%Err,MSG)
        1023           0 :        WRITE(MSG,*) ' - size range       : ', SALA_REDGE_um
        1024           0 :        CALL HCO_MSG(HcoState%Config%Err,MSG)
        1025           0 :        WRITE(MSG,*) ' - wind scale factor: ', Inst%WindScale
        1026           0 :        CALL HCO_MSG(HcoState%Config%Err,MSG)
        1027             :
        1028           0 :        IF ( Inst%EmitSnowSS ) THEN
        1029           0 :           WRITE(MSG,*) ' - Arctic Snow Salinity on FYI (psu): ', Inst%NSLNT_FYI
        1030           0 :           CALL HCO_MSG(HcoState%Config%Err,MSG)
        1031           0 :           WRITE(MSG,*) ' - Arctic Snow Salinity on MYI (psu): ', Inst%NSLNT_MYI
        1032           0 :           CALL HCO_MSG(HcoState%Config%Err,MSG)
        1033           0 :           WRITE(MSG,*) ' - Antarctic Snow Salinity on FYI (psu): ', Inst%SSLNT_FYI
        1034           0 :           CALL HCO_MSG(HcoState%Config%Err,MSG)
        1035           0 :           WRITE(MSG,*) ' - Antarctic Snow Salinity on FYI (psu): ', Inst%SSLNT_MYI
        1036           0 :           CALL HCO_MSG(HcoState%Config%Err,MSG)
        1037           0 :           WRITE(MSG,*) ' - Arctic Snow age (days): ', Inst%NAGE
        1038           0 :           CALL HCO_MSG(HcoState%Config%Err,MSG)
        1039           0 :           WRITE(MSG,*) ' - Antarctic Snow age(days): ', Inst%SAGE
        1040           0 :           CALL HCO_MSG(HcoState%Config%Err,MSG)
        1041           0 :           WRITE(MSG,*) ' - Number of particle per snowflake: ', Inst%NumP
        1042           0 :           CALL HCO_MSG(HcoState%Config%Err,MSG)
        1043             :        ENDIF
        1044             :
        1045           0 :        WRITE(MSG,*) 'Accumulation Chloride: ', TRIM(SpcNamesSS(3)),  &
        1046           0 :                     ':', Inst%IDTSALACL
        1047           0 :        CALL HCO_MSG(HcoState%Config%Err,MSG)
        1048           0 :        WRITE(MSG,*) 'Coarse Chloride: ', TRIM(SpcNamesSS(4)),  &
        1049           0 :                     ':', Inst%IDTSALCCL
        1050           0 :        CALL HCO_MSG(HcoState%Config%Err,MSG)
        1051           0 :        WRITE(MSG,*) 'Accumulation Alkalinity: ', TRIM(SpcNamesSS(5)),  &
        1052           0 :                     ':', Inst%IDTSALAAL
        1053           0 :        CALL HCO_MSG(HcoState%Config%Err,MSG)
        1054           0 :        WRITE(MSG,*) 'Coarse Alkalinity: ', TRIM(SpcNamesSS(6)),  &
        1055           0 :                     ':', Inst%IDTSALCAL
        1056           0 :        CALL HCO_MSG(HcoState%Config%Err,MSG)
        1057             :
        1058           0 :        IF ( Inst%CalcBrSalt ) THEN
        1059           0 :           WRITE(MSG,*) 'BrSALA: ', TRIM(SpcNamesSS(7)), Inst%IDTBrSALA
        1060           0 :           CALL HCO_MSG(HcoState%Config%Err,MSG)
        1061           0 :           WRITE(MSG,*) 'BrSALC: ', TRIM(SpcNamesSS(8)), Inst%IDTBrSALC
        1062           0 :           CALL HCO_MSG(HcoState%Config%Err,MSG)
        1063           0 :           WRITE(MSG,*) 'Br- mass content: ', Inst%BrContent
        1064           0 :           CALL HCO_MSG(HcoState%Config%Err,MSG)
        1065             :        ENDIF
        1066             :
        1067           0 :        IF ( HcoState%MarinePOA ) THEN
        1068           0 :           WRITE(MSG,*) 'Hydrophobic marine organic aerosol: ',        &
        1069           0 :                        TRIM(SpcNamesSS(9)), ':', Inst%IDTMOPO
        1070           0 :           CALL HCO_MSG(HcoState%Config%Err,MSG)
        1071             :
        1072           0 :           WRITE(MSG,*) 'Hydrophilic marine organic aerosol: ',        &
        1073           0 :                        TRIM(SpcNamesSS(10)), ':', Inst%IDTMOPI
        1074           0 :           CALL HCO_MSG(HcoState%Config%Err,MSG)
        1075             :        ENDIF
        1076             :     ENDIF
        1077             :
        1078             :     ! ----------------------------------------------------------------------
        1079             :     ! Allocate module and subroutine arrays
        1080             :     ! ----------------------------------------------------------------------
        1081             :
        1082             :     ! Number of tracers dependent on MarinePOA (ewl, 7/9/15)
        1083           0 :     IF ( HcoState%MarinePOA ) THEN
        1084           0 :        Inst%NSALT = 4
        1085             :     ELSE
        1086           0 :        Inst%NSALT = 2
        1087             :     ENDIF
        1088             :
        1089           0 :     ALLOCATE ( Inst%NR  ( Inst%NSALT ), STAT=AS )
        1090           0 :     IF ( AS/=0 ) THEN
        1091           0 :        CALL HCO_ERROR( 'Cannot allocate NR', RC )
        1092           0 :        RETURN
        1093             :     ENDIF
        1094           0 :     Inst%NR = 0
        1095             :
        1096           0 :     ALLOCATE ( Inst%SS_DEN  ( Inst%NSALT ), STAT=AS )
        1097             :     IF ( AS/=0 ) THEN
        1098           0 :        CALL HCO_ERROR( 'Cannot allocate SS_DEN', RC )
        1099           0 :        RETURN
        1100             :     ENDIF
        1101           0 :     Inst%SS_DEN = 2200.d0
        1102             :
        1103           0 :     ALLOCATE ( Inst%SRRC   ( NR_MAX,   Inst%NSALT ), STAT=AS )
        1104             :     IF ( AS/=0 ) THEN
        1105           0 :        CALL HCO_ERROR( 'Cannot allocate SRRC', RC )
        1106           0 :        RETURN
        1107             :     ENDIF
        1108           0 :     Inst%SRRC = 0d0
        1109           0 :     ALLOCATE ( Inst%SRRC_N ( NR_MAX,   Inst%NSALT ), STAT=AS )
        1110             :     IF ( AS/=0 ) THEN
        1111           0 :        CALL HCO_ERROR( 'Cannot allocate SRRC_N', RC )
        1112           0 :        RETURN
        1113             :     ENDIF
        1114           0 :     Inst%SRRC_N = 0d0
        1115           0 :     ALLOCATE ( Inst%RREDGE ( 0:NR_MAX, Inst%NSALT ), STAT=AS )
        1116             :     IF ( AS/=0 ) THEN
        1117           0 :        CALL HCO_ERROR( 'Cannot allocate RREDGE', RC )
        1118           0 :        RETURN
        1119             :     ENDIF
        1120           0 :     Inst%RREDGE = 0d0
        1121           0 :     ALLOCATE ( Inst%RRMID  ( NR_MAX,   Inst%NSALT ), STAT=AS )
        1122             :     IF ( AS/=0 ) THEN
        1123           0 :        CALL HCO_ERROR( 'Cannot allocate RRMID', RC )
        1124           0 :        RETURN
        1125             :     ENDIF
        1126           0 :     Inst%RRMID = 0d0
        1127             :
        1128           0 :     ALLOCATE ( Inst%NDENS_SALA( HcoState%NX, HcoState%NY), STAT=AS )
        1129             :     IF ( AS/=0 ) THEN
        1130           0 :        CALL HCO_ERROR( 'Cannot allocate NDENS_SALA', RC )
        1131           0 :        RETURN
        1132             :     ENDIF
        1133           0 :     Inst%NDENS_SALA = 0.0_sp
        1134             :
        1135           0 :     ALLOCATE ( Inst%NDENS_SALC( HcoState%NX, HcoState%NY), STAT=AS )
        1136             :     IF ( AS/=0 ) THEN
        1137           0 :        CALL HCO_ERROR( 'Cannot allocate NDENS_SALC', RC )
        1138           0 :        RETURN
        1139             :     ENDIF
        1140           0 :     Inst%NDENS_SALC = 0.0_sp
        1141             :
        1142             :     ! Allocate for blowing snow simulation
        1143           0 :     IF ( Inst%EmitSnowSS ) THEN
        1144           0 :         ALLOCATE ( Inst%F_DI_N_FYI( NR_MAX,   Inst%NSALT ), STAT=AS )
        1145             :         IF ( AS/=0 ) THEN
        1146           0 :            CALL HCO_ERROR( 'Cannot allocate F_DI_N_FYI', RC )
        1147           0 :            RETURN
        1148             :         ENDIF
        1149           0 :         Inst%F_DI_N_FYI = 0.0_sp
        1150             :
        1151           0 :         ALLOCATE ( Inst%F_DI_N_MYI( NR_MAX,   Inst%NSALT ), STAT=AS )
        1152             :         IF ( AS/=0 ) THEN
        1153           0 :            CALL HCO_ERROR( 'Cannot allocate F_DI_N_MYI', RC )
        1154           0 :            RETURN
        1155             :         ENDIF
        1156           0 :         Inst%F_DI_N_MYI = 0.0_sp
        1157             :
        1158           0 :         ALLOCATE ( Inst%F_DN_N_FYI( NR_MAX,   Inst%NSALT ), STAT=AS )
        1159             :         IF ( AS/=0 ) THEN
        1160           0 :            CALL HCO_ERROR( 'Cannot allocate F_DN_N_FYI', RC )
        1161           0 :            RETURN
        1162             :         ENDIF
        1163           0 :         Inst%F_DN_N_FYI = 0.0_sp
        1164             :
        1165           0 :         ALLOCATE ( Inst%F_DN_N_MYI( NR_MAX,   Inst%NSALT ), STAT=AS )
        1166             :         IF ( AS/=0 ) THEN
        1167           0 :            CALL HCO_ERROR( 'Cannot allocate F_DN_N_MYI', RC )
        1168           0 :            RETURN
        1169             :         ENDIF
        1170           0 :         Inst%F_DN_N_MYI = 0.0_sp
        1171             :
        1172           0 :         ALLOCATE ( Inst%F_DI_S_FYI( NR_MAX,   Inst%NSALT ), STAT=AS )
        1173             :         IF ( AS/=0 ) THEN
        1174           0 :            CALL HCO_ERROR( 'Cannot allocate F_DI_S_FYI', RC )
        1175           0 :            RETURN
        1176             :         ENDIF
        1177           0 :         Inst%F_DI_S_FYI = 0.0_sp
        1178             :
        1179           0 :         ALLOCATE ( Inst%F_DI_S_MYI( NR_MAX,   Inst%NSALT ), STAT=AS )
        1180             :         IF ( AS/=0 ) THEN
        1181           0 :            CALL HCO_ERROR( 'Cannot allocate F_DI_S_MYI', RC )
        1182           0 :            RETURN
        1183             :         ENDIF
        1184           0 :         Inst%F_DI_S_MYI = 0.0_sp
        1185             :
        1186           0 :         ALLOCATE ( Inst%F_DN_S_FYI( NR_MAX,   Inst%NSALT ), STAT=AS )
        1187             :         IF ( AS/=0 ) THEN
        1188           0 :            CALL HCO_ERROR( 'Cannot allocate F_DN_S_FYI', RC )
        1189           0 :            RETURN
        1190             :         ENDIF
        1191           0 :         Inst%F_DN_S_FYI = 0.0_sp
        1192             :
        1193           0 :         ALLOCATE ( Inst%F_DN_S_MYI( NR_MAX,   Inst%NSALT ), STAT=AS )
        1194             :         IF ( AS/=0 ) THEN
        1195           0 :            CALL HCO_ERROR( 'Cannot allocate F_DN_S_MYI', RC )
        1196           0 :            RETURN
        1197             :         ENDIF
        1198           0 :         Inst%F_DN_S_MYI = 0.0_sp
        1199             :     ENDIF
        1200             :
        1201           0 :     IF ( HcoState%MarinePOA ) THEN
        1202             :
        1203             :        ! Allocate density of phobic marine organic aerosols
        1204           0 :        ALLOCATE ( Inst%NDENS_MOPO( HcoState%NX, HcoState%NY), STAT=AS )
        1205             :        IF ( AS/=0 ) THEN
        1206           0 :           CALL HCO_ERROR( 'Cannot allocate NDENS_MOPO', RC )
        1207           0 :           RETURN
        1208             :        ENDIF
        1209           0 :        Inst%NDENS_MOPO = 0.0_sp
        1210             :
        1211             :        ! Allocate density of philic marine organic aerosols
        1212           0 :        ALLOCATE ( Inst%NDENS_MOPI( HcoState%NX, HcoState%NY), STAT=AS )
        1213             :        IF ( AS/=0 ) THEN
        1214           0 :           CALL HCO_ERROR( 'Cannot allocate NDENS_MOPI', RC )
        1215           0 :           RETURN
        1216             :        ENDIF
        1217           0 :        Inst%NDENS_MOPI = 0.0_sp
        1218             :
        1219           0 :        ALLOCATE ( Inst%CHLR( HcoState%NX, HcoState%NY), STAT=AS )
        1220             :        IF ( AS/=0 ) THEN
        1221           0 :           CALL HCO_ERROR( 'Cannot allocate CHLR', RC )
        1222           0 :           RETURN
        1223             :        ENDIF
        1224           0 :        Inst%CHLR = 0.0_hp
        1225             :
        1226             :     ENDIF
        1227             :
        1228             :     !=================================================================
        1229             :     ! Define edges and midpoints of each incremental radius bin
        1230             :     !=================================================================
        1231             :
        1232             :     ! Constant [volume * time * other stuff??]
        1233             :     !CONST   = 4d0/3d0 * PI * DR * DTEMIS * 1.d-18 * 1.373d0
        1234             :
        1235             :     !CONST_N = DTEMIS * DR * 1.373d0
        1236             :     !  Constant for converting from [#/m2/s/um] to [#/m2]
        1237           0 :     CONST_N = HcoState%TS_EMIS * (DR * BETHA)
        1238             :
        1239             :     ! Do for accumulation, fine mode, and marine organics (if enabled)
        1240           0 :     DO N = 1,Inst%NSALT
        1241             :
        1242             :        ! Lower and upper limit of size bin N [um]
        1243             :        ! Note that these are dry size bins. In order to
        1244             :        ! get wet (RH=80%) sizes, we need to multiply by
        1245             :        ! BETHA.
        1246             :
        1247             :        ! Accumulation mode
        1248           0 :        IF ( N==1 ) THEN
        1249           0 :           R0 = SALA_REDGE_um(1)
        1250           0 :           R1 = SALA_REDGE_um(2)
        1251             :
        1252             :        ! Coarse mode
        1253           0 :        ELSEIF ( N==2 ) THEN
        1254           0 :           R0 = SALC_REDGE_um(1)
        1255           0 :           R1 = SALC_REDGE_um(2)
        1256             :
        1257             :        ! Marine phobic (mj, bg, 7/9/15)
        1258           0 :        ELSEIF ( N==3 ) THEN
        1259           0 :           R0 = SALA_REDGE_um(1)
        1260           0 :           R1 = SALA_REDGE_um(2)
        1261             :
        1262             :        ! Marine philic (mj, bg, 7/9/15)
        1263           0 :        ELSEIF ( N==4 ) THEN
        1264           0 :           R0 = SALC_REDGE_um(1)
        1265           0 :           R1 = SALC_REDGE_um(2)
        1266             :        ENDIF
        1267             :
        1268             :        ! Number of radius size bins
        1269           0 :        Inst%NR(N) = INT( ( ( R1 - R0 ) / DR ) + 0.5d0 )
        1270             :
        1271             :        ! Error check
        1272           0 :        IF ( Inst%NR(N) > NR_MAX ) THEN
        1273           0 :           MSG = 'Too many bins'
        1274           0 :           CALL HCO_ERROR(MSG, RC )
        1275           0 :           RETURN
        1276             :        ENDIF
        1277             :
        1278             :        ! Lower edge of 0th bin
        1279           0 :        Inst%RREDGE(0,N) = R0
        1280             :
        1281             :        ! Loop over the # of radius bins
        1282           0 :        DO R = 1, Inst%NR(N)
        1283             :
        1284             :           ! Midpoint of IRth bin
        1285           0 :           Inst%RRMID(R,N)  = Inst%RREDGE(R-1,N) + ( DR / 2d0 )
        1286             :
        1287             :           ! Upper edge of IRth bin
        1288           0 :           Inst%RREDGE(R,N) = Inst%RREDGE(R-1,N) + DR
        1289             :
        1290             :           ! Sea salt base source [#/m2]. Note that the Gong formulation
        1291             :           ! is for r80 (radius at 80% RH), so we need to multiply RRMID
        1292             :           ! by the scaling factor BETHA=2.
        1293           0 :           A           = 4.7*(1.+30.*(BETHA*Inst%RRMID(R,N)))             &
        1294           0 :                        **(-0.017*(BETHA*Inst%RRMID(R,N))**(-1.44))
        1295           0 :           B           = (0.433d0-LOG10(BETHA*Inst%RRMID(R,N))) / 0.433d0
        1296           0 :           Inst%SRRC_N(R,N) = CONST_N * 1.373                            &
        1297             :                       * (1.d0/(BETHA*Inst%RRMID(R,N))**(A))            &
        1298             :                       * (1.d0+0.057d0*(BETHA*Inst%RRMID(R,N))**3.45d0) &
        1299           0 :                       * 10d0**(1.607d0*EXP(-(B**2)))
        1300             :
        1301             :           ! Sea salt base source [kg/m2]: multiply the number of particles
        1302             :           ! by the dry volume multiplied by the dry density of sea-salt.
        1303           0 :           Inst%SRRC(R,N) = Inst%SRRC_N(R,N) * 4d0/3d0 * HcoState%Phys%PI * 1.d-18 &
        1304           0 :                          * Inst%SS_DEN( N ) * (Inst%RRMID(R,N))**3
        1305             :
        1306             :           !-----------------------------------------------------------
        1307             :           ! IMPORTANT NOTE!
        1308             :           !
        1309             :           ! In mathematics, "LOG" means "log10".
        1310             :           ! In Fortran,     "LOG" means "ln" (and LOG10 is "log10").
        1311             :           !
        1312             :           ! The following equations require log to the base 10, so
        1313             :           ! we need to use the Fortran function LOG10 instead of LOG.
        1314             :           ! (jaegle, bmy, 11/23/09)
        1315             :           !-----------------------------------------------------------
        1316             :
        1317             : !          ! Old Monahan et al. (1986) formulation
        1318             : !          ! Sea salt base source [kg/m2]
        1319             : !          CONST_N = DTEMIS * (DR * BETHA)
        1320             : !          SRRC(R,N)  = CONST * SS_DEN( N )
        1321             : !     &         * ( 1.d0 + 0.057d0*( BETHA * RRMID(R,N) )**1.05d0 )
        1322             : !     &         * 10d0**( 1.19d0*
        1323             : !     &           EXP(-((0.38d0-LOG10(BETHA*RRMID(R,N)))/0.65d0)**2))
        1324             : !     &         / BETHA**2
        1325             :
        1326             : !          ! Sea salt base source [#/m2] (bec, bmy, 4/13/05)
        1327             : !          SRRC_N(R,N) = CONST_N * (1.d0/RRMID(R,N)**3)
        1328             : !     &         * (1.d0+0.057d0*(BETHA*RRMID(R,N))**1.05d0)
        1329             : !     &         * 10d0**(1.19d0*EXP(-((0.38d0-LOG10(BETHA*RRMID(R,N)))
        1330             : !     &        /0.65d0)**2))/ BETHA**2
        1331             :
        1332             : !### Debug
        1333             : !###           WRITE( 6, 100 ) R,RREDGE(R-1,N),RRMID(R,N),RREDGE(R,N),SRRC(R,N)
        1334             : !### 100        FORMAT( 'IR, R0, RRMID, R1: ', i3, 3f11.4,2x,es13.6 )
        1335             :        ENDDO !R
        1336             :
        1337             :        !size bins for blowing snow - Huang 6/12/20
        1338           0 :        IF ( Inst%EmitSnowSS .and. N .LT. 3 ) THEN
        1339             :          !-------------- Define size distribution ---------------------
        1340             :          ! for southern hemisphere FYI
        1341             :          D_SNOW = 1.0d0
        1342           0 :          DO ND = 1, NR_MAX
        1343             :             D_DRY =  ( Inst%NSLNT_FYI * RHOICE / (1000.d0 &
        1344           0 :                   * Inst%NumP * RHONACL ) )**( 1d0 / 3d0 ) * D_SNOW
        1345             :
        1346           0 :             IF (D_DRY .ge. R0*2d0 .and. D_DRY .le. R1*2d0 ) THEN
        1347             :
        1348             :            !----------------------------------------------------------
        1349             :            ! NOTES:
        1350             :            ! For size distribution
        1351             :            ! define the two-parameter gamma probability density funtion here
        1352             :            ! Yang et al 2008 eq (6)
        1353             :            !----------------------------------------------------------
        1354             :            ! Midpoint of IRth bin
        1355           0 :                Inst%F_DI_N_FYI(ND, N) = EXP( - D_SNOW / B_SALT ) &
        1356             :                 * D_SNOW**( A_SALT - 1.d0 ) &
        1357           0 :                 / ( B_SALT**A_SALT * GAMMA( A_SALT ) )
        1358             :             ELSE
        1359           0 :                Inst%F_DI_N_FYI(ND, N) = 0d0
        1360             :             ENDIF
        1361           0 :             Inst%F_DN_N_FYI(ND, N) = Inst%F_DI_N_FYI(ND,N) / (4d0/3d0 * HcoState%Phys%PI &
        1362           0 :                       * 1.d-18 * Inst%SS_DEN( N ) * (D_DRY/2d0)**3)
        1363             :
        1364           0 :             D_SNOW = D_SNOW + DDSNOW
        1365             :          ENDDO
        1366             :
        1367             :          ! for southern hemisphere MYI
        1368             :          D_SNOW = 1.0d0
        1369           0 :          DO ND = 1, NR_MAX
        1370             :             D_DRY =  ( Inst%NSLNT_MYI * RHOICE / (1000.d0 &
        1371           0 :                   * Inst%NumP * RHONACL ) )**( 1d0 / 3d0 ) * D_SNOW
        1372             :
        1373           0 :             IF (D_DRY .ge. R0*2d0 .and. D_DRY .le. R1*2d0 ) THEN
        1374             :            ! Midpoint of IRth bin
        1375           0 :                Inst%F_DI_N_MYI(ND, N) = EXP( - D_SNOW / B_SALT ) &
        1376             :                 * D_SNOW**( A_SALT - 1.d0 ) &
        1377           0 :                 / ( B_SALT**A_SALT * GAMMA( A_SALT ) )
        1378             :             ELSE
        1379           0 :                Inst%F_DI_N_MYI(ND, N) = 0d0
        1380             :             ENDIF
        1381           0 :             Inst%F_DN_N_MYI(ND, N) = Inst%F_DI_N_MYI(ND,N) / (4d0/3d0 * HcoState%Phys%PI &
        1382           0 :                       * 1.d-18 * Inst%SS_DEN( N ) * (D_DRY/2d0)**3)
        1383             :
        1384           0 :             D_SNOW = D_SNOW + DDSNOW
        1385             :          ENDDO
        1386             :
        1387             :          ! for southern hemisphere FYI
        1388             :          D_SNOW = 1.0d0
        1389           0 :          DO ND = 1, NR_MAX
        1390             :             D_DRY =  ( Inst%SSLNT_FYI * RHOICE / (1000.d0 &
        1391           0 :                   * Inst%NumP * RHONACL ) )**( 1d0 / 3d0 ) * D_SNOW
        1392             :
        1393           0 :             IF (D_DRY .ge. R0*2d0 .and. D_DRY .le. R1*2d0 ) THEN
        1394             :           ! Midpoint of IRth bin
        1395           0 :                Inst%F_DI_S_FYI(ND, N) = EXP( - D_SNOW / B_SALT ) &
        1396             :                 * D_SNOW**( A_SALT - 1.d0 ) &
        1397           0 :                 / ( B_SALT**A_SALT * GAMMA( A_SALT ) )
        1398             :             ELSE
        1399           0 :                Inst%F_DI_S_FYI(ND, N) = 0d0
        1400             :             ENDIF
        1401           0 :             Inst%F_DN_S_FYI(ND, N) = Inst%F_DI_S_FYI(ND,N)/ (4d0/3d0 * HcoState%Phys%PI &
        1402           0 :                       * 1.d-18 * Inst%SS_DEN( N ) * (D_DRY/2d0)**3)
        1403           0 :             D_SNOW = D_SNOW + DDSNOW
        1404             :          ENDDO
        1405             :
        1406             :          ! for southern hemisphere MYI
        1407             :          D_SNOW = 1.0d0
        1408           0 :          DO ND = 1, NR_MAX
        1409             :             D_DRY =  ( Inst%SSLNT_MYI * RHOICE / (1000.d0 &
        1410           0 :                   * Inst%NumP * RHONACL ) )**( 1d0 / 3d0 ) * D_SNOW
        1411             :
        1412           0 :             IF (D_DRY .ge. R0*2d0 .and. D_DRY .le. R1*2d0 ) THEN
        1413             :           ! Midpoint of IRth bin
        1414           0 :                Inst%F_DI_S_MYI(ND, N) = EXP( - D_SNOW / B_SALT ) &
        1415             :                 * D_SNOW**( A_SALT - 1.d0 ) &
        1416           0 :                 / ( B_SALT**A_SALT * GAMMA( A_SALT ) )
        1417             :             ELSE
        1418           0 :                Inst%F_DI_S_MYI(ND, N) = 0d0
        1419             :             ENDIF
        1420           0 :             Inst%F_DN_S_MYI(ND, N) = Inst%F_DI_S_MYI(ND,N)/ (4d0/3d0 * HcoState%Phys%PI &
        1421           0 :                       * 1.d-18 * Inst%SS_DEN( N ) * (D_DRY/2d0)**3)
        1422           0 :             D_SNOW = D_SNOW + DDSNOW
        1423             :          ENDDO
        1424             :
        1425             :        ENDIF
        1426             :
        1427             :     ENDDO !N
        1428             :
        1429             :     !=======================================================================
        1430             :     ! Create diagnostics. The number densities of both modes are always
        1431             :     ! written into a diagnostics so that they can be used by other routines
        1432             :     ! and from outside of HEMCO. These diagnostics just hold a pointer
        1433             :     ! to the respective density arrays filled by the run method of this
        1434             :     ! module.
        1435             :     !=======================================================================
        1436             :     CALL Diagn_Create ( HcoState   = HcoState,              &
        1437             :                         cName      = 'SEASALT_DENS_FINE',   &
        1438             :                         ExtNr      = Inst%ExtNrSS,          &
        1439             :                         Cat        = -1,                    &
        1440             :                         Hier       = -1,                    &
        1441             :                         HcoID      = Inst%IDTSALA,          &
        1442             :                         SpaceDim   = 2,                     &
        1443             :                         OutUnit    = 'number_dens',         &
        1444             :                         AutoFill   = 0,                     &
        1445             :                         Trgt2D     = Inst%NDENS_SALA,       &
        1446             :                         COL = HcoState%Diagn%HcoDiagnIDManual, &
        1447           0 :                         RC         = RC                      )
        1448           0 :     IF ( RC /= HCO_SUCCESS ) THEN
        1449           0 :         CALL HCO_ERROR( 'ERROR 18', RC, THISLOC=LOC )
        1450           0 :         RETURN
        1451             :     ENDIF
        1452             :
        1453             :     CALL Diagn_Create ( HcoState   = HcoState,              &
        1454             :                         cName      = 'SEASALT_DENS_COARSE', &
        1455             :                         ExtNr      = Inst%ExtNrSS,          &
        1456             :                         Cat        = -1,                    &
        1457             :                         Hier       = -1,                    &
        1458             :                         HcoID      = Inst%IDTSALC,          &
        1459             :                         SpaceDim   = 2,                     &
        1460             :                         OutUnit    = 'number_dens',         &
        1461             :                         AutoFill   = 0,                     &
        1462             :                         Trgt2D     = Inst%NDENS_SALC,       &
        1463             :                         COL = HcoState%Diagn%HcoDiagnIDManual, &
        1464           0 :                         RC         = RC                      )
        1465           0 :     IF ( RC /= HCO_SUCCESS ) THEN
        1466           0 :         CALL HCO_ERROR( 'ERROR 19', RC, THISLOC=LOC )
        1467           0 :         RETURN
        1468             :     ENDIF
        1469             :
        1470             :     ! Create marine density diagnostics only if marine POA enabled
        1471           0 :     IF ( HcoState%MarinePOA ) THEN
        1472             :
        1473             :        CALL Diagn_Create ( HcoState   = HcoState,              &
        1474             :                            cName      = 'SEASALT_DENS_PHOBIC', &
        1475             :                            ExtNr      = Inst%ExtNrSS,         &
        1476             :                            Cat        = -1,                    &
        1477             :                            Hier       = -1,                    &
        1478             :                            HcoID      = Inst%IDTMOPO,          &
        1479             :                            SpaceDim   = 2,                     &
        1480             :                            OutUnit    = 'number_dens',         &
        1481             :                            AutoFill   = 0,                     &
        1482             :                            Trgt2D     = Inst%NDENS_MOPO,       &
        1483             :                            COL = HcoState%Diagn%HcoDiagnIDManual, &
        1484           0 :                            RC         = RC                      )
        1485           0 :        IF ( RC /= HCO_SUCCESS ) THEN
        1486           0 :            CALL HCO_ERROR( 'ERROR 20', RC, THISLOC=LOC )
        1487           0 :            RETURN
        1488             :        ENDIF
        1489             :
        1490             :        CALL Diagn_Create ( HcoState   = HcoState,              &
        1491             :                            cName      = 'SEASALT_DENS_PHILIC', &
        1492             :                            ExtNr      = Inst%ExtNrSS,          &
        1493             :                            Cat        = -1,                    &
        1494             :                            Hier       = -1,                    &
        1495             :                            HcoID      = Inst%IDTMOPI,          &
        1496             :                            SpaceDim   = 2,                     &
        1497             :                            OutUnit    = 'number_dens',         &
        1498             :                            AutoFill   = 0,                     &
        1499             :                            Trgt2D     = Inst%NDENS_MOPI,       &
        1500             :                            COL = HcoState%Diagn%HcoDiagnIDManual, &
        1501           0 :                            RC         = RC                      )
        1502           0 :        IF ( RC /= HCO_SUCCESS ) THEN
        1503           0 :            CALL HCO_ERROR( 'ERROR 21', RC, THISLOC=LOC )
        1504           0 :            RETURN
        1505             :        ENDIF
        1506             :
        1507             :     ENDIF
        1508             :
        1509             :     !=======================================================================
        1510             :     ! Activate this module and the fields of ExtState that it uses
        1511             :     !=======================================================================
        1512             :
        1513             :     ! Activate met fields used by this module
        1514           0 :     ExtState%TSKIN%DoUse    = .TRUE.
        1515           0 :     ExtState%U10M%DoUse     = .TRUE.
        1516           0 :     ExtState%V10M%DoUse     = .TRUE.
        1517           0 :     ExtState%FROCEAN%DoUse  = .TRUE.
        1518           0 :     ExtState%FRSEAICE%DoUse = .TRUE.
        1519             :
        1520             :     ! for blowing snow
        1521           0 :     IF ( Inst%EmitSnowSS ) THEN
        1522           0 :        ExtState%USTAR%DoUse = .TRUE.
        1523           0 :        ExtState%T2M%DoUse   = .TRUE.
        1524           0 :        ExtState%QV2M%DoUse  = .TRUE.
        1525             :     ENDIF
        1526             :
        1527             :     ! Return w/ success
        1528           0 :     IF ( ALLOCATED(HcoIDsSS    ) ) DEALLOCATE(HcoIDsSS    )
        1529           0 :     IF ( ALLOCATED(SpcNamesSS  ) ) DEALLOCATE(SpcNamesSS  )
        1530             :
        1531           0 :     CALL HCO_LEAVE( HcoState%Config%Err,RC )
        1532             :
        1533           0 :   END SUBROUTINE HCOX_SeaSalt_Init
        1534             : !EOC
        1535             : !------------------------------------------------------------------------------
        1536             : !                   Harmonized Emissions Component (HEMCO)                    !
        1537             : !------------------------------------------------------------------------------
        1538             : !BOP
        1539             : !
        1540             : ! !IROUTINE: HCOX_SeaSalt_Final
        1541             : !
        1542             : ! !DESCRIPTION: Subroutine HcoX\_SeaSalt\_Final deallocates
        1543             : !  all module arrays.
        1544             : !\\
        1545             : !\\
        1546             : ! !INTERFACE:
        1547             : !
        1548           0 :   SUBROUTINE HCOX_SeaSalt_Final ( ExtState )
        1549             : !
        1550             : ! !INPUT PARAMETERS:
        1551             : !
        1552             :     TYPE(Ext_State),  POINTER       :: ExtState   ! Module options
        1553             : !
        1554             : ! !REVISION HISTORY:
        1555             : !  15 Dec 2013 - C. Keller - Initial version
        1556             : !  See https://github.com/geoschem/hemco for complete history
        1557             : !EOP
        1558             : !------------------------------------------------------------------------------
        1559             : !BOC
        1560             : !
        1561             :     !=================================================================
        1562             :     ! HCOX_SeaSalt_Final begins here!
        1563             :     !=================================================================
        1564           0 :     CALL InstRemove ( ExtState%SeaSalt )
        1565             :
        1566           0 :   END SUBROUTINE HCOX_SeaSalt_Final
        1567             : !EOC
        1568             : !------------------------------------------------------------------------------
        1569             : !                   Harmonized Emissions Component (HEMCO)                    !
        1570             : !------------------------------------------------------------------------------
        1571             : !BOP
        1572             : !
        1573             : ! !IROUTINE: InstGet
        1574             : !
        1575             : ! !DESCRIPTION: Subroutine InstGet returns a poiner to the desired instance.
        1576             : !\\
        1577             : !\\
        1578             : ! !INTERFACE:
        1579             : !
        1580           0 :   SUBROUTINE InstGet ( Instance, Inst, RC, PrevInst )
        1581             : !
        1582             : ! !INPUT PARAMETERS:
        1583             : !
        1584             :     INTEGER                             :: Instance
        1585             :     TYPE(MyInst),     POINTER           :: Inst
        1586             :     INTEGER                             :: RC
        1587             :     TYPE(MyInst),     POINTER, OPTIONAL :: PrevInst
        1588             : !
        1589             : ! !REVISION HISTORY:
        1590             : !  18 Feb 2016 - C. Keller   - Initial version
        1591             : !  See https://github.com/geoschem/hemco for complete history
        1592             : !EOP
        1593             : !------------------------------------------------------------------------------
        1594             : !BOC
        1595             :     TYPE(MyInst),     POINTER    :: PrvInst
        1596             :
        1597             :     !=================================================================
        1598             :     ! InstGet begins here!
        1599             :     !=================================================================
        1600             :
        1601             :     ! Get instance. Also archive previous instance.
        1602           0 :     PrvInst => NULL()
        1603           0 :     Inst    => AllInst
        1604           0 :     DO WHILE ( ASSOCIATED(Inst) )
        1605           0 :        IF ( Inst%Instance == Instance ) EXIT
        1606           0 :        PrvInst => Inst
        1607           0 :        Inst    => Inst%NextInst
        1608             :     END DO
        1609           0 :     IF ( .NOT. ASSOCIATED( Inst ) ) THEN
        1610           0 :        RC = HCO_FAIL
        1611           0 :        RETURN
        1612             :     ENDIF
        1613             :
        1614             :     ! Pass output arguments
        1615           0 :     IF ( PRESENT(PrevInst) ) PrevInst => PrvInst
        1616             :
        1617             :     ! Cleanup & Return
        1618           0 :     PrvInst => NULL()
        1619           0 :     RC = HCO_SUCCESS
        1620             :
        1621             :   END SUBROUTINE InstGet
        1622             : !EOC
        1623             : !------------------------------------------------------------------------------
        1624             : !                   Harmonized Emissions Component (HEMCO)                    !
        1625             : !------------------------------------------------------------------------------
        1626             : !BOP
        1627             : !
        1628             : ! !IROUTINE: InstCreate
        1629             : !
        1630             : ! !DESCRIPTION: Subroutine InstCreate creates a new instance.
        1631             : !\\
        1632             : !\\
        1633             : ! !INTERFACE:
        1634             : !
        1635           0 :   SUBROUTINE InstCreate ( ExtNr, Instance, Inst, RC )
        1636             : !
        1637             : ! !INPUT PARAMETERS:
        1638             : !
        1639             :     INTEGER,       INTENT(IN)       :: ExtNr
        1640             : !
        1641             : ! !OUTPUT PARAMETERS:
        1642             : !
        1643             :     INTEGER,       INTENT(  OUT)    :: Instance
        1644             :     TYPE(MyInst),  POINTER          :: Inst
        1645             : !
        1646             : ! !INPUT/OUTPUT PARAMETERS:
        1647             : !
        1648             :     INTEGER,       INTENT(INOUT)    :: RC
        1649             : !
        1650             : ! !REVISION HISTORY:
        1651             : !  18 Feb 2016 - C. Keller   - Initial version
        1652             : !  See https://github.com/geoschem/hemco for complete history
        1653             : !EOP
        1654             : !------------------------------------------------------------------------------
        1655             : !BOC
        1656             :     TYPE(MyInst), POINTER          :: TmpInst
        1657             :     INTEGER                        :: nnInst
        1658             :
        1659             :     !=================================================================
        1660             :     ! InstCreate begins here!
        1661             :     !=================================================================
        1662             :
        1663             :     ! ----------------------------------------------------------------
        1664             :     ! Generic instance initialization
        1665             :     ! ----------------------------------------------------------------
        1666             :     ! Initialize
        1667           0 :     Inst => NULL()
        1668             :
        1669             :     ! Get number of already existing instances
        1670           0 :     TmpInst => AllInst
        1671           0 :     nnInst = 0
        1672           0 :     DO WHILE ( ASSOCIATED(TmpInst) )
        1673           0 :        nnInst  =  nnInst + 1
        1674           0 :        TmpInst => TmpInst%NextInst
        1675             :     END DO
        1676             :
        1677             :     ! Create new instance
        1678           0 :     ALLOCATE(Inst)
        1679           0 :     Inst%Instance = nnInst + 1
        1680           0 :     Inst%ExtNr    = ExtNr
        1681             :
        1682             :     ! Init values
        1683           0 :     Inst%ExtNrSS       = -1
        1684           0 :     Inst%IDTSALA       = -1
        1685           0 :     Inst%IDTSALC       = -1
        1686           0 :     Inst%IDTMOPI       = -1
        1687           0 :     Inst%IDTMOPO       = -1
        1688           0 :     Inst%IDTBrSALA     = -1
        1689           0 :     Inst%IDTBrSALC     = -1
        1690           0 :     Inst%CalcBrSalt    = .FALSE.
        1691           0 :     Inst%BrContent     = 1.0
        1692           0 :     Inst%WindScale     = 1.0
        1693           0 :     Inst%ColdSST       = .FALSE.
        1694           0 :     Inst%EmitSnowSS    = .FALSE.
        1695           0 :     Inst%NSLNT_FYI     = 0.0
        1696           0 :     Inst%NSLNT_MYI     = 0.0
        1697           0 :     Inst%SSLNT_FYI     = 0.0
        1698           0 :     Inst%SSLNT_MYI     = 0.0
        1699           0 :     Inst%NAGE          = 0.0
        1700           0 :     Inst%SAGE          = 0.0
        1701           0 :     Inst%NumP            = 1.0
        1702             :
        1703             :     ! Attach to instance list
        1704           0 :     Inst%NextInst => AllInst
        1705           0 :     AllInst       => Inst
        1706             :
        1707             :     ! Update output instance
        1708           0 :     Instance = Inst%Instance
        1709             :
        1710             :     ! ----------------------------------------------------------------
        1711             :     ! Type specific initialization statements follow below
        1712             :     ! ----------------------------------------------------------------
        1713             :
        1714             :     ! Return w/ success
        1715           0 :     RC = HCO_SUCCESS
        1716             :
        1717           0 :   END SUBROUTINE InstCreate
        1718             : !EOC
        1719             : !------------------------------------------------------------------------------
        1720             : !                   Harmonized Emissions Component (HEMCO)                    !
        1721             : !------------------------------------------------------------------------------
        1722             : !BOP
        1723             : !
        1724             : ! !IROUTINE: InstRemove
        1725             : !
        1726             : ! !DESCRIPTION: Subroutine InstRemove creates a new instance.
        1727             : !\\
        1728             : !\\
        1729             : ! !INTERFACE:
        1730             : !
        1731           0 :   SUBROUTINE InstRemove ( Instance )
        1732             : !
        1733             : ! !INPUT PARAMETERS:
        1734             : !
        1735             :     INTEGER                         :: Instance
        1736             : !
        1737             : ! !REVISION HISTORY:
        1738             : !  18 Feb 2016 - C. Keller   - Initial version
        1739             : !  See https://github.com/geoschem/hemco for complete history
        1740             : !EOP
        1741             : !------------------------------------------------------------------------------
        1742             : !BOC
        1743             :     INTEGER                     :: RC
        1744             :     TYPE(MyInst), POINTER       :: PrevInst
        1745             :     TYPE(MyInst), POINTER       :: Inst
        1746             :
        1747             :     !=================================================================
        1748             :     ! InstRemove begins here!
        1749             :     !=================================================================
        1750             :
        1751             :     ! Init
        1752           0 :     PrevInst => NULL()
        1753           0 :     Inst     => NULL()
        1754             :
        1755             :     ! Get instance. Also archive previous instance.
        1756           0 :     CALL InstGet ( Instance, Inst, RC, PrevInst=PrevInst )
        1757             :
        1758             :     ! Instance-specific deallocation
        1759           0 :     IF ( ASSOCIATED(Inst) ) THEN
        1760             :
        1761             :        !---------------------------------------------------------------------
        1762             :        ! Deallocate fields of Inst before popping off from the list
        1763             :        ! in order to avoid memory leaks (Bob Yantosca (17 Aug 2022)
        1764             :        !---------------------------------------------------------------------
        1765           0 :        IF ( ASSOCIATED( Inst%NR ) ) THEN
        1766           0 :           DEALLOCATE( Inst%NR )
        1767             :        ENDIF
        1768           0 :        Inst%NR => NULL()
        1769             :
        1770           0 :        IF ( ASSOCIATED( Inst%SS_DEN ) ) THEN
        1771           0 :           DEALLOCATE( Inst%SS_DEN )
        1772             :        ENDIF
        1773           0 :        Inst%SS_DEN => NULL()
        1774             :
        1775           0 :        IF ( ASSOCIATED( Inst%SRRC ) ) THEN
        1776           0 :           DEALLOCATE( Inst%SRRC )
        1777             :        ENDIF
        1778           0 :        Inst%SRRC => NULL()
        1779             :
        1780           0 :        IF ( ASSOCIATED( Inst%SRRC_N ) ) THEN
        1781           0 :           DEALLOCATE( Inst%SRRC_N )
        1782             :        ENDIF
        1783           0 :        Inst%SRRC_N => NULL()
        1784             :
        1785           0 :        IF ( ASSOCIATED( Inst%RREDGE ) ) THEN
        1786           0 :           DEALLOCATE( Inst%RREDGE )
        1787             :        ENDIF
        1788           0 :        Inst%RREDGE => NULL()
        1789             :
        1790           0 :        IF ( ASSOCIATED( Inst%RRMID  ) ) THEN
        1791           0 :           DEALLOCATE( Inst%RRMID )
        1792             :        ENDIF
        1793           0 :        Inst%RRMID => NULL()
        1794             :
        1795           0 :        IF ( ASSOCIATED( Inst%NDENS_SALA ) ) THEN
        1796           0 :           DEALLOCATE( Inst%NDENS_SALA )
        1797             :        ENDIF
        1798           0 :        Inst%NDENS_SALA => NULL()
        1799             :
        1800           0 :        IF ( ASSOCIATED( Inst%NDENS_SALC ) ) THEN
        1801           0 :           DEALLOCATE( Inst%NDENS_SALC )
        1802             :        ENDIF
        1803           0 :        Inst%NDENS_SALC => NULL()
        1804             :
        1805           0 :        IF ( ASSOCIATED( Inst%NDENS_MOPO ) ) THEN
        1806           0 :           DEALLOCATE( Inst%NDENS_MOPO )
        1807             :        ENDIF
        1808           0 :        Inst%NDENS_MOPO => NULL()
        1809             :
        1810           0 :        IF ( ASSOCIATED( Inst%NDENS_MOPI ) ) THEN
        1811           0 :           DEALLOCATE( Inst%NDENS_MOPI )
        1812             :        ENDIF
        1813           0 :        Inst%NDENS_MOPI => NULL()
        1814             :
        1815           0 :        IF ( ASSOCIATED( Inst%CHLR ) ) THEN
        1816           0 :           DEALLOCATE( Inst%CHLR )
        1817             :        ENDIF
        1818           0 :        Inst%CHLR => NULL()
        1819             :
        1820           0 :        IF ( ASSOCIATED( Inst%F_DI_N_FYI ) ) THEN
        1821           0 :           DEALLOCATE( Inst%F_DI_N_FYI )
        1822             :        ENDIF
        1823           0 :        Inst%F_DI_N_FYI => NULL()
        1824             :
        1825           0 :        IF ( ASSOCIATED( Inst%F_DI_N_MYI ) ) THEN
        1826           0 :           DEALLOCATE( Inst%F_DI_N_MYI )
        1827             :        ENDIF
        1828           0 :        Inst%F_DI_N_MYI => NULL()
        1829             :
        1830           0 :        IF ( ASSOCIATED( Inst%F_DI_S_FYI ) ) THEN
        1831           0 :           DEALLOCATE( Inst%F_DI_S_FYI )
        1832             :        ENDIF
        1833           0 :        Inst%F_DI_S_FYI => NULL()
        1834             :
        1835           0 :        IF ( ASSOCIATED( Inst%F_DI_S_MYI ) ) THEN
        1836           0 :           DEALLOCATE( Inst%F_DI_S_MYI )
        1837             :        ENDIF
        1838           0 :        Inst%F_DI_S_MYI => NULL()
        1839             :
        1840           0 :        IF ( ASSOCIATED( Inst%F_DN_N_FYI ) ) THEN
        1841           0 :           DEALLOCATE( Inst%F_DN_N_FYI )
        1842             :        ENDIF
        1843           0 :        Inst%F_DN_N_FYI => NULL()
        1844             :
        1845           0 :        IF ( ASSOCIATED( Inst%F_DN_N_MYI ) ) THEN
        1846           0 :           DEALLOCATE( Inst%F_DN_N_MYI )
        1847             :        ENDIF
        1848           0 :        Inst%F_DN_N_MYI => NULL()
        1849             :
        1850           0 :        IF ( ASSOCIATED( Inst%F_DN_S_FYI ) ) THEN
        1851           0 :           DEALLOCATE( Inst%F_DN_S_FYI )
        1852             :        ENDIF
        1853           0 :        Inst%F_DN_S_FYI => NULL()
        1854             :
        1855           0 :        IF ( ASSOCIATED( Inst%F_DN_S_MYI ) ) THEN
        1856           0 :           DEALLOCATE( Inst%F_DN_S_MYI )
        1857             :        ENDIF
        1858           0 :        Inst%F_DN_S_MYI => NULL()
        1859             :
        1860           0 :        IF ( ASSOCIATED( Inst%MULTIICE ) ) THEN
        1861           0 :           DEALLOCATE( Inst%MULTIICE )
        1862             :        ENDIF
        1863           0 :        Inst%MULTIICE => NULL()
        1864             :
        1865             :        !---------------------------------------------------------------------
        1866             :        ! Pop off instance from list
        1867             :        !---------------------------------------------------------------------
        1868           0 :        IF ( ASSOCIATED(PrevInst) ) THEN
        1869           0 :           PrevInst%NextInst => Inst%NextInst
        1870             :        ELSE
        1871           0 :           AllInst => Inst%NextInst
        1872             :        ENDIF
        1873           0 :        DEALLOCATE(Inst)
        1874             :     ENDIF
        1875             :
        1876             :     ! Free pointers before exiting
        1877           0 :     PrevInst => NULL()
        1878           0 :     Inst     => NULL()
        1879             :
        1880           0 :    END SUBROUTINE InstRemove
        1881             : !EOC
        1882           0 : END MODULE HCOX_SeaSalt_Mod

Generated by: LCOV version 1.14