!------------------------------------------------------------------------------ ! Harmonized Emissions Component (HEMCO) ! !------------------------------------------------------------------------------ !BOP ! ! !MODULE: hcox_seasalt_mod.F90 ! ! !DESCRIPTION: Module HCOX\_SeaSalt\_Mod contains routines to calculate ! sea salt aerosol emissions, following the implementation in GEOS-Chem. ! Emission number densities of the fine and coarse mode sea salt aerosols ! are written into diagnostic containers `SEASALT\_DENS\_FINE` and ! `SEASALT\_DENS\_COARSE`, respectively. !\\ !\\ ! This is a HEMCO extension module that uses many of the HEMCO core ! utilities. !\\ !\\ ! !INTERFACE: ! MODULE HCOX_SeaSalt_Mod ! ! !USES: ! USE HCO_Error_Mod USE HCO_Diagn_Mod USE HCO_State_Mod, ONLY : HCO_State USE HCOX_State_Mod, ONLY : Ext_State IMPLICIT NONE PRIVATE ! ! !PUBLIC MEMBER FUNCTIONS: ! PUBLIC :: HCOX_SeaSalt_Init PUBLIC :: HCOX_SeaSalt_Run PUBLIC :: HCOX_SeaSalt_Final ! ! !REVISION HISTORY: ! 15 Dec 2013 - C. Keller - Now a HEMCO extension module ! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ ! ! !PRIVATE TYPES: ! TYPE :: MyInst ! Tracer IDs INTEGER :: Instance INTEGER :: ExtNr ! Tracer IDs INTEGER :: ExtNrSS ! Extension number for seasalt INTEGER :: IDTSALA ! Fine aerosol model species ID INTEGER :: IDTSALC ! Coarse aerosol model species ID INTEGER :: IDTMOPO ! marine organic aerosol - phobic INTEGER :: IDTMOPI ! marine organic aerosol - philic INTEGER :: IDTBrSALA ! Br- in accum. sea salt aerosol INTEGER :: IDTBrSALC ! Br- in coarse sea salt aerosol LOGICAL :: CalcBrSalt ! Calculate Br- content? LOGICAL :: EmitSnowSS ! Calculate sea salt emission blowing snow LOGICAL :: ColdSST ! Flag to correct SSA emissions over cold waters INTEGER :: IDTSALACL ! Fine aerosol Chloride species ID INTEGER :: IDTSALCCL ! Coarse aerosol Chloride species ID INTEGER :: IDTSALAAL ! Fine SSA Alkalinity species ID INTEGER :: IDTSALCAL ! Coarse SSA Alkalinity species ID ! Scale factors REAL*8 :: BrContent ! Ratio of Br- to dry SSA (mass) REAL*8 :: WindScale ! Wind adjustment factor REAL*8 :: NSLNT_FYI ! North Hemisphere snow salinity on first year ice (FYI) (psu) REAL*8 :: NSLNT_MYI ! North Hemisphere snow salinity on multiyear ice (MYI) (psu) REAL*8 :: SSLNT_FYI ! South Hemisphere snow salinity on FYI (psu) REAL*8 :: SSLNT_MYI ! South Hemisphere snow salinity on MYI (psu) REAL*8 :: NAGE ! North Hemisphere snow age (days) REAL*8 :: SAGE ! South Hemisphere snow age (days) REAL*8 :: NumP ! number of particle per snowflake ! Module variables INTEGER :: NSALT ! # of seasalt tracers INTEGER, POINTER :: NR(:) ! Size bin information REAL*8, POINTER :: SRRC (:,:) REAL*8, POINTER :: SRRC_N(:,:) REAL*8, POINTER :: RREDGE(:,:) REAL*8, POINTER :: RRMID (:,:) REAL*8, POINTER :: SS_DEN(:) ! densities REAL*8, POINTER :: F_DI_N_FYI(:,:) ! add for blowing snow for NH REAL*8, POINTER :: F_DI_N_MYI(:,:) ! add for blowing snow for NH REAL*8, POINTER :: F_DI_S_FYI(:,:) ! add for blowing snow for SH REAL*8, POINTER :: F_DI_S_MYI(:,:) ! add for blowing snow for SH REAL*8, POINTER :: F_DN_N_FYI(:,:) ! add for blowing snow for NH REAL*8, POINTER :: F_DN_N_MYI(:,:) ! add for blowing snow for NH REAL*8, POINTER :: F_DN_S_FYI(:,:) ! add for blowing snow for SH REAL*8, POINTER :: F_DN_S_MYI(:,:) ! add for blowing snow for SH ! Number densities REAL(sp), POINTER :: NDENS_SALA(:,:) => NULL() REAL(sp), POINTER :: NDENS_SALC(:,:) => NULL() REAL(sp), POINTER :: NDENS_MOPO(:,:) => NULL() REAL(sp), POINTER :: NDENS_MOPI(:,:) => NULL() REAL(sp), POINTER :: MULTIICE(:,:) => NULL() ! add for blowing snow ! MODIS Chlorophyll-A REAL(hp), POINTER :: CHLR(:,:) => NULL() TYPE(MyInst), POINTER :: NextInst => NULL() END TYPE MyInst ! Pointer to instances TYPE(MyInst), POINTER :: AllInst => NULL() ! ! !DEFINED PARAMETERS: ! INTEGER, PARAMETER :: NR_MAX = 200 ! max. # of bins per mode ! Increment of radius for Emission integration (um) REAL*8, PARAMETER :: DR = 5.d-2 REAL*8, PARAMETER :: BETHA = 2.d0 CONTAINS !EOC !------------------------------------------------------------------------------- ! Harmonized Emissions Component (HEMCO) ! !------------------------------------------------------------------------------ !BOP ! ! !IROUTINE: HCOX_SeaSalt_Run ! ! !DESCRIPTION: Subroutine HcoX\_SeaSalt\_Run is the driver run routine to ! calculate SeaSalt emissions in HEMCO. !\\ !\\ ! !INTERFACE: ! SUBROUTINE HCOX_SeaSalt_Run( ExtState, HcoState, RC ) ! ! !USES: ! USE HCO_Calc_Mod, ONLY : HCO_EvalFld USE HCO_FluxArr_Mod, ONLY : HCO_EmisAdd ! ! !INPUT PARAMETERS: ! TYPE(HCO_State), POINTER :: HcoState ! Output obj TYPE(Ext_State), POINTER :: ExtState ! Module options ! ! !INPUT/OUTPUT PARAMETERS: ! INTEGER, INTENT(INOUT) :: RC ! Success or failure? ! ! !REMARKS: ! References: ! ============================================================================ ! (1 ) Chin, M., P. Ginoux, S. Kinne, B. Holben, B. Duncan, R. Martin, ! J. Logan, A. Higurashi, and T. Nakajima, "Tropospheric aerosol ! optical thickness from the GOCART model and comparisons with ! satellite and sunphotometers measurements", J. Atmos Sci., 2001. ! (2 ) Gong, S., L. Barrie, and J.-P. Blanchet, "Modeling sea-salt ! aerosols in the atmosphere. 1. Model development", J. Geophys. Res., ! v. 102, 3805-3818, 1997. ! (3 ) Gong, S. L., "A parameterization of sea-salt aerosol source function ! for sub- and super-micron particles", Global Biogeochem. Cy., 17(4), ! 1097, doi:10.1029/2003GB002079, 2003. ! (4 ) Jaegle, L., P.K. Quinn, T.S. Bates, B. Alexander, J.-T. Lin, "Global ! distribution of sea salt aerosols: New constraints from in situ and ! remote sensing observations", Atmos. Chem. Phys., 11, 3137-3157, ! doi:10.5194/acp-11-3137-2011. ! (5 ) Huang, J., Jaeglé, L., "Wintertime enhancements of sea salt aerosol in ! polar regions consistent with a sea ice source from blowing snow." ! Atmos. Chem. Phys. 17, 3699–3712. https://doi.org/10.5194/acp-17-3699-2017, 2017. ! (6 ) Huang, J., Jaeglé, L., Chen, Q., Alexander, B., Sherwen, T., ! Evans, M. J., Theys, N., and Choi, S. "Evaluating the impact of ! blowing snow sea salt aerosol on springtime BrO and O3 in the Arctic, ! Atmos. Chem. Phys. Discuss., https://doi.org/10.5194/acp-2019-1094, 2020. ! (7 ) Tschudi, M., W. N. Meier, J. S. Stewart, C. Fowler, and J. Maslanik. ! "EASE-Grid Sea Ice Age, Version 4." NASA National Snow and Ice Data Center ! Distributed Active Archive Center. doi: https://doi.org/10.5067/UTAV7490FEPB., 2019. ! ! !REVISION HISTORY: ! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC ! ! !LOCAL VARIABLES: ! TYPE(MyInst), POINTER :: Inst INTEGER :: I, J, N, R REAL*8 :: SALT, SALT_N, CHLR REAL*8 :: A_M2 REAL*8 :: W10M REAL :: FLUX REAL(hp), TARGET :: FLUXSALA (HcoState%NX,HcoState%NY) REAL(hp), TARGET :: FLUXSALC (HcoState%NX,HcoState%NY) REAL(hp), TARGET :: FLUXBrSalA(HcoState%NX,HcoState%NY) REAL(hp), TARGET :: FLUXBrSalC(HcoState%NX,HcoState%NY) REAL(hp), TARGET :: FLUXMOPO (HcoState%NX,HcoState%NY) REAL(hp), TARGET :: FLUXMOPI (HcoState%NX,HcoState%NY) REAL(hp), TARGET :: FLUXSALACL(HcoState%NX,HcoState%NY) REAL(hp), TARGET :: FLUXSALCCL(HcoState%NX,HcoState%NY) REAL(hp), TARGET :: FLUXSALAAL(HcoState%NX,HcoState%NY) REAL(hp), TARGET :: FLUXSALCAL(HcoState%NX,HcoState%NY) ! New variables (jaegle 5/11/11) REAL*8 :: SST, SCALE ! jpp, 3/2/10 REAL*8 :: SALT_NR ! B. Gantt, M. Johnson (7,9/15) REAL*8 :: OMSS1, OMSS2 ! New variables for blowing snow (huang, 04/09/20) REAL*8 :: SNOWSALT REAL*8 :: FROPEN, FRFIRST REAL*8 :: FRICTVEL, WVMR, TEMP REAL*8 :: PRESS, P_ICE, RH_ICE REAL*8 :: D, FK, FD REAL*8 :: PSI, QSPRIME, UT, APRIM REAL*8 :: QS, QSNOWICE_FYI, QSNOWICE_MYI,QBSALT, QB0 REAL*8 :: SLNT, SLNT_FYI, SLNT_MYI REAL*8 :: AGE, ISFROST ! New parameters for blowiung snow (huang, 04/09/20) REAL*8, PARAMETER :: LS = 2839d3 ! Latent heat of sublimation @ T=-30C (J/kg). ! Varies very little with Temperature REAL*8, PARAMETER :: RV = 461.5d0 !J kg-1 K-1 REAL*8, PARAMETER :: RHONACL = 2160.0d0 !kg/m3 REAL*8, PARAMETER :: RHOICE = 900.0d0 !kg/m3 REAL*8, PARAMETER :: K = 2.16d-2 !J m-1 s-1 K-1 REAL*8, PARAMETER :: A0 = 3.78407d-1 REAL*8, PARAMETER :: A1 = -8.64089d-2 REAL*8, PARAMETER :: A2 = -1.60570d-2 REAL*8, PARAMETER :: A3 = 7.25516d-4 REAL*8, PARAMETER :: A4 = -1.25650d-1 REAL*8, PARAMETER :: A5 = 2.48430d-2 REAL*8, PARAMETER :: A6 = -9.56871d-4 REAL*8, PARAMETER :: A7 = 1.24600d-2 REAL*8, PARAMETER :: A8 = 1.56862d-3 REAL*8, PARAMETER :: A9 = -2.93002d-4 REAL*8, PARAMETER :: A_SALT = 2.0d0 !from Mann et al. 2000 REAL*8, PARAMETER :: B_SALT = 37.5d0 !in um REAL*8, PARAMETER :: DDSNOW = 2.0d0 !in um for snow particle interval LOGICAL, SAVE :: FIRST = .TRUE. LOGICAL, SAVE :: FIRSTSAL = .TRUE. CHARACTER(LEN=31) :: FLDNME INTEGER :: NDAYS!, cYYYY, cMM, cDD REAL(hp), TARGET :: MULTI(HcoState%NX,HcoState%NY) REAL(hp), TARGET :: SNOWSALA (HcoState%NX,HcoState%NY) REAL(hp), TARGET :: SNOWSALC (HcoState%NX,HcoState%NY) ! Error handling LOGICAL :: ERR CHARACTER(LEN=255) :: MSG, LOC !================================================================= ! HCOX_SeaSalt_Run begins here! !================================================================= LOC = 'HCOX_SeaSalt_Run (HCOX_SEASALT_MOD.F90)' ! Return if extension disabled IF ( ExtState%SeaSalt <= 0 ) RETURN ! Enter CALL HCO_ENTER( HcoState%Config%Err, LOC, RC ) IF ( RC /= HCO_SUCCESS ) THEN CALL HCO_ERROR( 'ERROR 0', RC, THISLOC=LOC ) RETURN ENDIF ! Exit status ERR = .FALSE. ! Get instance Inst => NULL() CALL InstGet ( ExtState%SeaSalt, Inst, RC ) IF ( RC /= HCO_SUCCESS ) THEN WRITE(MSG,*) 'Cannot find SeaSalt instance Nr. ', ExtState%SeaSalt CALL HCO_ERROR(MSG,RC) RETURN ENDIF ! Init values FLUXSALA = 0.0_hp FLUXSALC = 0.0_hp FLUXBrSalA = 0.0_hp FLUXBrSalC = 0.0_hp FLUXMOPO = 0.0_hp FLUXMOPI = 0.0_hp FLUXSALACL = 0.0_hp FLUXSALCCL = 0.0_hp FLUXSALAAL = 0.0_hp FLUXSALCAL = 0.0_hp SNOWSALA = 0.0_hp SNOWSALC = 0.0_hp ! If the marine POA option is on, get the HEMCO pointer to MODIS CHLR IF ( HcoState%MarinePOA ) THEN CALL HCO_EvalFld ( HcoState, 'MODIS_CHLR', Inst%CHLR, RC ) IF ( RC /= HCO_SUCCESS ) THEN WRITE(MSG,*) 'Cannot find MODIS CHLR data for marine POA' CALL HCO_ERROR(MSG, RC) RETURN ENDIF ENDIF IF ( Inst%EmitSnowSS ) THEN ! Read in distribution of multi-year sea ice from ! remotely sensed observations of sea ice motion and sea ! ice extent for the Arctic (Tschudi et al., 2019). For the ! Antarctic, the multi year sea ice extent is based on the minimum ! MERRA-2 sea ice extent of the previous summer. CALL HCO_EvalFld ( HcoState, 'MULTISEAICE', MULTI, RC ) IF ( RC /= HCO_SUCCESS ) THEN WRITE(MSG,*) 'Cannot find MULTISEAICE data for blowing snow' CALL HCO_ERROR(MSG, RC) RETURN ENDIF ENDIF !================================================================= ! Emission is integrated over a given size range for each bin !================================================================= !$OMP PARALLEL DO & !$OMP DEFAULT( SHARED ) & !$OMP PRIVATE( I, J, A_M2, W10M, SST, SCALE, N ) & !$OMP PRIVATE( SALT, SALT_N, R, SALT_NR, RC ) & !$OMP PRIVATE( OMSS1, OMSS2, CHLR ) & !$OMP PRIVATE( FROPEN, SNOWSALT, AGE ) & !$OMP PRIVATE( FRICTVEL, WVMR, TEMP, PRESS, P_ICE, RH_ICE ) & !$OMP PRIVATE( D, FK, FD, PSI, QSPRIME, APRIM, UT, FRFIRST ) & !$OMP PRIVATE( SLNT, SLNT_FYI, SLNT_MYI ) & !$OMP PRIVATE( QBSALT, QB0, QS, QSNOWICE_FYI, QSNOWICE_MYI ) & !$OMP SCHEDULE( DYNAMIC ) ! Loop over surface boxes DO J = 1, HcoState%NY DO I = 1, HcoState%NX ! Grid box surface area on simulation grid [m2] A_M2 = HcoState%Grid%AREA_M2%Val( I, J ) ! Advance to next grid box if it's not over water or sea ice IF ( ExtState%FROCEAN%Arr%Val(I,J) <= 0d0 .and. & ExtState%FRSEAICE%Arr%Val(I,J) <= 0d0 ) CYCLE ! Wind speed at 10 m altitude [m/s] W10M = SQRT( ExtState%U10M%Arr%Val(I,J)**2 & + ExtState%V10M%Arr%Val(I,J)**2 ) ! Sea surface temperature in Celcius (jaegle 5/11/11) SST = ExtState%TSKIN%Arr%Val(I,J) - 273.15d0 ! Limit SST to 0-30C range SST = MAX( SST , 0d0 ) ! limit to 0C SST = MIN( SST , 30d0 ) ! limit to 30C ! Empirical SST scaling factor (jaegle 5/11/11) SCALE = 0.329d0 + 0.0904d0*SST - & 0.00717d0*SST**2d0 + 0.000207d0*SST**3d0 ! Limit the SST scaling factor to 0.25 over cold SST (below 5C) IF ( Inst%ColdSST .and. SST<= 5.0d0 ) SCALE = 0.25d0 ! Reset to using original Gong (2003) emissions (jaegle 6/30/11) !SCALE = 1.0d0 ! Apply to only the open ocean fraction of the gridbox (Huang 06/12/20) FROPEN = ExtState%FROCEAN%Arr%Val(I,J)-ExtState%FRSEAICE%Arr%Val(I,J) IF ( FROPEN < 0d0 ) FROPEN = 0d0 ! Eventually apply wind scaling factor. SCALE = SCALE * Inst%WindScale * FROPEN !---------------------------------------------------------------- ! huang, 04/09/20: Add blowing snow emissions over sea ice !---------------------------------------------------------------- IF ( Inst%EmitSnowSS ) THEN IF ( ExtState%FRSEAICE%Arr%Val(I,J) > 0d0 )THEN ! Friction velocity [m/s] FRICTVEL = ExtState%USTAR%Arr%Val(I,J) ! Convert specific humidity [g H2O/kg air] to water vapor mixing ratio [v/v] ! QV2m is in kg H2O/kg air WVMR = ExtState%QV2M%Arr%Val(I,J) * 28.973d0 / 18.0d0 ! Temperature at 2M in grid box (I,J) [K] TEMP = ExtState%T2M%Arr%Val(I,J) ! Surface pressure at grid box (I,J). Convert from [Pa] to [hPa] PRESS = HcoState%Grid%PSFC%Val( I, J ) /100d0 ! Calculate saturation vapor pressure over ice [in Pa] at temperature ! TS [K] P_ICE = 10d0**(-2663.5d0/TEMP+12.537d0) ! Calculate relative humidity with respect to ice [%] RH_ICE = PRESS * WVMR / (P_ICE*0.01d0) *100.0d0 ! Limit RH to 100% IF (RH_ICE > 100d0) RH_ICE =100.0d0 ! Coefficient of Diffusion of water vapor in air [m2/s] ! Parameterization of Massman, W.J. "A review of teh molecular diffusivities of ! H2O, CO2, CH4... in air, O2 and N2 near STP" Atmos. Env., 32, 6, 1111-1127, 1998. D = 2.178d-5*(1000d0/PRESS)*(TEMP/273.15d0)**1.81 ! Heat conductivity and vapor diffusion terms [m s/kg] ! Rogers and Yau "A short course in cloud physics", 1989, Eqn 9.4, with ! RV = 461.5 [J/kg/K] Individual gas constant for water vapor ! LS = 2839.0*1d3 [J/kg ] Latent heat of sublimation @ T=-30C ! K = 2.16d-2 [J/(m s K)] Coeff of thermal conductivity of Air [Table 7.1 Rogers and Yau] FK = ( LS / (RV * TEMP ) -1d0 ) * LS / (K * TEMP) FD = ( RV * TEMP ) / (D * P_ICE) ! Variable PSI [m2/s] Equation 11 from Dery and Yau (2001) ! RHOICE = 900 kg/m3 Density of ice PSI = (RH_ICE/100.d0 - 1d0)/(2d0 * RHOICE * (FK + FD)) ! Convert PSI from m2/s to units of -1x10d-12 m2/s PSI = PSI * (-1.0d12) ! Qs prime [mm/day snow water equivalent] Equation 11 Dery and Yau (2001) QSPRIME = A0 + A1*PSI + A2*PSI**2d0 + A3*PSI**3d0 & + A4* W10M + A5*PSI*W10M & + A6*W10M*PSI**2d0 + A7*W10M**2d0 & + A8*PSI*W10M**2d0 + A9*W10M**3d0 IF ( QSPRIME < 0.0d0 ) QSPRIME = 0.0d0 !APRIM IF ( HcoState%Grid%YEDGE%Val(I,J) .lt. 0 ) AGE = Inst%SAGE*24.0d0 IF ( HcoState%Grid%YEDGE%Val(I,J) .ge. 0 ) AGE = Inst%NAGE*24.0d0 APRIM = (1.038d0+0.03758d0*AGE-0.00014349d0*AGE**2d0 & + (1.911315d-7*AGE**3d0) )**(-1d0) ! Threshold wind speed [m/s] UT = 6.975d0 + 0.0033d0 * (TEMP - 273.15d0 + 27.27d0 )**2.0d0 !IF (W10M > UT) THEN ! add RH<100 too IF (W10M > UT .and. RH_ICE<100d0) THEN QBSALT = 0.385d0*(1.0d0-Ut/W10M)**2.59d0/FRICTVEL QB0 = 0.385d0*(1d0-6.975d0/W10M)**2.59d0/FRICTVEL ! Snow sublimation rate [kg/m2/s] Equation 1 in Yang et al. (2008) ! The constant 1.1574d-5 converts mm/day column integrated sublimation rate to kg m-2 s-1 QS = 1.1574d-5*APRIM*QSPRIME*QBSALT/QB0 ELSE QS = 0d0 ENDIF !set up the snow salinity IF ( HcoState%Grid%YEDGE%Val(I,J) .lt. 0 ) SLNT_FYI = Inst%SSLNT_FYI IF ( HcoState%Grid%YEDGE%Val(I,J) .lt. 0 ) SLNT_MYI = Inst%SSLNT_MYI IF ( HcoState%Grid%YEDGE%Val(I,J) .ge. 0 ) SLNT_FYI = Inst%NSLNT_FYI IF ( HcoState%Grid%YEDGE%Val(I,J) .ge. 0 ) SLNT_MYI = Inst%NSLNT_MYI ! Sea ice fraction that is first year FRFIRST = ExtState%FRSEAICE%Arr%Val(I,J) - MULTI(I,J) IF ( FRFIRST < 0d0 ) FRFIRST = 0d0 ! Apply FYI salinity to FYI seaice fraction and MYI salinity to MYI fraction !SLNT = SLNT_FYI * FRFIRST + SLNT_MYI * MULTI(I,J) ! Assume MYI salinity is 50% of FYI !SLNT = SLNT * FRFIRST + SLNT * 0.5 * MULTI(I,J) ! Convert snow sublimation rate to sea salt production rate [kg/m2/s] ! Calculate it separately for FYI and MYI, scaled by their respective sea ice fraction QSNOWICE_FYI = QS * SLNT_FYI * FRFIRST / 1000d0 QSNOWICE_MYI = QS * SLNT_MYI * MULTI(I,J) / 1000d0 ELSE QSNOWICE_FYI = 0.0d0 QSNOWICE_MYI = 0.0d0 ENDIF ENDIF ! End of added blowing snow section !----------------------------------------------------------------- ! Do for accumulation and coarse mode, and Marine POA if enabled DO N = 1,Inst%NSALT ! Reset values for SALT, SALT_N, and SNOWSALT SALT = 0d0 SALT_N = 0d0 SNOWSALT = 0d0 ! update seasalt from blowing snow - huang 1/4/18 IF (( Inst%EmitSnowSS ) .and. ( N .LT.3 )) THEN IF ( HcoState%Grid%YEDGE%Val(I,J) .lt. 0 ) THEN ! Southern Hemisphere SALT = SALT + HcoState%TS_EMIS * A_M2 & * ( QSNOWICE_FYI * SUM( Inst%F_DI_S_FYI(:,N) ) + & QSNOWICE_MYI * SUM( Inst%F_DI_S_MYI(:,N) ) ) * DDSNOW SNOWSALT = SNOWSALT + HcoState%TS_EMIS * A_M2 & * ( QSNOWICE_FYI * SUM( Inst%F_DI_S_FYI(:,N) ) + & QSNOWICE_MYI * SUM( Inst%F_DI_S_MYI(:,N) ) ) * DDSNOW SALT_N = SALT_N + HcoState%TS_EMIS * A_M2 & * ( QSNOWICE_FYI * SUM( Inst%F_DN_S_FYI(:,N) ) + & QSNOWICE_MYI * SUM( Inst%F_DN_S_MYI(:,N) ) ) * DDSNOW ELSE ! Northern Hemisphere SALT = SALT + HcoState%TS_EMIS * A_M2 & * ( QSNOWICE_FYI * SUM( Inst%F_DI_N_FYI(:,N) ) + & QSNOWICE_MYI * SUM( Inst%F_DI_N_MYI(:,N) ) ) * DDSNOW SNOWSALT = SNOWSALT + HcoState%TS_EMIS * A_M2 & * ( QSNOWICE_FYI * SUM( Inst%F_DI_N_FYI(:,N) ) + & QSNOWICE_MYI * SUM( Inst%F_DI_N_MYI(:,N) ) ) * DDSNOW SALT_N = SALT_N + HcoState%TS_EMIS * A_M2 & * ( QSNOWICE_FYI * SUM( Inst%F_DN_N_FYI(:,N) ) + & QSNOWICE_MYI * SUM( Inst%F_DN_N_MYI(:,N) ) ) * DDSNOW ENDIF ! ewl: comment out for blowing snow since calcbr2 retired ! ! add bromine blowing snow ! IF ( Inst%CalcBr2 ) THEN ! IF ( HcoState%Grid%YEDGE%Val(I,J) .lt. 0 ) THEN ! SSA_Br2 = SSA_Br2 + HcoState%TS_EMIS * A_M2 & ! * (QSNOWICE_FYI * SUM( Inst%F_DI_S_FYI(:,N) ) + & ! QSNOWICE_MYI * SUM( Inst%F_DI_S_MYI(:,N) ) ) * DDSNOW & ! * 0.00223d0 * 0.7d0 / 2.0d0 ! ELSE ! SSA_Br2 = SSA_Br2 + HcoState%TS_EMIS * A_M2 & ! * (QSNOWICE_FYI * SUM( Inst%F_DI_N_FYI(:,N) ) + & ! QSNOWICE_MYI * SUM( Inst%F_DI_N_MYI(:,N) ) ) * DDSNOW & ! * 0.00223d0 * 0.7d0 / 2.0d0 ! ENDIF ! ENDIF ENDIF ! Loop over size bins DO R = 1, Inst%NR(N) ! Coarse and accumulation modes IF ( N .LT. 3 ) THEN ! Update SeaSalt source into SALT [kg] SALT = SALT + & ( SCALE * Inst%SRRC(R,N) * A_M2 * W10M**3.41d0 ) ! Update SeaSalt source into SALT_N [#] ! (bec, bmy, 4/13/05) SALT_N = SALT_N + & ( SCALE * Inst%SRRC_N(R,N) * A_M2 * W10M**3.41d0 ) ENDIF ! Marine organic aerosols (M. Johnson, B. Gantt) IF ( N .EQ. 3 ) THEN ! Get MODIS Chlorophyll-a CHLR = Inst%CHLR(I,J) ! Calculate organic mass fraction of SSA OMSS1 = 1.0 / ( 1.0 + EXP( -2.63 * 3.0 * CHLR & + 0.18 * 3.0 * W10M ) ) OMSS2 = ( OMSS1 ) / (1.0 + 0.03 & * EXP( 6.81 * ( Inst%RRMID(R,N) * 2.0 ) ) ) & + 0.03 * ( OMSS1 ) ! Update seasalt source into SALT [kg] SALT = SALT + 6.0 * ( ( Inst%SRRC(R,N) * SCALE * A_M2 & * W10M**3.41d0 * OMSS2 ) & * ( 1.0 / ( 2.2 / ( 1.0 - OMSS2 & * (1.0 - 2200.0 / 1000.0 ) ) ) ) ) SALT_N = SALT_N + 6.0 * ( Inst%SRRC_N(R,N) * SCALE * A_M2 & * W10M**3.41d0 * OMSS2 ) ENDIF ENDDO !R ! ---------------------------------------------------------------- ! Pass sea salt emissions do emission array [kg/m2/s] ! ---------------------------------------------------------------- ! kg --> kg/m2/s IF ( N == 1 ) THEN FLUXSALA(I,J) = SALT / A_M2 / HcoState%TS_EMIS SNOWSALA(I,J) = SNOWSALT / A_M2 / HcoState%TS_EMIS ELSEIF ( N == 2 ) THEN FLUXSALC(I,J) = SALT / A_M2 / HcoState%TS_EMIS SNOWSALC(I,J) = SNOWSALT / A_M2 / HcoState%TS_EMIS ELSEIF ( N == 3 ) THEN FLUXMOPO(I,J) = SALT / A_M2 / HcoState%TS_EMIS ELSEIF ( N == 4 ) THEN FLUXMOPI(I,J) = SALT / A_M2 / HcoState%TS_EMIS ENDIF ! ---------------------------------------------------------------- ! Write out number density for diagnostics [#] ! ---------------------------------------------------------------- IF ( N == 1 ) THEN Inst%NDENS_SALA(I,J) = SALT_N ELSEIF ( N == 2 ) THEN Inst%NDENS_SALC(I,J) = SALT_N ELSEIF ( N == 3 ) THEN Inst%NDENS_MOPO(I,J) = SALT_N ELSEIF ( N == 4 ) THEN Inst%NDENS_MOPI(I,J) = SALT_N ENDIF ENDDO !N ENDDO !I ENDDO !J !$OMP END PARALLEL DO ! Check exit status IF ( ERR ) THEN RC = HCO_FAIL RETURN ENDIF !================================================================= ! PASS TO HEMCO STATE AND UPDATE DIAGNOSTICS !================================================================= ! SALA IF ( Inst%IDTSALA > 0 ) THEN ! Add flux to emission array CALL HCO_EmisAdd( HcoState, FLUXSALA, Inst%IDTSALA, & RC, ExtNr=Inst%ExtNrSS ) IF ( RC /= HCO_SUCCESS ) THEN CALL HCO_ERROR( 'HCO_EmisAdd error: FLUXSALA', RC ) RETURN ENDIF ENDIF ! SALC IF ( Inst%IDTSALC > 0 ) THEN ! Add flux to emission array CALL HCO_EmisAdd( HcoState, FLUXSALC, Inst%IDTSALC, & RC, ExtNr=Inst%ExtNrSS ) IF ( RC /= HCO_SUCCESS ) THEN CALL HCO_ERROR( 'HCO_EmisAdd error: FLUXSALC', RC ) RETURN ENDIF ENDIF ! SALA Chloride, xnw 10/13/17 IF ( Inst%IDTSALACL > 0 ) THEN FLUXSALACL = ( FLUXSALA + SNOWSALA ) * 0.5504d0 ! Add flux to emission array CALL HCO_EmisAdd( HcoState, FLUXSALACL, Inst%IDTSALACL, & RC, ExtNr=Inst%ExtNrSS ) IF ( RC /= HCO_SUCCESS ) THEN CALL HCO_ERROR( 'HCO_EmisAdd error: FLUXSALACL', RC) RETURN ENDIF ENDIF ! SALC Chloride, xnw 11/17/17 IF ( Inst%IDTSALCCL > 0 ) THEN FLUXSALCCL = ( FLUXSALC + SNOWSALC ) * 0.5504d0 ! Add flux to emission array CALL HCO_EmisAdd( HcoState, FLUXSALCCL, Inst%IDTSALCCL, & RC, ExtNr=Inst%ExtNrSS ) IF ( RC /= HCO_SUCCESS ) THEN CALL HCO_ERROR( 'HCO_EmisAdd error: FLUXSALCCL', RC) RETURN ENDIF ENDIF ! SALA Alkalinity, xnw 11/30/17 IF ( Inst%IDTSALAAL > 0 ) THEN FLUXSALAAL = FLUXSALA ! Add flux to emission array CALL HCO_EmisAdd( HcoState, FLUXSALAAL, Inst%IDTSALAAL, & RC, ExtNr=Inst%ExtNrSS ) IF ( RC /= HCO_SUCCESS ) THEN CALL HCO_ERROR( 'HCO_EmisAdd error: FLUXSALAAL', RC) RETURN ENDIF ENDIF ! SALC Alkalinity, xnw 11/30/17 IF ( Inst%IDTSALCAL > 0 ) THEN FLUXSALCAL = FLUXSALC ! Add flux to emission array CALL HCO_EmisAdd( HcoState, FLUXSALCAL, Inst%IDTSALCAL, & RC, ExtNr=Inst%ExtNrSS ) IF ( RC /= HCO_SUCCESS ) THEN CALL HCO_ERROR( 'HCO_EmisAdd error: FLUXSALCAL', RC) RETURN ENDIF ENDIF ! Bromine incorporated into sea salt IF ( Inst%CalcBrSalt ) THEN ! Scale BrSalX emissions to SalX. ! Also add blowing snow Br emissions assuming a factor of 5 enrichment ! factor relative to seawater FluxBrSalA = Inst%BrContent * (FluxSalA + SNOWSALA * 5.0d0) FluxBrSalC = Inst%BrContent * (FluxSalC + SNOWSALC * 5.0d0) ! Add flux to emission array CALL HCO_EmisAdd( HcoState, FLUXBrSalA, Inst%IDTBrSalA, & RC, ExtNr=Inst%ExtNrSS ) IF ( RC /= HCO_SUCCESS ) THEN CALL HCO_ERROR( 'HCO_EmisAdd error: FLUXBrSalA', RC ) RETURN ENDIF ! Add flux to emission array CALL HCO_EmisAdd( HcoState, FLUXBrSalC, Inst%IDTBrSalC, & RC, ExtNr=Inst%ExtNrSS ) IF ( RC /= HCO_SUCCESS ) THEN CALL HCO_ERROR( 'HCO_EmisAdd error: FLUXBrSalC', RC ) RETURN ENDIF ENDIF ! MOPO IF ( Inst%IDTMOPO > 0 ) THEN ! Add flux to emission array CALL HCO_EmisAdd( HcoState, FLUXMOPO, Inst%IDTMOPO, & RC, ExtNr=Inst%ExtNrSS ) IF ( RC /= HCO_SUCCESS ) THEN CALL HCO_ERROR( 'HCO_EmisAdd error: FLUXMOPO', RC ) RETURN ENDIF ENDIF ! MOPI IF ( Inst%IDTMOPI > 0 ) THEN ! Add flux to emission array CALL HCO_EmisAdd( HcoState, FLUXMOPI, Inst%IDTMOPI, & RC, ExtNr=Inst%ExtNrSS ) IF ( RC /= HCO_SUCCESS ) THEN CALL HCO_ERROR( 'HCO_EmisAdd error: FLUXMOPI', RC ) RETURN ENDIF ENDIF ! Cleanup Inst => NULL() ! Leave w/ success CALL HCO_LEAVE( HcoState%Config%Err,RC ) END SUBROUTINE HCOX_SeaSalt_Run !EOC !------------------------------------------------------------------------------ ! Harmonized Emissions Component (HEMCO) ! !------------------------------------------------------------------------------ !BOP ! ! !IROUTINE: HCOX_SeaSalt_Init ! ! !DESCRIPTION: Subroutine HcoX\_SeaSalt\_Init initializes all ! extension variables. !\\ !\\ ! !INTERFACE: ! SUBROUTINE HCOX_SeaSalt_Init( HcoState, ExtName, ExtState, RC ) ! ! !USES: ! USE HCO_State_Mod, ONLY : HCO_GetHcoID USE HCO_STATE_MOD, ONLY : HCO_GetExtHcoID USE HCO_ExtList_Mod, ONLY : GetExtNr USE HCO_ExtList_Mod, ONLY : GetExtOpt ! ! !INPUT PARAMETERS: ! TYPE(HCO_State), POINTER :: HcoState ! HEMCO state object CHARACTER(LEN=*), INTENT(IN ) :: ExtName ! Extension name TYPE(Ext_State), POINTER :: ExtState ! Options object ! ! !INPUT/OUTPUT PARAMETERS: ! INTEGER, INTENT(INOUT) :: RC ! Return status ! ! !REVISION HISTORY: ! 15 Dec 2013 - C. Keller - Initial version ! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC ! ! !LOCAL VARIABLES: ! INTEGER :: ExtNrSS INTEGER :: N, R, AS REAL*8 :: A, B, R0, R1 REAL*8 :: CONST_N CHARACTER(LEN=255) :: MSG, LOC INTEGER :: nSpcSS, minLen REAL*8 :: SALA_REDGE_um(2), SALC_REDGE_um(2) REAL(dp) :: tmpScale LOGICAL :: FOUND INTEGER, ALLOCATABLE :: HcoIDsSS(:) CHARACTER(LEN=31), ALLOCATABLE :: SpcNamesSS(:) TYPE(MyInst), POINTER :: Inst ! Local variables for blowing snow INTEGER :: ND, IH !IH for different hemisphere REAL*8 :: D_SNOW, D_DRY REAL*8, PARAMETER :: A_SALT = 2.0d0 !from Mann et al. 2000 REAL*8, PARAMETER :: B_SALT = 37.5d0 !in um REAL*8, PARAMETER :: DDSNOW = 2.0d0 !in um for snow particle interval REAL*8, PARAMETER :: RHONACL = 2160.0d0 !kg/m3 REAL*8, PARAMETER :: RHOICE = 900.0d0 !kg/m3 !================================================================= ! HCOX_SeaSalt_Init begins here! !================================================================= LOC = 'HCOX_SeaSalt_Init (HCOX_SEASALT_MOD.F90)' ! Extension number for seasalt ExtNrSS = GetExtNr( HcoState%Config%ExtList, TRIM(ExtName) ) IF ( ExtNrSS <= 0 ) RETURN ! Enter CALL HCO_ENTER( HcoState%Config%Err, LOC, RC ) IF ( RC /= HCO_SUCCESS ) THEN CALL HCO_ERROR( 'ERROR 1', RC, THISLOC=LOC ) RETURN ENDIF ! Create Instance Inst => NULL() CALL InstCreate ( ExtNrSS, ExtState%SeaSalt, Inst, RC ) IF ( RC /= HCO_SUCCESS ) THEN CALL HCO_ERROR ( 'Cannot create SeaSalt instance', RC ) RETURN ENDIF ! Also fill ExtNrSS - this is the same as the parent ExtNr Inst%ExtNrSS = ExtNrSS ! ---------------------------------------------------------------------- ! Get species IDs and settings ! ---------------------------------------------------------------------- ! Read settings specified in configuration file ! Note: the specified strings have to match those in ! the config. file! Call GetExtOpt ( HcoState%Config, Inst%ExtNrSS, 'Model sea salt Br-', & OptValBool=Inst%CalcBrSalt, RC=RC ) IF ( Inst%CalcBrSalt ) THEN minLen = 4 CALL GetExtOpt( HcoState%Config, Inst%ExtNrSS, 'Br- mass ratio', & OptValDp=Inst%BrContent, RC=RC ) IF ( RC /= HCO_SUCCESS ) THEN CALL HCO_ERROR( 'ERROR 2', RC, THISLOC=LOC ) RETURN ENDIF ELSE minLen = 2 Inst%IDTBrSALA = -1 Inst%IDTBrSALC = -1 Inst%BrContent = 0.0d0 ENDIF ! Get HEMCO species IDs CALL HCO_GetExtHcoID( HcoState, Inst%ExtNrSS, HcoIDsSS, & SpcNamesSS, nSpcSS, RC ) IF ( RC /= HCO_SUCCESS ) THEN CALL HCO_ERROR( 'ERROR 3', RC, THISLOC=LOC ) RETURN ENDIF IF ( nSpcSS < minLen ) THEN MSG = 'Not enough sea salt emission species set' CALL HCO_ERROR(MSG, RC ) RETURN ENDIF Inst%IDTSALA = HcoIDsSS(1) Inst%IDTSALC = HcoIDsSS(2) Inst%IDTSALACL = HcoIDsSS(3) Inst%IDTSALCCL = HcoIDsSS(4) Inst%IDTSALAAL = HcoIDsSS(5) Inst%IDTSALCAL = HcoIDsSS(6) IF ( Inst%CalcBrSalt ) Inst%IDTBrSALA = HcoIDsSS(7) IF ( Inst%CalcBrSalt ) Inst%IDTBrSALC = HcoIDsSS(8) IF ( HcoState%MarinePOA ) THEN Inst%IDTMOPO = HcoIDsSS(9) Inst%IDTMOPI = HcoIDsSS(10) ENDIF ! Get aerosol radius' SALA_REDGE_um(:) = 0.0d0 SALC_REDGE_um(:) = 0.0d0 CALL GetExtOpt( HcoState%Config, Inst%ExtNrSS, 'SALA lower radius', & OptValDp=SALA_REDGE_um(1), RC=RC ) IF ( RC /= HCO_SUCCESS ) THEN CALL HCO_ERROR( 'ERROR 4', RC, THISLOC=LOC ) RETURN ENDIF CALL GetExtOpt( HcoState%Config, Inst%ExtNrSS, 'SALA upper radius', & OptValDp=SALA_REDGE_um(2), RC=RC ) IF ( RC /= HCO_SUCCESS ) THEN CALL HCO_ERROR( 'ERROR 5', RC, THISLOC=LOC ) RETURN ENDIF CALL GetExtOpt( HcoState%Config, Inst%ExtNrSS, 'SALC lower radius', & OptValDp=SALC_REDGE_um(1), RC=RC ) IF ( RC /= HCO_SUCCESS ) THEN CALL HCO_ERROR( 'ERROR 6', RC, THISLOC=LOC ) RETURN ENDIF CALL GetExtOpt( HcoState%Config, Inst%ExtNrSS, 'SALC upper radius', & OptValDp=SALC_REDGE_um(2), RC=RC ) IF ( RC /= HCO_SUCCESS ) THEN CALL HCO_ERROR( 'ERROR 7', RC, THISLOC=LOC ) RETURN ENDIF ! fix scaling factor over cold water SST (<5 degC) CALL GetExtOpt ( HcoState%Config, Inst%ExtNrSS, 'Reduce SS cold water', & OptValBool=Inst%ColdSST, RC=RC ) IF ( RC /= HCO_SUCCESS ) THEN CALL HCO_ERROR( 'ERROR 8', RC, THISLOC=LOC ) RETURN ENDIF ! Add a SSA source from blowing snow (by J. Huang) CALL GetExtOpt ( HcoState%Config, Inst%ExtNrSS, 'Blowing Snow SS', & OptValBool=Inst%EmitSnowSS, RC=RC ) IF ( RC /= HCO_SUCCESS ) THEN CALL HCO_ERROR( 'ERROR 9', RC, THISLOC=LOC ) RETURN ENDIF ! Whether or not differentiate snow salinity on FYI and MYI (by J. Huang) !CALL GetExtOpt ( HcoState%Config, Inst%ExtNrSS, 'Diff salinity on ice', & ! OptValBool=Inst%FYIsnow, RC=RC ) !IF ( RC /= HCO_SUCCESS ) RETURN ! Add snow salinity (NH and SH), snow age and number of particles ! per snowflake as external factor from configuration file IF ( Inst%EmitSnowSS ) THEN CALL GetExtOpt( HcoState%Config, Inst%ExtNrSS, 'NH FYI snow salinity', & OptValDp=Inst%NSLNT_FYI, RC=RC ) IF ( RC /= HCO_SUCCESS ) THEN CALL HCO_ERROR( 'ERROR 10', RC, THISLOC=LOC ) RETURN ENDIF CALL GetExtOpt( HcoState%Config, Inst%ExtNrSS, 'NH MYI snow salinity', & OptValDp=Inst%NSLNT_MYI, RC=RC ) IF ( RC /= HCO_SUCCESS ) THEN CALL HCO_ERROR( 'ERROR 11', RC, THISLOC=LOC ) RETURN ENDIF CALL GetExtOpt( HcoState%Config, Inst%ExtNrSS, 'SH FYI snow salinity', & OptValDp=Inst%SSLNT_FYI, RC=RC ) IF ( RC /= HCO_SUCCESS ) THEN CALL HCO_ERROR( 'ERROR 12', RC, THISLOC=LOC ) RETURN ENDIF CALL GetExtOpt( HcoState%Config, Inst%ExtNrSS, 'SH MYI snow salinity', & OptValDp=Inst%SSLNT_MYI, RC=RC ) IF ( RC /= HCO_SUCCESS ) THEN CALL HCO_ERROR( 'ERROR 13', RC, THISLOC=LOC ) RETURN ENDIF CALL GetExtOpt( HcoState%Config, Inst%ExtNrSS, 'NH snow age', & OptValDp=Inst%NAGE, RC=RC ) IF ( RC /= HCO_SUCCESS ) THEN CALL HCO_ERROR( 'ERROR 14', RC, THISLOC=LOC ) RETURN ENDIF CALL GetExtOpt( HcoState%Config, Inst%ExtNrSS, 'SH snow age', & OptValDp=Inst%SAGE, RC=RC ) IF ( RC /= HCO_SUCCESS ) THEN CALL HCO_ERROR( 'ERROR 15', RC, THISLOC=LOC ) RETURN ENDIF CALL GetExtOpt( HcoState%Config, Inst%ExtNrSS, 'N per snowflake', & OptValDp=Inst%NumP, RC=RC ) IF ( RC /= HCO_SUCCESS ) THEN CALL HCO_ERROR( 'ERROR 16', RC, THISLOC=LOC ) RETURN ENDIF ELSE Inst%NSLNT_FYI = 0.1d0 ! default value 0.1 psu for NH FYI snow Inst%NSLNT_MYI = 0.05d0 ! default value 0.05 psu for NH MYI snow Inst%SSLNT_FYI = 0.03d0 ! default value 0.03 psu for SH FYI snow Inst%SSLNT_FYI = 0.015d0 ! default value 0.015 psu for SH MYI snow Inst%NAGE = 3.0d0 ! default value 3 days snow age in NH Inst%SAGE = 1.5d0 ! default value 1.5 days snow age in SH Inst%NumP = 5.0d0 ! default value of 5 particles per snowflake ENDIF ! Final BrSalt flag Inst%CalcBrSalt = ( Inst%CalcBrSalt .and. Inst%IDTBrSALA > 0 .and. Inst%IDTBrSALC > 0 ) ! The source function calculated with GEOS-4 2x2.5 wind speeds ! is too high compared to GEOS-5 at the same resolution. The 10m ! winds in GEOS-4 are too rapid. To correct this, apply a global ! scaling factor of 0.72 (jaegle 5/11/11) ! Now check first if this factor is specified in configuration file CALL GetExtOpt( HcoState%Config, Inst%ExtNrSS, 'Wind scale factor', & OptValDp=tmpScale, FOUND=FOUND, RC=RC ) IF ( RC /= HCO_SUCCESS ) THEN CALL HCO_ERROR( 'ERROR 17', RC, THISLOC=LOC ) RETURN ENDIF IF ( .NOT. FOUND ) THEN tmpScale = 1.0d0 ENDIF Inst%WindScale = tmpScale ! Verbose mode IF ( HcoState%amIRoot ) THEN MSG = 'Use sea salt aerosol emissions (extension module)' CALL HCO_MSG(HcoState%Config%Err,MSG, SEP1='-' ) IF ( HcoState%MarinePOA ) THEN MSG = 'Use marine organic aerosols option' CALL HCO_MSG(HcoState%Config%Err,MSG, SEP1='-' ) ENDIF WRITE(MSG,*) 'Accumulation aerosol: ', TRIM(SpcNamesSS(1)), & ':', Inst%IDTSALA CALL HCO_MSG(HcoState%Config%Err,MSG) WRITE(MSG,*) ' - size range : ', SALA_REDGE_um CALL HCO_MSG(HcoState%Config%Err,MSG) WRITE(MSG,*) 'Coarse aerosol : ', TRIM(SpcNamesSS(2)), & ':', Inst%IDTSALC CALL HCO_MSG(HcoState%Config%Err,MSG) WRITE(MSG,*) ' - size range : ', SALA_REDGE_um CALL HCO_MSG(HcoState%Config%Err,MSG) WRITE(MSG,*) ' - wind scale factor: ', Inst%WindScale CALL HCO_MSG(HcoState%Config%Err,MSG) IF ( Inst%EmitSnowSS ) THEN WRITE(MSG,*) ' - Arctic Snow Salinity on FYI (psu): ', Inst%NSLNT_FYI CALL HCO_MSG(HcoState%Config%Err,MSG) WRITE(MSG,*) ' - Arctic Snow Salinity on MYI (psu): ', Inst%NSLNT_MYI CALL HCO_MSG(HcoState%Config%Err,MSG) WRITE(MSG,*) ' - Antarctic Snow Salinity on FYI (psu): ', Inst%SSLNT_FYI CALL HCO_MSG(HcoState%Config%Err,MSG) WRITE(MSG,*) ' - Antarctic Snow Salinity on FYI (psu): ', Inst%SSLNT_MYI CALL HCO_MSG(HcoState%Config%Err,MSG) WRITE(MSG,*) ' - Arctic Snow age (days): ', Inst%NAGE CALL HCO_MSG(HcoState%Config%Err,MSG) WRITE(MSG,*) ' - Antarctic Snow age(days): ', Inst%SAGE CALL HCO_MSG(HcoState%Config%Err,MSG) WRITE(MSG,*) ' - Number of particle per snowflake: ', Inst%NumP CALL HCO_MSG(HcoState%Config%Err,MSG) ENDIF WRITE(MSG,*) 'Accumulation Chloride: ', TRIM(SpcNamesSS(3)), & ':', Inst%IDTSALACL CALL HCO_MSG(HcoState%Config%Err,MSG) WRITE(MSG,*) 'Coarse Chloride: ', TRIM(SpcNamesSS(4)), & ':', Inst%IDTSALCCL CALL HCO_MSG(HcoState%Config%Err,MSG) WRITE(MSG,*) 'Accumulation Alkalinity: ', TRIM(SpcNamesSS(5)), & ':', Inst%IDTSALAAL CALL HCO_MSG(HcoState%Config%Err,MSG) WRITE(MSG,*) 'Coarse Alkalinity: ', TRIM(SpcNamesSS(6)), & ':', Inst%IDTSALCAL CALL HCO_MSG(HcoState%Config%Err,MSG) IF ( Inst%CalcBrSalt ) THEN WRITE(MSG,*) 'BrSALA: ', TRIM(SpcNamesSS(7)), Inst%IDTBrSALA CALL HCO_MSG(HcoState%Config%Err,MSG) WRITE(MSG,*) 'BrSALC: ', TRIM(SpcNamesSS(8)), Inst%IDTBrSALC CALL HCO_MSG(HcoState%Config%Err,MSG) WRITE(MSG,*) 'Br- mass content: ', Inst%BrContent CALL HCO_MSG(HcoState%Config%Err,MSG) ENDIF IF ( HcoState%MarinePOA ) THEN WRITE(MSG,*) 'Hydrophobic marine organic aerosol: ', & TRIM(SpcNamesSS(9)), ':', Inst%IDTMOPO CALL HCO_MSG(HcoState%Config%Err,MSG) WRITE(MSG,*) 'Hydrophilic marine organic aerosol: ', & TRIM(SpcNamesSS(10)), ':', Inst%IDTMOPI CALL HCO_MSG(HcoState%Config%Err,MSG) ENDIF ENDIF ! ---------------------------------------------------------------------- ! Allocate module and subroutine arrays ! ---------------------------------------------------------------------- ! Number of tracers dependent on MarinePOA (ewl, 7/9/15) IF ( HcoState%MarinePOA ) THEN Inst%NSALT = 4 ELSE Inst%NSALT = 2 ENDIF ALLOCATE ( Inst%NR ( Inst%NSALT ), STAT=AS ) IF ( AS/=0 ) THEN CALL HCO_ERROR( 'Cannot allocate NR', RC ) RETURN ENDIF Inst%NR = 0 ALLOCATE ( Inst%SS_DEN ( Inst%NSALT ), STAT=AS ) IF ( AS/=0 ) THEN CALL HCO_ERROR( 'Cannot allocate SS_DEN', RC ) RETURN ENDIF Inst%SS_DEN = 2200.d0 ALLOCATE ( Inst%SRRC ( NR_MAX, Inst%NSALT ), STAT=AS ) IF ( AS/=0 ) THEN CALL HCO_ERROR( 'Cannot allocate SRRC', RC ) RETURN ENDIF Inst%SRRC = 0d0 ALLOCATE ( Inst%SRRC_N ( NR_MAX, Inst%NSALT ), STAT=AS ) IF ( AS/=0 ) THEN CALL HCO_ERROR( 'Cannot allocate SRRC_N', RC ) RETURN ENDIF Inst%SRRC_N = 0d0 ALLOCATE ( Inst%RREDGE ( 0:NR_MAX, Inst%NSALT ), STAT=AS ) IF ( AS/=0 ) THEN CALL HCO_ERROR( 'Cannot allocate RREDGE', RC ) RETURN ENDIF Inst%RREDGE = 0d0 ALLOCATE ( Inst%RRMID ( NR_MAX, Inst%NSALT ), STAT=AS ) IF ( AS/=0 ) THEN CALL HCO_ERROR( 'Cannot allocate RRMID', RC ) RETURN ENDIF Inst%RRMID = 0d0 ALLOCATE ( Inst%NDENS_SALA( HcoState%NX, HcoState%NY), STAT=AS ) IF ( AS/=0 ) THEN CALL HCO_ERROR( 'Cannot allocate NDENS_SALA', RC ) RETURN ENDIF Inst%NDENS_SALA = 0.0_sp ALLOCATE ( Inst%NDENS_SALC( HcoState%NX, HcoState%NY), STAT=AS ) IF ( AS/=0 ) THEN CALL HCO_ERROR( 'Cannot allocate NDENS_SALC', RC ) RETURN ENDIF Inst%NDENS_SALC = 0.0_sp ! Allocate for blowing snow simulation IF ( Inst%EmitSnowSS ) THEN ALLOCATE ( Inst%F_DI_N_FYI( NR_MAX, Inst%NSALT ), STAT=AS ) IF ( AS/=0 ) THEN CALL HCO_ERROR( 'Cannot allocate F_DI_N_FYI', RC ) RETURN ENDIF Inst%F_DI_N_FYI = 0.0_sp ALLOCATE ( Inst%F_DI_N_MYI( NR_MAX, Inst%NSALT ), STAT=AS ) IF ( AS/=0 ) THEN CALL HCO_ERROR( 'Cannot allocate F_DI_N_MYI', RC ) RETURN ENDIF Inst%F_DI_N_MYI = 0.0_sp ALLOCATE ( Inst%F_DN_N_FYI( NR_MAX, Inst%NSALT ), STAT=AS ) IF ( AS/=0 ) THEN CALL HCO_ERROR( 'Cannot allocate F_DN_N_FYI', RC ) RETURN ENDIF Inst%F_DN_N_FYI = 0.0_sp ALLOCATE ( Inst%F_DN_N_MYI( NR_MAX, Inst%NSALT ), STAT=AS ) IF ( AS/=0 ) THEN CALL HCO_ERROR( 'Cannot allocate F_DN_N_MYI', RC ) RETURN ENDIF Inst%F_DN_N_MYI = 0.0_sp ALLOCATE ( Inst%F_DI_S_FYI( NR_MAX, Inst%NSALT ), STAT=AS ) IF ( AS/=0 ) THEN CALL HCO_ERROR( 'Cannot allocate F_DI_S_FYI', RC ) RETURN ENDIF Inst%F_DI_S_FYI = 0.0_sp ALLOCATE ( Inst%F_DI_S_MYI( NR_MAX, Inst%NSALT ), STAT=AS ) IF ( AS/=0 ) THEN CALL HCO_ERROR( 'Cannot allocate F_DI_S_MYI', RC ) RETURN ENDIF Inst%F_DI_S_MYI = 0.0_sp ALLOCATE ( Inst%F_DN_S_FYI( NR_MAX, Inst%NSALT ), STAT=AS ) IF ( AS/=0 ) THEN CALL HCO_ERROR( 'Cannot allocate F_DN_S_FYI', RC ) RETURN ENDIF Inst%F_DN_S_FYI = 0.0_sp ALLOCATE ( Inst%F_DN_S_MYI( NR_MAX, Inst%NSALT ), STAT=AS ) IF ( AS/=0 ) THEN CALL HCO_ERROR( 'Cannot allocate F_DN_S_MYI', RC ) RETURN ENDIF Inst%F_DN_S_MYI = 0.0_sp ENDIF IF ( HcoState%MarinePOA ) THEN ! Allocate density of phobic marine organic aerosols ALLOCATE ( Inst%NDENS_MOPO( HcoState%NX, HcoState%NY), STAT=AS ) IF ( AS/=0 ) THEN CALL HCO_ERROR( 'Cannot allocate NDENS_MOPO', RC ) RETURN ENDIF Inst%NDENS_MOPO = 0.0_sp ! Allocate density of philic marine organic aerosols ALLOCATE ( Inst%NDENS_MOPI( HcoState%NX, HcoState%NY), STAT=AS ) IF ( AS/=0 ) THEN CALL HCO_ERROR( 'Cannot allocate NDENS_MOPI', RC ) RETURN ENDIF Inst%NDENS_MOPI = 0.0_sp ALLOCATE ( Inst%CHLR( HcoState%NX, HcoState%NY), STAT=AS ) IF ( AS/=0 ) THEN CALL HCO_ERROR( 'Cannot allocate CHLR', RC ) RETURN ENDIF Inst%CHLR = 0.0_hp ENDIF !================================================================= ! Define edges and midpoints of each incremental radius bin !================================================================= ! Constant [volume * time * other stuff??] !CONST = 4d0/3d0 * PI * DR * DTEMIS * 1.d-18 * 1.373d0 !CONST_N = DTEMIS * DR * 1.373d0 ! Constant for converting from [#/m2/s/um] to [#/m2] CONST_N = HcoState%TS_EMIS * (DR * BETHA) ! Do for accumulation, fine mode, and marine organics (if enabled) DO N = 1,Inst%NSALT ! Lower and upper limit of size bin N [um] ! Note that these are dry size bins. In order to ! get wet (RH=80%) sizes, we need to multiply by ! BETHA. ! Accumulation mode IF ( N==1 ) THEN R0 = SALA_REDGE_um(1) R1 = SALA_REDGE_um(2) ! Coarse mode ELSEIF ( N==2 ) THEN R0 = SALC_REDGE_um(1) R1 = SALC_REDGE_um(2) ! Marine phobic (mj, bg, 7/9/15) ELSEIF ( N==3 ) THEN R0 = SALA_REDGE_um(1) R1 = SALA_REDGE_um(2) ! Marine philic (mj, bg, 7/9/15) ELSEIF ( N==4 ) THEN R0 = SALC_REDGE_um(1) R1 = SALC_REDGE_um(2) ENDIF ! Number of radius size bins Inst%NR(N) = INT( ( ( R1 - R0 ) / DR ) + 0.5d0 ) ! Error check IF ( Inst%NR(N) > NR_MAX ) THEN MSG = 'Too many bins' CALL HCO_ERROR(MSG, RC ) RETURN ENDIF ! Lower edge of 0th bin Inst%RREDGE(0,N) = R0 ! Loop over the # of radius bins DO R = 1, Inst%NR(N) ! Midpoint of IRth bin Inst%RRMID(R,N) = Inst%RREDGE(R-1,N) + ( DR / 2d0 ) ! Upper edge of IRth bin Inst%RREDGE(R,N) = Inst%RREDGE(R-1,N) + DR ! Sea salt base source [#/m2]. Note that the Gong formulation ! is for r80 (radius at 80% RH), so we need to multiply RRMID ! by the scaling factor BETHA=2. A = 4.7*(1.+30.*(BETHA*Inst%RRMID(R,N))) & **(-0.017*(BETHA*Inst%RRMID(R,N))**(-1.44)) B = (0.433d0-LOG10(BETHA*Inst%RRMID(R,N))) / 0.433d0 Inst%SRRC_N(R,N) = CONST_N * 1.373 & * (1.d0/(BETHA*Inst%RRMID(R,N))**(A)) & * (1.d0+0.057d0*(BETHA*Inst%RRMID(R,N))**3.45d0) & * 10d0**(1.607d0*EXP(-(B**2))) ! Sea salt base source [kg/m2]: multiply the number of particles ! by the dry volume multiplied by the dry density of sea-salt. Inst%SRRC(R,N) = Inst%SRRC_N(R,N) * 4d0/3d0 * HcoState%Phys%PI * 1.d-18 & * Inst%SS_DEN( N ) * (Inst%RRMID(R,N))**3 !----------------------------------------------------------- ! IMPORTANT NOTE! ! ! In mathematics, "LOG" means "log10". ! In Fortran, "LOG" means "ln" (and LOG10 is "log10"). ! ! The following equations require log to the base 10, so ! we need to use the Fortran function LOG10 instead of LOG. ! (jaegle, bmy, 11/23/09) !----------------------------------------------------------- ! ! Old Monahan et al. (1986) formulation ! ! Sea salt base source [kg/m2] ! CONST_N = DTEMIS * (DR * BETHA) ! SRRC(R,N) = CONST * SS_DEN( N ) ! & * ( 1.d0 + 0.057d0*( BETHA * RRMID(R,N) )**1.05d0 ) ! & * 10d0**( 1.19d0* ! & EXP(-((0.38d0-LOG10(BETHA*RRMID(R,N)))/0.65d0)**2)) ! & / BETHA**2 ! ! Sea salt base source [#/m2] (bec, bmy, 4/13/05) ! SRRC_N(R,N) = CONST_N * (1.d0/RRMID(R,N)**3) ! & * (1.d0+0.057d0*(BETHA*RRMID(R,N))**1.05d0) ! & * 10d0**(1.19d0*EXP(-((0.38d0-LOG10(BETHA*RRMID(R,N))) ! & /0.65d0)**2))/ BETHA**2 !### Debug !### WRITE( 6, 100 ) R,RREDGE(R-1,N),RRMID(R,N),RREDGE(R,N),SRRC(R,N) !### 100 FORMAT( 'IR, R0, RRMID, R1: ', i3, 3f11.4,2x,es13.6 ) ENDDO !R !size bins for blowing snow - Huang 6/12/20 IF ( Inst%EmitSnowSS .and. N .LT. 3 ) THEN !-------------- Define size distribution --------------------- ! for southern hemisphere FYI D_SNOW = 1.0d0 DO ND = 1, NR_MAX D_DRY = ( Inst%NSLNT_FYI * RHOICE / (1000.d0 & * Inst%NumP * RHONACL ) )**( 1d0 / 3d0 ) * D_SNOW IF (D_DRY .ge. R0*2d0 .and. D_DRY .le. R1*2d0 ) THEN !---------------------------------------------------------- ! NOTES: ! For size distribution ! define the two-parameter gamma probability density funtion here ! Yang et al 2008 eq (6) !---------------------------------------------------------- ! Midpoint of IRth bin Inst%F_DI_N_FYI(ND, N) = EXP( - D_SNOW / B_SALT ) & * D_SNOW**( A_SALT - 1.d0 ) & / ( B_SALT**A_SALT * GAMMA( A_SALT ) ) ELSE Inst%F_DI_N_FYI(ND, N) = 0d0 ENDIF Inst%F_DN_N_FYI(ND, N) = Inst%F_DI_N_FYI(ND,N) / (4d0/3d0 * HcoState%Phys%PI & * 1.d-18 * Inst%SS_DEN( N ) * (D_DRY/2d0)**3) D_SNOW = D_SNOW + DDSNOW ENDDO ! for southern hemisphere MYI D_SNOW = 1.0d0 DO ND = 1, NR_MAX D_DRY = ( Inst%NSLNT_MYI * RHOICE / (1000.d0 & * Inst%NumP * RHONACL ) )**( 1d0 / 3d0 ) * D_SNOW IF (D_DRY .ge. R0*2d0 .and. D_DRY .le. R1*2d0 ) THEN ! Midpoint of IRth bin Inst%F_DI_N_MYI(ND, N) = EXP( - D_SNOW / B_SALT ) & * D_SNOW**( A_SALT - 1.d0 ) & / ( B_SALT**A_SALT * GAMMA( A_SALT ) ) ELSE Inst%F_DI_N_MYI(ND, N) = 0d0 ENDIF Inst%F_DN_N_MYI(ND, N) = Inst%F_DI_N_MYI(ND,N) / (4d0/3d0 * HcoState%Phys%PI & * 1.d-18 * Inst%SS_DEN( N ) * (D_DRY/2d0)**3) D_SNOW = D_SNOW + DDSNOW ENDDO ! for southern hemisphere FYI D_SNOW = 1.0d0 DO ND = 1, NR_MAX D_DRY = ( Inst%SSLNT_FYI * RHOICE / (1000.d0 & * Inst%NumP * RHONACL ) )**( 1d0 / 3d0 ) * D_SNOW IF (D_DRY .ge. R0*2d0 .and. D_DRY .le. R1*2d0 ) THEN ! Midpoint of IRth bin Inst%F_DI_S_FYI(ND, N) = EXP( - D_SNOW / B_SALT ) & * D_SNOW**( A_SALT - 1.d0 ) & / ( B_SALT**A_SALT * GAMMA( A_SALT ) ) ELSE Inst%F_DI_S_FYI(ND, N) = 0d0 ENDIF Inst%F_DN_S_FYI(ND, N) = Inst%F_DI_S_FYI(ND,N)/ (4d0/3d0 * HcoState%Phys%PI & * 1.d-18 * Inst%SS_DEN( N ) * (D_DRY/2d0)**3) D_SNOW = D_SNOW + DDSNOW ENDDO ! for southern hemisphere MYI D_SNOW = 1.0d0 DO ND = 1, NR_MAX D_DRY = ( Inst%SSLNT_MYI * RHOICE / (1000.d0 & * Inst%NumP * RHONACL ) )**( 1d0 / 3d0 ) * D_SNOW IF (D_DRY .ge. R0*2d0 .and. D_DRY .le. R1*2d0 ) THEN ! Midpoint of IRth bin Inst%F_DI_S_MYI(ND, N) = EXP( - D_SNOW / B_SALT ) & * D_SNOW**( A_SALT - 1.d0 ) & / ( B_SALT**A_SALT * GAMMA( A_SALT ) ) ELSE Inst%F_DI_S_MYI(ND, N) = 0d0 ENDIF Inst%F_DN_S_MYI(ND, N) = Inst%F_DI_S_MYI(ND,N)/ (4d0/3d0 * HcoState%Phys%PI & * 1.d-18 * Inst%SS_DEN( N ) * (D_DRY/2d0)**3) D_SNOW = D_SNOW + DDSNOW ENDDO ENDIF ENDDO !N !======================================================================= ! Create diagnostics. The number densities of both modes are always ! written into a diagnostics so that they can be used by other routines ! and from outside of HEMCO. These diagnostics just hold a pointer ! to the respective density arrays filled by the run method of this ! module. !======================================================================= CALL Diagn_Create ( HcoState = HcoState, & cName = 'SEASALT_DENS_FINE', & ExtNr = Inst%ExtNrSS, & Cat = -1, & Hier = -1, & HcoID = Inst%IDTSALA, & SpaceDim = 2, & OutUnit = 'number_dens', & AutoFill = 0, & Trgt2D = Inst%NDENS_SALA, & COL = HcoState%Diagn%HcoDiagnIDManual, & RC = RC ) IF ( RC /= HCO_SUCCESS ) THEN CALL HCO_ERROR( 'ERROR 18', RC, THISLOC=LOC ) RETURN ENDIF CALL Diagn_Create ( HcoState = HcoState, & cName = 'SEASALT_DENS_COARSE', & ExtNr = Inst%ExtNrSS, & Cat = -1, & Hier = -1, & HcoID = Inst%IDTSALC, & SpaceDim = 2, & OutUnit = 'number_dens', & AutoFill = 0, & Trgt2D = Inst%NDENS_SALC, & COL = HcoState%Diagn%HcoDiagnIDManual, & RC = RC ) IF ( RC /= HCO_SUCCESS ) THEN CALL HCO_ERROR( 'ERROR 19', RC, THISLOC=LOC ) RETURN ENDIF ! Create marine density diagnostics only if marine POA enabled IF ( HcoState%MarinePOA ) THEN CALL Diagn_Create ( HcoState = HcoState, & cName = 'SEASALT_DENS_PHOBIC', & ExtNr = Inst%ExtNrSS, & Cat = -1, & Hier = -1, & HcoID = Inst%IDTMOPO, & SpaceDim = 2, & OutUnit = 'number_dens', & AutoFill = 0, & Trgt2D = Inst%NDENS_MOPO, & COL = HcoState%Diagn%HcoDiagnIDManual, & RC = RC ) IF ( RC /= HCO_SUCCESS ) THEN CALL HCO_ERROR( 'ERROR 20', RC, THISLOC=LOC ) RETURN ENDIF CALL Diagn_Create ( HcoState = HcoState, & cName = 'SEASALT_DENS_PHILIC', & ExtNr = Inst%ExtNrSS, & Cat = -1, & Hier = -1, & HcoID = Inst%IDTMOPI, & SpaceDim = 2, & OutUnit = 'number_dens', & AutoFill = 0, & Trgt2D = Inst%NDENS_MOPI, & COL = HcoState%Diagn%HcoDiagnIDManual, & RC = RC ) IF ( RC /= HCO_SUCCESS ) THEN CALL HCO_ERROR( 'ERROR 21', RC, THISLOC=LOC ) RETURN ENDIF ENDIF !======================================================================= ! Activate this module and the fields of ExtState that it uses !======================================================================= ! Activate met fields used by this module ExtState%TSKIN%DoUse = .TRUE. ExtState%U10M%DoUse = .TRUE. ExtState%V10M%DoUse = .TRUE. ExtState%FROCEAN%DoUse = .TRUE. ExtState%FRSEAICE%DoUse = .TRUE. ! for blowing snow IF ( Inst%EmitSnowSS ) THEN ExtState%USTAR%DoUse = .TRUE. ExtState%T2M%DoUse = .TRUE. ExtState%QV2M%DoUse = .TRUE. ENDIF ! Return w/ success IF ( ALLOCATED(HcoIDsSS ) ) DEALLOCATE(HcoIDsSS ) IF ( ALLOCATED(SpcNamesSS ) ) DEALLOCATE(SpcNamesSS ) CALL HCO_LEAVE( HcoState%Config%Err,RC ) END SUBROUTINE HCOX_SeaSalt_Init !EOC !------------------------------------------------------------------------------ ! Harmonized Emissions Component (HEMCO) ! !------------------------------------------------------------------------------ !BOP ! ! !IROUTINE: HCOX_SeaSalt_Final ! ! !DESCRIPTION: Subroutine HcoX\_SeaSalt\_Final deallocates ! all module arrays. !\\ !\\ ! !INTERFACE: ! SUBROUTINE HCOX_SeaSalt_Final ( ExtState ) ! ! !INPUT PARAMETERS: ! TYPE(Ext_State), POINTER :: ExtState ! Module options ! ! !REVISION HISTORY: ! 15 Dec 2013 - C. Keller - Initial version ! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC ! !================================================================= ! HCOX_SeaSalt_Final begins here! !================================================================= CALL InstRemove ( ExtState%SeaSalt ) END SUBROUTINE HCOX_SeaSalt_Final !EOC !------------------------------------------------------------------------------ ! Harmonized Emissions Component (HEMCO) ! !------------------------------------------------------------------------------ !BOP ! ! !IROUTINE: InstGet ! ! !DESCRIPTION: Subroutine InstGet returns a poiner to the desired instance. !\\ !\\ ! !INTERFACE: ! SUBROUTINE InstGet ( Instance, Inst, RC, PrevInst ) ! ! !INPUT PARAMETERS: ! INTEGER :: Instance TYPE(MyInst), POINTER :: Inst INTEGER :: RC TYPE(MyInst), POINTER, OPTIONAL :: PrevInst ! ! !REVISION HISTORY: ! 18 Feb 2016 - C. Keller - Initial version ! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC TYPE(MyInst), POINTER :: PrvInst !================================================================= ! InstGet begins here! !================================================================= ! Get instance. Also archive previous instance. PrvInst => NULL() Inst => AllInst DO WHILE ( ASSOCIATED(Inst) ) IF ( Inst%Instance == Instance ) EXIT PrvInst => Inst Inst => Inst%NextInst END DO IF ( .NOT. ASSOCIATED( Inst ) ) THEN RC = HCO_FAIL RETURN ENDIF ! Pass output arguments IF ( PRESENT(PrevInst) ) PrevInst => PrvInst ! Cleanup & Return PrvInst => NULL() RC = HCO_SUCCESS END SUBROUTINE InstGet !EOC !------------------------------------------------------------------------------ ! Harmonized Emissions Component (HEMCO) ! !------------------------------------------------------------------------------ !BOP ! ! !IROUTINE: InstCreate ! ! !DESCRIPTION: Subroutine InstCreate creates a new instance. !\\ !\\ ! !INTERFACE: ! SUBROUTINE InstCreate ( ExtNr, Instance, Inst, RC ) ! ! !INPUT PARAMETERS: ! INTEGER, INTENT(IN) :: ExtNr ! ! !OUTPUT PARAMETERS: ! INTEGER, INTENT( OUT) :: Instance TYPE(MyInst), POINTER :: Inst ! ! !INPUT/OUTPUT PARAMETERS: ! INTEGER, INTENT(INOUT) :: RC ! ! !REVISION HISTORY: ! 18 Feb 2016 - C. Keller - Initial version ! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC TYPE(MyInst), POINTER :: TmpInst INTEGER :: nnInst !================================================================= ! InstCreate begins here! !================================================================= ! ---------------------------------------------------------------- ! Generic instance initialization ! ---------------------------------------------------------------- ! Initialize Inst => NULL() ! Get number of already existing instances TmpInst => AllInst nnInst = 0 DO WHILE ( ASSOCIATED(TmpInst) ) nnInst = nnInst + 1 TmpInst => TmpInst%NextInst END DO ! Create new instance ALLOCATE(Inst) Inst%Instance = nnInst + 1 Inst%ExtNr = ExtNr ! Init values Inst%ExtNrSS = -1 Inst%IDTSALA = -1 Inst%IDTSALC = -1 Inst%IDTMOPI = -1 Inst%IDTMOPO = -1 Inst%IDTBrSALA = -1 Inst%IDTBrSALC = -1 Inst%CalcBrSalt = .FALSE. Inst%BrContent = 1.0 Inst%WindScale = 1.0 Inst%ColdSST = .FALSE. Inst%EmitSnowSS = .FALSE. Inst%NSLNT_FYI = 0.0 Inst%NSLNT_MYI = 0.0 Inst%SSLNT_FYI = 0.0 Inst%SSLNT_MYI = 0.0 Inst%NAGE = 0.0 Inst%SAGE = 0.0 Inst%NumP = 1.0 ! Attach to instance list Inst%NextInst => AllInst AllInst => Inst ! Update output instance Instance = Inst%Instance ! ---------------------------------------------------------------- ! Type specific initialization statements follow below ! ---------------------------------------------------------------- ! Return w/ success RC = HCO_SUCCESS END SUBROUTINE InstCreate !EOC !------------------------------------------------------------------------------ ! Harmonized Emissions Component (HEMCO) ! !------------------------------------------------------------------------------ !BOP ! ! !IROUTINE: InstRemove ! ! !DESCRIPTION: Subroutine InstRemove creates a new instance. !\\ !\\ ! !INTERFACE: ! SUBROUTINE InstRemove ( Instance ) ! ! !INPUT PARAMETERS: ! INTEGER :: Instance ! ! !REVISION HISTORY: ! 18 Feb 2016 - C. Keller - Initial version ! See https://github.com/geoschem/hemco for complete history !EOP !------------------------------------------------------------------------------ !BOC INTEGER :: RC TYPE(MyInst), POINTER :: PrevInst TYPE(MyInst), POINTER :: Inst !================================================================= ! InstRemove begins here! !================================================================= ! Init PrevInst => NULL() Inst => NULL() ! Get instance. Also archive previous instance. CALL InstGet ( Instance, Inst, RC, PrevInst=PrevInst ) ! Instance-specific deallocation IF ( ASSOCIATED(Inst) ) THEN !--------------------------------------------------------------------- ! Deallocate fields of Inst before popping off from the list ! in order to avoid memory leaks (Bob Yantosca (17 Aug 2022) !--------------------------------------------------------------------- IF ( ASSOCIATED( Inst%NR ) ) THEN DEALLOCATE( Inst%NR ) ENDIF Inst%NR => NULL() IF ( ASSOCIATED( Inst%SS_DEN ) ) THEN DEALLOCATE( Inst%SS_DEN ) ENDIF Inst%SS_DEN => NULL() IF ( ASSOCIATED( Inst%SRRC ) ) THEN DEALLOCATE( Inst%SRRC ) ENDIF Inst%SRRC => NULL() IF ( ASSOCIATED( Inst%SRRC_N ) ) THEN DEALLOCATE( Inst%SRRC_N ) ENDIF Inst%SRRC_N => NULL() IF ( ASSOCIATED( Inst%RREDGE ) ) THEN DEALLOCATE( Inst%RREDGE ) ENDIF Inst%RREDGE => NULL() IF ( ASSOCIATED( Inst%RRMID ) ) THEN DEALLOCATE( Inst%RRMID ) ENDIF Inst%RRMID => NULL() IF ( ASSOCIATED( Inst%NDENS_SALA ) ) THEN DEALLOCATE( Inst%NDENS_SALA ) ENDIF Inst%NDENS_SALA => NULL() IF ( ASSOCIATED( Inst%NDENS_SALC ) ) THEN DEALLOCATE( Inst%NDENS_SALC ) ENDIF Inst%NDENS_SALC => NULL() IF ( ASSOCIATED( Inst%NDENS_MOPO ) ) THEN DEALLOCATE( Inst%NDENS_MOPO ) ENDIF Inst%NDENS_MOPO => NULL() IF ( ASSOCIATED( Inst%NDENS_MOPI ) ) THEN DEALLOCATE( Inst%NDENS_MOPI ) ENDIF Inst%NDENS_MOPI => NULL() IF ( ASSOCIATED( Inst%CHLR ) ) THEN DEALLOCATE( Inst%CHLR ) ENDIF Inst%CHLR => NULL() IF ( ASSOCIATED( Inst%F_DI_N_FYI ) ) THEN DEALLOCATE( Inst%F_DI_N_FYI ) ENDIF Inst%F_DI_N_FYI => NULL() IF ( ASSOCIATED( Inst%F_DI_N_MYI ) ) THEN DEALLOCATE( Inst%F_DI_N_MYI ) ENDIF Inst%F_DI_N_MYI => NULL() IF ( ASSOCIATED( Inst%F_DI_S_FYI ) ) THEN DEALLOCATE( Inst%F_DI_S_FYI ) ENDIF Inst%F_DI_S_FYI => NULL() IF ( ASSOCIATED( Inst%F_DI_S_MYI ) ) THEN DEALLOCATE( Inst%F_DI_S_MYI ) ENDIF Inst%F_DI_S_MYI => NULL() IF ( ASSOCIATED( Inst%F_DN_N_FYI ) ) THEN DEALLOCATE( Inst%F_DN_N_FYI ) ENDIF Inst%F_DN_N_FYI => NULL() IF ( ASSOCIATED( Inst%F_DN_N_MYI ) ) THEN DEALLOCATE( Inst%F_DN_N_MYI ) ENDIF Inst%F_DN_N_MYI => NULL() IF ( ASSOCIATED( Inst%F_DN_S_FYI ) ) THEN DEALLOCATE( Inst%F_DN_S_FYI ) ENDIF Inst%F_DN_S_FYI => NULL() IF ( ASSOCIATED( Inst%F_DN_S_MYI ) ) THEN DEALLOCATE( Inst%F_DN_S_MYI ) ENDIF Inst%F_DN_S_MYI => NULL() IF ( ASSOCIATED( Inst%MULTIICE ) ) THEN DEALLOCATE( Inst%MULTIICE ) ENDIF Inst%MULTIICE => NULL() !--------------------------------------------------------------------- ! Pop off instance from list !--------------------------------------------------------------------- IF ( ASSOCIATED(PrevInst) ) THEN PrevInst%NextInst => Inst%NextInst ELSE AllInst => Inst%NextInst ENDIF DEALLOCATE(Inst) ENDIF ! Free pointers before exiting PrevInst => NULL() Inst => NULL() END SUBROUTINE InstRemove !EOC END MODULE HCOX_SeaSalt_Mod