diff --git a/.codespellrc b/.codespellrc index 4f69a5d5..9568a90c 100644 --- a/.codespellrc +++ b/.codespellrc @@ -1,2 +1,2 @@ [codespell] -ignore-words-list = inout,iland +ignore-words-list = inout,iland,thik diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 88dbd8a4..cab5eeb8 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -37,7 +37,7 @@ jobs: - name: Build run: | - cmake -B $BUILD_DIR + cmake -B $BUILD_DIR -DCMAKE_POLICY_VERSION_MINIMUM=3.5 cmake --build $BUILD_DIR env: FC: ${{ matrix.compiler }} diff --git a/src/api/CMakeLists.txt b/src/api/CMakeLists.txt index 2a338f40..fbd7c2e9 100644 --- a/src/api/CMakeLists.txt +++ b/src/api/CMakeLists.txt @@ -8,6 +8,7 @@ target_link_libraries(${_lib} PUBLIC CATChem_process_dust) target_link_libraries(${_lib} PUBLIC CATChem_process_seasalt) target_link_libraries(${_lib} PUBLIC CATChem_process_plumerise) target_link_libraries(${_lib} PUBLIC CATChem_process_drydep) +target_link_libraries(${_lib} PUBLIC CATChem_process_bvoc) target_link_libraries(${_lib} PUBLIC CATChem_process_chem) set_target_properties( ${_lib} diff --git a/src/api/catchem.F90 b/src/api/catchem.F90 index 47324865..9c5eca5b 100644 --- a/src/api/catchem.F90 +++ b/src/api/catchem.F90 @@ -85,6 +85,13 @@ module CATChem ! Chemical mechanism solver use CCPr_Chem_mod, only: cc_get_micm_version => get_micm_version + ! BVOC emissions + use CCPr_Bvoc_Common_Mod, only: BvocStateType !< BVOC State + use CCPr_Bvoc_mod, only: cc_bvoc_init => CCPr_Bvoc_Init !< BVOC Process Initialization Routine + use CCPr_Bvoc_mod, only: cc_bvoc_run => CCPr_Bvoc_Run !< BVOC Process Run Routine + use CCPr_Bvoc_mod, only: cc_bvoc_finalize => CCPr_Bvoc_Final !< BVOC Process Finalization Routine + + implicit none public diff --git a/src/core/chemstate_mod.F90 b/src/core/chemstate_mod.F90 index 00ac1318..71f44317 100644 --- a/src/core/chemstate_mod.F90 +++ b/src/core/chemstate_mod.F90 @@ -22,6 +22,7 @@ module ChemState_Mod PUBLIC :: Chem_Allocate PUBLIC :: Find_Number_of_Species PUBLIC :: Find_Index_of_Species + PUBLIC :: Find_SeaSalt_Bin PUBLIC :: FindSpecByName PUBLIC :: GetSpecConc PUBLIC :: GetSpecConcByName @@ -63,16 +64,21 @@ module ChemState_Mod INTEGER :: nSpeciesGas !< Number of Gas Species INTEGER :: nSpeciesAero !< Number of Aerosol Species INTEGER :: nSpeciesAeroDryDep !< Number of Aerosol Species for Dry Dep + INTEGER :: nSpeciesDryDep !< Number of all Species for Dry Dep INTEGER :: nSpeciesTracer !< Number of Tracer Species INTEGER :: nSpeciesDust !< Number of Dust Species INTEGER :: nSpeciesSeaSalt !< Number of SeaSalt Species + INTEGER :: nSpeciesBin !< Number of SeaSalt Species Bin INTEGER, ALLOCATABLE :: SpeciesIndex(:) !< Total Species Index INTEGER, ALLOCATABLE :: TracerIndex(:) !< Tracer Species Index INTEGER, ALLOCATABLE :: AeroIndex(:) !< Aerosol Species Index INTEGER, ALLOCATABLE :: GasIndex(:) !< Gas Species Index INTEGER, ALLOCATABLE :: DustIndex(:) !< Dust Species Index INTEGER, ALLOCATABLE :: SeaSaltIndex(:) !< SeaSalt Species Index - INTEGER, ALLOCATABLE :: DryDepIndex(:) !< SeaSalt Species Index + real(fp),ALLOCATABLE :: SeaSaltBinLower(:) !< SeaSalt Species Bin Lower edge + real(fp),ALLOCATABLE :: SeaSaltBinUpper(:) !< SeaSalt Species Bin upper edge + INTEGER, ALLOCATABLE :: AeroDryDepIndex(:) !< Aerosol DryDep Species Index for Dry Dep + INTEGER, ALLOCATABLE :: DryDepIndex(:) !< All DryDep Species Index CHARACTER(len=50), ALLOCATABLE :: SpeciesNames(:) !< Species Names !--------------------------------------------------------------------- @@ -179,6 +185,7 @@ subroutine Find_Number_of_Species(ChemState, RC) ! Initialize to zero before counting species ChemState%nSpeciesAero = 0 ChemState%nSpeciesAeroDryDep = 0 + ChemState%nSpeciesDryDep = 0 ChemState%nSpeciesDust = 0 ChemState%nSpeciesGas = 0 ChemState%nSpeciesSeaSalt = 0 @@ -201,9 +208,13 @@ subroutine Find_Number_of_Species(ChemState, RC) if (ChemState%ChemSpecies(i)%is_tracer .eqv. .true.) then ChemState%nSpeciesTracer = ChemState%nSpeciesTracer + 1 endif - if (ChemState%ChemSpecies(i)%is_drydep .eqv. .true.) then + if ( (ChemState%ChemSpecies(i)%is_drydep .eqv. .true.) .and. & + (ChemState%ChemSpecies(i)%is_aerosol .eqv. .true.) ) then ChemState%nSpeciesAeroDryDep = ChemState%nSpeciesAeroDryDep + 1 endif + if (ChemState%ChemSpecies(i)%is_drydep .eqv. .true.) then + ChemState%nSpeciesDryDep = ChemState%nSpeciesDryDep + 1 + endif enddo end subroutine Find_Number_of_Species @@ -237,6 +248,7 @@ subroutine Find_Index_of_Species(ChemState, RC) integer :: dust_index ! Current Dust Index integer :: seasalt_index ! Current Seas Salt Index integer :: tracer_index ! Current Tracer Index + integer :: aero_drydep_index ! Current Aerosol DryDep Index integer :: drydep_index ! Current DryDep Index @@ -252,6 +264,7 @@ subroutine Find_Index_of_Species(ChemState, RC) dust_index = 1 seasalt_index = 1 tracer_index = 1 + aero_drydep_index = 1 drydep_index = 1 ! Allocate index arrays @@ -290,7 +303,14 @@ subroutine Find_Index_of_Species(ChemState, RC) RETURN ENDIF - ALLOCATE(Chemstate%DryDepIndex(ChemState%nSpeciesAeroDryDep), STAT=RC) + ALLOCATE(Chemstate%AeroDryDepIndex(ChemState%nSpeciesAeroDryDep), STAT=RC) + IF ( RC /= CC_SUCCESS ) THEN + errMsg = 'Error allocating Chemstate%AeroDryDepIndex' + call CC_Error(errMsg, RC, thisLoc) + RETURN + ENDIF + + ALLOCATE(Chemstate%DryDepIndex(ChemState%nSpeciesDryDep), STAT=RC) IF ( RC /= CC_SUCCESS ) THEN errMsg = 'Error allocating Chemstate%DryDepIndex' call CC_Error(errMsg, RC, thisLoc) @@ -319,6 +339,11 @@ subroutine Find_Index_of_Species(ChemState, RC) Chemstate%TracerIndex(tracer_index) = n tracer_index = tracer_index + 1 endif + if ( (ChemState%ChemSpecies(n)%is_drydep .eqv. .true.) .and. & + (ChemState%ChemSpecies(n)%is_aerosol .eqv. .true.) ) then + Chemstate%AeroDryDepIndex(aero_drydep_index) = n + aero_drydep_index = aero_drydep_index + 1 + endif if (ChemState%ChemSpecies(n)%is_drydep .eqv. .true.) then Chemstate%DryDepIndex(drydep_index) = n drydep_index = drydep_index + 1 @@ -327,6 +352,101 @@ subroutine Find_Index_of_Species(ChemState, RC) end subroutine Find_index_of_Species + !> \brief Find the bins of sea salt species + !! + !! \param ChemState The ChemState object + !! \param RC The return code + !! + !! \ingroup core_modules + !!!> + subroutine Find_SeaSalt_Bin(ChemState, RC) + ! USES + !USE Species_Mod, ONLY : SpeciesType + + IMPLICIT NONE + + ! INOUT Params + type(ChemStateType), INTENT(INOUT) :: ChemState ! chem State object + ! OUTPUT Params + INTEGER, INTENT(OUT) :: RC ! Success or failure + + ! Error handling + CHARACTER(LEN=255) :: ErrMsg + CHARACTER(LEN=255) :: thisLoc + + ! Local variables + integer :: n ! looping variable + integer :: n_bin ! number of sea salt bins + !real(fp) :: radius0 ! initial radius of sea salt bin + real(fp) :: lower_radius(10) ! lower radius of sea salt bin holder + real(fp) :: upper_radius(10) ! upper radius of sea salt bin holder + logical :: mask(10) = .FALSE. ! flag to for sorting bins by radius + + ! Initialize + RC = CC_SUCCESS + ErrMsg = '' + thisLoc = ' -> at Find_SeaSalt_Bin (in core/chemstate_mod.F90)' + + + ! Initialize to zero before counting species + n_bin = 0 + !radius0 = 0.0_fp + + ! Find possible sea salt bins + do n = 1, ChemState%nSpeciesSeaSalt + if (n == 1) then + n_bin = 1 + lower_radius(n_bin) = ChemState%ChemSpecies(Chemstate%SeaSaltIndex(n))%lower_radius + upper_radius(n_bin) = ChemState%ChemSpecies(Chemstate%SeaSaltIndex(n))%upper_radius + else + if ( ALL( ABS(lower_radius(1:n_bin) - ChemState%ChemSpecies(Chemstate%SeaSaltIndex(n))%lower_radius) > 0.0_fp )) then + n_bin = n_bin + 1 + lower_radius(n_bin) = ChemState%ChemSpecies(Chemstate%SeaSaltIndex(n))%lower_radius + upper_radius(n_bin) = ChemState%ChemSpecies(Chemstate%SeaSaltIndex(n))%upper_radius + endif + endif + enddo + + ! Allocate index arrays + ALLOCATE(Chemstate%SeaSaltBinLower(n_bin), STAT=RC) + IF ( RC /= CC_SUCCESS ) THEN + errMsg = 'Error allocating Chemstate%SeaSaltBinLower' + call CC_Error(errMsg, RC, thisLoc) + RETURN + ENDIF + + ALLOCATE(Chemstate%SeaSaltBinUpper(n_bin), STAT=RC) + IF ( RC /= CC_SUCCESS ) THEN + errMsg = 'Error allocating Chemstate%SeaSaltBinUpper' + call CC_Error(errMsg, RC, thisLoc) + RETURN + ENDIF + + !sort bins by radius from low to high for lower_radius + mask(1:n_bin) = .TRUE. + do n = 1, n_bin + Chemstate%SeaSaltBinLower(n) = MINVAL(lower_radius,mask) + mask(MINLOC(lower_radius,mask)) = .FALSE. + enddo + + !sort bins by radius from low to high for upper_radius + mask(1:n_bin) = .TRUE. + do n = 1, n_bin + Chemstate%SeaSaltBinUpper(n) = MINVAL(upper_radius,mask) + mask(MINLOC(upper_radius,mask)) = .FALSE. + enddo + + !check if the bins are continuous + do n = 1, n_bin-1 + if ( .not. rae(Chemstate%SeaSaltBinUpper(n), Chemstate%SeaSaltBinLower(n+1)) ) then + errMsg = 'Sea Salt Bins are not continuous' + call CC_Error(errMsg, RC, thisLoc) + RETURN + endif + enddo + + end subroutine Find_SeaSalt_Bin + !> \brief Find the species by name !! !! \param ChemState The ChemState object diff --git a/src/core/config_mod.F90 b/src/core/config_mod.F90 index d66b1968..173a310b 100644 --- a/src/core/config_mod.F90 +++ b/src/core/config_mod.F90 @@ -155,6 +155,15 @@ SUBROUTINE Read_Input_File( Config , GridState, EmisState, ChemState, RC, Config RETURN ENDIF + call Config_Process_Bvoc(ConfigInput, Config, RC) + IF ( RC /= CC_SUCCESS ) THEN + errMsg = 'Error in "Config_Process_Bvoc"!' + CALL CC_Error( errMsg, RC, thisLoc ) + CALL QFYAML_CleanUp( ConfigInput ) + CALL QFYAML_CleanUp( ConfigAnchored ) + RETURN + ENDIF + call Config_Process_Plumerise(ConfigInput, Config, RC) IF ( RC /= CC_SUCCESS ) THEN errMsg = 'Error in "Config_Process_Plumerise"!' @@ -215,7 +224,7 @@ END SUBROUTINE Read_Input_File !! !!!> SUBROUTINE Config_Chem_State( filename, GridState, ChemState, RC ) - USE ChemState_Mod, ONLY : ChemStateType, Find_Number_of_Species, Find_Index_of_Species + USE ChemState_Mod, ONLY : ChemStateType, Find_Number_of_Species, Find_Index_of_Species, Find_SeaSalt_Bin use Config_Opt_Mod, ONLY : ConfigType USE Error_Mod USE GridState_Mod, ONLY : GridStateType @@ -236,7 +245,7 @@ SUBROUTINE Config_Chem_State( filename, GridState, ChemState, RC ) real :: v_real logical :: v_logical - Character(len=17) :: tags(17) + Character(len=17) :: tags(22) RC = CC_SUCCESS @@ -258,7 +267,12 @@ SUBROUTINE Config_Chem_State( filename, GridState, ChemState, RC ) 'mw_g ', & 'viscosity ', & 'density ', & - 'BackgroundVV '/) + 'BackgroundVV ', & + 'dd_f0 ', & + 'dd_hstar ', & + 'dd_DvzAerSnow ', & + 'dd_DvzMinVal_snow', & + 'dd_DvzMinVal_land'/) !======================================================================== @@ -539,6 +553,83 @@ SUBROUTINE Config_Chem_State( filename, GridState, ChemState, RC ) ChemState%ChemSpecies(n)%viscosity = v_real write(*,*) '| viscosity: ', ChemState%ChemSpecies(n)%viscosity + !------------------------------------------------- + ! Initialize variables needed for dry deposition + !------------------------------------------------- + + key = TRIM(ChemState%SpeciesNames(n)) // '%' // 'dd_f0' + !if missing set to zero or MISSING_REAL + v_real = MISSING_REAL + CALL QFYAML_Add_Get( ConfigInput, TRIM(key), v_real, "", RC ) + IF (RC /= CC_SUCCESS) then + if (ChemState%ChemSpecies(n)%is_drydep ) then + ! if is_drydep dd_f0 must be present + errMsg = 'dd_f0 required for dry deposition of ' // TRIM(ChemState%SpeciesNames(n)) + CALL CC_Error( errMsg, RC, thisLoc ) + RETURN + endif + ENDIF + ChemState%ChemSpecies(n)%dd_f0 = v_real + write(*,*) '| dd_f0: ', ChemState%ChemSpecies(n)%dd_f0 + + key = TRIM(ChemState%SpeciesNames(n)) // '%' // 'dd_hstar' + !if missing set to zero or MISSING_REAL + v_real = MISSING_REAL + CALL QFYAML_Add_Get( ConfigInput, TRIM(key), v_real, "", RC ) + IF (RC /= CC_SUCCESS) then + if (ChemState%ChemSpecies(n)%is_drydep) then + ! if is_drydep dd_hstar must be present + errMsg = 'dd_hstar required for dry deposition of ' // TRIM(ChemState%SpeciesNames(n)) + CALL CC_Error( errMsg, RC, thisLoc ) + RETURN + endif + ENDIF + ChemState%ChemSpecies(n)%dd_hstar = v_real + write(*,*) '| dd_hstar: ', ChemState%ChemSpecies(n)%dd_hstar + + key = TRIM(ChemState%SpeciesNames(n)) // '%' // 'dd_DvzAerSnow' + !if missing set to zero or MISSING_REAL + v_real = ZERO + CALL QFYAML_Add_Get( ConfigInput, TRIM(key), v_real, "", RC ) + IF (RC /= CC_SUCCESS) then + if (ChemState%ChemSpecies(n)%is_drydep) then + ! issue a warning and give it a zero value above + errMsg = 'Warning: dd_DvzAerSnow is not provided for ' // TRIM(ChemState%SpeciesNames(n)) + CALL CC_Error( errMsg, RC, thisLoc ) + endif + ENDIF + ChemState%ChemSpecies(n)%dd_DvzAerSnow = v_real + write(*,*) '| dd_DvzAerSnow: ', ChemState%ChemSpecies(n)%dd_DvzAerSnow + + key = TRIM(ChemState%SpeciesNames(n)) // '%' // 'dd_DvzMinVal_snow' + !if missing set to zero or MISSING_REAL + v_real = ZERO + CALL QFYAML_Add_Get( ConfigInput, TRIM(key), v_real, "", RC ) + IF (RC /= CC_SUCCESS) then + if (ChemState%ChemSpecies(n)%is_drydep) then + ! issue a warning and give it a zero value above + errMsg = 'Warning: dd_DvzMinVal_snow is not provided for ' // TRIM(ChemState%SpeciesNames(n)) + CALL CC_Error( errMsg, RC, thisLoc ) + endif + ENDIF + ChemState%ChemSpecies(n)%dd_DvzMinVal_snow = v_real + write(*,*) '| dd_DvzMinVal_snow: ', ChemState%ChemSpecies(n)%dd_DvzMinVal_snow + + key = TRIM(ChemState%SpeciesNames(n)) // '%' // 'dd_DvzMinVal_land' + !if missing set to zero or MISSING_REAL + v_real = ZERO + CALL QFYAML_Add_Get( ConfigInput, TRIM(key), v_real, "", RC ) + IF (RC /= CC_SUCCESS) then + if (ChemState%ChemSpecies(n)%is_drydep) then + ! issue a warning and give it a zero value above + errMsg = 'Warning: dd_DvzMinVal_land is not provided for ' // TRIM(ChemState%SpeciesNames(n)) + CALL CC_Error( errMsg, RC, thisLoc ) + endif + ENDIF + ChemState%ChemSpecies(n)%dd_DvzMinVal_land = v_real + write(*,*) '| dd_DvzMinVal_land: ', ChemState%ChemSpecies(n)%dd_DvzMinVal_land + + !--------------------------------------- ! Allocate initial Species Concentration !--------------------------------------- @@ -560,6 +651,13 @@ SUBROUTINE Config_Chem_State( filename, GridState, ChemState, RC ) RETURN ENDIF + CALL Find_SeaSalt_Bin(ChemState, RC) + IF (RC /= CC_SUCCESS) THEN + errMsg = 'Error in Find_SeaSalt_Bin' + CALL CC_Error( errMsg, RC, thisLoc ) + RETURN + ENDIF + write(*,*) '=========================================================' write(*,*) '| Chemstate SUMMARY' write(*,*) '| number_of_species: ', ChemState%nSpecies @@ -569,6 +667,8 @@ SUBROUTINE Config_Chem_State( filename, GridState, ChemState, RC ) write(*,*) '| number of tracers: ', ChemState%nSpeciesTracer write(*,*) '| number of dust: ', ChemState%nSpeciesDust write(*,*) '| number of seasalt: ', ChemState%nSpeciesSeaSalt + write(*,*) '| Sea Salt bin lower: ', ChemState%SeaSaltBinLower + write(*,*) '| Sea Salt bin upper: ', ChemState%SeaSaltBinUpper write(*,*) '=========================================================' END SUBROUTINE Config_Chem_State @@ -1315,6 +1415,7 @@ SUBROUTINE Config_Process_DryDep( ConfigInput, Config, RC ) ! ! Scalars LOGICAL :: v_bool + real(fp) :: v_real INTEGER :: v_int ! Strings @@ -1343,7 +1444,7 @@ SUBROUTINE Config_Process_DryDep( ConfigInput, Config, RC ) Config%drydep_activate = v_bool - key = "process%drydep%scheme_opt" + key = "process%drydep%aero_scheme_opt" v_int = MISSING_INT CALL QFYAML_Add_Get( ConfigInput, TRIM( key ), v_int, "", RC ) IF ( RC /= CC_SUCCESS ) THEN @@ -1351,7 +1452,7 @@ SUBROUTINE Config_Process_DryDep( ConfigInput, Config, RC ) v_int = 1 ! default is one RETURN ENDIF - Config%drydep_scheme = v_int + Config%drydep_aero_scheme = v_int key = "process%drydep%resuspension" @@ -1363,14 +1464,150 @@ SUBROUTINE Config_Process_DryDep( ConfigInput, Config, RC ) ENDIF Config%drydep_resuspension = v_bool + key = "process%drydep%gas_scheme_opt" + v_int = MISSING_INT + CALL QFYAML_Add_Get( ConfigInput, TRIM( key ), v_int, "", RC ) + IF ( RC /= CC_SUCCESS ) THEN + errMsg = TRIM( key ) // 'Not Found, Setting Default to 1' + v_int = 1 ! default is one + RETURN + ENDIF + Config%drydep_gas_scheme = v_int + + key = "process%drydep%co2_effect" + v_bool = MISSING_BOOL + CALL QFYAML_Add_Get( ConfigInput, TRIM( key ), v_bool, "", RC ) + IF ( RC /= CC_SUCCESS ) THEN + errMsg = TRIM( key ) // 'Not Found, Setting Default to FALSE' + CALL CC_Error( errMsg, RC, thisLoc ) + ENDIF + Config%drydep_co2_effect = v_bool + + key = "process%drydep%co2_level" + v_real = MISSING_REAL + CALL QFYAML_Add_Get( ConfigInput, TRIM( key ), v_real, "", RC ) + IF ( RC /= CC_SUCCESS ) THEN + errMsg = TRIM( key ) // 'Not Found, Setting Default to 600.0' + CALL CC_Error( errMsg, RC, thisLoc ) + v_real = 600.0_fp + ENDIF + Config%drydep_co2_level = v_real + + key = "process%drydep%co2_reference" + v_real = MISSING_REAL + CALL QFYAML_Add_Get( ConfigInput, TRIM( key ), v_real, "", RC ) + IF ( RC /= CC_SUCCESS ) THEN + errMsg = TRIM( key ) // 'Not Found, Setting Default to 380.0' + CALL CC_Error( errMsg, RC, thisLoc ) + v_real = 380.0_fp + ENDIF + Config%drydep_co2_reference = v_real + write(*,*) "DryDeposition Configuration" write(*,*) '------------------------------------' write(*,*) 'Config%drydep_activate = ', Config%drydep_activate - write(*,*) 'Config%drydep_scheme = ', Config%drydep_scheme + write(*,*) 'Config%drydep_aero_scheme = ', Config%drydep_aero_scheme + write(*,*) 'Config%drydep_gas_scheme = ', Config%drydep_gas_scheme write(*,*) 'Config%drydep_resuspension = ', Config%drydep_resuspension + write(*,*) 'Config%drydep_co2_effect = ', Config%drydep_co2_effect + write(*,*) 'Config%drydep_co2_level = ', Config%drydep_co2_level + write(*,*) 'Config%drydep_co2_reference = ', Config%drydep_co2_reference write(*,*) '------------------------------------' END SUBROUTINE Config_Process_DryDep + !> \brief Process BVOC configuration + !! + !! This function processes the biogenic VOC configuration and performs the necessary actions based on the configuration. + !! + !! \param[in] ConfigInput The YAML configuration object + !! \param[inout] Config The configuration object + !! \param[out] RC The return code + !! + !! \ingroup core_modules + !!!> + SUBROUTINE Config_Process_Bvoc( ConfigInput, Config, RC ) + USE CharPak_Mod, ONLY : StrSplit + USE Error_Mod + USE Config_Opt_Mod, ONLY : ConfigType + + TYPE(QFYAML_t), INTENT(INOUT) ::ConfigInput ! YAML Config object + TYPE(ConfigType), INTENT(INOUT) :: Config ! Input options + + ! + ! !OUTPUT PARAMETERS: + ! + INTEGER, INTENT(OUT) :: RC ! Success or failure + ! !LOCAL VARIABLES: + ! + ! Scalars + LOGICAL :: v_bool + INTEGER :: v_int + ! Reals + REAL(fp) :: v_real + ! Strings + CHARACTER(LEN=255) :: thisLoc + CHARACTER(LEN=512) :: errMsg + CHARACTER(LEN=QFYAML_StrLen) :: key + + !======================================================================== + ! Config_Process_Bvoc begins here! + !======================================================================== + + ! Initialize + RC = CC_SUCCESS + thisLoc = ' -> at Config_Process_Bvoc (in CATChem/src/core/config_mod.F90)' + errMsg = '' + ! TODO #105 Fix reading of config file + key = "process%bvoc%activate" + v_bool = MISSING_BOOL + CALL QFYAML_Add_Get( ConfigInput, TRIM( key ), v_bool, "", RC ) + IF ( RC /= CC_SUCCESS ) THEN + errMsg = 'Error parsing ' // TRIM( key ) // '!' + CALL CC_Error( errMsg, RC, thisLoc ) + RETURN + ENDIF + Config%bvoc_activate = v_bool + + key = "process%bvoc%scheme_opt" + v_int = MISSING_INT + CALL QFYAML_Add_Get( ConfigInput, TRIM( key ), v_int, "", RC ) + IF ( RC /= CC_SUCCESS ) THEN + errMsg = TRIM( key ) // ' Not Found, Setting Default to 1' + CALL CC_Warning( errMsg, RC, thisLoc ) + v_int = 1 ! default is one + ENDIF + Config%bvoc_scheme = v_int + + key = "process%bvoc%co2_inhib" + v_bool = MISSING_BOOL + CALL QFYAML_Add_Get( ConfigInput, TRIM( key ), v_bool, "", RC ) + IF ( RC /= CC_SUCCESS ) THEN + errMsg = TRIM( key ) // ' Not Found, Setting Default to TRUE' + CALL CC_Warning( errMsg, RC, thisLoc ) + v_bool = .TRUE. ! default is true + ENDIF + Config%megan_co2_inhib = v_bool + + key = 'process%bvoc%co2_conc_ppm' + v_real = MISSING_REAL + CALL QFYAML_Add_Get( ConfigInput, TRIM( key ), v_real, "", RC ) + IF ( RC /= CC_SUCCESS ) THEN + errMsg = TRIM( key ) // ' Not Found, Setting Default to 390.0' + CALL CC_Warning( errMsg, RC, thisLoc ) + v_real = 390.0_fp ! default is 390 ppm + ENDIF + Config%megan_co2_conc_ppm = v_real + + write(*,*) "BVOC Configuration" + write(*,*) '------------------------------------' + write(*,*) 'Config%bvoc_activate = ', Config%bvoc_activate + write(*,*) 'Config%bvoc_scheme = ', Config%bvoc_scheme + write(*,*) 'Config%megan_co2_inhib = ', Config%megan_co2_inhib + write(*,*) 'Config%megan_co2_conc_ppm = ', Config%megan_co2_conc_ppm + write(*,*) '------------------------------------' + + END SUBROUTINE Config_Process_Bvoc + END MODULE config_mod diff --git a/src/core/config_opt_mod.F90 b/src/core/config_opt_mod.F90 index cc62f873..8b79c79a 100644 --- a/src/core/config_opt_mod.F90 +++ b/src/core/config_opt_mod.F90 @@ -45,6 +45,10 @@ MODULE Config_Opt_Mod !! - `drydep_activate` : Activate drydep process !! - `drydep_scheme` : Scheme option for drydep process !! - `drydep_resuspension` : Activate resuspension + !! - `bvoc_activate` : Activate BVOC process + !! - `bvoc_scheme` : Scheme option for BVOC process + !! - `megan_co2_inhib` : use CO2 inhibition for isoprene? + !! - `megan_co2_conc_ppm` : If so, provide CO2 concentrations !! !! \ingroup core_modules !!!> @@ -94,13 +98,23 @@ MODULE Config_Opt_Mod INTEGER :: seasalt_scheme real(fp) :: seasalt_scalefactor + ! BVOC Process + LOGICAL :: bvoc_activate + INTEGER :: bvoc_scheme + LOGICAL :: megan_co2_inhib + real(fp) :: megan_co2_conc_ppm + ! Plumerise Process LOGICAL :: plumerise_activate ! DryDeposition Process LOGICAL :: drydep_activate - INTEGER :: drydep_scheme + INTEGER :: drydep_aero_scheme LOGICAL :: drydep_resuspension !< Turn on resuspension + INTEGER :: drydep_gas_scheme + LOGICAL :: drydep_co2_effect + real(fp) :: drydep_co2_level + real(fp) :: drydep_co2_reference END TYPE ConfigType @@ -173,8 +187,18 @@ SUBROUTINE Set_Config( am_I_Root, Config, RC ) ! Dry Dep Process Config%drydep_activate = .FALSE. - Config%drydep_scheme = 1 + Config%drydep_aero_scheme = 1 Config%drydep_resuspension = .FALSE. + Config%drydep_gas_scheme = 1 + Config%drydep_co2_effect = .FALSE. + Config%drydep_co2_level = 600.0_fp + Config%drydep_co2_reference = 380.0_fp + + !BVOC Process + Config%bvoc_activate = .FALSE. + Config%bvoc_scheme = 1 + Config%megan_co2_inhib = .TRUE. + Config%megan_co2_conc_ppm = 390.0_fp END SUBROUTINE Set_Config !> \brief Cleanup the Config options diff --git a/src/core/diagstate_mod.F90 b/src/core/diagstate_mod.F90 index 1317fd03..ec29f909 100644 --- a/src/core/diagstate_mod.F90 +++ b/src/core/diagstate_mod.F90 @@ -51,6 +51,15 @@ module DiagState_Mod real(fp), allocatable :: drydep_frequency(:) real(fp), allocatable :: drydep_vel(:) + ! MEGAN historical variables + ! TODO: this is better to be done in restart files if possible in the future + real(fp), allocatable :: T_LAST24H !< temperature of last 24 hours + real(fp), allocatable :: T_LASTXDAYS !< temperature of last NUM_DAYS + real(fp), allocatable :: PARDR_LASTXDAYS !< direct radiation of last NUM_DAYS + real(fp), allocatable :: PARDF_LASTXDAYS !< diffuse radiation of last NUM_DAYS + real(fp), allocatable :: PMISOLAI !< LAI of last 24 hours + + ! Species Specific Variables @@ -108,22 +117,33 @@ subroutine Diag_Allocate(Config, DiagState, ChemState, RC) ! If dry deposition process is activated then allocate dry dep related diagnostics !write (*,*) "ChemState%nSpeciesAeroDryDep=", ChemState%nSpeciesAeroDryDep if (Config%drydep_activate) then - Allocate(DiagState%drydep_frequency(ChemState%nSpeciesAeroDryDep), STAT=RC) + + Allocate(DiagState%drydep_frequency(ChemState%nSpeciesDryDep), STAT=RC) IF ( RC /= CC_SUCCESS ) THEN - ErrMsg = 'Could not Allocate DiagState%drydep_frequency(ChemState%nSpeciesAeroDryDep)' + ErrMsg = 'Could not Allocate DiagState%drydep_frequency(ChemState%nSpeciesDryDep)' CALL CC_Error( ErrMsg, RC, thisLoc ) + RETURN ENDIF - DiagState%drydep_frequency(ChemState%nSpeciesAeroDryDep)= ZERO + DiagState%drydep_frequency(ChemState%nSpeciesDryDep)= ZERO - Allocate(DiagState%drydep_vel(ChemState%nSpeciesAeroDryDep), STAT=RC) + Allocate(DiagState%drydep_vel(ChemState%nSpeciesDryDep), STAT=RC) IF ( RC /= CC_SUCCESS ) THEN - ErrMsg = 'Could not Allocate DiagState%drydep_vel(ChemState%nSpeciesAeroDryDep)' + ErrMsg = 'Could not Allocate DiagState%drydep_vel(ChemState%nSpeciesDryDep)' CALL CC_Error( ErrMsg, RC, thisLoc ) + RETURN ENDIF - DiagState%drydep_vel(ChemState%nSpeciesAeroDryDep)= ZERO + DiagState%drydep_vel(ChemState%nSpeciesDryDep)= ZERO endif + ! If bvoc process is activated then allocate bvoc related diagnostics + if (Config%bvoc_activate) then + DiagState%T_LAST24H = ZERO + DiagState%T_LASTXDAYS = ZERO + DiagState%PARDR_LASTXDAYS = ZERO + DiagState%PARDF_LASTXDAYS = ZERO + DiagState%PMISOLAI = ZERO + endif end subroutine Diag_Allocate diff --git a/src/core/metstate_mod.F90 b/src/core/metstate_mod.F90 index 164ccdb1..145d177b 100644 --- a/src/core/metstate_mod.F90 +++ b/src/core/metstate_mod.F90 @@ -192,6 +192,31 @@ MODULE MetState_Mod REAL(fp), ALLOCATABLE :: PMID(:) !< Average wet air pressure [hPa] defined as arithmetic average of edge pressures REAL(fp), ALLOCATABLE :: PMID_DRY(:) !< Dry air partial pressure [hPa] defined as arithmetic avg of edge pressures + ! Some met fields need for MEGAN but not included yet. Some variables can be calculated online in the future + !--------------------- + real(fp) :: PMISOLAI !< LAI of previous month + real(fp), pointer :: PFT_16(:) !< plant functional type fraction + real(fp) :: Q_DIR_2 !< surface downwelling par diffuse flux + real(fp) :: Q_DIFF_2 !< surface downwelling par beam flux + real(fp) :: PARDR_LASTXDAYS !< Avg. PARDF of last NUM_DAYS + real(fp) :: PARDF_LASTXDAYS !< Avg. PARDR of last NUM_DAYS + real(fp) :: T_LASTXDAYS !< Avg. temperature of last NUM_DAYS + real(fp) :: T_LAST24H !< Avg. temperature of last 24 hours + real(fp) :: LAT !< Latitude + integer :: DOY !< Day of year + real(fp) :: LocalHour !< Local hour + real(fp) :: D_BTW_M !< Days between mid-months + + !some met fields need for Wesely dry deposition but not included yet + !--------------------------------------- + real(fp) :: OBK !< Monin-Obhukov length [m] + integer, allocatable :: ILAND(:) !< Land type ID in current grid box + real(fp) :: SALINITY !< Sea water salinity + real(fp) :: IODIDE !< Iodine concentration (TODO: may be get from ChemState) + real(fp) :: LON !< Longitude + character(len=20) :: LUCNAME !< name of land use category + logical :: LNLPBL !< non-local PBL scheme flag (TODO:where to put this ) + END TYPE MetStateType CONTAINS diff --git a/src/core/species_mod.F90 b/src/core/species_mod.F90 index 338d18bc..cdf7bc51 100644 --- a/src/core/species_mod.F90 +++ b/src/core/species_mod.F90 @@ -50,6 +50,12 @@ module species_mod real(kind=fp) :: upper_radius !< upper radius in meters real(kind=fp) :: viscosity !< kinematic viscosity (m2/s) + ! used for dry deposition + real(kind=fp) :: dd_f0 !< reactivity factor for oxidation of biological substances + real(kind=fp) :: dd_hstar !< Henry’s law constant + real(kind=fp) :: dd_DvzAerSnow !< fix dry deposition velocity (cm/s) over ice and snow for certain aerosol species + real(kind=fp) :: dd_DvzMinVal_snow !< minimum dry deposition velocity (cm/s) over snow and ice + real(kind=fp) :: dd_DvzMinVal_land !< minimum dry deposition velocity (cm/s) over land ! Default background concentration real(kind=fp) :: BackgroundVV !< Background conc [v/v] diff --git a/src/process/CMakeLists.txt b/src/process/CMakeLists.txt index a563f0b7..109da070 100644 --- a/src/process/CMakeLists.txt +++ b/src/process/CMakeLists.txt @@ -4,4 +4,5 @@ add_subdirectory(dust) add_subdirectory(seasalt) add_subdirectory(plumerise) add_subdirectory(drydep) +add_subdirectory(bvoc) add_subdirectory(chem) diff --git a/src/process/bvoc/CCPr_BVOC_Mod.F90 b/src/process/bvoc/CCPr_BVOC_Mod.F90 new file mode 100644 index 00000000..7a680e60 --- /dev/null +++ b/src/process/bvoc/CCPr_BVOC_Mod.F90 @@ -0,0 +1,402 @@ +!> \brief Driver for the CATCHem Process: BVOC +!! +!! +!! \defgroup catchem_bvoc_process +!! +!! \author Wei Li +!! \date 07/2024 +!!!> +MODULE CCPR_BVOC_mod + USE Precision_mod, only : fp, ZERO + USE Error_Mod, Only : CC_Error, CC_SUCCESS, CC_FAILURE, CC_CheckVar + USE constants, only : PI_180 + USE DiagState_Mod, Only : DiagStateType + USE MetState_Mod, Only : MetStateType + USE ChemState_Mod, Only : ChemStateType + USE Config_Opt_Mod, Only : ConfigType + USE CCPr_BVOC_Common_Mod, Only : BvocStateType + USE EmisState_Mod, Only : EmisStateType + + IMPLICIT NONE + + PRIVATE + + PUBLIC :: CCPR_BVOC_Init + PUBLIC :: CCPR_BVOC_Run + PUBLIC :: CCPR_BVOC_Final + +CONTAINS + + !> + !! \brief Initialize the CATChem BVOC module + !! + !! \param Config_Opt CATCHem configuration options + !! \param BvocState CATCHem Bvoc state + !! \param EmisState CATCHem Emission state + !! \param ChmState CATCHem chemical state + !! \param RC Error return code + !! + !!!> + !SUBROUTINE CCPR_BVOC_Init( Config, ChemState, EmisState, BvocState, RC ) + SUBROUTINE CCPR_BVOC_Init( Config, EmisState, BvocState, RC ) + ! USE + + IMPLICIT NONE + ! INPUT PARAMETERS + !----------------- + TYPE(ConfigType), intent(in) :: Config ! Module options + !TYPE(ChemStateType), intent(in) :: ChemState ! Chemical state + TYPE(EmisStateType), intent(in) :: EmisState ! Emission state + + ! INPUT/OUTPUT PARAMETERS + !------------------------ + TYPE(BvocStateType), intent(inout) :: BvocState ! Bvoc state + INTEGER, intent(inout) :: RC ! Success or failure + + ! Error handling + !--------------- + CHARACTER(LEN=255) :: ErrMsg + CHARACTER(LEN=255) :: ThisLoc + + ! LOCAL VARIABLES + !---------------- + INTEGER :: c + + ! Put any local variables here + + !================================================================= + ! CCPR_BVOC_Init begins here! + !================================================================= + RC = CC_SUCCESS + ThisLoc = ' -> at CCPR_BVOC_INIT (in process/bvoc/ccpr_bvoc_mod.F90)' + + ! First check if process is activated in config | if not don't allocate arrays or pointers + if (Config%Bvoc_activate) then + + ! Activate Process + !------------------ + BvocState%Activate = .true. + + ! Set Scheme Options + !------------------- + if (Config%bvoc_scheme < 0) then ! not listed in config + BvocState%SchemeOpt = 1 + else + BvocState%SchemeOpt = Config%bvoc_scheme + endif + + ! CO2 inhibition option + !TODO: what if it is not given in the configuration file properly + !------------------ + BvocState%CO2Inhib = Config%megan_co2_inhib + + ! Set CO2 concentration (ppm) + ! In case it is given as a negative value in config + !---------------------------- + if (Config%megan_co2_conc_ppm < 0) then + BvocState%CO2conc = 390.0_fp + else + BvocState%CO2conc = Config%megan_co2_conc_ppm + endif + + ! Check GLOBCO2 if CO2 inhibition is turned on (LISOPCO2 = .TRUE.) + ! GLOBCO2 should be between 150-1250 ppmv. Isoprene response to + ! CO2 outside this range has no empirical basis. + if ( BvocState%CO2Inhib ) then + if ( BvocState%CO2conc < 150.0_fp .or. & + BvocState%CO2conc > 1250.0_fp ) then + RC = CC_FAILURE + ErrMsg = 'Global CO2 outside valid range of 150-1250 ppmv!' + call CC_Error( errMsg, RC, thisLoc ) + return + endif + endif + + !-------------------------------------------- + !Find bvoc caterory index in EmisState for future use + do c = 1, EmisState%nCats + if (EmisState%Cats(c)%name == 'BVOC') then + BvocState%CatIndex = c + exit + endif + end do + + ! Set number of species from EmisState + !---------------------- + BvocState%nBvocSpecies = EmisState%Cats(BvocState%CatIndex)%nSpecies + + !------------------------------------ + ! Allocate emission species index + ALLOCATE( BvocState%BvocSpeciesIndex(BvocState%nBvocSpecies), STAT=RC ) + CALL CC_CheckVar('BvocState%BvocSpeciesIndex', 0, RC) + IF (RC /= CC_SUCCESS) RETURN + BvocState%BvocSpeciesIndex = -1 + + ! Allocate emission speceis names + ALLOCATE( BvocState%BvocSpeciesName(BvocState%nBvocSpecies), STAT=RC ) + CALL CC_CheckVar('BvocState%BvocSpeciesName', 0, RC) + IF (RC /= CC_SUCCESS) RETURN + BvocState%BvocSpeciesName = '' + + ! Allocate CatChem species index + ALLOCATE( BvocState%SpcIDs(BvocState%nBvocSpecies), STAT=RC ) + CALL CC_CheckVar('BvocState%SpcIDs', 0, RC) + IF (RC /= CC_SUCCESS) RETURN + BvocState%SpcIDs = -1 + + ! Allocate emission flux + ALLOCATE( BvocState%EmissionPerSpecies(BvocState%nBvocSpecies), STAT=RC ) + CALL CC_CheckVar('BvocState%EmissionPerSpecies', 0, RC) + IF (RC /= CC_SUCCESS) RETURN + BvocState%EmissionPerSpecies = ZERO + + ! Allocate normalized factor + ! There should be a different normalization factor for each compound, but + ! we calculate only 1 normalization factor for all compounds + ALLOCATE( BvocState%EmisNormFactor(1) , STAT=RC) + CALL CC_CheckVar('BvocState%EmisNormFactor', 0, RC) + IF (RC /= CC_SUCCESS) RETURN + BvocState%EmisNormFactor(1) = 1.0_fp + + !initialize the total emission + BvocState%TotalEmission = ZERO + + !TODO: emission factor from 7 speceis are read from files and put in MetSate by now + ! Others are calculated using 'PFT_16', which is also added in MetState + ! Some met values (last 15 day T average) may need another function and be saved to restart file. + + !TODO: emission species name and ID should read from a namelist. Give them values for now + ! They are not really used since EmisState controls the species needed now. Keep it as comments for now. + !BvocState%BvocSpeciesIndex = (/1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21/) + !BvocState%BvocSpeciesName(/'ISOP','APIN','BPIN','LIMO','SABI','MYRC','CARE', + !'OCIM','OMON','ALD2','MOH', 'EOH', 'MBOX','FAXX', + !'AAXX','ACET','PRPE','C2H4','FARN','BCAR','OSQT' /) + + else + + BvocState%Activate = .false. + + endif + + end subroutine CCPR_BVOC_Init + + !> + !! \brief Run the BVOC process + !! + !! \param [IN] MetState The MetState object + !! \param [INOUT] DiagState The DiagState object + !! \param [INOUT] BvocState The BvocState object + !! \param [INOUT] ChemState The ChemState object + !! \param [INOUT] EmisState The EmisState object + !! \param [OUT] RC Return code + !!!> + !SUBROUTINE CCPr_BVOC_Run( MetState, EmisState, DiagState, BvocState, ChemState, RC ) + SUBROUTINE CCPr_BVOC_Run( MetState, EmisState, DiagState, BvocState, RC ) + + ! USE + USE CCPr_Scheme_MeganV21_Mod, ONLY: CCPr_Scheme_MeganV21 ! Megan scheme + USE CCPr_BVOC_Common_Mod, Only : CALC_NORM_FAC + + IMPLICIT NONE + ! INPUT PARAMETERS + TYPE(MetStatetype), INTENT(INOUT) :: MetState ! MetState Instance + + ! INPUT/OUTPUT PARAMETERS + TYPE(EmisStateType), INTENT(INOUT) :: EmisState ! Emission Instance + TYPE(DiagStatetype), INTENT(INOUT) :: DiagState ! DiagState Instance + TYPE(BvocStateType), INTENT(INOUT) :: BvocState ! Bvoc State Instance + !TYPE(ChemStatetype), INTENT(INOUT) :: ChemState ! ChemState Instance + + ! OUTPUT PARAMETERS + INTEGER, INTENT(OUT) :: RC ! Return Code + + ! LOCAL VARIABLES + CHARACTER(LEN=255) :: ErrMsg, thisLoc, MSG + REAL(fp),PARAMETER :: D2RAD = PI_180 + integer :: s !, c, cat_bvoc_idx + ! e-folding time to be applied to long-term past conditions (in days) + REAL(fp), PARAMETER :: TAU_DAYS = 5.0_fp + ! e-folding time to be applied to short-term past conditions (in hours) + REAL(fp), PARAMETER :: TAU_HOURS = 12.0_fp + REAL(fp) :: TS_EMIS !emission time step + REAL(fp) :: DNEWFRAC ! Weight for new value in running mean (Days) + REAL(fp) :: DOLDFRAC ! Weight for old value in running mean (Days) + REAL(fp) :: HNEWFRAC ! Weight for new value in running mean (24H) + REAL(fp) :: HOLDFRAC ! Weight for old value in running mean (24H) + logical, save :: FIRST = .TRUE. + + ! Initialize + RC = CC_SUCCESS + errMsg = '' + thisLoc = ' -> at CCPr_BVOC_Run (in process/bvoc/ccpr_bvoc_mod.F90)' + + ! Run the BVOC Scheme if activated + !---------------------------------- + if (BvocState%Activate) then + + if (FIRST) then + ! Calculate normalization factor + ! Not really used now based on Sam's method in which 0.21 is used + CALL CALC_NORM_FAC( D2RAD, BvocState%EmisNormFactor(1), RC ) + if (RC /= CC_SUCCESS) then + MSG = 'call on CALC_NORM_FAC failed!' + call CC_Error( MSG, RC , thisLoc) + endif + FIRST = .FALSE. + endif + + ! Set to 1 day since we know that LAI is updated every day. + MetState%D_BTW_M= 1.0_fp + + ! Run the BVOC Scheme (only MEGANv2.1 for now) + ! Put the scheme function in a loop based on EmisSate%cat%nSpecies and calculate + ! the flux we need and do not need to map the flux back to EmisState + !------------------------- + do s = 1, EmisState%Cats(BvocState%CatIndex)%nSpecies + + if (BvocState%SchemeOpt == 1) then ! MEGANv2.1 + call CCPr_Scheme_MeganV21( & + EmisState%Cats(BvocState%CatIndex)%Species(s)%name, & + EmisState%Cats(BvocState%CatIndex)%Species(s)%Flux(1), & + MetState%LAI, & + MetState%PFT_16, & + MetState%PMISOLAI, & + MetState%Q_DIR_2, & + MetState%Q_DIFF_2, & + MetState%PARDR_LASTXDAYS, & + MetState%PARDF_LASTXDAYS, & + MetState%TS, & + MetState%T_LASTXDAYS, & + MetState%T_LAST24H, & + MetState%GWETROOT, & + BvocState%CO2Inhib, & + BvocState%CO2conc, & + MetState%SUNCOS, & + MetState%LAT, & + MetState%DOY, & + MetState%LocalHour, & + MetState%D_BTW_M, & + RC) + if (RC /= CC_SUCCESS) then + errMsg = 'Error in CCPr_Scheme_MeganV21' + CALL CC_Error( errMsg, RC, thisLoc ) + endif + else + errMsg = 'ERROR: Unknown BVOC scheme option' + RC = CC_FAILURE + CALL CC_Error( errMsg, RC, thisLoc ) + return + + endif !end if scheme option + + !put it back to BvocState (may not be necessary) + BvocState%BvocSpeciesIndex(s) = s + BvocState%BvocSpeciesName(s) = EmisState%Cats(BvocState%CatIndex)%Species(s)%name + BvocState%EmissionPerSpecies(s) = EmisState%Cats(BvocState%CatIndex)%Species(s)%Flux(1) + BvocState%TotalEmission = BvocState%TotalEmission + BvocState%EmissionPerSpecies(s) + + end do ! for each species requested in EmisState + + !----------------------------------------------------------------- + ! Update historical temperature / radiation values + !----------------------------------------------------------------- + ! Calculate weights for running means of historic variables + ! DNEWFRAC and DOLDFRAC are the weights given to the current + ! and existing value, respectively, when updating running means + ! over the last X days. HNEWFRAC and HOLDFRAC are the same but + ! for the 24H means. (following MEGAN in HEMCO) + + !TODO: use the same time step with MET for now; emission may have its own in the future; make sure the unit is seconds + TS_EMIS = MetState%TSTEP + DNEWFRAC = TS_EMIS / ( TAU_DAYS * 24.0_fp * 3600.0_fp ) + DOLDFRAC = 1.0_fp - DNEWFRAC + HNEWFRAC = TS_EMIS / ( TAU_HOURS * 3600.0_fp ) + HOLDFRAC = 1.0_fp - HNEWFRAC + + ! Updated temperature of last 24 hours + MetState%T_LAST24H = ( HOLDFRAC * MetState%T_LAST24H ) + ( HNEWFRAC * MetState%TS ) + ! Updated temperature of last NUM_DAYS + MetState%T_LASTXDAYS = ( DOLDFRAC * MetState%T_LASTXDAYS ) + ( DNEWFRAC * MetState%TS ) + ! Updated direct radiation of last NUM_DAYS + MetState%PARDR_LASTXDAYS = ( DOLDFRAC * MetState%PARDR_LASTXDAYS ) + ( DNEWFRAC * MetState%Q_DIR_2 ) + ! Updated diffuse radiation of last NUM_DAYS + MetState%PARDF_LASTXDAYS = ( DOLDFRAC * MetState%PARDF_LASTXDAYS ) + ( DNEWFRAC * MetState%Q_DIFF_2 ) + ! Updated LAI of last 24 hours (named LAI_PREVDAY in HEMCO and given to PMISOLAI; here we use PMISOLAI directly) + MetState%PMISOLAI = ( HOLDFRAC * MetState%PMISOLAI ) + ( HNEWFRAC * MetState%LAI ) + + ! Fill Diagnostic Variables + !TODO: This is better to be done in Restart files if we have them in the future + !TODO: There also should be some initial values for these historical variables if it is a 'cold' start. The initial values used in HEMCO is: + !TODO: T_LAST24H =288.15_fp; T_LASTXDAYS =288.15; PARDR_LASTXDAYS=30.0; PARDF_LASTXDAYS=48.0; PMISOLAI =current LAI + !-------------------------- + DiagState%T_LAST24H = MetState%T_LAST24H + DiagState%T_LASTXDAYS = MetState%T_LASTXDAYS + DiagState%PARDR_LASTXDAYS = MetState%PARDR_LASTXDAYS + DiagState%PARDF_LASTXDAYS = MetState%PARDF_LASTXDAYS + DiagState%PMISOLAI = MetState%PMISOLAI + + endif !if BOVC is activated or not + + end subroutine CCPr_BVOC_Run + + !> + !! \brief Finalize BVOC + !! + !! \param [INOUT] BvocState + !! \param [OUT] RC Return code + !!!> + SUBROUTINE CCPr_BVOC_Final( BVOCState, RC ) + + ! USE + !---- + + IMPLICIT NONE + + ! INPUT/OUTPUT PARAMETERS + TYPE(BvocStateType), INTENT(INOUT) :: BvocState ! BvocState Instance + + ! OUTPUT PARAMETERS + INTEGER, INTENT(OUT) :: RC ! Return Code + + ! LOCAL VARIABLES + CHARACTER(LEN=255) :: ErrMsg, thisLoc + + ! Initialize + RC = CC_SUCCESS + errMsg = '' + thisLoc = ' -> at CCPr_BVOC_Final (in process/bvoc/ccpr_BVOC_mod.F90)' + + ! Deallocate any arrays here + IF (ALLOCATED(BvocState%BvocSpeciesIndex)) THEN + DEALLOCATE( BvocState%BvocSpeciesIndex, STAT=RC ) + CALL CC_CheckVar('BvocState%BvocSpeciesIndex', 0, RC) + IF (RC /= CC_SUCCESS) RETURN + ENDIF + + IF (ALLOCATED(BvocState%BvocSpeciesName)) THEN + DEALLOCATE( BvocState%BvocSpeciesName, STAT=RC ) + CALL CC_CheckVar('BvocState%BvocSpeciesName', 0, RC) + IF (RC /= CC_SUCCESS) RETURN + ENDIF + + IF (ALLOCATED(BvocState%SpcIDs)) THEN + DEALLOCATE( BvocState%SpcIDs, STAT=RC ) + CALL CC_CheckVar('BvocState%SpcIDs', 0, RC) + IF (RC /= CC_SUCCESS) RETURN + ENDIF + + IF (ALLOCATED(BvocState%EmissionPerSpecies)) THEN + DEALLOCATE( BvocState%EmissionPerSpecies, STAT=RC ) + CALL CC_CheckVar('BvocState%EmissionPerSpecies', 0, RC) + IF (RC /= CC_SUCCESS) RETURN + ENDIF + + IF (ALLOCATED(BvocState%EmisNormFactor)) THEN + DEALLOCATE( BvocState%EmisNormFactor, STAT=RC ) + CALL CC_CheckVar('BvocState%EmisNormFactor', 0, RC) + IF (RC /= CC_SUCCESS) RETURN + ENDIF + + end subroutine CCPr_BVOC_Final + +END MODULE CCPR_BVOC_Mod diff --git a/src/process/bvoc/CMakeLists.txt b/src/process/bvoc/CMakeLists.txt new file mode 100644 index 00000000..9ff46410 --- /dev/null +++ b/src/process/bvoc/CMakeLists.txt @@ -0,0 +1,15 @@ +set( + _srcs + CCPr_BVOC_Mod.F90 + ccpr_bvoc_common_mod.F90 + ccpr_scheme_meganv21_mod.F90 +) + +set(_lib CATChem_process_bvoc) + +add_library(${_lib} ${_srcs}) +target_link_libraries(${_lib} PUBLIC CATChem_core) +set_target_properties( + ${_lib} + PROPERTIES Fortran_MODULE_DIRECTORY ${CMAKE_BINARY_DIR}/include +) diff --git a/src/process/bvoc/ccpr_bvoc_common_mod.F90 b/src/process/bvoc/ccpr_bvoc_common_mod.F90 new file mode 100644 index 00000000..83ae8196 --- /dev/null +++ b/src/process/bvoc/ccpr_bvoc_common_mod.F90 @@ -0,0 +1,1772 @@ +!> +!! \file ccpr_bvoc_common_mod.F90 +!! \brief Contains module ccpr_bvoc_common_mod +!! +!! \ingroup catchem_bvoc_process +!! +!! \author Barry Baker +!! \date 05/2024 +!!!> +module CCPr_BVOC_Common_Mod + use precision_mod, only: fp, ZERO, rae + use Error_Mod + use constants + implicit none + private + + public :: GET_MEGAN_PARAMS + public :: GET_GAMMA_PAR_PCEEA + public :: GET_GAMMA_PAR_C + public :: GET_GAMMA_T_LI + public :: GET_GAMMA_T_LD + public :: GET_GAMMA_T_LD_C + public :: GET_GAMMA_LAI + public :: GET_GAMMA_AGE + public :: GET_GAMMA_SM + public :: CALC_NORM_FAC + public :: Calc_Sun_Frac + public :: SOLAR_ANGLE + public :: GET_GAMMA_CO2 + public :: CALC_AEF + public :: GET_CDEA + public :: BvocStateType + + !> \brief Type for CATCHem BVOC Process + !! + !! \details Contains all the information needed to run the CATChem BVOC Process + !! + !! This type contains the following variables: + !! - Activate : Activate Process (True/False) + !! - nBvocSpecies : Number of BVOC processes + !! - BvocSpeciesIndex : Index of BVOC species + !! - SpcIDs : CATChem species IDs + !! - CO2Inhib : CO2 inhibition for isoprene Option [true/false] + !! - CO2conc : CO2 concentration [ppmv] + !! - ISOPscale : factors to scale isoprene emissions + !! - ISOPtoSOAP : isoprene conversion factor to SOAP + !! - ISOPtoSOAS : isoprene conversion factor to SOAS + !! - MONOtoSOAP : monoterpene conversion factor to SOAP + !! - MONOtoSOAS : monoterpene conversion factor to SOAS + !! - TERPtoSOAP : other terpene conversion factor to SOAP + !! - TERPtoSOAS : other terpene conversion factor to SOAS + !! - TotalEmission : Total Emission [kg/m^2/s] + !! - EmissionPerSpecies : Emission Rate per Bvoc species [kg/m^2/s] + !! + !! \ingroup catchem_bvoc_process + !!!> + TYPE :: BvocStateType + ! Generic Variables for Every Process + Logical :: Activate !< Activate Process (True/False) + INTEGER :: SchemeOpt !< Scheme Option + integer :: nBvocSpecies !< Number of BVOC processes + integer, allocatable :: BvocSpeciesIndex(:) !< Index of BVOC species + character(len=31), allocatable :: BvocSpeciesName(:) !< name of BVOC species + integer, allocatable :: SpcIDs(:) !< CATChem species IDs + integer :: CatIndex !< Index of emission category in EmisState + + ! Process Specific Parameters + real(fp) :: TotalEmission !< Total emission [kg/m^2/s] + real(fp), allocatable :: EmissionPerSpecies(:) !< Emission per species [kg/m^2/s] + real(fp), allocatable :: EmisNormFactor(:) !< Emission normalized factor (onle one used for all now) + + ! Scheme Options (ISOP scaling is turned off at the moment) + Logical :: CO2Inhib !< CO2 inhibition for isoprene Option [True/False] + real(fp) :: CO2conc !< CO2 concentration [ppmv] + !real(fp) :: ISOPscale !< factors to scale isoprene emissions + !real(fp) :: ISOPtoSOAP !< isoprene conversion factor to SOAP + !real(fp) :: ISOPtoSOAS !< isoprene conversion factor to SOAS + !real(fp) :: MONOtoSOAP !< monoterpene conversion factor to SOAP + !real(fp) :: MONOtoSOAS !< monoterpene conversion factor to SOAS + !real(fp) :: TERPtoSOAP !< other terpenes conversion factor to SOAP + !real(fp) :: TERPtoSOAS !< other terpenes conversion factor to SOAS + + + !================================================================= + ! Module specific variables/arrays/data pointers come below + !================================================================= + + END TYPE BvocStateType + +contains + !> + !! \brief Computes the light-independent fraction of emissions + !! + !!References: + !! new function from below Sam et al, 2020 + !! Silva, S. J., Heald, C. L., and Guenther, A. B.: Development of a reduced-complexity + !! plant canopy physics surrogate model for use in chemical transport models: a case study + !! with GEOS-Chem v12.3.0, Geosci. Model Dev., 13, 2569–2585, + !! https://doi.org/10.5194/gmd-13-2569-2020, 2020. + !! + !! \param LAI leaf area index + !! \param Sinbeta + !! \param Distgauss Gauss distance + !! \param SunFrac output of light-dependent emission factor + !! + !! \ingroup catchem_bvoc_process + !!!> + subroutine Calc_Sun_Frac( LAI, Sinbeta, Distgauss, SunFrac) + IMPLICIT NONE + ! Parameters + !----------- + real(fp), intent(in) :: LAI !< leaf area index + real(fp), intent(in) :: Sinbeta !< + real(fp), intent(in) :: Distgauss !< + real(fp), intent(out) :: SunFrac !< Activity factor for the light-independent fraction of emissions + + ! Local Variables + !---------------- + real(fp), parameter :: Cluster = 0.9 !< Standard reference temperature [K] + real(fp), parameter :: CANTRAN = 0.2 !< + real(fp) :: Kb, LAIadj, LAIdepth !< + + !-------------------------------------------- + ! main function + !-------------------------------------------- + Kb = Cluster * 0.5 / Sinbeta + LAIadj = LAI / ( 1 - CANTRAN ) + LAIdepth = LAIadj * Distgauss + + if ((Sinbeta > 0.002) .AND. (LAIadj > 0.001)) then + SunFrac = EXP(-Kb * LAIdepth) + else + SunFrac = 0.2 + endif + return + + end subroutine Calc_Sun_Frac + + !> + !! \returns the emission parameters for each MEGAN compound needed to compute emissions. + !! + !! Guenther et al, (GMD 2012) and associated MEGANv2.1 source code + !! + !! \param CPD, + !! \param BTA, LIDF, C_T1, C_EO, A_NEW, A_GRO, A_MAT, A_OLD, BI_DIR + !! + !! \ingroup catchem_bvoc_process + !!!> + subroutine GET_MEGAN_PARAMS( CPD, BTA, LIDF, C_T1, C_EO, A_NEW, A_GRO, A_MAT, A_OLD, BI_DIR, RC) + + ! Uses + use precision_mod, only : fp + use Error_Mod, Only : CC_FAILURE, CC_Error + IMPLICIT NONE + ! input Parameters + character(LEN=256), intent(in) :: CPD ! Compound name + ! input/output Parameters + real(fp), intent(inout) :: BTA !< Beta coefficient for temperature activity factor for light-independent fraction + + real(fp), intent(inout) :: LIDF !< Light-dependent fraction of emissions + real(fp), intent(inout) :: C_T1 !< CT1 parameter for temperature activity factor for light-dependent fraction + real(fp), intent(inout) :: C_EO !< Ceo parameter for temperature activity factor for light-dependent fraction + real(fp), intent(inout) :: A_NEW !< Relative emission factor (new leaves) + real(fp), intent(inout) :: A_GRO !< Relative emission factor (growing leaves) + real(fp), intent(inout) :: A_MAT !< Relative emission factor (mature leaves) + real(fp), intent(inout) :: A_OLD !< Relative emission factor (old leaves) + logical, intent(inout) :: BI_DIR !< Logical flag to indicate bidirectional exchange + integer, intent(out) :: RC !< Success or Failure + + !local variables + character(len=255) :: MSG, thisLoc + + !================================================================= + ! GET_MEGAN_PARAMS begins here! + !================================================================= + + ! Initialize values + BTA = 0.0_fp + LIDF = 0.0_fp + C_T1 = 0.0_fp + C_EO = 0.0_fp + A_NEW = 0.0_fp + A_GRO = 0.0_fp + A_MAT = 0.0_fp + A_OLD = 0.0_fp + BI_DIR = .FALSE. + + ! ---------------------------------------------------------------- + ! Note that not all the above compounds are used in standard chemistry + ! simulations, but they are provided here for future incorporation or + ! specialized applications. More compounds can be added as needed + ! by adding the corresponding CPD name and the appropriate parameters. + ! + ! Values are from Table 4 in Guenther et al., 2012 + ! ---------------------------------------------------------------- + + ! Isoprene, MBO + IF ( TRIM(CPD) == 'ISOP' .OR. & + TRIM(CPD) == 'MBOX' ) THEN + BTA = 0.13_fp ! Not actually used for ISOP, MBO + LIDF = 1.0_fp + C_T1 = 95.0_fp + C_EO = 2.0_fp + A_NEW = 0.05_fp + A_GRO = 0.6_fp + A_MAT = 1.0_fp + A_OLD = 0.9_fp + BI_DIR = .FALSE. + + ! Myrcene, sabinene, alpha-pinene + ELSE IF ( TRIM(CPD) == 'MYRC' .OR. & + TRIM(CPD) == 'SABI' .OR. & + TRIM(CPD) == 'APIN' ) THEN + BTA = 0.10_fp + LIDF = 0.6_fp + C_T1 = 80.0_fp + C_EO = 1.83_fp + A_NEW = 2.0_fp + A_GRO = 1.8_fp + A_MAT = 1.0_fp + A_OLD = 1.05_fp + BI_DIR = .FALSE. + + ! Limonene, 3-carene, beta-pinene + ELSE IF ( TRIM(CPD) == 'LIMO' .OR. & + TRIM(CPD) == 'CARE' .OR. & + TRIM(CPD) == 'BPIN' ) THEN + BTA = 0.10_fp + LIDF = 0.2_fp + C_T1 = 80.0_fp + C_EO = 1.83_fp + A_NEW = 2.0_fp + A_GRO = 1.8_fp + A_MAT = 1.0_fp + A_OLD = 1.05_fp + BI_DIR = .FALSE. + + ! t-beta-ocimene + ELSE IF ( TRIM(CPD) == 'OCIM' ) THEN + BTA = 0.10_fp + LIDF = 0.8_fp + C_T1 = 80.0_fp + C_EO = 1.83_fp + A_NEW = 2.0_fp + A_GRO = 1.8_fp + A_MAT = 1.0_fp + A_OLD = 1.05_fp + BI_DIR = .FALSE. + + ! Other monoterpenes (lumped) + ELSE IF ( TRIM(CPD) == 'OMON' ) THEN + BTA = 0.10_fp + LIDF = 0.4_fp + C_T1 = 80.0_fp + C_EO = 1.83_fp + A_NEW = 2.0_fp + A_GRO = 1.8_fp + A_MAT = 1.0_fp + A_OLD = 1.05_fp + BI_DIR = .FALSE. + + ! Methanol + ELSE IF ( TRIM(CPD) == 'MOH' ) THEN + BTA = 0.08_fp + LIDF = 0.8_fp + C_T1 = 60.0_fp + C_EO = 1.6_fp + A_NEW = 3.5_fp + A_GRO = 3.0_fp + A_MAT = 1.0_fp + A_OLD = 1.2_fp + BI_DIR = .FALSE. + + ! Acetone + ELSE IF ( TRIM(CPD) == 'ACET' ) THEN + BTA = 0.1_fp + LIDF = 0.2_fp + C_T1 = 80.0_fp + C_EO = 1.83_fp + A_NEW = 1.0_fp + A_GRO = 1.0_fp + A_MAT = 1.0_fp + A_OLD = 1.0_fp + BI_DIR = .FALSE. + + ! Bidirectional VOC: Ethanol, formaldehyde, acetaldehyde, formic acid, + ! acetic acid + ELSE IF ( TRIM(CPD) == 'EOH' .OR. & + TRIM(CPD) == 'CH2O' .OR. & + TRIM(CPD) == 'ALD2' .OR. & + TRIM(CPD) == 'FAXX' .OR. & + TRIM(CPD) == 'AAXX' ) THEN + BTA = 0.13_fp + LIDF = 0.8_fp + C_T1 = 95.0_fp + C_EO = 2.0_fp + A_NEW = 1.0_fp + A_GRO = 1.0_fp + A_MAT = 1.0_fp + A_OLD = 1.0_fp + BI_DIR = .TRUE. + + ! Stress VOCs: ethene, toluene, HCN + ! There are others species in this category but none are currently + ! used in GEOS-Chem + ELSE IF ( TRIM(CPD) == 'C2H4' .OR. & + TRIM(CPD) == 'TOLU' .OR. & + TRIM(CPD) == 'HCNX' ) THEN + BTA = 0.1_fp + LIDF = 0.8_fp + C_T1 = 80.0_fp + C_EO = 1.83_fp + A_NEW = 1.0_fp + A_GRO = 1.0_fp + A_MAT = 1.0_fp + A_OLD = 1.0_fp + BI_DIR = .FALSE. + + ! Other VOCs: >C2 alkenes + ! This includes propene, butene and very minor contribution from + ! larger alkenes + ELSE IF ( TRIM(CPD) == 'PRPE' ) THEN + BTA = 0.1_fp + LIDF = 0.2_fp + C_T1 = 80.0_fp + C_EO = 1.83_fp + A_NEW = 1.0_fp + A_GRO = 1.0_fp + A_MAT = 1.0_fp + A_OLD = 1.0_fp + BI_DIR = .FALSE. + + ! SOAupdate: Sesquiterpenes hotp 3/2/10 + ! alpha-Farnesene, beta-Caryophyllene, other sesquiterpenes + ELSE IF ( TRIM(CPD) == 'FARN' .OR. & + TRIM(CPD) == 'BCAR' .OR. & + TRIM(CPD) == 'OSQT' ) THEN + BTA = 0.17_fp + LIDF = 0.5_fp + C_T1 = 130.0_fp + C_EO = 2.37_fp + A_NEW = 0.4_fp + A_GRO = 0.6_fp + A_MAT = 1.0_fp + A_OLD = 0.95_fp + BI_DIR = .FALSE. + + ! Calls for any other MEGAN compounds (e.g. sesquiterpenes, etc.) can + ! be added following the above format based on the parameters in + ! Guenther 2012 or the MEGAN source code. + ELSE + RC = CC_FAILURE + MSG = 'Invalid compound name' + thisLoc = ' -> at CCPr_BVOC_Common (in process/bvoc/ccpr_bvoc_common_mod.F90)' + call CC_Error( MSG, RC , thisLoc) + return + + ENDIF + return + + end subroutine GET_MEGAN_PARAMS + + !> + !! \brief Computes the PCEEA gamma activity factor with sensitivity to light + !! + !! References: + !! Guenther et al, 2006; Guenther et al, 2007, MEGAN v2.1 user guide + !! Code was taken & adapted directly from the MEGAN v2.1 source code. + !! + !! \param Q_DIR_2, Q_DIFF_2 + !! \param PARDR_AVG_SIM, PARDF_AVG_SIM + !! \param LAT, DOY, LocalHour + !! \param D2RAD, RAD2D + !! + !! \ingroup catchem_bvoc_process + !!!> + subroutine GET_GAMMA_PAR_PCEEA(Q_DIR_2, Q_DIFF_2, PARDR_AVG_SIM, PARDF_AVG_SIM, & + LAT, DOY, LocalHour, D2RAD, RAD2D, GAMMA_P_PCEEA) + + IMPLICIT NONE + ! Parameters + real(fp), intent(in) :: Q_DIR_2 !< Direct PAR [W/m2] + real(fp), intent(in) :: Q_DIFF_2 !< Diffuse PAR [W/m2] + real(fp), intent(in) :: PARDR_AVG_SIM !< Avg direct PAR [W/m2] + real(fp), intent(in) :: PARDF_AVG_SIM !< Avg diffuse PAR [W/m2] + real(fp), intent(in) :: LAT !< Note: this may need a new function and put in local variable + integer, intent(in) :: DOY !< Note: this may need a new function and put in local variable + real(fp), intent(in) :: LocalHour !< Note: this may need a new function and put in local variable + real(fp), intent(in) :: D2RAD, RAD2D !< Note: this could be put in constants + real(fp), intent(out) :: GAMMA_P_PCEEA !< GAMMA factor for light + + ! Local Variables + real(fp) :: mmPARDR_DAILY !< + real(fp) :: mmPARDF_DAILY !< + real(fp) :: PAC_DAILY, PAC_INSTANT, C_PPFD + real(fp) :: PTOA, PHI + real(fp) :: BETA, SINbeta + real(fp) :: AAA, BBB + !real(fp) :: LocalHour, LAT + !integer :: DOY + !integer :: RC + + ! Constants + !real(fp), parameter :: mmd = 3.4 !< median mass diameter [microns] + ! W/m2 -> umol/m2/s + REAL(fp), PARAMETER :: WM2_TO_UMOLM2S = 4.766_fp + + !----------------------------------------------------- + ! Compute GAMMA_PAR_PCEEA + !----------------------------------------------------- + ! Initialize + C_PPFD = 0.0_fp + PTOA = 0.0_fp + + ! Convert past light conditions to micromol/m2/s + mmPARDR_DAILY = PARDR_AVG_SIM * WM2_TO_UMOLM2S + mmPARDF_DAILY = PARDF_AVG_SIM * WM2_TO_UMOLM2S + + ! Work out the light at the top of the canopy. + PAC_DAILY = mmPARDR_DAILY + mmPARDF_DAILY + PAC_INSTANT = (Q_DIR_2 + Q_DIFF_2) * WM2_TO_UMOLM2S + + ! Get latitude + !LAT = HcoState%Grid%YMID%Val(I,J) + + ! Get day of year, local-time and latitude + !CALL HcoClock_Get( HcoState%Clock, cDOY = DOY, RC=RC ) + !CALL HcoClock_GetLocal( HcoState, I, J, cH = LocalHour, RC=RC ) + + ! Get solar elevation angle + CALL SOLAR_ANGLE( DOY, LocalHour, LAT, D2RAD, SINbeta ) + BETA = ASIN( SINbeta ) * RAD2D + + IF ( SINbeta < 0.0_fp ) THEN + + GAMMA_P_PCEEA = 0.0_fp + + ELSEIF ( SINbeta > 0.0_fp ) THEN + + ! PPFD at top of atmosphere + PTOA = 3000.0_fp + 99.0_fp * & + COS( 2._fp * 3.14159265358979323_fp * & + ( DOY - 10.0_fp ) / 365.0_fp ) + + ! Above canopy transmission + PHI = PAC_INSTANT / ( SINbeta * PTOA ) + + ! Work out gamma P + BBB = 1.0_fp + 0.0005_fp *( PAC_DAILY - 400.0_fp ) + AAA = ( 2.46_fp * BBB * PHI ) - ( 0.9_fp * PHI**2 ) + + GAMMA_P_PCEEA = SINbeta * AAA + + ENDIF + + ! Screen unforced errors. IF solar elevation angle is + ! less than 1 THEN gamma_p can not be greater than 0.1. + IF ( BETA < 1.0_fp .AND. GAMMA_P_PCEEA > 0.1_fp ) THEN + GAMMA_P_PCEEA = 0.0_fp + ENDIF + + ! Prevent negative values + GAMMA_P_PCEEA = MAX( GAMMA_P_PCEEA , 0.0_fp ) + + return + end subroutine GET_GAMMA_PAR_PCEEA + + !> + !! \brief Computes the local solar angle for a given day of year, latitude and longitude (or local time). + !! + !! References: + !! (1 ) Guenther et al, 2006 + !! (2 ) Guenther et al, MEGAN v2.1 user manual 2007-09 + !! This code was taken directly from the MEGAN v2.1 source code + !! + !! \param DOY, SHOUR + !! \param LAT + !! \param D2RAD + !! + !! \ingroup catchem_bvoc_process + !!!> + subroutine SOLAR_ANGLE(DOY, SHOUR, LAT, D2RAD, SINbeta) + + IMPLICIT NONE + ! Parameters + integer, intent(in) :: DOY !< Day of year + real(fp), intent(in) :: SHOUR !< Local time + real(fp), intent(in) :: LAT !< Latitude + real(fp), intent(in) :: D2RAD !< Degree to radiance + real(fp), intent(out) :: SINbeta !< Sin of the local solar angle + + + ! local variable + real(fp) :: sindelta, cosdelta, A, B + + ! Calculation of sin beta + sindelta = -SIN( 0.40907_fp ) * COS( 6.28_fp * ( DOY + 10 ) / 365 ) + + cosdelta = (1-sindelta**2.0_fp)**0.5_fp + + A = SIN( LAT * D2RAD ) * sindelta + B = COS( LAT * D2RAD ) * cosdelta + + SINbeta = A + B * COS( 2.0_fp * PI * ( SHOUR-12 )/24 ) + + return + end subroutine SOLAR_ANGLE + + !> + !! \brief Computes the temperature activity factor for the light-independent fraction of emissions + !! + !!References: + !! (1 ) Guenther et al, 2006 + !! (2 ) Guenther et al, MEGAN user manual 2007-08 + !!(3 ) Guenther et al., GMD 2012 and MEGANv2.1 source code + !! + !! \param T + !! \param T_Leaf_Int, T_Leaf_Temp + !! \param BETA + !! + !! \ingroup catchem_bvoc_process + !!!> + subroutine GET_GAMMA_T_LI(T, BETA, T_Leaf_Int, T_Leaf_Temp, GAMMA_T_LI) + IMPLICIT NONE + ! Parameters + real(fp), intent(in) :: T !< + real(fp), intent(in) :: BETA !< Temperature factor per species + real(fp), intent(in) :: T_Leaf_Int !< + real(fp), intent(in) :: T_Leaf_Temp !< Soil Moisture Attenuation Factor + real(fp), intent(out) :: GAMMA_T_LI !< Factor for the light-independent emissions + + ! Local Variables + !---------------- + real(fp) :: L_T !< + !real(fp) :: L_PT_T !< + real(fp), parameter :: T_STANDARD = 303.0_fp + + !-------------------------------------------- + ! GET_GAMMAT_T_LI begins here! + !-------------------------------------------- + L_T = T * T_Leaf_Temp + T_Leaf_Int + GAMMA_T_LI = EXP( BETA * ( T - T_STANDARD ) ) + + return + end subroutine GET_GAMMA_T_LI + + !> + !! \brief Computes the temperature sensitivity for the light-dependent fraction of emissions. + !! + !! References: + !! (1 ) Guenther et al, 1995 + !! (2 ) Guenther et al, 2006 + !! (3 ) Guenther et al, MEGAN v2.1 user manual 2007-08 + ! ! (4 ) Guenther et al., GMD 2012 and MEGANv2.1 source code. + !! + !! \param T + !! \param PT_15, PT_1 + !! \param CT1, CEO + !! + !! \ingroup catchem_bvoc_process + !!!> + !subroutine GET_GAMMA_T_LD(T, PT_15, PT_1, CT1, CEO, GAMMA_T_LD) + subroutine GET_GAMMA_T_LD(T, PT_15, CT1, CEO, GAMMA_T_LD) + IMPLICIT NONE + ! Parameters + real(fp), intent(in) :: T !< Current leaf temperature [K] + real(fp), intent(in) :: PT_15 !< Average leaf temperature over the past 15 days + !real(fp), intent(in) :: PT_1 !< Average leaf temperature over the past arbitrary day(s). Not used at present + real(fp), intent(in) :: CT1, CEO !< Compound-specific parameters for light-dependent temperature activity + real(fp), intent(out) :: GAMMA_T_LD !< Temperature activity factor for the light-dependent emissions + + ! Local Variables + real(fp) :: C_T, CT2 !< + real(fp) :: E_OPT, T_OPT, X !< + ! Ideal gas constant [J/mol/K] (!!!! Note: the constant module is 8.314) + real(fp), parameter :: R = 8.3144598e-3_fp + + !-------------------------------------------- + ! GET_GAMMA_T_LD begins here! + !-------------------------------------------- + E_OPT = CEO * EXP( 0.08_fp * ( PT_15 - 2.97e2_fp ) ) + T_OPT = 3.13e2_fp + ( 6.0e-1_fp * ( PT_15 - 2.97e2_fp ) ) + CT2 = 200.0_fp + + ! Variable related to temperature + X = ( 1.0_fp/T_OPT - 1.0_fp/T ) / R + + ! C_T: Effect of temperature on leaf BVOC emission, including + ! effect of average temperature over previous 15 days, based on + ! Eq 5a, 5b, 5c from Guenther et al, 1999. + C_T = E_OPT * CT2 * EXP( CT1 * X ) / & + ( CT2 - CT1 * ( 1.0_fp - EXP( CT2 * X ) ) ) + + ! Hourly emission activity = C_T + ! Prevent negative values + GAMMA_T_LD = MAX( C_T, 0.0_fp ) + + return + end subroutine GET_GAMMA_T_LD + + !> + !! \brief Computes the gamma exchange activity factor which is sensitive to leaf area. + !! + !! References: + !! (1 ) Guenther et al, 2006 + !! (2 ) Guenther et al, MEGAN user manual 2007-08 + !! (3 ) Guenther et al., GMD 2012 and MEGANv2.1 source code. + !! + !! \param CMLAI + !! \param BIDIREXCH + !! + !! \ingroup catchem_bvoc_process + !!!> + subroutine GET_GAMMA_LAI(CMLAI, BIDIREXCH, GAMMA_LAI) + IMPLICIT NONE + ! Parameters + real(fp), intent(in) :: CMLAI !< Current month's LAI [cm2/cm2] + logical, intent(in) :: BIDIREXCH !< Logical flag for bidirectional exchange + real(fp), intent(out) :: GAMMA_LAI !< LAI factor + + ! Local Variables + + !-------------------------------------------- + ! GET_GAMMA_LAI begins here! + !-------------------------------------------- + + ! Formulation for birectional compounds is as described for + ! ALD2 in Millet et al., ACP 2010 + IF ( BIDIREXCH ) THEN + + IF ( CMLAI <= 6.0_fp) THEN + + ! if lai less than 2: + IF ( CMLAI <= 2.0_fp ) THEN + GAMMA_LAI = 0.5_fp * CMLAI + + ! if between 2 and 6: + ELSE + GAMMA_LAI = 1.0_fp - 0.0625_fp * ( CMLAI - 2.0_fp ) + END IF + + ELSE + ! keep at 0.75 for LAI > 6 + GAMMA_LAI = 0.75_fp + END IF + + ! For all other compounds use the standard gamma_lai formulation + ELSE + !GAMMA_LAI = 0.49_fp * CMLAI / SQRT( 1.0_fp + 0.2_fp * CMLAI*CMLAI) + GAMMA_LAI = 1.0_fp !canopy add + ENDIF + + return + + end subroutine GET_GAMMA_LAI + + !> + !! \brief Computes the temperature sensitivity for the light-dependent + !! fraction of emissions using the updated Canopy Model (Sam Silva's paper). + !! + !! References: + !! + !! + !! \param T + !! \param PT_15, PT_24 + !! \param CT1, CEO + !! \param T_Leaf_Int, T_Leaf_Temp + !! + !! \ingroup catchem_bvoc_process + !!!> + !subroutine GET_GAMMA_T_LD_C(T, PT_15, PT_24, CT1, CEO, T_Leaf_Int, T_Leaf_Temp, GAMMA_T_LD_C ) + subroutine GET_GAMMA_T_LD_C(T, PT_24, CT1, CEO, T_Leaf_Int, T_Leaf_Temp, GAMMA_T_LD_C ) + + IMPLICIT NONE + + ! Input Parameters + !----------------- + real(fp), intent(in) :: T !< + real(fp), intent(in) :: T_leaf_Int !< + real(fp), intent(in) :: T_Leaf_Temp !< + !!!!!!!TODO: Sam's version has no 15-day average temperature effects + !real(fp), intent(in) :: PT_15 !< Average leaf temperature over the past 15 days. Not used at present + real(fp), intent(in) :: PT_24 !< Average leaf temperature over the past day + real(fp), intent(in) :: CT1, CEO !< Compound-specific parameters + + ! Output Parameters + !------------------ + real(fp), intent(out) :: GAMMA_T_LD_C !< threshold friction velocity + + + ! Local Variables + !----------------- + real(fp) :: C_T, CT2 !< + real(fp) :: E_OPT, T_OPT, X !< + real(fp) :: L_T, L_PT_T !< + ! Ideal gas constant [J/mol/K] (!!!! Note: the constant module is 8.314) + real(fp), parameter :: R = 8.3144598e-3_fp + + !================================================================= + ! GET_GAMMA_T_LD begins here! + !================================================================= + + L_T = T * T_Leaf_Temp + T_Leaf_Int + L_PT_T = PT_24 * T_Leaf_Temp + T_Leaf_Int + + E_OPT = CEO * EXP( 0.1_fp * ( L_PT_T - 2.97e2_fp ) ) + T_OPT = 3.125e2_fp + ( 6.0e-1_fp * ( L_PT_T - 2.97e2_fp ) ) + CT2 = 230.0_fp + + ! Variable related to temperature + X = ( 1.0_fp/T_OPT - 1.0_fp/L_T ) / R + + ! C_T: Effect of temperature on leaf BVOC emission, including + ! effect of average temperature over previous 15 days, based on + ! Eq 5a, 5b, 5c from Guenther et al, 1999. + C_T = E_OPT * CT2 * EXP( CT1 * X ) / & + ( CT2 - CT1 * ( 1.0_fp - EXP( CT2 * X ) ) ) + + ! Hourly emission activity = C_T + ! Prevent negative values + IF (T < 260) THEN + GAMMA_T_LD_C = 0.0_fp + ELSE + GAMMA_T_LD_C = MAX( C_T, 0.0_fp ) + ENDIF + + return + + end subroutine GET_GAMMA_T_LD_C + + + !> + !! \brief Computes the PCEEA gamma activity factor with sensitivity to light. + !! + !! References: + !! (1 ) Guenther et al, 2006 + !! (2 ) Guenther et al, 2007, MEGAN v2.1 user guide + !! + !! \param Q_DIR_2,Q_DIFF_2 + !! \param PARDR_AVG_SIM, PARDF_AVG_SIM + !! \param P_Leaf_LAI, P_Leaf_Int, LAI, PSTD + !! + !! \ingroup catchem_bvoc_process + !!!> + subroutine GET_GAMMA_PAR_C(Q_DIR_2, Q_DIFF_2, PARDR_AVG_SIM, PARDF_AVG_SIM, & + P_Leaf_LAI, P_Leaf_Int, LAI, PSTD, GAMMA_P_C) + IMPLICIT NONE + ! Parameters + real(fp), intent(in) :: Q_DIR_2 !< Direct PAR [W/m2] + real(fp), intent(in) :: Q_DIFF_2 !< Diffuse PAR [W/m2] + real(fp), intent(in) :: PARDR_AVG_SIM !< Avg direct PAR [W/m2] + real(fp), intent(in) :: PARDF_AVG_SIM !< Avg diffuse PAR [W/m2] + real(fp), intent(in) :: P_Leaf_LAI !< + real(fp), intent(in) :: P_Leaf_Int !< + real(fp), intent(in) :: LAI !< + real(fp), intent(in) :: PSTD !< + real(fp), intent(out) :: GAMMA_P_C !< GAMMA factor for light + + ! Local Variables + real(fp) :: mmPARDR_DAILY !< + real(fp) :: mmPARDF_DAILY !< + real(fp) :: PAC_DAILY !< + real(fp) :: PAC_INSTANT !< + real(fp) :: C_PPFD !< + real(fp) :: PTOA !< + !real(fp) :: PHI !< + !real(fp) :: BETA, SINbeta !< + real(fp) :: C1 !< + real(fp) :: Alpha !< + + !-------------------------------------------- + ! GET_GAMMA_PAR_C begins here! + !-------------------------------------------- + ! Initialize + C_PPFD = 0.0_fp + PTOA = 0.0_fp + + ! Convert past light conditions to micromol/m2/s + mmPARDR_DAILY = PARDR_AVG_SIM + mmPARDF_DAILY = PARDF_AVG_SIM + + ! Work out the light at the top of the canopy. + PAC_DAILY = mmPARDR_DAILY + mmPARDF_DAILY + PAC_INSTANT = Q_DIR_2 + Q_DIFF_2 + + PAC_DAILY = PAC_DAILY * exp(P_Leaf_Int + P_Leaf_LAI * LAI) + PAC_INSTANT = PAC_INSTANT * exp(P_Leaf_Int + P_Leaf_LAI * LAI) + + IF ( PAC_DAILY < 0.01_fp ) THEN + + GAMMA_P_C = 0.0_fp + + ELSE + Alpha = 0.004 + Alpha = 0.004 - 0.0005*LOG(PAC_DAILY) + C1 = 1.03 + C1 = 0.0468 * EXP(0.0005 * (PAC_DAILY - PSTD)) * & + (PAC_DAILY ** 0.6) + GAMMA_P_C = (Alpha * C1 * PAC_INSTANT) / & + ((1 + Alpha**2. * PAC_INSTANT**2.)**0.5) + ENDIF + ! Prevent negative values + GAMMA_P_C = MAX( GAMMA_P_C , 0.0_fp ) + + return + end subroutine GET_GAMMA_PAR_C + + + !> + !! \brief Computes the + !! + !!References: + !! (1 ) Probably from Sam Silva paper !!!Note + !! + !! \param CMLAI + !! + !! \ingroup catchem_bvoc_process + !!!> + subroutine GET_CDEA(CMLAI, CDEA) + IMPLICIT NONE + ! Parameters + real(fp), intent(in) :: CMLAI !< Current month's LAI [cm2/cm2] + real(fp), intent(out) :: CDEA(5) !< + + ! Local Variables + !---------------- + real(fp) :: LAIdepth !< + REAL(fp) :: Cdepth(5) + integer :: K + real(fp), parameter :: CCD1 = -0.2_fp + real(fp), parameter :: CCD2 = 1.3_fp + + !-------------------------------------------- + ! GET_CDEA begins here! + !-------------------------------------------- + Cdepth (1) = 0.0469101 + Cdepth (2) = 0.2307534 + Cdepth (3) = 0.5 + Cdepth (4) = 0.7692465 + Cdepth (5) = 0.9530899 + DO K = 1, 5 + LAIdepth = CMLAI * Cdepth(K) + IF ( LAIdepth .GT. 3 ) THEN + LAIdepth = 3.0 + ENDIF + CDEA(K) = CCD1 * LAIdepth + CCD2 + ENDDO + + return + end subroutine GET_CDEA + + !> + !! \brief Computes the gamma exchange activity factor which is sensitive to leaf age + !! + !!References: + !! (1 ) Guenther et al, 2006 + !! (2 ) Guenther et al, MEGAN user manual 2007-08 + !! (3 ) Guenther et al., GMD 2012 and MEGANv2.1 source code + !! + !! \param CMLAI, PMLAI + !! \param DBTWN, TT + !! \param AN, AG, AM, AO + !! + !! \ingroup catchem_bvoc_process + !!!> + subroutine GET_GAMMA_AGE(CMLAI, PMLAI, DBTWN, TT, AN, AG, AM, AO, GAMMA_AGE) + IMPLICIT NONE + ! Parameters + real(fp), intent(in) :: CMLAI !< Current month's LAI [cm2/cm2] + real(fp), intent(in) :: PMLAI !< Previous months LAI [cm2/cm2] + real(fp), intent(in) :: DBTWN !< Number of days between + real(fp), intent(in) :: TT !< Daily average temperature [K] + real(fp), intent(in) :: AN !< Relative emission factor (new leaves) + real(fp), intent(in) :: AG !< Relative emission factor (growing leaves) + real(fp), intent(in) :: AM !< Relative emission factor (mature leaves) + real(fp), intent(in) :: AO !< Relative emission factor (old leaves) + real(fp), intent(out) :: GAMMA_AGE !< leaf age activity factor + + ! Local Variables + !---------------- + real(fp) :: FNEW !< Fraction of new leaves in canopy + real(fp) :: FGRO !< Fraction of growing leaves + real(fp) :: FMAT !< Fraction of mature leaves + real(fp) :: FOLD !< Fraction of old leaves + real(fp) :: TI !< number of days after budbreak required to induce emissions + real(fp) :: TM !< number of days after budbreak required to reach peak emissions + + !-------------------------------------------- + ! GET_GAMMAT_AGE begins here! + !-------------------------------------------- + + !----------------------- + ! Compute TI and TM + ! (mpb,2009) + !----------------------- + TI = 0.0_fp !avoid uninitialized warning when compiling + IF ( TT <= 303.0_fp ) THEN + TI = 5.0_fp + 0.7_fp * ( 300.0_fp - TT ) + ELSEIF ( TT > 303.0_fp ) THEN + TI = 2.9_fp + ENDIF + TM = 2.3_fp * TI + + !----------------------- + ! Compute GAMMA_AGE + !----------------------- + + !use rae function from pecision_mod to avoid "equality comparison for real" warning + IF ( rae(CMLAI, PMLAI) ) THEN !(i.e. LAI stays the same) + + FNEW = 0.0_fp + FGRO = 0.1_fp + FMAT = 0.8_fp + FOLD = 0.1_fp + + ELSE IF ( CMLAI > PMLAI ) THEN !(i.e. LAI has INcreased) + + ! Calculate Fnew + IF ( DBTWN > TI ) THEN + FNEW = ( TI / DBTWN ) * ( 1.0_fp - PMLAI / CMLAI ) + ELSE + FNEW = 1.0_fp - ( PMLAI / CMLAI ) + ENDIF + + ! Calculate FMAT + IF ( DBTWN > TM ) THEN + FMAT = ( PMLAI / CMLAI ) + & + (( DBTWN - TM ) / DBTWN )*( 1.0_fp - PMLAI / CMLAI ) + ELSE + FMAT = ( PMLAI / CMLAI ) + ENDIF + + ! Calculate Fgro and Fold + FGRO = 1.0_fp - FNEW - FMAT + FOLD = 0.0_fp + + ELSE ! This is the case if PMLAI > CMLAI (i.e. LAI has DEcreased) + + FNEW = 0.0_fp + FGRO = 0.0_fp + FOLD = ( PMLAI - CMLAI ) / PMLAI + FMAT = 1.0_fp - FOLD + + ENDIF + + ! Age factor + GAMMA_AGE = FNEW * AN + FGRO * AG + FMAT * AM + FOLD * AO + + ! Prevent negative values + GAMMA_AGE = MAX( GAMMA_AGE , 0.0_fp ) + + return + end subroutine GET_GAMMA_AGE + + + !> + !! \brief Computes ctivity factor for soil moisture + !! + !!References: + !! (1 ) Guenther et al, 2006 + !! (2 ) Guenther et al., GMD 2012 and MEGANv2.1 source code + !! + !! \param GWETROOT + !! \param CMPD + !! + !! \ingroup catchem_bvoc_process + !!!> + subroutine GET_GAMMA_SM(GWETROOT, CMPD, GAMMA_SM) + IMPLICIT NONE + ! Parameters + real(fp), intent(in) :: GWETROOT !< Relative root zone wetness (unitless) + character(len=256), intent(in) :: CMPD !< Compound name + real(fp), intent(out) :: GAMMA_SM !< Activity factor + + ! Local Variables + !---------------- + real(fp) :: GWETROOT2 !< + + !-------------------------------------------- + ! GET_GAMMAT_SM begins here! + !-------------------------------------------- + ! By default gamma_sm is 1.0 + GAMMA_SM = 1.0_fp + + ! Error trap: GWETROOT must be between 0.0 and 1.0 (ckeller, 4/16/15) + !GWETROOT = MIN(MAX(ExtState%GWETROOT%Arr%Val(I,J),0.0_fp),1.0_fp) + GWETROOT2 = MIN(MAX(GWETROOT,0.0_fp),1.0_fp) + + IF ( TRIM( CMPD ) == 'ALD2' .OR. TRIM ( CMPD ) == 'EOH' ) THEN + + ! GWETROOT = degree of saturation or wetness in the root-zone + ! (top meter of soil). This is defined as the ratio of the volumetric + ! soil moisture to the porosity. We use a soil moisture activity factor + ! for ALD2 to account for stimulation of emission by flooding. + ! (Millet et al., ACP 2010) + ! Constant value of 1.0 for GWETROOT = 0-0.9, increasing linearly to + ! 3.0 at GWETROOT =1. + GAMMA_SM = MAX( 20.0_fp * GWETROOT - 17.0_fp, 1.0_fp) + + ENDIF + + return + end subroutine GET_GAMMA_SM + + !> + !! \brief Computes the CO2 activity factor associated with CO2 inhibition of isoprene emission. + !! + !!References: + !! (1 ) Heald, C. L., Wilkinson, M. J., Monson, R. K., Also, C. A., + !! Wang, G. L., and Guenther, A.: Response of isoprene emission + !! to ambient co(2) changes and implications for global budgets, + !! Global Change Biology, 15, 1127-1140, 2009. + !! (2 ) Wilkinson, M. J., Monson, R. K., Trahan, N., Lee, S., Brown, E., + !! Jackson, R. B., Polley, H. W., Fay, P. A., and Fall, R.: Leaf + !! isoprene emission rate as a function of atmospheric CO2 + !! concentration, Global Change Biology, 15, 1189-1200, 2009. + !!(3 ) Possell, M., and Hewitt, C. N.: Isoprene emissions from plants + !! are mediated by atmospheric co2 concentrations, Global Change + !! Biology, 17, 1595-1610, 2011. + !! + !! \param CO2a + !! + !! \ingroup catchem_bvoc_process + !!!> + subroutine GET_GAMMA_CO2(CO2a, GAMMA_CO2) + IMPLICIT NONE + ! Parameters + real(fp), intent(in) :: CO2a !< Atmospheric CO2 conc [ppmv] + real(fp), intent(out) :: GAMMA_CO2 !< CO2 activity factor [unitless] + + ! Local Variables + !---------------- + real(fp) :: CO2i !< Intercellular CO2 conc [ppmv] + real(fp) :: ISMAXi !< Asymptote for intercellular CO2 + real(fp) :: HEXPi !< Exponent for intercellular CO2 + real(fp) :: CSTARi !< Scaling coef for intercellular CO2 + real(fp) :: ISMAXa !< Asymptote for atmospheric CO2 + real(fp) :: HEXPa !< Exponent for atmospheric CO2 + real(fp) :: CSTARa !< Scaling coef for atmospheric CO2 + logical :: LPOSSELL !< Use Possell & Hewitt (2011)? + logical :: LWILKINSON !< Use Wilkinson et al. (2009)? + + !-------------------------------------------- + ! GET_GAMMAT_CO2 begins here! + !-------------------------------------------- + + !---------------------------------------------------------- + ! Choose between two alternative CO2 inhibition schemes + !---------------------------------------------------------- + + ! Empirical relationship of Possell & Hewitt (2011) based on nine + ! experimental studies including Wilkinson et al. (2009). This is + ! especially recommended for sub-ambient CO2 concentrations: + LPOSSELL = .TRUE. ! Default option + + ! Semi-process-based parameterization of Wilkinson et al. (2009), + ! taking into account of sensitivity to intercellular CO2 + ! fluctuation, which is here set as a constant fraction of + ! atmospheric CO2: + LWILKINSON = .FALSE. ! Set .TRUE. only if LPOSSELL = .FALSE. + + !----------------------- + ! Compute GAMMA_CO2 + !----------------------- + + IF ( LPOSSELL ) THEN + + ! Use empirical relationship of Possell & Hewitt (2011): + GAMMA_CO2 = 8.9406_fp / ( 1.0_fp + 8.9406_fp * 0.0024_fp * CO2a ) + + ELSEIF ( LWILKINSON ) THEN + + ! Use parameterization of Wilkinson et al. (2009): + + ! Parameters for intercellular CO2 using linear interpolation: + IF ( CO2a <= 600.0_fp ) THEN + ISMAXi = 1.036_fp - (1.036_fp - 1.072_fp) / & + (600.0_fp - 400.0_fp) * (600.0_fp - CO2a) + HEXPi = 2.0125_fp - (2.0125_fp - 1.7000_fp) / & + (600.0_fp - 400.0_fp) * (600.0_fp - CO2a) + CSTARi = 1150.0_fp - (1150.0_fp - 1218.0_fp) / & + (600.0_fp - 400.0_fp) * (600.0_fp - CO2a) + ELSEIF ( CO2a > 600.0_fp .AND. CO2a < 800.0_fp ) THEN + ISMAXi = 1.046_fp - (1.046_fp - 1.036_fp) / & + (800.0_fp - 600.0_fp) * (800.0_fp - CO2a) + HEXPi = 1.5380_fp - (1.5380_fp - 2.0125_fp) / & + (800.0_fp - 600.0_fp) * (800.0_fp - CO2a) + CSTARi = 2025.0_fp - (2025.0_fp - 1150.0_fp) / & + (800.0_fp - 600.0_fp) * (800.0_fp - CO2a) + ELSE + ISMAXi = 1.014_fp - (1.014_fp - 1.046_fp) / & + (1200.0_fp - 800.0_fp) * (1200.0_fp - CO2a) + HEXPi = 2.8610_fp - (2.8610_fp - 1.5380_fp) / & + (1200.0_fp - 800.0_fp) * (1200.0_fp - CO2a) + CSTARi = 1525.0_fp - (1525.0_fp - 2025.0_fp) / & + (1200.0_fp - 800.0_fp) * (1200.0_fp - CO2a) + ENDIF + + ! Parameters for atmospheric CO2: + ISMAXa = 1.344_fp + HEXPa = 1.4614_fp + CSTARa = 585.0_fp + + ! For now, set CO2_Ci = 0.7d0 * CO2_Ca as recommended by Heald + ! et al. (2009): + CO2i = 0.7_fp * CO2a + + ! Compute GAMMA_CO2: + GAMMA_CO2 = ( ISMAXi - ISMAXi * CO2i**HEXPi / & + ( CSTARi**HEXPi + CO2i**HEXPi ) ) & + * ( ISMAXa - ISMAXa * ( 0.7_fp * CO2a )**HEXPa / & + ( CSTARa**HEXPa + ( 0.7_fp * CO2a )**HEXPa ) ) + + ELSE + + ! No CO2 inhibition scheme is used; GAMMA_CO2 set to unity: + GAMMA_CO2 = 1.0_fp + + ENDIF + + return + end subroutine GET_GAMMA_CO2 + + !> + !! \brief Computes the normalization factor needed to compute emissions + !! + !!References: + !!(1 ) Guenther et al., GMD 2012 and MEGANv2.1 source code + !!(2 ) Created by dbm 11/2012. We calculate only 1 normalization factor for all + !! compounds based on the isoprene gamma values. Formally there should be a + !! different normalization factor for each compound, but we are following + !! Alex Guenther's approach here and the MEGAN source code. + !! + !! \param D2RAD_FAC + !! \param NORM_FAC + !! \param RC + !! + !! \ingroup catchem_bvoc_process + !!!> + subroutine CALC_NORM_FAC(D2RAD_FAC, NORM_FAC, RC) + use Error_Mod, Only : CC_SUCCESS !, CC_FAILURE, CC_Error + IMPLICIT NONE + ! Parameters + real(fp), intent(in) :: D2RAD_FAC !< + real(fp), intent(out) :: NORM_FAC !< + integer, intent(out) :: RC !< + + ! Local Variables + !---------------- + real(fp) :: PAC_DAILY + real(fp) :: GAMMA_T_LI_STANDARD + real(fp) :: GAMMA_SM_STANDARD + real(fp) :: CMLAI, GAMMA_LAI_STANDARD + real(fp) :: GAMMA_AGE_STANDARD + real(fp) :: PT_15, T, R, CEO, CT1, E_OPT, T_OPT, CT2, X + real(fp) :: LDF, GAMMA_STANDARD + !canopy add by Sam Silva (some variables are unused because of this) + !real(fp) :: PHI, AAA, BBB, EA2L, GAMMA_P_STANDARD, GAMMA_T_LD_STANDARD + real(fp) :: SunF, GAMMA_TP_STANDARD + real(fp) :: T_Leaf_Int_Sun(5) + real(fp) :: T_Leaf_Int_Shade(5) + real(fp) :: T_Leaf_Temp_Sun(5) + real(fp) :: T_Leaf_Temp_Shade(5) + !real(fp) :: T_Leaf_Wind_Sun(5) + !real(fp) :: T_Leaf_Wind_Shade(5) + real(fp) :: P_Leaf_Int_Sun(5) + real(fp) :: P_Leaf_Int_Shade(5) + real(fp) :: P_Leaf_LAI_Sun(5) + real(fp) :: P_Leaf_LAI_Shade(5) + real(fp) :: Distgauss(5), CDEA(5), VPGWT(5) + real(fp) :: EA1L, GAMMA_T_LD_SUN, GAMMA_T_LD_SHADE + real(fp) :: L_PT_T, L_T, C1, LAI, GAMMA_PAR_SUN + real(fp) :: GAMMA_PAR_SHADE, ALPHA, PAC_INSTANT + integer :: Q + + !-------------------------------------------- + ! CALC_NORM_FAC begins here! + !-------------------------------------------- + + ! ----------------- + ! GAMMA_P for standard conditions + ! ----------------- + ! Based on Eq. 11b from Guenther et al., 2006 + ! Using standard conditions of phi = 0.6, solar angle of 60 deg, + ! and P_daily = 400 + ! Note corrigendum for Eq. 11b in that paper, should be a + ! minus sign before the 0.9. canopy add + !PAC_DAILY = 400.0_fp + !PHI = 0.6_fp + !BBB = 1.0_fp + 0.0005_fp *( PAC_DAILY - 400.0_fp ) + !AAA = ( 2.46_fp * BBB * PHI ) - ( 0.9_fp * PHI**2 ) + ! sin(60) = 0.866 + !GAMMA_P_STANDARD = 0.866_fp * AAA + + ! ----------------- + ! GAMMA_T_LI for standard conditions + ! ----------------- + ! gamma_t_li = EXP( Beta * ( T - T_Standard ) ) + ! This is 1.0 for T = T_Standard + GAMMA_T_LI_STANDARD = 1.0_fp + + ! ----------------- + ! GAMMA_SM for standard conditions + ! ----------------- + ! Standard condition is soil moisture = 0.3 m^3/m^3 + ! GAMMA_SM = 1.0 for all compounds under this condition + GAMMA_SM_STANDARD = 1.0_fp + ! ----------------- + ! GAMMA_TP for standard conditions canopy add + ! ----------------- + ! gamma_t_li = EXP( Beta * ( T - T_Standard ) ) + ! This is 1.0 for T = T_Standard + + CALL GET_CDEA( 5.0_fp, CDEA ) + Distgauss = (/0.0469101, 0.2307534, 0.5, 0.7692465, & + 0.9530899/) + VPGWT = (/0.1184635, 0.2393144, 0.284444444, & + 0.2393144, 0.1184635/) + P_Leaf_Int_Sun = (/1.0831_fp, 1.0964_fp, 1.1036_fp, & + 1.0985_fp, 1.0901_fp/) + P_Leaf_Int_Shade = (/0.8706_fp, 0.8895_fp, 0.9160_fp, & + 0.9407_fp, 0.9564_fp/) + + P_Leaf_LAI_Sun = (/0.0018_fp, -0.1281_fp, -0.2977_fp, & + -0.4448_fp, -0.5352_fp/) + P_Leaf_LAI_Shade = (/0.0148_fp, -0.1414_fp, -0.3681_fp, & + -0.5918_fp, -0.7425_fp/) + + T_Leaf_Int_Sun = (/-13.891_fp, -12.322_fp, -1.032_fp, & + -5.172_fp, -5.589_fp/) + T_Leaf_Int_Shade = (/-12.846_fp, -11.343_fp, -1.068_fp, & + -5.551_fp, -5.955_fp/) + + T_Leaf_Temp_Sun = (/1.064_fp, 1.057_fp, 1.031_fp, & + 1.050_fp, 1.051_fp/) + T_Leaf_Temp_Shade = (/1.060_fp, 1.053_fp, 1.031_fp, & + 1.051_fp, 1.052_fp/) + + GAMMA_TP_STANDARD = 0.0_fp + LDF = 1.0_fp + LAI = 5.0_fp + DO Q = 1, 5 + + PAC_INSTANT = 1500.0_fp/4.766_fp + PAC_DAILY = 740.0_fp/4.766_fp + + PAC_INSTANT = PAC_INSTANT * exp(P_Leaf_Int_Sun(Q) + & + P_Leaf_LAI_Sun(Q) * LAI) + PAC_DAILY = PAC_DAILY * exp(P_Leaf_Int_Sun(Q) + & + P_Leaf_LAI_Sun(Q) * LAI) + Alpha = 0.004 - 0.0005*LOG(PAC_DAILY) + C1 = 0.0468 * EXP(0.0005 * (PAC_DAILY - 200.0_fp)) * & + (PAC_DAILY ** 0.6) + GAMMA_PAR_Sun = (Alpha * C1 * PAC_INSTANT) / & + ((1 + Alpha**2. * PAC_INSTANT**2.)**0.5) + + PAC_INSTANT = 1500.0_fp/4.766_fp + PAC_DAILY = 740.0_fp/4.766_fp + PAC_DAILY = PAC_DAILY * exp(P_Leaf_Int_Shade(Q) + & + P_Leaf_LAI_Shade(Q) * LAI) + PAC_INSTANT = PAC_INSTANT * exp(P_Leaf_Int_Shade(Q) + & + P_Leaf_LAI_Shade(Q) * LAI) + Alpha = 0.004 - 0.0005*LOG(PAC_DAILY) + C1 = 0.0468 * EXP(0.0005 * (PAC_DAILY - 50.0_fp)) * & + (PAC_DAILY ** 0.6) + GAMMA_PAR_Shade = (Alpha * C1 * PAC_INSTANT) / & + ((1 + Alpha**2. * PAC_INSTANT**2.)**0.5) + + PT_15 = 298.5_fp + T = 303.0_fp + R = 8.3144598e-3_fp + CEO = 2.0_fp + CT1 = 95.0_fp + CT2 = 230.0_fp + + L_T = T * T_Leaf_Temp_Sun(Q) + T_Leaf_Int_Sun(Q) + L_PT_T = PT_15 * T_Leaf_Temp_Sun(Q) + T_Leaf_Int_Sun(Q) + E_OPT = CEO * EXP( 0.1_fp * ( L_PT_T - 2.97e2_fp ) ) + T_OPT = 3.125e2_fp + ( 6.0e-1_fp * ( L_PT_T - 2.97e2_fp ) ) + X = ( 1.0_fp/T_OPT - 1.0_fp/L_T ) / R + GAMMA_T_LD_Sun = E_OPT * CT2 * EXP( CT1 * X ) / & + ( CT2 - CT1 * ( 1.0_fp - EXP( CT2 * X ) ) ) + + L_T = T * T_Leaf_Temp_Shade(Q) + T_Leaf_Int_Shade(Q) + L_PT_T = PT_15 * T_Leaf_Temp_Shade(Q) + T_Leaf_Int_Shade(Q) + E_OPT = CEO * EXP( 0.08_fp * ( L_PT_T - 2.97e2_fp ) ) + T_OPT = 3.125e2_fp + ( 6.0e-1_fp * ( L_PT_T - 2.97e2_fp ) ) + X = ( 1.0_fp/T_OPT - 1.0_fp/L_T ) / R + GAMMA_T_LD_Shade = E_OPT * CT2 * EXP( CT1 * X ) / & + ( CT2 - CT1 * ( 1.0_fp - EXP( CT2 * X ) ) ) + + call Calc_Sun_Frac(5.0_fp,SIN(60.0_fp*D2RAD_FAC), & + Distgauss(Q), SunF) + Ea1L = CDEA(Q) * GAMMA_PAR_Sun * GAMMA_T_LD_Sun * SunF + & + GAMMA_PAR_Shade * GAMMA_T_LD_Shade * (1-SunF) + + ! write(*,*) ' ' + ! write(*,*) '--- GET_MEGAN_NormFrac --- ' + ! write(*,*) 'GAMMA_TP_STANDARD : ', GAMMA_TP_STANDARD + ! write(*,*) 'Ea1L : ', Ea1L + ! write(*,*) 'SunF : ', SunF + ! write(*,*) 'CDEA : ', CDEA(Q) + ! write(*,*) 'VPGWT : ', VPGWT(Q) + ! write(*,*) 'Q : ', Q + ! write(*,*) 'Q : ', Q + ! write(*,*) 'GAMMA_PAR_Sun : ', GAMMA_PAR_Sun + ! write(*,*) 'GAMMA_PAR_Shade : ', GAMMA_PAR_Shade + ! write(*,*) 'GAMMA_T_LD_Sun : ', GAMMA_T_LD_Sun + ! write(*,*) 'GAMMA_T_LD_Shade : ', GAMMA_T_LD_Shade + + GAMMA_TP_STANDARD = GAMMA_TP_STANDARD + & + (Ea1L*LDF)* VPGWT(Q) + ENDDO + + ! write(*,*) ' ' + ! write(*,*) '--- GET_MEGAN_NormFrac --- ' + ! write(*,*) 'GAMMA_TP_STANDARD : ', GAMMA_TP_STANDARD + ! write(*,*) 'Ea1L : ', Ea1L + ! write(*,*) 'SunF : ', SunF + ! write(*,*) 'CDEA : ', CDEA(Q) + ! write(*,*) 'VPGWT : ', VPGWT(Q) + ! write(*,*) 'Q : ', Q + + ! ----------------- + ! GAMMA_LAI for standard conditions + ! ----------------- + ! Standard condition is LAI = 5 + CMLAI = 5.0_fp + !canopy add + !GAMMA_LAI_STANDARD = 0.49_fp * CMLAI / SQRT( 1.0_fp + 0.2_fp * CMLAI*CMLAI ) + GAMMA_LAI_STANDARD = CMLAI + ! ----------------- + ! GAMMA_AGE for standard conditions + ! ----------------- + ! Standard condition is 0% new, 10% growing, 80% mature, 10% old foliage + ! Isoprene uses A_NEW = 0.05d0, A_GRO = 0.6d0, A_MAT = 1.d0, A_OLD = 0.9d0 + GAMMA_AGE_STANDARD = 0.1_fp*0.6_fp + 0.8_fp*1.0_fp + 0.1_fp*0.9_fp + + ! ----------------- + ! GAMMA_T_LD for standard conditions + ! ----------------- + ! Standard condition is + ! PT_15 = average leaf temp over past 24-240 hours = 297K + ! T = air temperature = 303K + !PT_15 = 297.0_fp + !T = 303.0_fp + !R = 8.3144598e-3_fp + ! parameters for isoprene + !CEO = 2.0_fp + !CT1 = 95.0_fp + + !E_OPT = CEO * EXP( 0.08_fp * ( PT_15 - 2.97e2_fp ) ) + !T_OPT = 3.13e2_fp + ( 6.0e-1_fp * ( PT_15 - 2.97e2_fp ) ) + !CT2 = 200.0_fp + + ! Variable related to temperature + !X = ( 1.0_fp/T_OPT - 1.0_fp/T ) / R + + !GAMMA_T_LD_STANDARD = E_OPT * CT2 * EXP( CT1 * X ) / & + ! ( CT2 - CT1 * ( 1.0_fp - EXP( CT2 * X ) ) ) + + ! ----------------- + ! Overall GAMMA_STANDARD + ! ----------------- + ! LDF = 1d0 for isoprene + !LDF = 1.0_fp + !GAMMA_STANDARD = & + ! GAMMA_AGE_STANDARD * GAMMA_SM_STANDARD * GAMMA_LAI_STANDARD & + ! * ((1.0_fp - LDF) * GAMMA_T_LI_STANDARD & + ! + (LDF * GAMMA_P_STANDARD * GAMMA_T_LD_STANDARD)) + ! This ends up being 1.0101081. + !canopy add + GAMMA_STANDARD = GAMMA_AGE_STANDARD * GAMMA_SM_STANDARD * & + GAMMA_TP_STANDARD * GAMMA_LAI_STANDARD + + NORM_FAC = 1.0_fp / GAMMA_STANDARD + + !write(*,*) ' ' + !write(*,*) '--- GET_MEGAN_NormFrac --- ' + !write(*,*) 'GAMMA_STANDARD : ', GAMMA_STANDARD + !write(*,*) 'GAMMA_AGE_STANDARD : ', GAMMA_AGE_STANDARD + !write(*,*) 'GAMMA_SM_STANDARD : ', GAMMA_SM_STANDARD + !write(*,*) 'GAMMA_TP_STANDARD : ', GAMMA_TP_STANDARD + !write(*,*) 'GAMMA_LAI_STANDARD : ', GAMMA_LAI_STANDARD + + RC = CC_SUCCESS + return + end subroutine CALC_NORM_FAC + + !> + !! \brief Computes Emission Factors for all biogenic VOC species + !! Note; I separate the reading AE into the main GET_MEGAN_EMIS function + !! Here only the species need to be calculaed are included + !!References: + !! (1 ) Guenther et al, 2004 + !! + !! \param PFT_16 + !! \param CMPD + !! \param AE, RC + !! + !! \ingroup catchem_bvoc_process + !!!> + subroutine CALC_AEF(PFT_16, CMPD ,AE, RC) + IMPLICIT NONE + ! Parameters + real(fp), intent(in) :: PFT_16(16) !< 16 PFT array (TODO:read from MetState??) + character(len=256), intent(in) :: CMPD !< compound name + real(fp), intent(out) :: AE !< annual emission factor for the compound + integer, intent(out) :: RC !< Success or Failure + + ! Local Variables + !---------------- + integer :: P, ARR_IND + real(fp) :: FACTOR + character(len=255) :: MSG, thisLoc + REAL(fp) :: PFT_EF_OMON(15), PFT_EF_MOH(15) + REAL(fp) :: PFT_EF_ACET(15), PFT_EF_BIDR(15) + REAL(fp) :: PFT_EF_STRS(15), PFT_EF_OTHR(15) + ! ---> + ! dbm, compute EF maps for a-pinene and myrcene as well since there seems to + ! be an issue with the EF maps for these species provided on the MEGAN + ! data portal + REAL(fp) :: PFT_EF_APIN(15), PFT_EF_MYRC(15) + ! <--- + REAL(fp) :: PFT_EF_FARN(15), PFT_EF_BCAR(15) + REAL(fp) :: PFT_EF_OSQT(15) + REAL(fp) :: EM_FRAC_ALD2(15), EM_FRAC_EOH(15) + REAL(fp) :: EM_FRAC_FAXX(15), EM_FRAC_AAXX(15) + REAL(fp) :: EM_FRAC_CH2O(15) + !try to calculate the seven read-in species online + REAL(fp) :: PFT_EF_ISOP(15), PFT_EF_MBOX(15) + REAL(fp) :: PFT_EF_BPIN(15), PFT_EF_CARE(15) + REAL(fp) :: PFT_EF_LIMO(15), PFT_EF_OCIM(15) + REAL(fp) :: PFT_EF_SABI(15) + !----------------------------------------------------------------- + ! Point to PFT fractions (the array needs to be in that order) + !----------------------------------------------------------------- + ! CLM4 PFT coverage (unitless) + ! From Table 3 in Guenther et al., 2012 + ! PFT_BARE : Bare + ! PFT_NDLF_EVGN_TMPT_TREE : Needleleaf evergreen temperate tree + ! PFT_NDLF_EVGN_BORL_TREE : Needleleaf evergreen boreal tree + ! PFT_NDLF_DECD_BORL_TREE : Needleleaf deciduous boreal tree + ! PFT_BDLF_EVGN_TROP_TREE : Broadleaf evergreen tropical tree + ! PFT_BDLF_EVGN_TMPT_TREE : Broadleaf evergreen temperate tree + ! PFT_BDLF_DECD_TROP_TREE : Broadleaf deciduous tropical tree + ! PFT_BDLF_DECD_TMPT_TREE : Broadleaf deciduous temperate tree + ! PFT_BDLF_DECD_BORL_TREE : Broadleaf deciduous boreal tree + ! PFT_BDLF_EVGN_SHRB : Broadleaf evergreen temperate shrub + ! PFT_BDLF_DECD_TMPT_SHRB : Broadleaf deciduous temperate shrub + ! PFT_BDLF_DECD_BORL_SHRB : Broadleaf deciduous boreal shrub + ! PFT_C3_ARCT_GRSS : Arctic C3 grass + ! PFT_C3_NARC_GRSS : Cool C3 grass + ! PFT_C4_GRSS : Warm C4 grass + ! PFT_CROP : Crop + + ! -------------------------------------------------------------------------------- + ! PFT-specific EFs from Table 2 in Guenther et al., 2012 + ! in ug compound/m2/h + ! PFTs 1-15 in the table correspond to #2-16 + ! (i.e., excluding bare ground #1) in the above array. + ! -------------------------------------------------------------------------------- + ! Compound Class EF1 EF2 EF3 EF4 EF5 EF6 EF7 EF8 EF9 EF10 EF11 EF12 EF13 EF14 EF15 + ! -------------------------------------------------------------------------------- + ! Other Monoterp 180 180 170 150 150 150 150 150 110 200 110 5 5 5 5 + ! Methanol 900 900 900 500 900 500 900 900 900 900 900 500 500 500 900 + ! Acetone 240 240 240 240 240 240 240 240 240 240 240 80 80 80 80 + ! Bidirect VOC 500 500 500 500 500 500 500 500 500 500 500 80 80 80 80 + ! Stress VOC 300 300 300 300 300 300 300 300 300 300 300 300 300 300 300 + ! Other VOC 140 140 140 140 140 140 140 140 140 140 140 140 140 140 140 + ! a-Pinene 500 500 510 600 400 600 400 400 200 300 200 2 2 2 2 + ! Myrcene 70 70 60 80 30 80 30 30 30 50 30 0.3 0.3 0.3 0.3 + ! a-Farnesene 40 40 40 60 40 60 40 40 40 40 40 3 3 3 4 + ! b-Carophyllene 80 80 80 60 40 60 40 40 50 50 50 1 1 1 4 + ! Other sesqt. 120 120 120 120 100 120 100 100 100 100 100 2 2 2 2 + ! -------------------------------------------------------------------------------- + + ! One thing to note is these are net emissions to the canopy atmosphere + ! but not net emissions to the above canopy atmosphere since they don't + ! account for within-canopy deposition. Only an issue for OVOCs. + + !try to calculate the seven read-in species online now + ! EF1 EF2 EF3 EF4 EF5 + PFT_EF_ISOP = (/600.0_fp, 3000.0_fp, 1.0_fp, 7000.0_fp, 10000.0_fp, & + ! EF6 EF7 EF8 EF9 EF10 + 7000.0_fp, 10000.0_fp,11000.0_fp, 2000.0_fp, 4000.0_fp, & + ! EF11 EF12 EF13 EF14 EF15 + 4000.0_fp, 1600.0_fp, 800.0_fp, 200.0_fp, 1.0_fp/) + + ! EF1 EF2 EF3 EF4 EF5 + PFT_EF_MBOX = (/700.0_fp, 60.0_fp, 0.01_fp, 0.01_fp, 0.01_fp, & + ! EF6 EF7 EF8 EF9 EF10 + 0.01_fp, 0.01_fp, 2.0_fp, 0.01_fp, 0.01_fp, & + ! EF11 EF12 EF13 EF14 EF15 + 0.01_fp, 0.01_fp, 0.01_fp, 0.01_fp, 0.01_fp/) + + ! EF1 EF2 EF3 EF4 EF5 + PFT_EF_BPIN = (/300.0_fp, 300.0_fp, 200.0_fp, 120.0_fp, 130.0_fp, & + ! EF6 EF7 EF8 EF9 EF10 + 120.0_fp, 130.0_fp, 130.0_fp, 100.0_fp, 150.0_fp, & + ! EF11 EF12 EF13 EF14 EF15 + 100.0_fp, 1.5_fp , 1.5_fp , 1.5_fp , 1.5_fp/) + + ! EF1 EF2 EF3 EF4 EF5 + PFT_EF_CARE = (/160.0_fp, 160.0_fp, 80.0_fp, 40.0_fp, 30.0_fp, & + ! EF6 EF7 EF8 EF9 EF10 + 40.0_fp, 30.0_fp, 30.0_fp, 30.0_fp, 100.0_fp, & + ! EF11 EF12 EF13 EF14 EF15 + 30.0_fp, 0.3_fp , 0.3_fp , 0.3_fp , 0.3_fp/) + + ! EF1 EF2 EF3 EF4 EF5 + PFT_EF_LIMO = (/100.0_fp, 100.0_fp, 130.0_fp, 80.0_fp, 80.0_fp, & + ! EF6 EF7 EF8 EF9 EF10 + 80.0_fp, 80.0_fp, 80.0_fp, 60.0_fp, 100.0_fp, & + ! EF11 EF12 EF13 EF14 EF15 + 60.0_fp, 0.7_fp , 0.7_fp , 0.7_fp , 0.7_fp/) + + ! EF1 EF2 EF3 EF4 EF5 + PFT_EF_OCIM = (/70.0_fp, 70.0_fp, 60.0_fp, 150.0_fp, 120.0_fp, & + ! EF6 EF7 EF8 EF9 EF10 + 150.0_fp, 120.0_fp, 120.0_fp, 90.0_fp, 150.0_fp, & + ! EF11 EF12 EF13 EF14 EF15 + 90.0_fp, 2.0_fp , 2.0_fp , 2.0_fp , 2.0_fp/) + + ! EF1 EF2 EF3 EF4 EF5 + PFT_EF_SABI = (/70.0_fp, 70.0_fp, 40.0_fp, 80.0_fp, 50.0_fp, & + ! EF6 EF7 EF8 EF9 EF10 + 80.0_fp, 50.0_fp, 50.0_fp, 50.0_fp, 70.0_fp, & + ! EF11 EF12 EF13 EF14 EF15 + 50.0_fp, 0.7_fp , 0.7_fp , 0.7_fp , 0.7_fp/) + + ! default EF online calculation below + ! EF1 EF2 EF3 EF4 EF5 + PFT_EF_OMON = (/180.0_fp, 180.0_fp, 170.0_fp, 150.0_fp, 150.0_fp, & + ! EF6 EF7 EF8 EF9 EF10 + 150.0_fp, 150.0_fp, 150.0_fp, 110.0_fp, 200.0_fp, & + ! EF11 EF12 EF13 EF14 EF15 + 110.0_fp, 5.0_fp , 5.0_fp , 5.0_fp , 5.0_fp/) + + ! EF1 EF2 EF3 EF4 EF5 + PFT_EF_MOH = (/900.0_fp, 900.0_fp, 900.0_fp, 500.0_fp, 900.0_fp, & + ! EF6 EF7 EF8 EF9 EF10 + 500.0_fp, 900.0_fp, 900.0_fp, 900.0_fp, 900.0_fp, & + ! EF11 EF12 EF13 EF14 EF15 + 900.0_fp, 500.0_fp, 500.0_fp, 500.0_fp, 900.0_fp/) + + ! EF1 EF2 EF3 EF4 EF5 + PFT_EF_ACET = (/240.0_fp, 240.0_fp, 240.0_fp, 240.0_fp, 240.0_fp, & + ! EF6 EF7 EF8 EF9 EF10 + 240.0_fp, 240.0_fp, 240.0_fp, 240.0_fp, 240.0_fp, & + ! EF11 EF12 EF13 EF14 EF15 + 240.0_fp, 80.0_fp , 80.0_fp , 80.0_fp , 80.0_fp/) + + ! EF1 EF2 EF3 EF4 EF5 + PFT_EF_BIDR = (/500.0_fp, 500.0_fp, 500.0_fp, 500.0_fp, 500.0_fp, & + ! EF6 EF7 EF8 EF9 EF10 + 500.0_fp, 500.0_fp, 500.0_fp, 500.0_fp, 500.0_fp, & + ! EF11 EF12 EF13 EF14 EF15 + 500.0_fp, 80.0_fp , 80.0_fp , 80.0_fp , 80.0_fp/) + + ! EF1 EF2 EF3 EF4 EF5 + PFT_EF_STRS = (/300.0_fp, 300.0_fp, 300.0_fp, 300.0_fp, 300.0_fp, & + ! EF6 EF7 EF8 EF9 EF10 + 300.0_fp, 300.0_fp, 300.0_fp, 300.0_fp, 300.0_fp, & + ! EF11 EF12 EF13 EF14 EF15 + 300.0_fp, 300.0_fp, 300.0_fp, 300.0_fp, 300.0_fp/) + + ! EF1 EF2 EF3 EF4 EF5 + PFT_EF_OTHR = (/140.0_fp, 140.0_fp, 140.0_fp, 140.0_fp, 140.0_fp, & + ! EF6 EF7 EF8 EF9 EF10 + 140.0_fp, 140.0_fp, 140.0_fp, 140.0_fp, 140.0_fp, & + ! EF11 EF12 EF13 EF14 EF15 + 140.0_fp, 140.0_fp, 140.0_fp, 140.0_fp, 140.0_fp/) + + ! ---> Now compute EFs for a-pinene and myrcene as well (dbm, 12/2012) + ! EF1 EF2 EF3 EF4 EF5 + PFT_EF_APIN = (/500.0_fp, 500.0_fp, 510.0_fp, 600.0_fp, 400.0_fp, & + ! EF6 EF7 EF8 EF9 EF10 + 600.0_fp, 400.0_fp, 400.0_fp, 200.0_fp, 300.0_fp, & + ! EF11 EF12 EF13 EF14 EF15 + 200.0_fp, 2.0_fp, 2.0_fp, 2.0_fp, 2.0_fp/) + + ! EF1 EF2 EF3 EF4 EF5 + PFT_EF_MYRC = (/70.0_fp, 70.0_fp, 60.0_fp, 80.0_fp, 30.0_fp, & + ! EF6 EF7 EF8 EF9 EF10 + 80.0_fp, 30.0_fp, 30.0_fp, 30.0_fp, 50.0_fp, & + ! EF11 EF12 EF13 EF14 EF15 + 30.0_fp, 0.3_fp, 0.3_fp, 0.3_fp, 0.3_fp/) + ! <--- + + ! EF1 EF2 EF3 EF4 EF5 + PFT_EF_FARN = (/40.0_fp, 40.0_fp, 40.0_fp, 60.0_fp, 40.0_fp, & + ! EF6 EF7 EF8 EF9 EF10 + 60.0_fp, 40.0_fp, 40.0_fp, 40.0_fp, 40.0_fp, & + ! EF11 EF12 EF13 EF14 EF15 + 40.0_fp, 3.0_fp, 3.0_fp, 3.0_fp, 4.0_fp/) + + ! EF1 EF2 EF3 EF4 EF5 + PFT_EF_BCAR = (/80.0_fp, 80.0_fp, 80.0_fp, 60.0_fp, 40.0_fp, & + ! EF6 EF7 EF8 EF9 EF10 + 60.0_fp, 40.0_fp, 40.0_fp, 50.0_fp, 50.0_fp, & + ! EF11 EF12 EF13 EF14 EF15 + 50.0_fp, 1.0_fp, 1.0_fp, 1.0_fp, 4.0_fp/) + + ! EF1 EF2 EF3 EF4 EF5 + PFT_EF_OSQT = (/120.0_fp, 120.0_fp, 120.0_fp, 120.0_fp, 100.0_fp, & + ! EF6 EF7 EF8 EF9 EF10 + 120.0_fp, 100.0_fp, 100.0_fp, 100.0_fp, 100.0_fp, & + ! EF11 EF12 EF13 EF14 EF15 + 100.0_fp, 2.0_fp, 2.0_fp, 2.0_fp, 2.0_fp/) + + ! Other monoterpenes, methanol, acetone, MBO are each 100% of their + ! respective categories. The VOCs within the stress category each + ! account for a specific fraction of emissions across all PFTs + ! (ethene 58%, toluene 3%, HCN 1.5%). The VOCs within the + ! other category also account for a given fraction of emissions + ! across all PFTs (propene 48%, butene 24%, other alkenes 0.2%). But + ! VOCs in the bidirectional category account for a different amount of + ! the total flux for the different PFTs. So in this case we define a + ! vector containing these fractions. + + ! Acetaldehyde: 40% of bidirectional category flux, except 25% + ! for grasses and crops + ! EF1 EF2 EF3 EF4 EF5 + EM_FRAC_ALD2 = (/0.40_fp, 0.40_fp, 0.40_fp, 0.40_fp, 0.40_fp, & + ! EF6 EF7 EF8 EF9 EF10 + 0.40_fp, 0.40_fp, 0.40_fp, 0.40_fp, 0.40_fp, & + ! EF11 EF12 EF13 EF14 EF15 + 0.40_fp, 0.25_fp, 0.25_fp, 0.25_fp, 0.25_fp/) + + ! Ethanol: 40% of bidirectional category flux, except 25% + ! for grasses and crops + ! EF1 EF2 EF3 EF4 EF5 + EM_FRAC_EOH = (/0.40_fp, 0.40_fp, 0.40_fp, 0.40_fp, 0.40_fp, & + ! EF6 EF7 EF8 EF9 EF10 + 0.40_fp, 0.40_fp, 0.40_fp, 0.40_fp, 0.40_fp, & + ! EF11 EF12 EF13 EF14 EF15 + 0.40_fp, 0.25_fp, 0.25_fp, 0.25_fp, 0.25_fp/) + + ! Formic acid: 6% of bidirectional category flux, except 15% + ! for grasses and crops + ! EF1 EF2 EF3 EF4 EF5 + EM_FRAC_FAXX = (/0.06_fp, 0.06_fp, 0.06_fp, 0.06_fp, 0.06_fp, & + ! EF6 EF7 EF8 EF9 EF10 + 0.06_fp, 0.06_fp, 0.06_fp, 0.06_fp, 0.06_fp, & + ! EF11 EF12 EF13 EF14 EF15 + 0.06_fp, 0.15_fp, 0.15_fp, 0.15_fp, 0.15_fp/) + + ! Acetic acid: 6% of bidirectional category flux, except 15% + ! for grasses and crops + ! EF1 EF2 EF3 EF4 EF5 + EM_FRAC_AAXX = (/0.06_fp, 0.06_fp, 0.06_fp, 0.06_fp, 0.06_fp, & + ! EF6 EF7 EF8 EF9 EF10 + 0.06_fp, 0.06_fp, 0.06_fp, 0.06_fp, 0.06_fp, & + ! EF11 EF12 EF13 EF14 EF15 + 0.06_fp, 0.15_fp, 0.15_fp, 0.15_fp, 0.15_fp/) + + ! Formaldehyde: 8% of bidirectional category flux, except 20% + ! for grasses and crops + ! EF1 EF2 EF3 EF4 EF5 + EM_FRAC_CH2O = (/0.08_fp, 0.08_fp, 0.08_fp, 0.08_fp, 0.08_fp, & + ! EF6 EF7 EF8 EF9 EF10 + 0.08_fp, 0.08_fp, 0.08_fp, 0.08_fp, 0.08_fp, & + ! EF11 EF12 EF13 EF14 EF15 + 0.08_fp, 0.20_fp, 0.20_fp, 0.20_fp, 0.20_fp/) + + !-------------------------------------------- + ! GET_GAMMAT_T_LI begins here! + !-------------------------------------------- + AE = 0.0_fp + ! Loop through plant types + do P = 1, 15 + ! Add 1 to PFT_16 index to skip bare ground + ARR_IND = P + 1 + ! Don't need to divide PFT_16 by 100 since it is already fraction + select case ( TRIM(CMPD) ) + !try to calculate the seven read-in species online now + ! ISOP: 100% of category + case ('ISOP') + AE = AE + PFT_16(ARR_IND) * PFT_EF_ISOP(P) + ! MBOX: 100% of category + case ('MBOX') + AE = AE + PFT_16(ARR_IND) * PFT_EF_MBOX(P) + ! BPIN: 100% of category + case ('BPIN') + AE = AE + PFT_16(ARR_IND) * PFT_EF_BPIN(P) + ! CARE: 100% of category + case ('CARE') + AE = AE + PFT_16(ARR_IND) * PFT_EF_CARE(P) + ! LIMO: 100% of category + case ('LIMO') + AE = AE + PFT_16(ARR_IND) * PFT_EF_LIMO(P) + ! OCIM: 100% of category + case ('OCIM') + AE = AE + PFT_16(ARR_IND) * PFT_EF_OCIM(P) + ! SABI: 100% of category + case ('SABI') + AE = AE + PFT_16(ARR_IND) * PFT_EF_SABI(P) + ! ---> Now compute EFs for a-pinene and myrcene as well + ! a-pinene: 100% of category + case ('APIN') + AE = AE + PFT_16(ARR_IND) * PFT_EF_APIN(P) + ! Myrcene: 100% of category + case ('MYRC') + AE = AE + PFT_16(ARR_IND) * PFT_EF_MYRC(P) + ! Other monoterpenes: 100% of category + case ('OMON') + AE = AE + PFT_16(ARR_IND) * PFT_EF_OMON(P) + ! a-Farnesene: 100% of category + case ('FARN') + AE = AE + PFT_16(ARR_IND) * PFT_EF_FARN(P) + ! b-Caryophyllene: 100% of category + case ('BCAR') + AE = AE + PFT_16(ARR_IND) * PFT_EF_BCAR(P) + ! Other sesquiterpenes: 100% of category + case ('OSQT') + AE = AE + PFT_16(ARR_IND) * PFT_EF_OSQT(P) + ! Methanol: 100% of category + case ('MOH') + AE = AE + PFT_16(ARR_IND) * PFT_EF_MOH(P) + ! Acetone: 100% of category + case ('ACET') + AE = AE + PFT_16(ARR_IND) * PFT_EF_ACET(P) + ! Ethanol: variable fraction of category + case ('EOH') + AE = AE + PFT_16(ARR_IND) * EM_FRAC_EOH(P) * PFT_EF_BIDR(P) + ! Formaldehyde: variable fraction of category + case ('CH2O') + AE = AE + PFT_16(ARR_IND) * EM_FRAC_CH2O(P) * PFT_EF_BIDR(P) + ! Acetaldehyde: variable fraction of category + case ('ALD2') + AE = AE + PFT_16(ARR_IND) * EM_FRAC_ALD2(P) * PFT_EF_BIDR(P) + ! Formic acid: variable fraction of category + case ('FAXX') + AE = AE + PFT_16(ARR_IND) * EM_FRAC_FAXX(P) * PFT_EF_BIDR(P) + ! Acetic acid: variable fraction of category + case ('AAXX') + AE = AE + PFT_16(ARR_IND) * EM_FRAC_AAXX(P) * PFT_EF_BIDR(P) + ! Ethene: 58% of "stress" category for all PFTs + case ('C2H4') + AE = AE + PFT_16(ARR_IND) * PFT_EF_STRS(P) * 0.58_fp + ! Toluene: 3% of "stress" category for all PFTs + case ('TOLU') + AE = AE + PFT_16(ARR_IND) * PFT_EF_STRS(P) * 0.03_fp + ! HCN: 1.5% of "stress" category for all PFTs + case ('HCNX') + AE = AE + PFT_16(ARR_IND) * PFT_EF_STRS(P) * 0.015_fp + ! Propene: 48% of "other" category for all PFTs + ! Butene: 24% of "other" category for all PFTs + ! Larger alkenes: 0.2% of "other" category for all PFTs + ! Total: 72.2% + case ('PRPE') + AE = AE + PFT_16(ARR_IND) * PFT_EF_OTHR(P) * 0.722_fp + case default + RC = CC_FAILURE + MSG = 'Invalid compound name' + thisLoc = ' -> at CCPr_bvoc_Common (in process/bvoc/ccpr_bvoc_common_mod.F90)' + call CC_Error( MSG, RC , thisLoc) + return + end select + enddo + + ! Convert AEF arrays from [ug/m2/hr] to [kg/m2/s] + FACTOR = 1.0e-9_fp / 3600.0_fp + AE = AE * Factor + ! Return w/ success + RC = CC_SUCCESS + return + end subroutine CALC_AEF + + +end module CCPr_BVOC_Common_Mod diff --git a/src/process/bvoc/ccpr_scheme_meganv21_mod.F90 b/src/process/bvoc/ccpr_scheme_meganv21_mod.F90 new file mode 100644 index 00000000..716c46cc --- /dev/null +++ b/src/process/bvoc/ccpr_scheme_meganv21_mod.F90 @@ -0,0 +1,442 @@ +!> +!! \file +!! \brief Contains MEGAN2.1 biogenic VOC emission Scheme based on HEMCO and Sam Silva's canopy edits +!! +!! Reference: +!! (1) HEMCO's HCOX_MEGAN_MOD module (https://github.com/geoschem/HEMCO), which is +!! based on Guenther et al, (GMD 2012) and associated MEGANv2.1 source code +!! https://doi.org/10.5194/gmd-5-1471-2012 +!! (2) Sam Silva's simplified canopy edits (GMD 2020) are also added +!! https://doi.org/10.5194/gmd-13-2569-2020 +!! +!! \author Wei Li +!! \date 07/2024 +!! \ingroup catchem_bvoc_process +!!!> + +module CCPr_Scheme_MeganV21_Mod + + implicit none + + private + + public :: CCPr_Scheme_MeganV21 + +contains + + !> \brief Brief description of the subroutine + !! + !! \param MeganSpecName Name of megan species + !! \param LAI leaf area index + !! \param PMISOLAI LAI of previous month + !! \param PFT_16(:) Plant functional type fraction + !! \param Q_DIR_2 Surface downwelling par diffuse flux + !! \param Q_DIFF_2 Surface downwelling par beam flux + !! \param PARDR_LASTXDAYS Avg. PARDF of last NUM_DAYS + !! \param PARDF_LASTXDAYS Avg. PARDR of last NUM_DAYS + !! \param TS Surface temperature + !! \param T_LASTXDAYS Avg. temperature of last NUM_DAYS + !! \param T_LAST24H Avg. temperature of last 24 hours + !! \param GWETROOT Root zone soil moisture + !! \param CO2Inhib Turn on CO2 inhibition? + !! \param CO2conc CO2 concentrations + !! \param SUNCOS Cosine of solar zenith angle + !! \param LAT Latitude + !! \param DOY Day of year + !! \param LocalHour Local hour + !! \param D_BTW_M Days between mid-months + !!!! \param AEF_ISOP Emission factor of ISOP read from file + !!!! \param AEF_MBOX Emission factor of MBOX read from file + !!!! \param AEF_BPIN Emission factor of BPIN read from file + !!!! \param AEF_CARE Emission factor of CARE read from file + !!!! \param AEF_LIMO Emission factor of LIMO read from file + !!!! \param AEF_OCIM Emission factor of OCIM read from file + !!!! \param AEF_SABI Emission factor of SABI read from file + !! \param EmisPerSpec Emission per Species + !! \param RC Success or Failure + !! + !! Note that other state types may be required, e.g. one specific to the process group. + !!!> + subroutine CCPr_Scheme_MeganV21( & + MeganSpecName, & + EmisPerSpec, & + LAI, & + PFT_16, & + PMISOLAI, & + Q_DIR_2, & + Q_DIFF_2, & + PARDR_LASTXDAYS, & + PARDF_LASTXDAYS, & + TS, & + T_LASTXDAYS, & + T_LAST24H, & + GWETROOT, & + CO2Inhib, & + CO2conc, & + SUNCOS, & + LAT, & + DOY, & + LocalHour, & + D_BTW_M, & + RC) + + ! Uses + USE Constants, Only : PI_180 ! Example to pull in a constant from the CONSTANTS MODULE < Modify as needed > + use precision_mod, only : fp ! Example to pull in a precision from the PRECISION MODULE < Modify as needed > + Use Error_Mod, Only : CC_SUCCESS ! Error Check Success + USE CCPr_BVOC_Common_Mod + + IMPLICIT NONE + + ! Arguments + !integer, intent(in) :: nMeganSpec !< Number of Megan Species + !character(len=10), intent(in) :: MeganSpecName(:) !< name of megan species + character(len=10), intent(in) :: MeganSpecName !< name of megan species + real(fp), intent(in) :: LAI !< leaf area index + real(fp), intent(in) :: PMISOLAI !< LAI of previous month + real(fp), intent(in) :: PFT_16(:) !< plant functional type fraction + real(fp), intent(in) :: Q_DIR_2 !< surface downwelling par diffuse flux + real(fp), intent(in) :: Q_DIFF_2 !< surface downwelling par beam flux + real(fp), intent(in) :: PARDR_LASTXDAYS !< Avg. PARDF of last NUM_DAYS + real(fp), intent(in) :: PARDF_LASTXDAYS !< Avg. PARDR of last NUM_DAYS + real(fp), intent(in) :: TS !< surface temperature + real(fp), intent(in) :: T_LASTXDAYS !< Avg. temperature of last NUM_DAYS + real(fp), intent(in) :: T_LAST24H !< Avg. temperature of last 24 hours + real(fp), intent(in) :: GWETROOT !< Root zone soil moisture + logical, intent(in) :: CO2Inhib !< turn on CO2 inhibition? + real(fp), intent(in) :: CO2conc !< CO2 concentrations + real(fp), intent(in) :: SUNCOS !< Cosine of solar zenith angle + real(fp), intent(in) :: LAT !< Latitude + integer, intent(in) :: DOY !< Day of year + real(fp), intent(in) :: LocalHour !< Local hour + real(fp), intent(in) :: D_BTW_M !< Days between mid-months + !These seven EFs are changed to be read online now instead of read from file + !real(fp), intent(in) :: AEF_ISOP !< Emission factor of ISOP read from file + !real(fp), intent(in) :: AEF_MBOX !< Emission factor of MBOX read from file + !real(fp), intent(in) :: AEF_BPIN !< Emission factor of BPIN read from file + !real(fp), intent(in) :: AEF_CARE !< Emission factor of CARE read from file + !real(fp), intent(in) :: AEF_LIMO !< Emission factor of LIMO read from file + !real(fp), intent(in) :: AEF_OCIM !< Emission factor of OCIM read from file + !real(fp), intent(in) :: AEF_SABI !< Emission factor of SABI read from file + !real(fp), intent(inout) :: EmisPerSpec(:) !< Emission per Species + real(fp), intent(inout) :: EmisPerSpec !< Emission per Species + !real(fp), intent(inout) :: TotalEmis !< Total Emission (TODO: not used by now) + integer, intent(out) :: RC ! Success or Failure + + ! Local Variables + character(len=256) :: errMsg + character(len=256) :: thisLoc + + real(fp) :: MEGAN_EMIS ! emission for each species [kg/m2/s] + character(len=256) :: CMPD ! Compound name + REAL(fp) :: GAMMA_LAI + REAL(fp) :: GAMMA_AGE + REAL(fp) :: GAMMA_TP !canopy add + REAL(fp) :: CDEA(5) !canopy add + REAL(fp) :: VPGWT(5) !canopy add + REAL(fp) :: GAMMA_PAR_Sun, GAMMA_PAR_Shade !canopy add + REAL(fp) :: GAMMA_T_LD_Sun, GAMMA_T_LD_Shade !canopy add + REAL(fp) :: GAMMA_T_LI_Sun, GAMMA_T_LI_Shade !canopy add + !REAL(fp) :: WINDSP !canopy add + REAL(fp) :: GAMMA_PAR + REAL(fp) :: GAMMA_T_LD + REAL(fp) :: GAMMA_T_LI + REAL(fp) :: GAMMA_SM + REAL(fp) :: GAMMA_CO2 + REAL(fp) :: AEF + !REAL(fp) :: D_BTW_M + !REAL(fp) :: TS, SUNCOS + !REAL(fp) :: Q_DIR_2, Q_DIFF_2 + REAL(fp) :: BETA, LDF, CT1, CEO + REAL(fp) :: ANEW, AGRO, AMAT, AOLD + REAL(fp) :: MISOLAI, PMISOLAI_NORM + REAL(fp) :: PFTSUM + REAL(fp), parameter :: LAI_MAX = 6.0_fp !Maximum LAI value [cm2/cm2] + REAL(fp), parameter :: D2RAD = PI_180 !Degrees to radians + REAL(fp), parameter :: RAD2D = 1.0_fp / PI_180 !Radians to degrees + !REAL(fp) :: LAT, LocalHour !canopy add + REAL(fp) :: PSTD + REAL(fp) :: Ea1L, Ea2L, SINbeta, SunF !canopy add + LOGICAL :: BIDIR + INTEGER :: K !, S, DOY !canopy add and below + REAL(fp) :: T_Leaf_Int_Sun(5) + REAL(fp) :: T_Leaf_Int_Shade(5) + REAL(fp) :: T_Leaf_Temp_Sun(5) + REAL(fp) :: T_Leaf_Temp_Shade(5) + !REAL(fp) :: T_Leaf_Wind_Sun(5) + !REAL(fp) :: T_Leaf_Wind_Shade(5) + REAL(fp) :: P_Leaf_Int_Sun(5) + REAL(fp) :: P_Leaf_Int_Shade(5) + REAL(fp) :: P_Leaf_LAI_Sun(5) + REAL(fp) :: P_Leaf_LAI_Shade(5) + REAL(fp) :: Distgauss(5) + + ! Initialize parameters, gamma values, and return value + errMsg = '' + thisLoc = ' -> at CCPr_Scheme_MeganV21 (in CCPr_Scheme_MeganV21_mod.F90)' + RC = CC_SUCCESS + + CDEA = 0.0_fp !canopy add + GAMMA_TP = 0.0_fp !canopy add + MEGAN_EMIS = 0.0_fp + GAMMA_LAI = 0.0_fp + GAMMA_AGE = 0.0_fp + GAMMA_T_LD = 0.0_fp + GAMMA_T_LI = 0.0_fp + GAMMA_PAR = 0.0_fp + GAMMA_SM = 0.0_fp + GAMMA_CO2 = 0.0_fp + BETA = 0.0_fp + AEF = 0.0_fp + LDF = 0.0_fp + CT1 = 0.0_fp + CEO = 0.0_fp + ANEW = 0.0_fp + AGRO = 0.0_fp + AMAT = 0.0_fp + AOLD = 0.0_fp + BIDIR = .FALSE. + + !---------------------------------- + ! Begin SchemeCCPr_Scheme_MeganV21 + !---------------------------------- + + EmisPerSpec = 0.0_fp + + !----------------------------------------------------- + ! Only interested in terrestrial biosphere + ! If ( local LAI > 0 ) replace the zeros assigned above + !----------------------------------------------------- + if ( LAI > 0.0_fp ) then + + !-----------------normalize LAI by total PFT fractions + PFTSUM = SUM( PFT_16(2:16) ) + MISOLAI = min(LAI/PFTSUM, LAI_MAX) + PMISOLAI_NORM= min(PMISOLAI/PFTSUM, LAI_MAX) + + !----------------- %%gamma values not related to compound%% ------------------ + + ! -------------------------------------------------- + ! GAMMA_par (light activity factor) + ! -------------------------------------------------- + + ! Calculate GAMMA PAR only during day + IF ( SUNCOS > 0.0_fp ) THEN + + call GET_GAMMA_PAR_PCEEA( Q_DIR_2, & + Q_DIFF_2, & + PARDR_LASTXDAYS, & + PARDF_LASTXDAYS, & + LAT, DOY, & + LocalHour, & + D2RAD, RAD2D, & + GAMMA_PAR) + ELSE + + ! If night + GAMMA_PAR = 0.0_fp + ENDIF + + ! -------------------------------------------------- + ! CO2 inhibition of isoprene (Tai, Jan 2013) + ! -------------------------------------------------- + IF ( CO2Inhib ) THEN + call GET_GAMMA_CO2( CO2conc, GAMMA_CO2 ) + ELSE + GAMMA_CO2 = 1.0_fp + ENDIF + + !Sam Silva's canopy related coefficients + T_Leaf_Int_Sun = (/-13.891_fp, -12.322_fp, -1.032_fp, -5.172_fp, -5.589_fp/) + T_Leaf_Int_Shade = (/-12.846_fp, -11.343_fp, -1.068_fp,-5.551_fp, -5.955_fp/) + T_Leaf_Temp_Sun = (/1.064_fp, 1.057_fp, 1.031_fp, 1.050_fp, 1.051_fp/) + T_Leaf_Temp_Shade = (/1.060_fp, 1.053_fp, 1.031_fp,1.051_fp, 1.052_fp/) + P_Leaf_Int_Sun = (/1.0831_fp, 1.0964_fp, 1.1036_fp, 1.0985_fp, 1.0901_fp/) + P_Leaf_Int_Shade = (/0.8706_fp, 0.8895_fp, 0.9160_fp,0.9407_fp, 0.9564_fp/) + P_Leaf_LAI_Sun = (/0.0018_fp, -0.1281_fp, -0.2977_fp, -0.4448_fp, -0.5352_fp/) + P_Leaf_LAI_Shade = (/0.0148_fp, -0.1414_fp, -0.3681_fp,-0.5918_fp, -0.7425_fp/) + VPGWT = (/0.1184635, 0.2393144, 0.284444444, 0.2393144, 0.1184635/) + Distgauss = (/0.0469101, 0.2307534, 0.5, 0.7692465, 0.9530899/) + + call SOLAR_ANGLE(DOY, LocalHour, LAT, D2RAD, SINbeta) + call GET_CDEA(MISOLAI, CDEA ) + + !--------------------- %%gamma values related to compound%% ---------------------- + + !DO S=1, nMeganSpec + + !CMPD = MeganSpecName(S) + CMPD = MeganSpecName + + ! -------------------------------------------- + ! Get MEGAN parameters for this compound + ! -------------------------------------------- + CALL GET_MEGAN_PARAMS ( CMPD, BETA, LDF, CT1, CEO, & + ANEW, AGRO, AMAT, AOLD, BIDIR, RC ) + + ! -------------------------------------------------- + ! GAMMA_LAI (leaf area index activity factor) + ! -------------------------------------------------- + call GET_GAMMA_LAI( MISOLAI, BIDIR, GAMMA_LAI ) + + ! -------------------------------------------------- + ! GAMMA_AGE (leaf age activity factor) + ! -------------------------------------------------- + call GET_GAMMA_AGE( MISOLAI, & + PMISOLAI_NORM, & + D_BTW_M, & + T_LASTXDAYS, & + ANEW, AGRO, AMAT, AOLD, & + GAMMA_AGE) + + ! -------------------------------------------------- + ! GAMMA_T_LI (temperature activity factor for + ! light-independent fraction) + ! -------------------------------------------------- + !GAMMA_T_LI = GET_GAMMA_T_LI( TS, BETA ) + + ! -------------------------------------------------- + ! GAMMA_T_LD (temperature activity factor for + ! light-dependent fraction) + ! -------------------------------------------------- + !GAMMA_T_LD = GET_GAMMA_T_LD( TS, Inst%T_LASTXDAYS(I,J), & + ! Inst%T_LAST24H(I,J), CT1, CEO ) + + ! -------------------------------------------------- + ! Sam Silva's edits to replace GAMMA_T_LD + ! and GAMMA_T_LI above + ! -------------------------------------------------- + GAMMA_TP = 0.0_fp + + DO K = 1, 5 + + call Calc_Sun_Frac(MISOLAI,SINbeta,Distgauss(K), SunF) + + PSTD = 200_fp + call GET_GAMMA_PAR_C(Q_DIR_2, & + Q_DIFF_2, & + PARDR_LASTXDAYS, & + PARDF_LASTXDAYS, & + P_Leaf_LAI_Sun(K), & + P_Leaf_Int_Sun(K), & + MISOLAI, PSTD, & + GAMMA_PAR_Sun) + + PSTD = 50_fp + call GET_GAMMA_PAR_C(Q_DIR_2, & + Q_DIFF_2, & + PARDR_LASTXDAYS, & + PARDF_LASTXDAYS, & + P_Leaf_LAI_Shade(K), & + P_Leaf_Int_Shade(K), & + MISOLAI, PSTD, & + GAMMA_PAR_Shade) + + call GET_GAMMA_T_LD_C( TS, & + ! T_LASTXDAYS, & + T_LAST24H, & + CT1, CEO, & + T_Leaf_Int_Sun(K), & + T_Leaf_Temp_Sun(K), & + GAMMA_T_LD_Sun ) + + call GET_GAMMA_T_LD_C(TS, & + ! T_LASTXDAYS, & + T_LAST24H, & + CT1, CEO, & + T_Leaf_Int_Shade(K), & + T_Leaf_Temp_Shade(K),& + GAMMA_T_LD_Shade ) + + call GET_GAMMA_T_LI( TS, BETA, & + T_Leaf_Int_Sun(K), & + T_Leaf_Temp_Sun(K), & + GAMMA_T_LI_Sun ) + + call GET_GAMMA_T_LI( TS, BETA, & + T_Leaf_Int_Shade(K), & + T_Leaf_Temp_Shade(K),& + GAMMA_T_LI_Shade ) + + Ea1L = CDEA(K) * GAMMA_PAR_Sun * GAMMA_T_LD_Sun * SunF + & + GAMMA_PAR_Shade * GAMMA_T_LD_Shade * (1-SunF) + + Ea2L = GAMMA_T_LI_Sun * SunF + & + GAMMA_T_LI_Shade * (1-SunF) + + GAMMA_TP = GAMMA_TP + & + (Ea1L*LDF + Ea2L*(1-LDF))* VPGWT(K) + + !!For test only + !if ( K==1 ) then + !write(*,*)'My test1',CMPD, CDEA(1), VPGWT(1),Distgauss(1),GAMMA_PAR_Sun,GAMMA_PAR_Shade,& + ! GAMMA_T_LD_Shade,GAMMA_T_LD_Sun,GAMMA_T_LI_Shade,GAMMA_T_LI_Sun + !endif + + ENDDO + + + ! -------------------------------------------------- + ! GAMMA_SM (soil moisture activity factor) + ! -------------------------------------------------- + call GET_GAMMA_SM( GWETROOT, CMPD, GAMMA_SM ) + + ! -------------------------------------------------- + ! emission factor (Note: EFs of these seven species are now calculated online instead of reading from file) + ! -------------------------------------------------- + !select case ( TRIM(CMPD) ) + ! case ('ISOP') + ! AEF = AEF_ISOP + ! case ('MBOX') + ! AEF = AEF_MBOX + ! case ('BPIN') + ! AEF = AEF_BPIN + ! case ('CARE') + ! AEF = AEF_CARE + ! case ('LIMO') + ! AEF = AEF_LIMO + ! case ('OCIM') + ! AEF = AEF_OCIM + ! case ('SABI') + ! AEF = AEF_SABI + ! case default !others are calculated inline + call CALC_AEF(PFT_16, CMPD, AEF, RC) + !end select + + ! -------------------------------------------------- + ! calculate emission + ! -------------------------------------------------- + ! Emission is the product of all of these in kg/m2/s. + ! Normalization factor ensures product of GAMMA values is 1.0 under + ! standard conditions. Norm_FAC = 0.21. canopy add + IF ( TRIM(CMPD) == 'ISOP' ) THEN + ! Only apply CO2 inhibition to isoprene + ! MEGAN_EMIS = Inst%NORM_FAC(1) * AEF * GAMMA_AGE * GAMMA_SM * & + ! GAMMA_LAI * ((1.0_fp - LDF) * GAMMA_T_LI + & + ! (LDF * GAMMA_PAR * GAMMA_T_LD)) * GAMMA_CO2 + MEGAN_EMIS = MISOLAI * AEF * GAMMA_AGE * GAMMA_SM * & + GAMMA_TP*GAMMA_CO2*GAMMA_LAI*0.21_fp + ELSE + ! MEGAN_EMIS = Inst%NORM_FAC(1) * AEF * GAMMA_AGE * GAMMA_SM * & + ! GAMMA_LAI * ((1.0_fp - LDF) * GAMMA_T_LI + & + ! (LDF * GAMMA_PAR * GAMMA_T_LD)) + MEGAN_EMIS = MISOLAI * AEF * GAMMA_AGE * GAMMA_SM * & + GAMMA_TP * GAMMA_LAI * 0.21_fp + + ENDIF + + !!!For test only + !write(*,*) 'my test2: ', CMPD, MISOLAI, AEF, GAMMA_AGE, GAMMA_SM, GAMMA_TP, GAMMA_CO2, GAMMA_LAI + + !EmisPerSpec(S) = MEGAN_EMIS + EmisPerSpec = MEGAN_EMIS + + !ENDDO !each species + + endif + + return + + end subroutine CCPr_Scheme_MeganV21 + +end module CCPr_Scheme_MeganV21_Mod diff --git a/src/process/drydep/CCPr_DryDep_Mod.F90 b/src/process/drydep/CCPr_DryDep_Mod.F90 index 4b10f40a..856747e2 100644 --- a/src/process/drydep/CCPr_DryDep_Mod.F90 +++ b/src/process/drydep/CCPr_DryDep_Mod.F90 @@ -2,7 +2,7 @@ !! !! \defgroup catchem_drydep_process !! -!! \author Lacey Holland +!! \authors Lacey Holland, Wei Li !! \date 07/2024 !!!> MODULE CCPR_DryDep_mod @@ -12,6 +12,7 @@ MODULE CCPR_DryDep_mod USE MetState_Mod, Only : MetStateType USE ChemState_Mod, Only : ChemStateType USE Config_Opt_Mod, Only : ConfigType + USE CCPr_drydep_Common_Mod !to initialize INIT_WEIGHTSS IMPLICIT NONE @@ -48,11 +49,15 @@ MODULE CCPR_DryDep_mod LOGICAL :: Activate ! Activate Process (True/False) LOGICAL :: Resuspension ! Activate resuspension (True/False) - INTEGER :: SchemeOpt ! Scheme Option (if there is only one SchemeOpt always = 1) + INTEGER :: AeroSchemeOpt ! Scheme Option for aerosol drydep + INTEGER :: GasSchemeOpt ! Scheme Option for gas drydep real :: particleradius ! Particle radius (m) real :: particledensity ! Particle density (kg/m^3) - real, allocatable :: drydep_frequency(:) ! could have one per chem species, revisit later - real, allocatable :: drydep_vel(:) ! could have one per chem species, revisit later + LOGICAL :: co2_effect ! CO2 effect on drydep + real(fp) :: co2_level ! CO2 level (ppm) + real(fp) :: co2_reference ! Reference CO2 level (ppm) + real, allocatable :: drydep_frequency(:) ! could have one per chem species, revisit later + real, allocatable :: drydep_vel(:) ! could have one per chem species, revisit later END TYPE DryDepStateType @@ -74,7 +79,6 @@ MODULE CCPR_DryDep_mod SUBROUTINE CCPR_DryDep_Init( Config, DryDepState, ChemState, RC ) ! USE - IMPLICIT NONE ! INPUT PARAMETERS !----------------- @@ -109,29 +113,45 @@ SUBROUTINE CCPR_DryDep_Init( Config, DryDepState, ChemState, RC ) ! Activate Process !------------------ DryDepState%Activate = .true. - allocate(DryDepState%drydep_frequency(ChemState%nSpeciesAeroDryDep), STAT=RC) + + ! Set scheme option + !------------------ + ! For now, the only option is SchemeOpt = 1,2; default is 1 + DryDepState%AeroSchemeOpt = Config%drydep_aero_scheme + DryDepState%GasSchemeOpt = Config%drydep_gas_scheme + + allocate(DryDepState%drydep_frequency(ChemState%nSpeciesDryDep), STAT=RC) IF ( RC /= CC_SUCCESS ) THEN - ErrMsg = 'Could not Allocate DryDepState%drydep_frequency(ChemState%nSpeciesAeroDryDep)' + ErrMsg = 'Could not Allocate DryDepState%drydep_frequency(ChemState%nSpeciesDryDep)' CALL CC_Error( ErrMsg, RC, ThisLoc ) + RETURN ENDIF - DryDepState%drydep_frequency(1:ChemState%nSpeciesAeroDryDep)=ZERO + DryDepState%drydep_frequency(1:ChemState%nSpeciesDryDep)=ZERO - allocate(DryDepState%drydep_vel(ChemState%nSpeciesAeroDryDep), STAT=RC) + allocate(DryDepState%drydep_vel(ChemState%nSpeciesDryDep), STAT=RC) IF ( RC /= CC_SUCCESS ) THEN - ErrMsg = 'Could not Allocate DryDepState%drydep_vel(ChemState%nSpeciesAeroDryDep)' + ErrMsg = 'Could not Allocate DryDepState%drydep_vel(ChemState%nSpeciesDryDep)' CALL CC_Error( ErrMsg, RC, ThisLoc ) + RETURN ENDIF - DryDepState%drydep_vel(1:ChemState%nSpeciesAeroDryDep)=ZERO - - ! Set scheme option - !------------------ - ! For now, the only option is SchemeOpt = 1 - if (Config%drydep_scheme==1) then - DryDepState%SchemeOpt = 1 - else - DryDepState%SchemeOpt = 1 + DryDepState%drydep_vel(1:ChemState%nSpeciesDryDep)=ZERO + + if (DryDepState%AeroSchemeOpt == 2) then !Zhang scheme + !calculate the volume distribution of sea salt aerosols (only need to do this once) + CALL INIT_WEIGHTSS(MINVAL(ChemState%SeaSaltBinLower), MAXVAL(ChemState%SeaSaltBinUpper), RC) + IF ( RC /= CC_SUCCESS ) THEN + ErrMsg = 'Could not Allocate arrays in INIT_WEIGHTSS' + CALL CC_Error( ErrMsg, RC, ThisLoc ) + RETURN + ENDIF end if + + ! Set other scheme-related options + !----------------------------------- DryDepState%Resuspension = Config%drydep_resuspension + DryDepState%co2_effect = Config%drydep_co2_effect + DryDepState%co2_level = Config%drydep_co2_level + DryDepState%co2_reference = Config%drydep_co2_reference else DryDepState%Activate = .false. end if @@ -154,6 +174,8 @@ SUBROUTINE CCPr_DryDep_Run( MetState, DiagState, DryDepState, ChemState, RC ) ! USE USE constants, only : Cp, g0, VON_KARMAN use CCPr_Scheme_GOCART_DryDep_Mod, only : CCPr_Scheme_GOCART_DryDep + use CCPr_Scheme_Wesely_Mod, only : CCPr_Scheme_Wesely + use CCPr_Scheme_Zhang_Aerosol_Mod, only : CCPr_Scheme_Zhang_Aero IMPLICIT NONE ! INPUT PARAMETERS @@ -173,6 +195,9 @@ SUBROUTINE CCPr_DryDep_Run( MetState, DiagState, DryDepState, ChemState, RC ) INTEGER :: i !< counter real :: radius real :: rhop + real(fp) :: W10, F0 !calculated 10m wind speed from U10M and V10M + !real(fp) :: THIK !codespell:ignore + real(fp) :: VD, DDFreq real :: drydepf(1,1) REAL(fp) :: dqa ! Change in Species due to drydep REAL(fp) :: SpecConc ! Temporary Species concentration @@ -189,66 +214,184 @@ SUBROUTINE CCPr_DryDep_Run( MetState, DiagState, DryDepState, ChemState, RC ) if (DryDepState%Activate) then ! Run the DryDep Scheme !------------------------- - if (DryDepState%SchemeOpt == 1) then - ! Run the DryDep Scheme - Only Applicable to AEROSOL species - !------------------------- - if (ChemState%nSpeciesAeroDryDep > 0) then + if (ChemState%nSpeciesDryDep > 0) then + + !TODO: used for Zhang aerosol scheme; may be read from MetState in the future + W10 = sqrt(MetState%U10M**2 + MetState%V10M**2) - ! loop through aerosol species - do i = 1, ChemState%nSpeciesAeroDryDep + ! loop through all drydep species + do i = 1, ChemState%nSpeciesDryDep + + if (ChemState%chemSpecies(ChemState%DryDepIndex(i))%is_aerosol) then radius = ChemState%chemSpecies(ChemState%DryDepIndex(i))%radius rhop = ChemState%chemSpecies(ChemState%DryDepIndex(i))%density - call CCPr_Scheme_GOCART_DryDep( MetState%NLEVS, & - MetState%T, & - MetState%AIRDEN, & - MetState%ZMID, & - MetState%LWI, & - MetState%USTAR, & - MetSTate%PBLH, & - MetState%HFLUX, & - VON_KARMAN, & - Cp, & - g0, & - MetState%Z0H, & - drydepf, & - DryDepState%Resuspension, & - radius, & - rhop, & - MetState%U10M, & - MetSTate%V10M, & - MetState%FRLAKE, & - MetState%GWETTOP, & - RC) - - - if (RC /= 0) then - errMsg = 'Error in GOCART DryDeposition' - CALL CC_Error( errMsg, RC, thisLoc ) - endif !if (RC /= CC_SUCCESS) - - ! Fill Diagnostic Variables - !-------------------------- - DryDepState%drydep_frequency(ChemState%DryDepIndex(i)) = drydepf(1,1) - DryDepState%drydep_vel(ChemState%DryDepIndex(i)) = MetState%ZMID(1) * drydepf(1,1) - DiagState%drydep_frequency(i)= drydepf(1,1) - DiagState%drydep_vel(i) = MetState%ZMID(1) * drydepf(1,1) - - ! apply drydep velocities/freq to chem species - dqa = 0. - SpecConc = ChemState%chemSpecies(ChemState%DryDepIndex(i))%conc(1) - dqa = MAX(0.0_fp, SpecConc * (1.-exp(-1*drydepf(1,1) * MetState%TSTEP))) - ChemState%chemSpecies(ChemState%DryDepIndex(i))%conc(1) = SpecConc - dqa - - end do ! do i = 1, ChemState%nSpeciesAeroDryDep - - endif ! if (ChemState%nSpeciesAeroDryDep > 0) - - endif ! if (DryDepState%SchemeOpt == 1) + if (DryDepState%AeroSchemeOpt == 1) then + ! Run the DryDep Scheme - GOCART scheme + !------------------------- + call CCPr_Scheme_GOCART_DryDep( MetState%NLEVS, & + MetState%T, & + MetState%AIRDEN, & + MetState%ZMID, & + MetState%LWI, & + MetState%USTAR, & + MetSTate%PBLH, & + MetState%HFLUX, & + VON_KARMAN, & + Cp, & + g0, & + MetState%Z0H, & + drydepf, & + DryDepState%Resuspension, & + radius, & + rhop, & + MetState%U10M, & + MetSTate%V10M, & + MetState%FRLAKE, & + MetState%GWETTOP, & + RC) + + if (RC /= 0) then + errMsg = 'Error in GOCART DryDeposition' + CALL CC_Error( errMsg, RC, thisLoc ) + endif !if (RC /= CC_SUCCESS) + + ! Fill Diagnostic Variables + !-------------------------- + DryDepState%drydep_frequency(i) = drydepf(1,1) + DryDepState%drydep_vel(i) = MetState%ZMID(1) * drydepf(1,1) + DiagState%drydep_frequency(i)= drydepf(1,1) + DiagState%drydep_vel(i) = MetState%ZMID(1) * drydepf(1,1) + + ! apply drydep velocities/freq to chem species + dqa = 0. + SpecConc = ChemState%chemSpecies(ChemState%DryDepIndex(i))%conc(1) + dqa = MAX(0.0_fp, SpecConc * (1.-exp(-1*drydepf(1,1) * MetState%TSTEP))) + ChemState%chemSpecies(ChemState%DryDepIndex(i))%conc(1) = SpecConc - dqa + + else if (DryDepState%AeroSchemeOpt == 2) then + ! Run the DryDep Scheme - Zhang aerosol scheme + !------------------------- + + call CCPr_Scheme_Zhang_Aero( & + MetState%TS, & + ChemState%chemSpecies(ChemState%DryDepIndex(i))%dd_hstar, & + ChemState%chemSpecies(ChemState%DryDepIndex(i))%mw_g/1000.0_fp, & + radius, & + rhop, & + MetState%USTAR, & + MetState%OBK, & !TODO: Need to add Obukhov length to met state + MetState%BXHEIGHT(1), & + MetState%Z0, & + MetState%RH(1)/100.0_fp, & !TODO: input is percent & RH is a array + MetState%PS * 100.0_fp, & !TODO: input is hPa; change to Pa + W10, & + ChemState%chemSpecies(ChemState%DryDepIndex(i))%short_name, & + MetState%ILAND, & !TODO: Need to add land use type to met state + MetState%FRLANDUSE, & + ChemState%SeaSaltBinLower, & + ChemState%SeaSaltBinUpper, & + MetState%LUCNAME, & + ChemState%chemSpecies(ChemState%DryDepIndex(i))%is_dust, & + ChemState%chemSpecies(ChemState%DryDepIndex(i))%is_seasalt, & + MetState%IsSnow, MetState%IsIce, & + ChemState%chemSpecies(ChemState%DryDepIndex(i))%dd_DvzAerSnow, & + ChemState%chemSpecies(ChemState%DryDepIndex(i))%dd_DvzMinVal_snow, & + ChemState%chemSpecies(ChemState%DryDepIndex(i))%dd_DvzMinVal_land, & + VD, DDFreq, RC ) + + if (RC /= CC_SUCCESS ) then + errMsg = 'Error in Zhang Aerosol DryDeposition' + CALL CC_Error( errMsg, RC, thisLoc ) + RETURN + endif + + ! Fill Diagnostic Variables + !-------------------------- + DryDepState%drydep_frequency(i) = DDFreq + DryDepState%drydep_vel(i) = VD + DiagState%drydep_frequency(i)= DDFreq + DiagState%drydep_vel(i) = VD + + ! apply drydep velocities/freq to chem species + dqa = 0. + SpecConc = ChemState%chemSpecies(ChemState%DryDepIndex(i))%conc(1) + dqa = MAX(0.0_fp, SpecConc * (1.-exp(-1*DDFreq * MetState%TSTEP))) + ChemState%chemSpecies(ChemState%DryDepIndex(i))%conc(1) = SpecConc - dqa + + end if !aeorsol scheme option end + + else !if gas or aerosol species + + if (DryDepState%GasSchemeOpt == 1) then + ! Run the DryDep Scheme - Wesely scheme + !------------------------- + + !It can be changed in the function so as not to modify the original values in the States + F0 = ChemState%chemSpecies(ChemState%DryDepIndex(i))%dd_f0 + + call CCPr_Scheme_Wesely( & + MetState%SWGDN, & + MetState%TS, & + MetState%SUNCOSmid, & + F0, & + ChemState%chemSpecies(ChemState%DryDepIndex(i))%dd_hstar, & + ChemState%chemSpecies(ChemState%DryDepIndex(i))%mw_g/1000.0_fp, & + MetState%USTAR, & + MetState%OBK, & !TODO: Need to add Obukhov length to met state + MetState%CLDFRC, & + MetState%BXHEIGHT(1), & + MetState%Z0, & + MetState%PS * 100.0_fp, & !TODO: input is hPa; change to Pa + ChemState%chemSpecies(ChemState%DryDepIndex(i))%short_name, & + MetState%FRLAI, & !TODO: whether LAI is separated to each land type? + MetState%ILAND, & !TODO: Need to add land use type to met state + MetState%FRLANDUSE, & + MetState%SALINITY, & !TODO: Need to add salinity to met state + MetState%TSKIN, & + MetState%IODIDE, & !TODO: Need to read from ChemState in the future + MetState%LON, & !TODO: Need to add longitude to met state + MetState%LAT, & + MetState%LUCNAME, & + DryDepState%co2_effect, & + DryDepState%co2_level, & + DryDepState%co2_reference, & + MetState%IsSnow, MetState%IsIce, MetState%IsLand, & + ChemState%chemSpecies(ChemState%DryDepIndex(i))%dd_DvzAerSnow, & + ChemState%chemSpecies(ChemState%DryDepIndex(i))%dd_DvzMinVal_snow, & + ChemState%chemSpecies(ChemState%DryDepIndex(i))%dd_DvzMinVal_land, & + VD, DDFreq, RC ) + + if (RC /= CC_SUCCESS ) then + errMsg = 'Error in Wesely DryDeposition' + CALL CC_Error( errMsg, RC, thisLoc ) + RETURN + endif + + ! Fill Diagnostic Variables + !-------------------------- + DryDepState%drydep_frequency(i) = DDFreq + DryDepState%drydep_vel(i) = VD + DiagState%drydep_frequency(i)= DDFreq + DiagState%drydep_vel(i) = VD + + ! apply drydep velocities/freq to chem species + dqa = 0. + SpecConc = ChemState%chemSpecies(ChemState%DryDepIndex(i))%conc(1) + dqa = MAX(0.0_fp, SpecConc * (1.-exp(-1*DDFreq * MetState%TSTEP))) + ChemState%chemSpecies(ChemState%DryDepIndex(i))%conc(1) = SpecConc - dqa + + end if !gas scheme option end + + end if !gas or aerosol species end + + end do ! do i = 1, ChemState%nSpeciesDryDep + + endif ! if (ChemState%nSpeciesAeroDryDep > 0) ! TO DO: apply dry dep velocities/freq to chem species - write(*,*) 'TODO: Need to figure out how to add back to the chemical species state ' + write(*,*) 'TODO: Need to figure out how to add back to the chemical species state' endif ! if (DryDepState%Activate) @@ -282,16 +425,32 @@ SUBROUTINE CCPr_DryDep_Finalize( DryDepState, RC ) errMsg = '' thisLoc = ' -> at CCPr_DryDep_Finalize (in process/drydep/ccpr_DryDep_mod.F90)' - DEALLOCATE( DryDepState%drydep_frequency, STAT=RC ) + IF ( ALLOCATED( DryDepState%drydep_frequency ) ) DEALLOCATE( DryDepState%drydep_frequency, STAT=RC ) IF ( RC /= CC_SUCCESS ) THEN ErrMsg = 'Could not Deallocate DryDepState%drydep_frequency' CALL CC_Error( ErrMsg, RC, ThisLoc ) + RETURN ENDIF - DEALLOCATE( DryDepState%drydep_vel, STAT=RC ) + IF ( ALLOCATED( DryDepState%drydep_vel ) ) DEALLOCATE( DryDepState%drydep_vel, STAT=RC ) IF ( RC /= CC_SUCCESS ) THEN ErrMsg = 'Could not Deallocate DryDepState%drydep_vel' CALL CC_Error( ErrMsg, RC, ThisLoc ) + RETURN + ENDIF + + IF ( ALLOCATED( DMID ) ) DEALLOCATE( DMID, STAT=RC ) + IF ( RC /= CC_SUCCESS ) THEN + ErrMsg = 'Could not Deallocate DMID' + CALL CC_Error( ErrMsg, RC, ThisLoc ) + RETURN + ENDIF + + IF ( ALLOCATED( SALT_V ) ) DEALLOCATE( SALT_V, STAT=RC ) + IF ( RC /= CC_SUCCESS ) THEN + ErrMsg = 'Could not Deallocate SALT_V' + CALL CC_Error( ErrMsg, RC, ThisLoc ) + RETURN ENDIF diff --git a/src/process/drydep/CMakeLists.txt b/src/process/drydep/CMakeLists.txt index ba0e7f9c..a7670261 100644 --- a/src/process/drydep/CMakeLists.txt +++ b/src/process/drydep/CMakeLists.txt @@ -1,4 +1,11 @@ -set(_srcs CCPr_DryDep_Mod.F90 ccpr_scheme_GOCART_DryDep_mod.F90) +set( + _srcs + CCPr_DryDep_Mod.F90 + ccpr_scheme_GOCART_DryDep_mod.F90 + ccpr_drydep_common_mod.F90 + ccpr_scheme_wesely_mod.F90 + ccpr_scheme_zhang_aerosol_mod.F90 +) set(_lib CATChem_process_drydep) diff --git a/src/process/drydep/ccpr_drydep_common_mod.F90 b/src/process/drydep/ccpr_drydep_common_mod.F90 new file mode 100644 index 00000000..a89308ac --- /dev/null +++ b/src/process/drydep/ccpr_drydep_common_mod.F90 @@ -0,0 +1,1753 @@ +!> +!! \file ccpr_drydep_common_mod.F90 +!! \brief Contains module ccpr_drydep_common_mod +!! +!! \ingroup catchem_drydep_process +!! +!! \author Wei Li +!! \date 02/2025 +!!!> +module CCPr_drydep_Common_Mod + use precision_mod, only: fp, ZERO, rae + use Error_Mod + use constants + implicit none + !private + + public :: Wesely_Rc_Gas + public :: AERO_SFCRSII + public :: Wesely_Ra_Rb + public :: INIT_WEIGHTSS + + + ! module variables (mainly some constants dependent on land use in the scheme) + + integer, parameter :: NDRYDTYPE = 11 !< # of drydep land types following GEOS-Chem + real(fp), parameter :: TWO_THIRDS = 2.0_fp / 3.0_fp + !real(fp), parameter :: H2OMW = 18.0_fp !declared in constant module + real(fp), parameter :: SMALL = 1.0e-10_fp !< Small number + integer, parameter :: IWATER = 1 !< Index for water in Olson land use + ! Arrays that hold information for each of the 11 drydep land types + integer :: IDRYDTYPE(NDRYDTYPE) + real(fp) :: IRAC(NDRYDTYPE), IRCLO(NDRYDTYPE), IRCLS(NDRYDTYPE) + real(fp) :: IRGSS(NDRYDTYPE), IRGSO(NDRYDTYPE), IRLU(NDRYDTYPE) + real(fp) :: IRI(NDRYDTYPE), IVSMAX(NDRYDTYPE) + !some Olson land use (74 types) related parameters + real(fp):: DRYCOEFF(20) !< DRYCOEFF : Baldocchi polynomial coeffs + integer :: IOLSON (74), IDEP_IOLSON(74) + integer :: IDEP_NOAH(20), IDEP_IGBP(17) + integer :: IZO(74) !< Roughness height for each Olson land types + + !assign some drydep values to arrays based on the 11 drydep land use in GEOS-Chem. + !Wesely (1989) is separated into seasons, but not sure how GEOS-Chem gets its values (TODO). + !You can find the values and references in https://wiki.seas.harvard.edu/geos-chem/index.php/Dry_deposition + !*********************************************************************** + !* The land types within each grid square are defined using the Olson + !* land-type database. Each of the Olson land types is assigned a + !* corresponding "deposition land type" with characteristic values of + !* surface resistance components. There are 74 Olson land-types but only + !* 11 deposition land-types (i.e., many of the Olson land types share the + !* same deposition characteristics). Surface resistance components for + !* the "deposition land types" are from Wesely [1989] except for tropical + !* forests [Jacob and Wofsy, 1990] and for tundra [Jacob et al., 1992]. + !* All surface resistance components are normalized to a leaf area index + !* of unity. + !* + !* Olson land types, deposition land types, and surface resistance + !* components are read from file 'Olson_2001_Drydep_Inputs.nc'; check that file for + !* further details. + !*********************************************************************** + + ! (1) (2) (3) (4) (5) (6) (7) (8) (9) (10) (11) + ! snow/ice deciduous coniferous agricultural shub/ Amozaon tundra Desert wetland urban water + ! forest forest land grassland forest + ! Note IRI(3) = 200 is hardcoded and not the same as in the file. + DATA IRI /9999, 200, 200, 200, 200, 200, 200, 9999, 200, 9999, 9999/ + DATA IRLU /9999, 9000, 9000, 9000, 9000, 1000, 4000, 9999, 9000, 9999, 9999/ + DATA IRAC / 0, 2000, 2000, 200, 100, 2000, 0, 0, 300, 100, 0/ + DATA IRGSS / 100, 500, 500, 150, 350, 200, 340, 1000, 0, 400, 0/ + DATA IRGSO /3500, 200, 200, 150, 200, 200, 340, 400, 1000, 300, 2000/ + DATA IRCLS /9999, 2000, 2000, 2000, 2000, 9999, 9999, 9999, 2500, 9999, 9999/ + DATA IRCLO /1000, 1000, 1000, 1000, 1000, 9999, 9999, 9999, 1000, 9999, 9999/ + DATA IVSMAX /100, 100, 100, 100, 100, 100, 100, 10, 100, 100, 10/ + DATA IDRYDTYPE /1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11/ + ! Olson land use related parameters (https://wiki.seas.harvard.edu/geos-chem/index.php/Olson_land_map) + DATA IOLSON /1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, & + 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, & + 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74/ + DATA IDEP_IOLSON / 11,10, 5, 3, 3, 2, 2, 5, 8, 7, 5, 8, 1, 9, 11, 11, 5, 5, 5, 2, 6, 3, 3, 2, 2, 2, 2, & + 3, 6, 6, 4, 4, 2, 6, 2, 4, 9, 4, 4, 4, 5, 5, 5, 2, 5, 9, 5, 5, 2, 8, 8, 5, & + 5, 7, 2, 4, 2, 2, 2, 5, 2, 2, 3, 5, 5, 9, 9, 9, 9, 8, 8, 8, 9, 11/ + DATA IDEP_NOAH / 3, 6, 3, 2, 2, 5, 5, 2, 5, 5, 9, 4, 10, 5, 1, 8, 11, 7, 7, 7 / + DATA IDEP_IGBP / 3, 6, 3, 2, 2, 5, 5, 2, 5, 5, 9, 4, 10, 5, 1, 8, 11 / !same as NOAH without the last three tundra types + !roughness height is not used now and is read from MET directly; so comment out + !DATA IZO / 10, 25000, 100, 10000, 10000, 10000, 10000, 100, 10, 2000, 100, 10, 1, 100, 1000, 1000, 1000, 100, 100, 2000, & + ! 10000, 10000,10000, 10000, 10000, 10000, 10000,10000,1000,10000,1000,1000,2000,10000,10000, 1000, 100, 1000, 1000,1000, & + ! 100, 100, 100, 2000, 100, 100, 1000, 1000, 1000, 1000,1000, 50, 50, 50, 2000, 2000, 2000, 2000, 1000, 100, & + ! 2000, 2000, 10000, 2000, 1000, 1000, 1000, 1000, 1000, 10, 1000,1000,500, 100 / + ! Baldocchi polynomial coeffs + DATA DRYCOEFF /-0.358, 3.02, 3.85, -0.0978, -3.66, 12, 0.252, -7.8, 0.226, 0.274, & + 1.14, -2.19, 0.261, -4.62, 0.685, -0.254, 4.37, -0.266, -0.159, -0.206 / + + !There are 15 land types in Zhang et al., 2001 **aerosol deposition** scheme. + !The land types in the model need to be mapped to these 15 land types. + !======================================================================= + ! # LUC [Zhang et al., 2001] GEOS-CHEM LUC (Corr. #) + !----------------------------------------------------------------------- + ! 1 - Evergreen needleleaf trees Snow/Ice (12) + ! 2 - Evergreen broadleaf trees Deciduous forest ( 4) + ! 3 - Deciduous needleleaf trees Coniferous forest ( 1) + ! 4 - Deciduous broadleaf trees Agricultural land ( 7) + ! 5 - Mixed broadleaf and needleleaf trees Shrub/grassland (10) + ! 6 - Grass Amazon forest ( 2) + ! 7 - Crops and mixed farming Tundra ( 9) + ! 8 - Desert Desert ( 8) + ! 9 - Tundra Wetland (11) + ! 10 - Shrubs and interrupted woodlands Urban (15) + ! 11 - Wet land with plants Water (14) + ! 12 - Ice cap and glacier + ! 13 - Inland water + ! 14 - Ocean + ! 15 - Urban + !======================================================================= + ! GEOS-CHEM LUC 1, 2, 3, 4, 5, 6, 7 8, 9,10,11 (TODO:may add other land types later) + INTEGER :: LUCINDEX_GC(11) = (/12, 4, 1, 7,10, 2, 9, 8,11,15,14/) + ! Noah-MP LUC mapping + INTEGER :: LUCINDEX_NOAH(20) = (/ 1, 2, 3, 4, 5, 10, 10, 10, 10, 6, 11, 7, 15, 7, 12, 8, 14, 9, 9, 9 /) + ! IGBP LUC mapping + INTEGER :: LUCINDEX_IGBP(17) = (/ 1, 2, 3, 4, 5, 10, 10, 10, 10, 6, 11, 7, 15, 7, 12, 8, 14 /) + + !======================================================================= + ! LUC 1, 2, 3, 4, 5, 6, 7, 8, + ! alpha 1.0, 0.6, 1.1, 0.8, 0.8, 1.2, 1.2, 50.0, + ! gamma 0.56, 0.58, 0.56, 0.56, 0.56, 0.54, 0.54, 0.54 + ! + ! LUC 9, 10, 11, 12, 13, 14, 15 + ! alpha 50.0, 1,3, 2.0, 50.0,100.0,100.0, 1.5 + ! gamma 0.54, 0.54, 0.54, 0.54, 0.50, 0.50, 0.56 + !======================================================================= + REAL(fp) :: ALPHA(15) = (/ 1.0e+0_fp, 0.6e+0_fp, 1.1e+0_fp, & + 0.8e+0_fp, 0.8e+0_fp, 1.2e+0_fp, & + 1.2e+0_fp, 50.0e+0_fp, 50.0e+0_fp, & + 1.3e+0_fp, 2.0e+0_fp, 50.0e+0_fp, & + 100.0e+0_fp, 100.0e+0_fp, 1.5e+0_fp /) + + REAL(fp) :: GAMMA(15) = (/ 0.56e+0_fp, 0.58e+0_fp, 0.56e+0_fp, & + 0.56e+0_fp, 0.56e+0_fp, 0.54e+0_fp, & + 0.54e+0_fp, 0.54e+0_fp, 0.54e+0_fp, & + 0.54e+0_fp, 0.54e+0_fp, 0.54e+0_fp, & + 0.50e+0_fp, 0.50e+0_fp, 0.56e+0_fp /) + + !...A unit is (mm) so multiply by 1.D-3 to (m) + ! LUC 1, 2, 3, 4, 5, 6, 7, 8, + ! SC1 2.0, 5.0, 2.0, 5.0, 5.0, 2.0, 2.0,-999., + ! SC2 2.0, 5.0, 2.0, 5.0, 5.0, 2.0, 2.0,-999., + ! A SC3 2.0, 5.0, 5.0, 10.0, 5.0, 5.0, 5.0,-999., + ! SC4 2.0, 5.0, 5.0, 10.0, 5.0, 5.0, 5.0,-999., + ! SC5 2.0, 5.0, 2.0, 5.0, 5.0, 2.0, 2.0,-999., + ! + ! LUC 9, 10, 11, 12, 13, 14, 15 + ! SC1 -999., 10.0, 10.0,-999.,-999.,-999., 10.0 + ! SC2 -999., 10.0, 10.0,-999.,-999.,-999., 10.0 + ! A SC3 -999., 10.0, 10.0,-999.,-999.,-999., 10.0 + ! SC4 -999., 10.0, 10.0,-999.,-999.,-999., 10.0 + ! SC5 -999., 10.0, 10.0,-999.,-999.,-999., 10.0 + REAL(fp) :: A(15,5) + + DATA A / 2.0e+0_fp, 5.0e+0_fp, 2.0e+0_fp, 5.0e+0_fp, 5.0e+0_fp, & + 2.0e+0_fp, 2.0e+0_fp, -999.e+0_fp, -999.e+0_fp, 10.0e+0_fp, & + 10.0e+0_fp, -999.e+0_fp, -999.e+0_fp, -999.e+0_fp, 10.0e+0_fp, & + + 2.0e+0_fp, 5.0e+0_fp, 2.0e+0_fp, 5.0e+0_fp, 5.0e+0_fp, & + 2.0e+0_fp, 2.0e+0_fp, -999.e+0_fp, -999.e+0_fp, 10.0e+0_fp, & + 10.0e+0_fp, -999.e+0_fp, -999.e+0_fp, -999.e+0_fp, 10.0e+0_fp, & + + 2.0e+0_fp, 5.0e+0_fp, 5.0e+0_fp, 10.0e+0_fp, 5.0e+0_fp, & + 5.0e+0_fp, 5.0e+0_fp, -999.e+0_fp, -999.e+0_fp, 10.0e+0_fp, & + 10.0e+0_fp, -999.e+0_fp, -999.e+0_fp, -999.e+0_fp, 10.0e+0_fp, & + + 2.0e+0_fp, 5.0e+0_fp, 5.0e+0_fp, 10.0e+0_fp, 5.0e+0_fp, & + 5.0e+0_fp, 5.0e+0_fp, -999.e+0_fp, -999.e+0_fp, 10.0e+0_fp, & + 10.0e+0_fp, -999.e+0_fp, -999.e+0_fp, -999.e+0_fp, 10.0e+0_fp, & + + 2.0e+0_fp, 5.0e+0_fp, 2.0e+0_fp, 5.0e+0_fp, 5.0e+0_fp, & + 2.0e+0_fp, 2.0e+0_fp, -999.e+0_fp, -999.e+0_fp, 10.0e+0_fp, & + 10.0e+0_fp, -999.e+0_fp, -999.e+0_fp, -999.e+0_fp, 10.0e+0_fp / + + ! Annual average of A; put in the function now + !REAL(fp) :: Aavg(15) + !Aavg(:) = (A(:,1)+A(:,2)+A(:,3)+A(:,4)+A(:,5))/5. + + ! Allocatable arrays for sea salt volume size bins + REAL(fp), ALLOCATABLE :: DMID (: ) + REAL(fp), ALLOCATABLE :: SALT_V (: ) + !TODO:put sea salt size bins here for now; may be read from input file later + real(fp), parameter :: SALA_REDGE_um(2)=(/0.01, 0.5/) !< accumulation mode Sea salt radius bin [um] + real(fp), parameter :: SALC_REDGE_um(2)=(/0.5, 8.0/) !< coarse mode Sea salt radius bin [um] + + + +contains + !> + !! \brief Computes the bulk surface resistance (Rc) for the gas species + !! + !!References: + !! Wesely, M. L. "Parameterization of surface resistances to gaseous dry deposition in + !! regional-scale numerical models." Atmospheric environment 41 (2007): 52-63. + !! https://doi.org/10.1016/0004-6981(89)90153-4 + !! + !! \param RADIAT Solar radiation [W/m2] + !! \param TEMP Temperature [K] + !! \param SUNCOS Cosine of solar zenith angle + !! \param F0 React. factor for oxidation depends on species + !! \param HSTAR Henry's law constant depends on species + !! \param XMW Molecular weight [kg/mol] + !! \param USTAR Friction velocity [m/s] + !! \param CFRAC Surface cloud fraction + !! \param PRESSU Surface pressure [Pa] + !! \param XLAI Leaf area index + !! \param II Index of the drydep land type + !! \param SPC Species name + !! \param SALINITY Salinity of the ocean + !! \param TSKIN Skin temperature + !! \param IODIDE Iodide concentration + !! \param XLON Longitude + !! \param YLAT Latitude + !! \param CO2_EFFECT CO2 effect on RS + !! \param CO2_LEVEL CO2 level + !! \param CO2_REF CO2 reference level + !! \param RSURFC Bulk Surface resistance [s/m] + !! \param RC Success or failure? + !! + !! \ingroup catchem_drydep_process + !!!> + subroutine Wesely_Rc_Gas( RADIAT, TEMP, SUNCOS, F0, HSTAR, XMW, USTAR, CFRAC, PRESSU, & + XLAI, II, SPC, SALINITY, TSKIN, IODIDE, XLON, YLAT, & + CO2_EFFECT, CO2_LEVEL, CO2_REF, RSURFC, RC) + IMPLICIT NONE + ! Parameters + !----------- + real(fp), intent(in) :: RADIAT !< Solar radiation [W/m2] + real(fp), intent(in) :: TEMP !< Temperature [K] + real(fp), intent(in) :: SUNCOS !< Cosine of solar zenith angle + real(fp), intent(inout) :: F0 !< React. factor for oxidation depends on species (inout because it is changed in the function) + real(fp), intent(in) :: HSTAR !< Henry's law constant depends on species + real(fp), intent(in) :: XMW !< Molecular weight [kg/mol] + real(fp), intent(in) :: USTAR !< Friction velocity [m/s] + real(fp), intent(in) :: CFRAC !< Surface cloud fraction + real(fp), intent(in) :: PRESSU !< Surface pressure [Pa] + real(fp), intent(in) :: XLAI !< Leaf area index + integer, intent(in) :: II !< Index of the drydep land type + !integer, intent(in) :: N_SPC !< Species ID (TODO: may be changed to species name) + character(len=20), intent(in) :: SPC !< Species name + !some inputs are for O3 over water and Hg over Amazon forest (not sure if we should include them for now) + real(fp), intent(in) :: SALINITY !< Salinity of the ocean + real(fp), intent(in) :: TSKIN !< Skin temperature + real(fp), intent(in) :: IODIDE !< Iodide concentration + real(fp), intent(in) :: XLON !< Longitude + real(fp), intent(in) :: YLAT !< Latitude + logical, intent(in) :: CO2_EFFECT !< CO2 effect on RS + real(fp), intent(in) :: CO2_LEVEL !< CO2 level + real(fp), intent(in) :: CO2_REF !< CO2 reference level + !output + real(fp), intent(out) :: RSURFC !< Bulk Surface resistance [s/m] + integer, intent(out) :: RC !< Success or failure? + + ! Local Variables + !---------------- + real(fp) :: RI, RLU, RAC, RGSS, RGSO, RCLS, RCLO + real(fp) :: RT,RIX,GFACT,GFACI,RS_SCALE + real(fp) :: RDC,RLUXX,RGSX,DTMP1,DTMP2,DTMP3,DTMP4 + real(fp) :: XMWH2O,TEMPK,TEMPC,DEPVw,alpha0 + real(fp) :: RCLX,RIXX !,BIOFIT + !string + character(len=255) :: thisLoc + character(len=512) :: ErrMsg + + !-------------------------------------------- + ! main function + !-------------------------------------------- + + ! Assume success + RC = CC_SUCCESS + ErrMsg = '' + ThisLoc = ' -> at Wesely_Rc_Gas (in process/drydep/CCPr_drydep_Commmon_Mod.F90)' + + ! Zero variables that aren't zeroed below + RSURFC = 0.0_fp + RI = 0.0_fp + RLU = 0.0_fp + RAC = 0.0_fp + RGSS = 0.0_fp + RGSO = 0.0_fp + RCLS = 0.0_fp + RCLO = 0.0_fp + RIX = 0.0_fp + GFACT = 0.0_fp + GFACI = 0.0_fp + RDC = 0.0_fp + XMWH2O = 0.0_fp + RIXX = 0.0_fp + RLUXX = 0.0_fp + RGSX = 0.0_fp + RCLX = 0.0_fp + DTMP1 = 0.0_fp + DTMP2 = 0.0_fp + DTMP3 = 0.0_fp + DTMP4 = 0.0_fp + !N_SPC = 0 + alpha0 = 0.0_fp + DEPVw = 0.0_fp + + !** TEMPK and TEMPC are surface air temperatures in K and in C + TEMPK = TEMP + TEMPC = TEMP - 273.15e+0_fp + + !* Adjust external surface resistances for temperature; + !* from Wesely [1989], expression given in text on p. 1296. + !* + !* BUG FIX! Wesely [1989] gives RT = 1000.0*EXP(-TEMPC-4.0) + !* RT = 1000.0*EXP(-(TEMPC-4.0)) + RT = 1000.0e+0_fp*EXP(-TEMPC-4.0e+0_fp) + + !If the surface to be snow or ice, set II to 1 instead. + !IF((State_Met%isSnow(I,J)).OR.(State_Met%isIce(I,J))) II=1 + + !************************************************************************ + !* Read the internal resistance RI (minimum stomatal resistance for + !* water vapor,per unit area of leaf) from the IRI array; a '9999' + !* value means no deposition to stomata so we impose a very large + !* value for RI. + ! + !* Adjust stomatal resistances for insolation and temperature: + !* Temperature adjustment is from Wesely [1989], equation (3). + !* + !* Light adjustment by the function BIOFIT is described by Wang + !* [1996]. It combines + !* - Local dependence of stomal resistance on the intensity I + !* of light impinging the leaf; this is expressed as a + !* multiplicative factor I/(I+b) to the stomatal resistance + !* where b = 50 W m-2 (equation (7) of Baldocchi et al.[1987]) + !* - radiative transfer of direct and diffuse radiation in the + !* canopy using equations (12)-(16) from Guenther et al.[1995] + !* - separate accounting of sunlit and shaded leaves using + !* equation (12) of Guenther et al. [1995] + !* - partitioning of the radiation at the top of the canopy into + !* direct and diffuse components using a parameterization to + !* results from an atmospheric radiative transfer model + !* [Wang, 1996] + !* The dependent variables of the function BIOFIT are the leaf + !* area index (XYLAI), the cosine of zenith angle (SUNCOS) and + !* the fractional cloud cover (CFRAC). The factor GFACI + !* integrates the light dependence over the canopy depth; sp even + !* though RI is input per unit area of leaf it need not be scaled + !* by LAI to yield a bulk canopy value because that's already + !* done in the GFACI formulation. + !******************************************************************** + !RI = DBLE(IRI(II)) + RI = IRI(II) + IF (RI .GE. 9999.e+0_fp) THEN + RI = 1.e+12_fp + ELSE + GFACT = 100.0e+0_fp + IF (TEMPC .GT. 0.e+0_fp .AND. TEMPC .LT. 40.e+0_fp) THEN + GFACT = 400.e+0_fp/TEMPC/(40.0e+0_fp-TEMPC) + ENDIF + + GFACI = 100.e+0_fp + IF ( RADIAT > 0.e+0_fp .and. XLAI > 0.e+0_fp ) THEN + GFACI = 1.e+0_fp / BIOFIT( DRYCOEFF, XLAI, SUNCOS, CFRAC, SIZE(DRYCOEFF) ) + ENDIF + RIX = RI*GFACT*GFACI + ! Apply scaling factor to RIX when CO2 effect is turned + ! on based on Franks et al. (2013) + If (CO2_EFFECT) THEN + RS_SCALE = CO2_LEVEL / CO2_REF * & + (CO2_LEVEL + 80.0_fp) * & + (CO2_REF - 40.0_fp) / & + (CO2_LEVEL - 40.0_fp) / & + (CO2_REF + 80.0_fp) + RIX = RIX * RS_SCALE + ENDIF + + ENDIF + + !*Cuticular resistances IRLU array defined above are per unit area of leaf; + !*divide them by the leaf area index to get a cuticular resistance for the bulk canopy. + !*If IRLU is '9999' it means there are no cuticular surfaces on which to deposit so + !*we impose a very large value for RLU. + !TODO: not sure if XLAI is land type dependent or not. + IF ( IRLU(II) >= 9999 .or. XLAI <= 0.e+0_fp ) THEN + RLU = 1.e+6_fp + ELSE + !RLU = DBLE( IRLU(II) ) / XLAI + RLU = IRLU(II) / XLAI + ! Additional resistance at low temperatures.Limit increase to a factor of 2. + ! Ref Jaegle et al. 2018 + RLU = MIN( RLU + RT, 2.e+0_fp * RLU ) + ENDIF + + !*The following are the remaining resistances for the Wesely model for a surface canopy + !*(Wesely 1989, Fig.1). + !RAC = MAX(DBLE(IRAC(II)), 1.e+0_fp) + RAC = MAX(IRAC(II), 1.e+0_fp) + IF (RAC .GE. 9999.e+0_fp) RAC = 1.e+12_fp + !RGSS = MAX(DBLE(IRGSS(II)), 1.e+0_fp) + RGSS = MAX(IRGSS(II), 1.e+0_fp) + ! Additional resistance at low temperatures.Limit increase to a factor of 2. + ! Ref Jaegle et al. 2018 + RGSS = MIN( RGSS + RT, 2.e+0_fp * RGSS ) + IF (RGSS .GE. 9999.e+0_fp) RGSS = 1.e12_fp + !RGSO = MAX(DBLE(IRGSO(II)) ,1.e+0_fp) + RGSO = MAX(IRGSO(II) ,1.e+0_fp) + RGSO = MIN( RGSO + RT, 2.e+0_fp * RGSO ) + IF (RGSO .GE. 9999.e+0_fp) RGSO = 1.e+12_fp + !RCLS = DBLE(IRCLS(II)) + RCLS = IRCLS(II) + RCLS = MIN( RCLS + RT, 2.e+0_fp * RCLS ) + IF (RCLS .GE. 9999.e+0_fp) RCLS = 1.e+12_fp + !RCLO = DBLE(IRCLO(II)) + RCLO = IRCLO(II) + RCLO = MIN( RCLO + RT, 2.e+0_fp * RCLO ) + IF (RCLO .GE. 9999.e+0_fp) RCLO = 1.e+12_fp + + !* Compute aerodynamic resistance to lower elements in lower part + !* of the canopy or structure, assuming level terrain - + !* equation (5) of Wesely [1989]. + !* species-dependent corrections to resistances + !* are from equations (6)-(9) of Wesely [1989]. + + RDC = 100.e+0_fp*(1.0e+0_fp+1000.0e+0_fp/(RADIAT+10.e+0_fp)) + + IF ( SPC .EQ. 'O3' ) THEN + !O3 over water + IF ((II .EQ. 11)) THEN + IF (SALINITY .GT. 20.0_fp) THEN + ! Now apply the Luhar et al. [2018] equations for the + ! special treatment of O3 dry deposition to the ocean + CALL OCEANO3(TSKIN,USTAR,IODIDE,DEPVw) + ! Now convert to the new rc value(s) + alpha0 = 10.0_fp**(-0.25-0.013 * (TSKIN-273.16_fp)) + RSURFC = 1.0_fp/(alpha0*DEPVw) + ELSE + ! It's not saline enough for 'ocean' so we instead don't change it from + ! 'default' rc to water + RSURFC = 2000.0_fp + ENDIF + ENDIF + + !O3 over snow/ice, the surface resistance is set to an observation derived value + IF ((II .EQ. 1)) THEN + RSURFC = 10000.0_fp + ENDIF + ELSE + !set a different F0 for Hg0 + IF (SPC .EQ. 'Hg0') THEN + ! Assume lower reactivity + F0 = 3.0e-05_fp + ! But if this is the rainforest land type and we fall + ! within the bounding box of the Amazon rainforest, + ! then increase reactivity as inferred from observations. + IF ( II == 6 .AND. & + XLON > -82.0_fp .AND. & + XLON < -33.0_fp .AND. & + YLAT > -34.0_fp .AND. & + YLAT < 14.0_fp ) THEN + F0 = 2.0e-01_fp + ENDIF + ENDIF + + XMWH2O = H2OMW * 1.e-3_fp + RIXX = RIX*DIFFG(TEMPK,PRESSU,XMWH2O)/ DIFFG(TEMPK,PRESSU,XMW) & + + 1.e+0_fp/(HSTAR/3000.e+0_fp+100.e+0_fp*F0) + RLUXX = 1.e+12_fp + IF (RLU .LT. 9999.e+0_fp) RLUXX = RLU/(HSTAR/1.0e+05_fp + F0) + RGSX = 1.e+0_fp/(HSTAR/1.0e+05_fp/RGSS + F0/RGSO) + RCLX = 1.e+0_fp/(HSTAR/1.0e+05_fp/RCLS + F0/RCLO) + !** Get the bulk surface resistance of the canopy, RSURFC, from + !** the network of resistances in parallel and in series (Fig.1 of Wesely [1989]) + DTMP1=1.e+0_fp/RIXX + DTMP2=1.e+0_fp/RLUXX + DTMP3=1.e+0_fp/(RAC+RGSX) + DTMP4=1.e+0_fp/(RDC+RCLX) + RSURFC = 1.e+0_fp/(DTMP1 + DTMP2 + DTMP3 + DTMP4) + ENDIF + + !TODO: this should be put in the main scheme function since it is also applied to aerosols + !*Set max and min values for bulk surface resistances + !!RSURFC = MAX(1.e+0_fp, MIN(RSURFC,9999.e+0_fp)) + !*because of high resistance values, different rule applied for ocean ozone + !!IF ((SPC .EQ. 'O3') .AND. (II .EQ. 11)) THEN + !! RSURFC = MAX(1.e+0_fp, MIN(RSURFC,999999.e+0_fp)) + !!ENDIF + ! Set Rc for strong acids (HNO3,HCl,HBr) to 1 s/m + ! Ref. Jaegle et al. 2018, cf. Erisman,van Pul,Ayers 1994 + !!IF ( HSTAR .gt. 1.e+10_fp ) RSURFC= 1.e+0_fp + + return + end subroutine Wesely_Rc_Gas + + !> + !! \brief calculates the dry deposition velocity of O3 to ocean + !! + !!References: + !! Pound, R. J., Sherwen, T., Helmig, D., Carpenter, L. J., and Evans, M. J.: + !! Influence of oceanic ozone deposition on tropospheric photochemistry, + !! Atmos. Chem. Phys., https://doi.org/10.5194/acp-20-4227-2020, 2020. + !! + !! \param TEMPK Temperatue [K] + !! \param USTAR Fictional Velocity [m/s] + !! \param IODIDE_IN Surface iodide concentration [nM] + !! \param DEPV output of the new deposition vel [cm/s] + !! + !! \ingroup catchem_drydep_process + !!!> + SUBROUTINE OCEANO3( TEMPK, USTAR, IODIDE_IN, DEPV ) + + IMPLICIT NONE + + !INPUT PARAMETERS: + REAL(fp), INTENT(IN) :: TEMPK ! Temperature [K] + REAL(fp), INTENT(IN) :: USTAR ! Fictional Velocity [m/s] + REAL(fp), INTENT(IN) :: IODIDE_IN ! Surface iodide concentration [nM] + REAL(fp), INTENT(OUT) :: DEPV ! the new deposition vel [cm/s] + !LOCAL VARIABLES: + REAL(fp) :: a0,D,DelM,b,PSI,LAM,EP,USTARWater,K0,K1,Iodide + + !================================================================= + ! OCEANO3 begins here! + !================================================================= + + USTARWater = 0.0345_fp * USTAR !waterside friction velocity + + Iodide = IODIDE_IN*1.0E-9_fp ! Convert from nM to M + + a0 = Iodide*EXP((-8772.2/TEMPK)+51.5) !chemical reactivity + + D = 1.1E-6*EXP(-1896.0/TEMPK) ! diffusivity + + DelM = SQRT(D/a0) ! reaction-diffusion length + + b = 2.0_fp/(0.4_fp*USTARWater) + + LAM = DelM*SQRT(a0/D) ! this cancels to 1 but here for completeness of equations + + EP = SQRT(2.0_fp*a0*b*(DelM+(b*D/2.0_fp))) + + PSI = EP/SQRT(a0*b**2*D) + + CALL K0K1_APROX(EP,K0,K1) + + DEPV = SQRT(a0*D)*((PSI*K1*COSH(LAM)+K0*SINH(LAM))/(PSI*K1* SINH(LAM)+K0*COSH(LAM))) + + END SUBROUTINE OCEANO3 + + !> + !! \brief estimate the modified Bessel functions of the second order zero (K0) and one (K1). + !! + !!References: + !! Approach initially described in Numerical Recipes in Fortran 90 second edition + !! (1996). This implementation is designed to be specific to the use + !! case required for calculating oceanic deposition velocity. Uses a + !! polynomial fit of each type of modified bessel function to + !! estimate the value of the function for each input. + !! + !! \param input_arg !the value we want the soln for + !! \param K0, K1 output of the modified bessel functions + !! + !! \ingroup catchem_drydep_process + !!!> + SUBROUTINE K0K1_APROX( input_arg, K0, K1 ) + + IMPLICIT NONE + !INPUT PARAMETERS: + REAL(fp), INTENT(IN) :: input_arg !the value we want the soln for + REAL(fp), INTENT(OUT) :: K0,K1 !the values of the modified bessel fncs + !LOCAL VARIABLES: + REAL(fp), DIMENSION(7) :: coeff !coefficients for polynomial fit + ! of each bessel function + REAL(fp) :: I0,I1 !modified bessel functions of + ! first kind order 0 and 1 + + ! determine which fit method is best for the bessel functions + IF (input_arg <= 2.0_fp) THEN + ! begin the calculation of k0 by estimating i0 + coeff = (/1.0,3.5156229,3.0899424,1.2067492,0.2659732, & + 0.360768e-1,0.45813e-2/) + I0 = poly_fit((input_arg/3.75_fp)**2,coeff) + !now we can use this estimate of i0 to calculate k0 + coeff = (/-0.57721566,0.42278420,0.23069756,0.3488590e-1, & + 0.262698e-2,0.10750e-3,0.74e-5/) + K0 = (-LOG(0.5_fp*input_arg)*I0)+ & + poly_fit(0.25_fp*input_arg**2,coeff) + + !begin the calculation of k0 by estimating i1 + coeff = (/0.5,0.87890594,0.51498869,0.15084934,0.2658733e-1, & + 0.301532e-2,0.32411e-3/) + I1 = input_arg*poly_fit((input_arg/3.75_fp)**2,coeff) + ! now we can use this to estimate to get a value for k1 + coeff = (/1.0,0.15443144,-0.67278579,-0.18156897, & + -0.1919402e-1,-0.110404e-2,-0.4686e-4/) + K1 = (LOG(0.5_fp*input_arg)*I1)+(1.0_fp/input_arg)* & + poly_fit(0.25_fp*input_arg**2,coeff) + ELSE !use a different approximation that doesn't need I0/I1 + coeff = (/1.25331414,-0.7832358e-1,0.2189568e-1,-0.1062446e-1, & + 0.587872e-2,-0.251540e-2,0.53208e-3/) + K0 = (EXP(-input_arg)/SQRT(input_arg))* & + poly_fit((2.0_fp/input_arg),coeff) + coeff = (/1.25331414,0.23498619,-0.3655620e-1,0.1504268e-1, & + -0.780353e-2,0.325614e-2,-0.68245e-3/) + K1 = (EXP(-input_arg)/SQRT(input_arg))* & + poly_fit((2.0_fp/input_arg),coeff) + ENDIF + + END SUBROUTINE K0K1_APROX + + !> + !! \brief calculate the value of a polynomial fit used in + !! the K0K1_APPROX function in estimating the values of a + !! modified bessel function. + !! + !!References: + !! + !! \param input + !! \param coeffs + !! + !! \ingroup catchem_drydep_process + !!!> + FUNCTION poly_fit ( input, coeffs ) + + !INPUT PARAMETERS: + REAL(fp), INTENT(IN) :: input + REAL(fp), DIMENSION(:), INTENT(IN) :: coeffs + !LOCAL VARIABLES: + REAL(fp) :: poly_fit + INTEGER :: i + + poly_fit = 0 + + DO i = 1,7,1 + poly_fit = poly_fit+coeffs(i)*input**i + ENDDO + + END FUNCTION poly_fit + + !> + !! \brief calculates the molecular diffusivity [m2/s] in air for a gas X + !! of molecular weight XM [kg] at temperature TK [K] and pressure PRESS [Pa]. + !! + !!References: + !! + !! \param TK Temperatue [K] + !! \param PRESS Pressure [Pa] + !! \param XM Molecular weight of gas [kg] + !! + !! \ingroup catchem_drydep_process + !!!> + + FUNCTION DIFFG( TK, PRESS, XM ) RESULT( DIFF_G ) + + !INPUT PARAMETERS: + REAL(fp), INTENT(IN) :: TK ! Temperature [K] + REAL(fp), INTENT(IN) :: PRESS ! Pressure [Pa] + REAL(fp), INTENT(IN) :: XM ! Molecular weight of gas [kg] + !LOCAL VARIABLES: + REAL(fp) :: AIRDEN, Z, DIAM, FRPATH, SPEED, DIFF_G + + !REMARKS: + !We specify the molecular weight of air (XMAIR) and the hard-sphere molecular + !radii of air (RADAIR) and of the diffusing gas (RADX). The molecular + !radius of air is given in a Table on p. 479 of Levine [1988]. The Table + !also gives radii for some other molecules. Rather than requesting the user + !to supply a molecular radius we specify here a generic value of 1.2E-10 m for + !all molecules, which is good enough in terms of calculating the diffusivity + !as long as molecule is not too big. + + !DEFINED PARAMETERS: + REAL(fp), PARAMETER :: XMAIR = 28.8e-3_fp ! Moist air molec wt? + REAL(fp), PARAMETER :: RADAIR = 1.2e-10_fp + REAL(fp), PARAMETER :: RADX = 1.5e-10_fp + + !================================================================= + ! DIFFG begins here! + !================================================================= + + ! Air density [molec/m3] + AIRDEN = ( PRESS * AVO ) / ( RSTARG * TK ) + + ! DIAM is the collision diameter for gas X with air. + DIAM = RADX + RADAIR + + ! Calculate the mean free path for gas X in air: + ! eq. 8.5 of Seinfeld [1986]; + Z = XM / XMAIR + FRPATH = 1e+0_fp /( PI * SQRT( 1e+0_fp + Z ) * AIRDEN * ( DIAM**2 ) ) + + ! Calculate average speed of gas X; eq. 15.47 of Levine [1988] + SPEED = SQRT( 8e+0_fp * RSTARG * TK / ( PI * XM ) ) + + ! Calculate diffusion coefficient of gas X in air; + ! eq. 8.9 of Seinfeld [1986] + DIFF_G = ( 3e+0_fp * PI / 32e+0_fp ) * ( 1e+0_fp + Z ) * FRPATH * SPEED + + END FUNCTION DIFFG + + !> + !! \brief computes the light correction used in the dry deposition and canopy NOx modules. + !! It was part of the old Harvard-GISS CTM and was ported into GEOS-Chem + !! + !!References: + !! Wang, Y., D.J. Jacob, and J.A. Logan, "Global simulation of tropospheric + !! O3-NOx-hydrocarbon chemistry, 1. Model formulation", J. Geophys. Res., + !! 103/D9, 10,713-10,726, 1998. + !! + !! \param COEFF1 Baldocchi drydep coefficients + !! \param XLAI1 Leaf area index [cm2/cm2] + !! \param SUNCOS1 Cosine( Solar Zenith Angle ) + !! \param CFRAC1 Cloud fraction [unitless] + !! \param NPOLY # of drydep coefficients + !! + !! \ingroup catchem_drydep_process + !!!> + FUNCTION BioFit( COEFF1, XLAI1, SUNCOS1, CFRAC1, NPOLY ) RESULT( BIO_FIT ) + + !INPUT PARAMETERS: + INTEGER, INTENT(IN) :: NPOLY ! # of drydep coefficients + REAL(fp), INTENT(IN) :: COEFF1(NPOLY) ! Baldocchi drydep coefficients + REAL(fp), INTENT(IN) :: XLAI1 ! Leaf area index [cm2/cm2] + REAL(fp), INTENT(IN) :: SUNCOS1 ! Cosine( Solar Zenith Angle ) + REAL(fp), INTENT(IN) :: CFRAC1 ! Cloud fraction [unitless] + !RETURN VALUE: + REAL(fp) :: BIO_FIT ! Resultant light correction + !DEFINED PARAMETERS: + INTEGER, PARAMETER :: KK = 4 + INTEGER, PARAMETER :: NN = 3 ! # of variables (LAI, SUNCOS, CLDFRC) + REAL(fp) :: ND(NN) = (/ 55.0e0_fp, 20.0e0_fp, 11.0e0_fp /) !scaling factor for each variable !codespell:ignore + REAL(fp) :: X0(NN) = (/ 11.0e0_fp, 1.0e0_fp, 1.0e0_fp /) !maximum for each variable + !LOCAL VARIABLES: + REAL(fp) :: XLOW !minimum for each variable + REAL(fp) :: TERM(KK) + REAL(fp) :: REALTERM(NPOLY) + INTEGER :: K,K1,K2,K3,I,I2 + + !================================================================= + ! BIOFIT begins here! + !================================================================= + TERM(1) = 1.0e0_fp + TERM(2) = XLAI1 + TERM(3) = SUNCOS1 + TERM(4) = CFRAC1 + !we replace SUNPARAM_R4( TERM(2:4) ) as below + !outdate lai,suncos,cloud fraction + DO I = 1, NN + I2 = I + 1 !variable index in TERM is from 2 + TERM(I2) = MIN( TERM(I2), X0(I) ) + ! XLOW = minimum for each variable + IF ( I .NE. 3 ) THEN + XLOW = X0(I) / ND(I) !codespell:ignore + ELSE + XLOW = 0.0e0_fp + ENDIF + TERM(I2) = MAX( TERM(I2), XLOW ) + TERM(I2) = TERM(I2) / X0(I) + ENDDO + + !get realterm + K = 0 + DO K3 = 1, KK + DO K2 = K3, KK + DO K1 = K2, KK + K = K + 1 + REALTERM(K)=TERM(K1)*TERM(K2)*TERM(K3) + ENDDO + ENDDO + ENDDO + + BIO_FIT = 0e0_fp + DO K = 1, NPOLY + BIO_FIT = BIO_FIT + COEFF1(K)*REALTERM(K) + END DO + IF ( BIO_FIT .LT. 0.1e0_fp ) BIO_FIT = 0.1e0_fp + + END FUNCTION BioFit + + + !> + !! \brief computes the aerodynamic resistance of aerosols. + !! + !!References: + !! Zhang, L., Gong, S., Padro, J., & Barrie, L. (2001). A size-segregated particle + !! dry deposition scheme for an atmospheric aerosol module. + !! Atmospheric environment., https://doi.org/10.1016/S1352-2310(00)00326-5 + !! + !! Emerson, E. W., et al. (2020). Revisiting particle dry deposition and its role + !! in radiative effect estimates. PNAS, 117(42), 26076-26082. + !! https://doi.org/10.1073/pnas.2014761117 + !! + !! \param SPC Species name + !! \param II Surface type index + !! \param IS_DUST Is dust species? + !! \param IS_SEASALT Is seasalt species? + !! \param LUCINDEX mapping above II to the 15 drydep land use categories + !! \param A_RADI Aerosol radius [m] + !! \param A_DEN Aerosol density [kg/m3] + !! \param PRESS Pressure [KPa] + !! \param TEMP Temperature [K] + !! \param USTAR Fictional Velocity [m/s] + !! \param RHB Relative humidity [fraction] + !! \param W10 10m wind speed [m/s] + !! \param LOWERBIN lower bound of sea-salt bins + !! \param UPPERBIN upper bound of sea-salt bins + !! \param VTSout output of setttling velocity [m/s] + !! \param RC success flag + !! \param RS return value of surface resistance [s/m] + !! + !! \ingroup catchem_drydep_process + !!!> + + FUNCTION AERO_SFCRSII( SPC, IS_DUST, IS_SEASALT, LUCINDEX, A_RADI, A_DEN, & + PRESS, TEMP, USTAR, RHB, W10, LOWERBIN, UPPERBIN, VTSout, RC) RESULT( RS ) + + IMPLICIT NONE + !INPUT PARAMETERS + CHARACTER(len=20), INTENT(IN) :: SPC ! Species name + !TODO: not sure if SPC or index is better + !INTEGER, INTENT(IN) :: K ! Drydep species index (range: 1-NUMDEP) + !INTEGER, INTENT(IN) :: II ! Surface type index of host model (e.g., GEOS-CHEM) + LOGICAL, INTENT(IN) :: IS_DUST, IS_SEASALT ! Is dust or seasalt species? + INTEGER, INTENT(IN) :: LUCINDEX !mapping to the 15 drydep land use categories + REAL(fp), INTENT(IN) :: A_RADI ! Aerosol radius [m] + REAL(fp), INTENT(IN) :: A_DEN ! Aerosol density [kg/m3] + REAL(fp), INTENT(IN) :: PRESS ! Pressure [kPa] (1 mb = 100 Pa = 0.1 kPa) + REAL(fp), INTENT(IN) :: TEMP ! Temperature [K] + REAL(fp), INTENT(IN) :: USTAR ! Friction velocity [m/s] + REAL(fp), INTENT(IN) :: RHB ! Relative humidity (fraction) + REAL(fp), INTENT(IN) :: W10 ! 10m wind speed [m/s]; only need for SeaSalt over water + REAL(fp), DIMENSION(:), INTENT(IN) :: LOWERBIN ! lower bound of sea-salt bins + REAL(fp), DIMENSION(:), INTENT(IN) :: UPPERBIN ! upper bound of sea-salt bins + !OUTPUT PARAMETERS + REAL(fp), INTENT(OUT) :: VTSout ! Settling velocity [m/s] + INTEGER, INTENT(OUT) :: RC ! success flag + !RETURN VALUE + REAL(fp) :: RS ! Surface resistance for particles [s/m] + + !define constants + REAL(fp), PARAMETER :: E0 = 3.0_fp + ! Emerson et al. (2020) added parameters + REAL(fp), PARAMETER :: UPSILON = 0.8_fp + REAL(fp), PARAMETER :: BETA = 1.7_fp + REAL(fp), PARAMETER :: CB = 0.2_fp + REAL(fp), PARAMETER :: CIN = 2.5_fp + REAL(fp), PARAMETER :: CIM = 0.4_fp + !increment of radius for integration of settling velocity (um) + REAL(fp), PARAMETER :: DR = 5.0e-2_fp + !LOCAL VARIABLES + INTEGER :: LUC + INTEGER :: ID,NR,n, n1 + REAL(fp) :: AIRVS ! kinematic viscosity of Air (m^2/s) + REAL(fp) :: DP ! Diameter of aerosol [um] + REAL(fp) :: PDP ! Press * Dp + REAL(fp) :: CONST ! Constant for settling velocity calculations + REAL(fp) :: SLIP ! Slip correction factor + REAL(fp) :: VISC ! Viscosity of air (Pa s) + REAL(fp) :: SALT_MASS, SALT_MASS_TOTAL, VTS_WEIGHT, DMIDW + real(fp) :: D0, D1 !lower and upper bounds of sea-salt dry diameter bins + REAL(fp) :: DIFF ! Brownian Diffusion constant for particles (m2/s) + REAL(fp) :: SC, ST ! Schmidt and Stokes number (nondim) + REAL(fp) :: DIAM, RDRY, RWET, RUM, DEN + REAL(fp) :: EB, EIM, EIN, R1, AA, VTS + REAL(fp) :: RHBL ! Relative humidity local + REAL(fp) :: Aavg(15) ! annual average of A + CHARACTER(LEN=255) :: ErrMsg, thisLoc + + ! Initialize + RC = CC_SUCCESS + errMsg = '' + thisLoc = ' -> at AERO_SFCRSII (in process/drydep/ccpr_drydep_common_mod.F90)' + + !================================================================= + ! ADUST_SFCRII begins here! + !================================================================= + + ! Annual average of A + Aavg(:) = (A(:,1)+A(:,2)+A(:,3)+A(:,4)+A(:,5))/5. + + LUC = LUCINDEX + AA = Aavg(LUC) * 1.e-3_fp + RS = 0e+0_fp !initialize returned value first + + !================================================================= + !...Ref. Zhang et al., AE 35(2001) 549-560 + !. + !...Model theroy + ! Vd = Vs + 1./(Ra+Rs) + ! where Vs is the gravitational settling velocity, + ! Ra is the aerodynamic resistance above the canopy + ! Rs is the surface resistance + ! Here we calculate Rs only.. + ! Rs = 1 / (Eo*Ustar*(Eb+Eim+Ein)*R1) + ! where Eo is an empirical constant ( = 3.) + ! Ustar is the friction velocity + ! Collection efficiency from + ! Eb, [Brownian diffusion] + ! Eim, [Impaction] + ! Ein, [Interception] + ! R1 is the correction factor representing the fraction + ! of particles that stick to the surface. + !======================================================================= + ! Eb is a funciont of Schmidt number, Eb = Sc^(-gamma) + ! Sc = v/D, v (the kinematic viscosity of air) + ! D (particle brownian diffusivity) + ! r usually lies between 1/2 and 2/3 + ! Eim is a function of Stokes number, St + ! St = Vs * Ustar / (g0 * A) for vegetated surfaces + ! St = Vs * Ustar * Ustar / v for smooth surface + ! A is the characteristic radius of collectors. + ! + ! 1) Slinn (1982) + ! Eim = 10^(-3/St) for smooth surface + ! Eim = St^2 / ( 1 + St^2 ) for vegetative canopies + ! 2) Peters and Eiden (1992) + ! Eim = ( St / ( alpha + St ) )^(beta) + ! alpha(=0.8) and beta(=2) are constants + ! 3) Giorgi (1986) + ! Eim = St^2 / ( 400 + St^2 ) for smooth surface + ! Eim = ( St / (0.6 + St) )^(3.2) for vegetative surface + ! 4) Davidson et al.(1982) + ! Eim = St^3 / (St^3+0.753*St^2+2.796St-0.202) for grassland + ! 5) Zhang et al.(2001) used 2) method with alpha varying with + ! vegetation type and beta equal to 2 + ! + ! Ein = 0.5 * ( Dp / A )^2 + ! + ! R1 (Particle rebound) = exp(-St^0.5) + !================================================================= + + ! Particle diameter [m] + ! A_RADI & A_DEN are read from inputs. + DIAM = A_RADI * 2.e+0_fp + + ! Particle density [kg/m3] + DEN = A_DEN + + !update DIAM of dust species; no hygroscopic growth for dust + !TODO: here we comment out these hardcoded lines and use the radius from inputs directly + !IF ( K == idd_DST1 .or. K == idd_DSTAL1 .or. K == idd_NITD1 .or. K == idd_SO4D1 ) THEN + !IF ( SPC == 'DST1' .or. SPC == 'DSTAL1' .or. SPC == 'NITD1' .or. SPC == 'SO4D1' .or. SPC == 'dust1') THEN + ! DIAM = 0.66895E-6 + !ENDIF + + !IF ( K == idd_DST2 .or. K == idd_DSTAL2 .or. K == idd_NITD2 .or. K == idd_SO4D2 ) THEN + !IF ( SPC == 'DST2' .or. SPC == 'DSTAL2' .or. SPC == 'NITD2' .or. SPC == 'SO4D2' .or. SPC == 'dust2') THEN + ! DIAM = 2.4907E-6 + !ENDIF + + !IF ( K == idd_DST3 .or. K == idd_DSTAL3 .or. K == idd_NITD3 .or. K == idd_SO4D3 ) THEN + !IF ( SPC == 'DST3' .or. SPC == 'DSTAL3' .or. SPC == 'NITD3' .or. SPC == 'SO4D3' ) THEN + ! DIAM = 4.164E-6 + !ENDIF + + !IF ( K == idd_DST4 .or. K == idd_DSTAL4 .or. K == idd_NITD4 .or. K == idd_SO4D4 ) THEN + !IF ( SPC == 'DST4' .or. SPC == 'DSTAL4' .or. SPC == 'NITD4' .or. SPC == 'SO4D4' ) THEN + ! DIAM = 6.677E-6 + !ENDIF + + ! Hygroscopic growth following Latimer and Martin (2019) ACP + RHBL = MAX( TINY(RHB), RHB ) + + ! Over oceans the RH in the viscous sublayer is set to 98%, + ! following Lewis and Schwartz (2004) + IF (LUC == 14) THEN + RHBL = 0.98 + ENDIF + + IF (.NOT. IS_DUST) THEN + !update DIAM and DEN after hygroscopic growth for non-dust species + call New_DIAM_DEN( SPC, IS_SEASALT, RHBL, RDRY, RWET, DIAM, DEN, RC) + if (RC /= CC_SUCCESS ) then + errMsg = 'New_DIAM_DEN failed.' + CALL CC_Error( errMsg, RC, thisLoc ) + RETURN + endif + ENDIF + + ! Dp [m] --> [um] = particle diameter if necessary + IF (DIAM > 0.001) THEN !here use 0.001 to determine if the unit is in m or um + DP = DIAM + DIAM = DIAM * 1.e-6_fp + ELSE + DP = DIAM * 1.e+6_fp + ENDIF + + ! Constant for settling velocity calculation + CONST = DEN * DIAM**2 * g0 / 18.e+0_fp + + !================================================================= + ! Slip correction factor calculations following Seinfeld, + ! pp464 which is thought to be more accurate but more computation + ! required. + ! # air molecule number density + ! num = P * 1d3 * 6.023d23 / (8.314 * Temp) + ! # gas mean free path + ! lambda = 1.d6/( 1.41421 * num * 3.141592 * (3.7d-10)**2 ) + ! # Slip correction + ! Slip = 1. + 2. * lambda * (1.257 + 0.4 * exp( -1.1 * Dp & + ! / (2. * lambda))) / Dp + ! + ! Note, Eq) 3.22 pp 50 in Hinds (Aerosol Technology) + ! which produce slip correction factore with small error + ! compared to the above with less computation. + !================================================================= + + ! Slip correction factor as function of (P*dp) + PDP = PRESS * DP + SLIP = 1e+0_fp + ( 15.60e+0_fp + 7.0e+0_fp * & + EXP( -0.059e+0_fp * PDP) ) / PDP + + ! Viscosity [Pa s] of air as a function of temp (K) + VISC = 1.458e-6_fp * (TEMP)**(1.5e+0_fp) / (TEMP + 110.4e+0_fp) + + ! Kinematic viscosity (Dynamic viscosity/Density) + AIRVS= VISC / 1.2928e+0_fp + + ! Settling velocity [m/s] + VTS = CONST * SLIP / VISC + !sea salt VTS update + IF (IS_SEASALT) THEN + ! This settling velocity is for the mid-point of the size bin. + ! Need to integrate over the size bin, taking into account the + ! mass distribution of sea-salt and the dependence of VTS on aerosol + ! size. See WET_SETTLING in SEASALT_MOD.f for more details. + + !TODO: this may be used in initialization of the scheme + !Number of bins for sea salt size distribution + !SALA_radius_bin_in_um: [0.01, 0.5]; SALC_radius_bin_in_um: [0.5, 8.0] + + ! Make sure that SALA, SALC bins are contiguous + !IF ( SALA_REDGE_um(2) /= SALC_REDGE_um(1) ) THEN + ! MSG = 'SALA and SALC bin edges are not contiguous!' + ! CALL ERROR_STOP( MSG, LOCATION ) + !ENDIF + !TODO: need to figure out how to read in these values from the namelist + NR = INT((( MAXVAL(UPPERBIN) - MINVAL(LOWERBIN) ) / DR ) + 0.5e+0_fp ) + + SALT_MASS_TOTAL = 0e+0_fp + VTS_WEIGHT = 0e+0_fp + + ! Dry particle radius [m] --> [um] + RUM = RDRY * 1.e+6_fp + + ! Check what the min/max range of the SS size bins are + !IF ( RUM .le. SALA_REDGE_um(2) ) THEN + ! D0 = SALA_REDGE_um(1)*2e+0_fp + ! D1 = SALA_REDGE_um(2)*2e+0_fp + !ELSE + ! D0 = SALC_REDGE_um(1)*2e+0_fp + ! D1 = SALC_REDGE_um(2)*2e+0_fp + !ENDIF + D0 = 0e+0_fp; D1 = 0e+0_fp; n1=1 + DO n =1, size(UPPERBIN) + IF ( (RUM .ge. LOWERBIN(n)) .and. (RUM .le. UPPERBIN(n)) ) THEN + D0 = LOWERBIN(n)*2e+0_fp + D1 = UPPERBIN(n)*2e+0_fp + n1=0 + EXIT + ENDIF + ENDDO + IF (n1 > 0) THEN ! D0 and D1 may not be set properly + errMsg = 'Sea salt radius is not in any bins. Check the species namelist.' + CALL CC_Error( errMsg, RC, thisLoc ) + RETURN + ENDIF + + DO ID = 1, NR + ! Calculate mass of wet aerosol (Dw = wet diameter, D = dry diameter): + ! Overall = dM/dDw = dV/dlnD * Rwet/Rdry * DEN /Rw + !TODO: DMID is not defined in this module. Need to define it. + IF (DMID(ID) .ge. D0 .and. DMID(ID) .le. D1 ) THEN + DMIDW = DMID(ID) * RWET/RDRY ! wet radius [um] + SALT_MASS = SALT_V(ID) * RWET/RDRY * DEN / & + (DMIDW*0.5e+0_fp) + VTS_WEIGHT = VTS_WEIGHT + & + !SALT_MASS * VTS * (DMIDW/(RWET*1d6*2e+0_fp) )** & + SALT_MASS * VTS * (DMIDW/(RWET*1e+6_fp*2e+0_fp) )** & + 2e+0_fp * (2e+0_fp * DR * RWET/RDRY) + SALT_MASS_TOTAL = SALT_MASS_TOTAL+SALT_MASS * & + (2e+0_fp * DR * RWET/RDRY) + ENDIF + ENDDO + + ! Final mass weighted setting velocity: + VTS = VTS_WEIGHT/SALT_MASS_TOTAL + END IF + + VTSout = VTS !need to save out for final Vd calculation + + ! Brownian diffusion constant for particle (m2/s) + DIFF = BOLTZ * TEMP * SLIP / (3.e+0_fp * PI * VISC * DIAM) + + ! Schmidt number + SC = AIRVS / DIFF + !EB = 1.e+0_fp/SC**(gamma(LUC)) + + !-------------------------------------------------------------- + ! NOTE: This loses precision, use TWO_THIRDS parameter instead + !EB = CB/SC**(0.6667e+0_fp) ! Emerson 2020 update JRP + !-------------------------------------------------------------- + EB = CB/SC**TWO_THIRDS ! Emerson 2020 update JRP + + ! Stokes number + IF ( AA < 0e+0_fp ) then + ST = VTS * USTAR * USTAR / ( AIRVS * g0 ) ! for smooth surface + EIN = 0e+0_fp + ELSE + ST = VTS * USTAR / ( g0 * AA ) ! for vegetated surfaces + !EIN = 0.5e+0_fp * ( DIAM / AA )**2 + EIN = CIN * ( DIAM / AA )**(UPSILON) ! Emerson 2020 update JRP + ENDIF + + IF (LUC == 14 .and. IS_SEASALT) THEN + EIM = 10.e+0_fp**( -3.e+0_fp/ ST ) ! for water surface + ! JRP: Emerson doesn't describe what to do here, so I'm leaving as is + ELSE + !EIM = ( ST / ( ALPHA(LUC) + ST ) )**(BETA) + EIM = CIM * ( ST / ( ALPHA(LUC) + ST ) )**(BETA) ! Emerson 2020 update JRP + EIM = MIN( EIM, 0.6e+0_fp ) + ENDIF + + IF (LUC == 11 .OR. LUC == 13 .OR. LUC == 14) THEN + R1 = 1.e+0_fp + ELSE + R1 = EXP( -1e+0_fp * SQRT( ST ) ) + ENDIF + + !add error check here to make sure RS below is not a infinite value + IF (rae(R1, 0.0_fp) .or. rae(USTAR, 0.0_fp)) THEN + errMsg = 'USTAR or R1 is zero. Check met field or diameter (in m) of aerosol is too big.' + CALL CC_Error( errMsg, RC, thisLoc ) + RETURN + ENDIF + + ! surface resistance for particle + IF (LUC == 14 .and. IS_SEASALT) THEN + ! Use the formulation of Slinn and Slinn (1980) for the impaction over + ! water surfaces for sea salt + RS = 1.e+0_fp / (USTAR**2.e+0_fp/ (W10*VON_KARMAN) * & + (EB + EIM ) + VTS) + ELSE + RS = 1.e0_fp / (E0 * USTAR * (EB + EIM + EIN) * R1 ) + ENDIF + + END FUNCTION AERO_SFCRSII + + + !> + !! \brief updates the diameter and density of non-dust aerosols + !! + !!References: + !! Adapted from GEOS-Chem source code (GeosCore/drydep_mod.F90) + !! ADUST_SFCRSII and AERO_SFCRSII functions + !! + !! \param SPC Species name + !! \param IS_SEASALT Is seasalt species? + !! \param RHBL Relative humidity [unitless] + !! \param RDRY Dry radius of particle [m] + !! \param RWET Wet radius of particle [m] + !! \param DIAM diameter of wet particle [m] + !! \param DEN density of particle [kg/m3] + !! \param RC return code + !! + !! \ingroup catchem_drydep_process + !!!> + SUBROUTINE New_DIAM_DEN( SPC, IS_SEASALT, RHBL, RDRY, RWET, DIAM, DEN, RC) + + IMPLICIT NONE + + !input parameters + character(len=20), INTENT(IN) :: SPC ! Species name + logical, INTENT(IN) :: IS_SEASALT ! Is sea salt species? + !INTEGER, INTENT(IN) :: K ! Drydep species index (range: 1-NUMDEP) + real(fp), INTENT(IN) :: RHBL ! Relative humidity local + real(fp), INTENT(OUT) :: RDRY ! dry radius of particle [m] + real(fp), INTENT(OUT) :: RWET ! wet radius of particle [m] + real(fp), INTENT(INOUT) :: DIAM ! diameter of wet particle [m] + real(fp), INTENT(INOUT) :: DEN ! density of particle [kg/m3] + integer, INTENT(OUT) :: RC ! success flag + !defined parameters + REAL(fp), PARAMETER :: C1 = 0.7674_fp + REAL(fp), PARAMETER :: C2 = 3.079_fp + REAL(fp), PARAMETER :: C3 = 2.573e-11_fp + REAL(fp), PARAMETER :: C4 = -1.424_fp + !REAL(fp), PARAMETER :: E0 = 3.0_fp + + ! Parameters for polynomial coefficients to derive seawater + ! density. From Tang et al. (1997) + REAL(fp), PARAMETER :: A1 = 7.93e-3_fp + REAL(fp), PARAMETER :: A2 = -4.28e-5_fp + REAL(fp), PARAMETER :: A3 = 2.52e-6_fp + REAL(fp), PARAMETER :: A4 = -2.35e-8_fp + REAL(fp), PARAMETER :: EPSI = 1.0e-4_fp + + ! parameters for assumed size distribution of accumulation and coarse + ! mode sea salt aerosols, as described in Jaegle et al. (ACP, 11, 2011) + ! 1) geometric dry mean diameters (microns) + !REAL(fp), PARAMETER :: RG_A = 0.085e+0_fp + !REAL(fp), PARAMETER :: RG_C = 0.4e+0_fp + ! 2) sigma of the size distribution + !REAL(fp), PARAMETER :: SIG_A = 1.5e+0_fp + !REAL(fp), PARAMETER :: SIG_C = 1.8e+0_fp + + !increment of radius for integration of settling velocity (um) + !REAL(fp), PARAMETER :: DR = 5.0e-2_fp + !local variables + real(fp) :: FAC1, FAC2 !Exponential factors for hygroscopic growth + real(fp) :: RUM !Radius of dry particle in micronmeters [um] + REAL(fp) :: RATIO_R !Ratio dry over wet radii + REAL(fp) :: DEN0, DEN1, WTP + integer :: I !Loop index + CHARACTER(LEN=255) :: ErrMsg, thisLoc + + ! Initialize + RC = CC_SUCCESS + errMsg = '' + thisLoc = ' -> at New_DIAM_DEN (in process/drydep/ccpr_drydep_common_mod.F90)' + + IF ( .NOT. IS_SEASALT ) THEN + + ! Particle diameter [m] + DIAM = 0.17378e-6_fp + RDRY = DIAM / 2.0e+0_fp !Not needed for further calculations for dust species + + ! SIA (TODO: keep this for now and need to be consistent with real species names in the future) + !IF ( K == idd_NIT .or. K == idd_NH4 .or. K == idd_SO4 ) THEN + IF ( SPC == 'NIT' .or. SPC == 'NH4' .or. SPC == 'SO4' ) THEN + ! Efflorescence transitions + IF (RHBL .LT. 0.35) THEN + ! DIAM is not changed + ELSE IF ((RHBL .GE. 0.35) .AND. (RHBL .LE. 0.40)) THEN + ! Linear hygroscopic growth + DIAM = DIAM + (DIAM * ((1.0_fp + 0.61_fp * 0.40_fp / & + (1.0_fp - 0.40_fp)) ** (1.0_fp / 3.0_fp)) - DIAM) / & + (0.40_fp - 0.35_fp) * (RHBL - 0.35_fp) + ELSE + ! Kohler hygroscopic growth + DIAM = DIAM * ((1.0_fp + 0.61_fp * RHBL / (1.0_fp - RHBL)) & + ** (1.0_fp / 3.0_fp)) + ENDIF + + !BC + !ELSE IF ( K == idd_BCPI .OR. K == idd_BCPO ) THEN + ELSE IF ( SPC == 'BCPI' .OR. SPC == 'BCPO' ) THEN + ! DIAM is not changed + + !OA + ELSE + DIAM = DIAM * ((1.0_fp + 0.1_fp * RHBL / (1.0_fp - RHBL)) & + ** (1.0_fp / 3.0_fp)) + ENDIF + + !get RWET + RWET = DIAM / 2.0e+0_fp + ! Particle density [kg/m3]; same for all aerosols except sea salt and dust + DEN = 1500 + + ELSE !sea salt aerosol case + + !drydepRadius = A_RADI(K) + RDRY = DIAM / 2.0e+0_fp + + ! Coarse seasalt (TODO: we commented out these hardcoded lines and use the radius from inputs directly) + !IF ( K == idd_NITS .or. K == idd_SALC .or. K == idd_SO4S .or. K == idd_BRSALC .or. K == idd_ISALC ) THEN + !IF ( SPC == 'NITS' .or. SPC == 'SALC' .or. SPC == 'SO4S' .or. SPC == 'BRSALC' .or. SPC == 'ISALC' ) THEN + ! RDRY = 0.74025E-6 + !ENDIF + + !IF ( K == idd_SALA .OR. K == idd_BRSALA .or. K == idd_ISALA ) THEN + !IF ( SPC == 'SALA' .OR. SPC == 'BRSALA' .or. SPC == 'ISALA' ) THEN + ! RDRY = 0.114945E-6 + !ENDIF + + ! Dry particle radius [um] + RUM = RDRY * 1.e+6_fp + + ! Exponential factors used for hygroscopic growth (not used now) + FAC1 = C1 * ( RUM**C2 ) + FAC2 = C3 * ( RUM**C4 ) + + ! Corrected bug in Gerber formulation: use of LOG10 (jaegle 5/11/11) + !RWET = 0.01e+0_fp*(FAC1/(FAC2-DLOG(RHBL))+RCM**3.e+0_fp)**0.33e+0_fp + !RWET = 1.d-6*(FAC1/(FAC2-LOG10(RHBL))+RUM**3.e+0_fp)**0.33333e+0_fp + + ! Use equation 5 in Lewis and Schwartz (2006) for sea salt growth [m] + ! (jaegle 5/11/11) + RWET = RDRY * (4.e+0_fp / 3.7e+0_fp) * & + ( (2.e+0_fp - RHBL)/(1.e+0_fp - RHBL) )**(1.e+0_fp/3.e+0_fp) + + ! Ratio dry over wet radii at the cubic power + !RATIO_R = ( A_RADI(K) / RWET )**3.e+0_fp + + ! Diameter of the wet aerosol [m] + DIAM = RWET * 2.e+0_fp + + ! Density of the wet aerosol [kg/m3] (bec, 12/8/04) + !DEN = RATIO_R * A_DEN(K) + ( 1.e+0_fp - RATIO_R ) * 1000.e+0_fp + + ! Above density calculation is chemically unsound because it ignores chemical solvation. + ! Iteratively solve Tang et al., 1997 equation 5 to calculate density of wet aerosol (kg/m3) + ! Redefine RATIO_R + RATIO_R = RDRY / RWET + + ! Assume an initial density of 1000 kg/m3 + DEN0 = DEN !assign initial DEN to DEN0 + DEN = 1000.e+0_fp + DEN1 = 0.e+0_fp !initialize + i = 0 !initialize loop index + !Note that if RH is too low, the loop will not converge and will run forever + DO WHILE ( ABS( DEN1-DEN ) .gt. EPSI ) + ! First calculate weight percent of aerosol (kg_RH=0.8/kg_wet) + WTP = 100.e+0_fp * DEN0/DEN * RATIO_R**3.e+0_fp + ! Then calculate density of wet aerosol using equation 5 + ! in Tang et al., 1997 [kg/m3] + DEN1 = ( 0.9971e+0_fp + (A1 * WTP) + (A2 * WTP**2) + & + (A3 * WTP**3) + (A4 * WTP**4) ) * 1000.e+0_fp + + ! Now calculate new weight percent using above density calculation + WTP = 100.e+0_fp * DEN0/DEN1 * RATIO_R**3.e+0_fp + ! Now recalculate new wet density [kg/m3] + DEN = ( 0.9971e+0_fp + (A1 * WTP) + (A2 * WTP**2) + & + (A3 * WTP**3) + (A4 * WTP**4) ) * 1000.e+0_fp + + ! add some protection against infinite loop + i = i+1 + IF ( i .GT. 500 ) THEN + errMsg = 'Error in calculating new density for sea salt aerosol due to very low RH input!' + CALL CC_Error( errMsg, RC, thisLoc ) + RETURN + ENDIF + + ENDDO + ENDIF + + END SUBROUTINE New_DIAM_DEN + + !> + !! \brief calculates the volume size distribution of sea-salt. + !! This only has to be done once. We assume that sea-salt is the + !! combination of a coarse mode and accumulation model log-normal + !! distribution functions. The resulting arrays are: DMID = diameter +! of bin and SALT_V = dV/dln(D) [in um3]. + !! + !!References: + !! Adapted from GEOS-Chem source code (GeosCore/drydep_mod.F90) + !! INIT_WEIGHTSS function + !! + !! + !! \param SALT_RLOW_um lowest edge of sea salt radius [um] + !! \param SALT_RUP_um uppest edge of sea sakt radius [um] + !! + !! \ingroup catchem_drydep_process + !!!> + + SUBROUTINE INIT_WEIGHTSS( SALT_RLOW_um, SALT_RUP_um, RC ) + + IMPLICIT NONE + !INPUT PARAMETERS: + real(fp), INTENT(IN) :: SALT_RLOW_um ! lowest edge of sea salt radius [um] + real(fp), INTENT(IN) :: SALT_RUP_um ! uppest edge of sea sakt radius [um] + INTEGER, INTENT(INOUT) :: RC ! Success or failure + !LOCAL VARIABLES: + !INTEGER :: N + REAL(fp) :: DEDGE + INTEGER :: ID,NR + !DEFINED PARAMETERS: + ! increment of radius for integration of settling velocity (um) + REAL(fp), PARAMETER :: DR = 5.e-2_fp + + ! parameters for assumed size distribution of acc and coarse mode + ! sea salt aerosols + ! geometric dry mean diameters (microns) + REAL(fp), PARAMETER :: RG_A = 0.085e+0_fp + REAL(fp), PARAMETER :: RG_C = 0.4e+0_fp + ! sigma of the size distribution + REAL(fp), PARAMETER :: SIG_A = 1.5e+0_fp + REAL(fp), PARAMETER :: SIG_C = 1.8e+0_fp + ! Error handling + !--------------- + CHARACTER(LEN=255) :: ErrMsg + CHARACTER(LEN=255) :: ThisLoc + + !================================================================= + ! INIT_WEIGHTSS begins here! + !================================================================= + ErrMsg = '' + ThisLoc = ' -> at INIT_WEIGHTSS (in process/drydep/ccpr_dryde_common_mod.F90)' + + ! Number of bins between the lowest bound of of the accumulation mode + ! sea salt and the upper bound of the coarse mode sea salt. + NR = INT((( SALT_RUP_um - SALT_RLOW_um ) / DR ) + 0.5e+0_fp ) + + ALLOCATE( DMID( NR ), STAT=RC ) + IF ( RC /= CC_SUCCESS ) THEN + ErrMsg = 'Could not allocate array DMID' + CALL CC_Error( ErrMsg, RC, ThisLoc ) + RETURN + END IF + DMID = 0e+0_fp + + ALLOCATE( SALT_V( NR ), STAT=RC ) + IF ( RC /= CC_SUCCESS ) THEN + ErrMsg = 'Could not allocate array SALT_V' + CALL CC_Error( ErrMsg, RC, ThisLoc ) + RETURN + END IF + SALT_V = 0e+0_fp + + !================================================================= + ! Define the volume size distribution of sea-salt. This only has + ! to be done once. We assume that sea-salt is the combination of a + ! coarse mode and accumulation model log-normal distribution functions + !================================================================= + + ! Lower edge of 0th bin diameter [um] + DEDGE=SALT_RLOW_um * 2e+0_fp + + ! Loop over diameters + DO ID = 1, NR + + ! Diameter of mid-point in microns + DMID(ID) = DEDGE + ( DR ) + + ! Calculate the dry volume size distribution as the sum of two + ! log-normal size distributions. The parameters for the size + ! distribution are based on Reid et al. and Quinn et al. + ! The scaling factors 13. and 0.8 for acc and coarse mode aerosols + ! are chosen to obtain a realistic distribution + ! SALT_V (D) = dV/dln(D) [um3] + SALT_V(ID) = PI / 6e+0_fp* (DMID(ID)**3) * ( & + 13e+0_fp*exp(-0.5*( LOG(DMID(ID))- & + LOG(RG_A*2e+0_fp) )**2e+0_fp/ & + LOG(SIG_A)**2e+0_fp ) & + /( sqrt(2e+0_fp * PI) * LOG(SIG_A) ) + & + 0.8e+0_fp*exp(-0.5*( LOG(DMID(ID))- & + LOG(RG_C*2e+0_fp) )**2e+0_fp/ & + LOG(SIG_C)**2e+0_fp) & + /( sqrt(2e+0_fp * PI) * LOG(SIG_C) ) ) + + ! update the next edge + DEDGE = DEDGE + DR*2e+0_fp + ENDDO + + END SUBROUTINE INIT_WEIGHTSS + + !> + !! \brief calculates the Ra and Rb term in the Wesely scheme + !! + !!References: + !! Wesely, M. L. "Parameterization of surface resistances to gaseous dry deposition in + !! regional-scale numerical models." Atmospheric environment 41 (2007): 52-63. + !! https://doi.org/10.1016/0004-6981(89)90153-4 + !! + !! \param TEMPK Temperatue [K] + !! \param PRESSU Pressure [Pa] + !! \param XMW Molecular weight [kg/mol] + !! \param USTAR Fictional Velocity [m/s] + !! \param OBK Monin-Obhukov length [m] + !! \param ZO Roughness length [m] + !! \param THIK height of first model layer [m] + !! \param IS_GAS flag for gas + !! \param Ra output of aerodynamic resistance [s/m] + !! \param Rb output of quasi-laminar boundary layer resistance [s/m] + !! \param RC Success or failure? + !! + !! \ingroup catchem_drydep_process + !!!> + subroutine Wesely_Ra_Rb(TEMP, PRESSU, XMW, USTAR, OBK, ZO, THIK, IS_GAS, Ra, Rb, RC) + IMPLICIT NONE + ! Parameters + !----------- + real(fp), intent(in) :: TEMP !< Temperature [K] + real(fp), intent(in) :: PRESSU !< Pressure [Pa] + real(fp), intent(in) :: XMW !< Molecular weight [kg/mol] + real(fp), intent(in) :: USTAR !< Friction velocity [m/s] + real(fp), intent(in) :: OBK !< Monin-Obhukov length [m] + real(fp), intent(in) :: ZO !< Roughness length [m] + real(fp), intent(in) :: THIK !< height of first model layer [m] + logical, intent(in) :: IS_GAS !< flag for gas + !output + real(fp), intent(out) :: Ra !< aerodynamic resistance [s/m] + real(fp), intent(out) :: Rb !< quasi-laminar boundary layer resistance [s/m] + integer, intent(out) :: RC !< Success or failure? + + ! Local Variables + !---------------- + real(fp) :: C1,CZ,XNU + real(fp) :: CKUSTR,REYNO,CORR1,CORR2,Z0OBK + real(fp) :: DUMMY1,DUMMY2,DUMMY3,DUMMY4 + real(fp) :: DAIR,TEMPK,TEMPC + logical :: LRGERA !stable atmosphere; a high aerodynamic resistance (RA=1.E4 m s-1) is imposed; else RA is calculated + !string + character(len=255) :: thisLoc + character(len=512) :: ErrMsg + + !-------------------------------------------- + ! main function + !-------------------------------------------- + + ! Assume success + RC = CC_SUCCESS + ErrMsg = '' + ThisLoc = ' -> at Wesely_Ra_Rb (in process/drydep/CCPr_drydep_Commmon_Mod.F90)' + + ! Zero variables that aren't zeroed below + CZ = 0.0_fp + CKUSTR = 0.0_fp + REYNO = 0.0_fp + CORR1 = 0.0_fp + CORR2 = 0.0_fp + Z0OBK = 0.0_fp + DUMMY1 = 0.0_fp + DUMMY2 = 0.0_fp + DUMMY3 = 0.0_fp + DUMMY4 = 0.0_fp + DAIR = 0.0_fp + Ra = 0.0_fp + Rb = 0.0_fp + + !CZ is Altitude (m) at which deposition velocity is computed + !use Midpoint height of first model level [m] + CZ = THIK / 2.0e+0_fp + + !** TEMPK and TEMPC are surface air temperatures in K and in C + TEMPK = TEMP + TEMPC = TEMP-273.15e+0_fp + + !** Calculate the kinematic viscosity XNU (m2 s-1) of air + !** as a function of temperature. + !** The kinematic viscosity is used to calculate the roughness heights + !** over water surfaces and to diagnose whether such surfaces are + !** aerodynamically rough or smooth using a Reynolds number criterion. + !** The expression for the temperature dependence of XNU + !** is from the FORTRAN code in Appendix II of Wesely [1988]; + !** I wasn't able to find an original reference but it seems benign enough. + C1 = TEMPK/273.15e+0_fp + XNU = 0.151e+0_fp*(C1**1.77e+0_fp)*1.0e-04_fp + + !***** Get aerodynamic resistances Ra and Rb. *********** + ! The aerodynamic resistance Ra is integrated from altitude z0+d up + ! to the altitude z1 at which the dry deposition velocity is to be + ! referenced. The integration corrects for stability using Monin- + ! Obukhov similarity formulas from Businger et al. [1971] which + ! apply over the range -2.5 < z/zMO < 1.5 (see their Figure 2). + ! Under very unstable conditions when z1 > -2.5 zMO, we assume that + ! there is no resistance to transfer in the convective column + ! between zMO and z1. Under very stable conditions when z1 > 1.5 zMO + ! we assume that vertical transfer in the column between zMO and z1 + ! is strongly suppressed so that the deposition velocity at altitude + ! z1 is very low. Under these conditions we just specify a very + ! large Ra=1.E4 s m-1 (LRGERA = T). + !** + ! The Reynolds number REYNO diagnoses whether a surface is + ! aerodynamically rough (REYNO > 1) or smooth. + ! + ! NOTE: The criterion "REYNO > 1" was originally "REYNO > 10". See + ! below for an explanation of why it was changed (hyl, 10/15/99) + ! + ! Surface is rough in all cases except over water with low wind + ! speeds. In the smooth case, vertical transport IN THE SUBLAYER + ! near the surface is limited by molecular diffusion and is + ! therefore very slow; we assign a large value we assign a large + ! value of Ra + Rb to account for this effect. [In Versions 3.2 + ! and earlier we used the formulation for Ra + Rb given in Equation + ! (12) of Walcek et al [1986] to calculate the aerodynamic + ! resistance over smooth surfaces. However, that expression fails + ! when u* is very small, as it yields negative values of Ra + Rb]. + ! (djj, hyl, bmy, 5/8/00) + !** + ! In the aerodynamically rough case, the expression for Ra is as + ! given in equation (5) of Jacob et al. [1992]: + ! + ! Ra = (1/ku*)*int(from z0 to z1) (phi(x)/z)dz + ! + ! where x = (z-D)/zMO, z is the height above ground, and D is the + ! displacement height which is typically 70-80% of the canopy + ! height [Brutsaert, 1982]. We change the vertical coordinate so + ! that z=0 at the displacement height; that's OK since for all + ! practical applications z1 >> D. In this manner we don't need + ! to assume any specific value for the displacement height. + ! Applying the variable transformation z -> x = z/zMO, the equation + ! above becomes + ! + ! Ra = (1/ku*)*int(from x0 to x1) (phi(x)/x)dx with x=z/zMO + ! + ! Here phi is a stability correction function originally formulated + ! by Businger et al. [1971] and given in eqns 5a and 5b of Jacob et + ! al. [1992]. For unstable conditions, + ! + ! phi(x) = a/sqrt(1-bx) where a=0.74, b = 9 + ! + ! The analytical solution to the integral is [Dwight, 1957, + ! integral 192.11]: + ! + ! int(dx/(x*sqrt(1-bx))) = log(abs((sqrt(1-bx)-1) + ! /(sqrt(1-bx)+1))) + ! + ! which yields the expression for Ra used in the code for + ! unstable conditions. For stable conditions, + ! + ! phi(x) = a + bx where a=0.74, b = 4.7 + ! + ! and the analytical solution to the integral is + ! + ! int((a/x)+b)dx = a*ln(x) + bx + ! + ! which yields the expression of Ra used in the code for stable + ! conditions. + !** + ! The formulation of RB for gases is equation (12) of Walcek et al. + ! [1986]. The parameterization for deposition of aerosols does not + ! include an RB term so RB for aerosols is set to zero. + ! Modify phi(x) according to the non-local mixing scheme + ! by Holtslag and Boville [1993] ( Lin, 07/18/08 ) + ! For unstable conditions, + ! phi(x) = a/sqrt(1-bx) where a=1.0, b=15.0 + ! + ! For stable conditions, + ! phi(x) = a + bx + ! where a=1.0, b=5.0 for 0 <= x <= 1, and + ! a=5.0, b=1.0 for x > 1.0 + !******************************************************** + + CKUSTR = VON_KARMAN * USTAR + REYNO = USTAR*ZO/XNU + CORR1 = CZ/OBK + ! Define Z0OBK + Z0OBK = ZO/OBK + + LRGERA = .FALSE. + ! Add option for non-local PBL + !IF (.NOT. LNLPBL) THEN + ! IF (CORR1 .GT. 0.e+0_fp) THEN + ! IF (CORR1 .GT. 1.5e+0_fp) LRGERA = .TRUE. + ! ELSEIF(CORR1 .LE. 0.e+0_fp) THEN + ! IF (CORR1 .LE. -2.5e+0_fp) CORR1 = -2.5e+0_fp + ! CORR2 = LOG(-CORR1) + ! ENDIF + !ENDIF + + !use rae function from pecision_mod to avoid "equality comparison for real" warning + IF ( rae(CKUSTR, 0.0e+0_fp) ) THEN + ErrMsg = 'CKUSTR cannot be zero.' + CALL CC_Error( ErrMsg, RC, ThisLoc ) + RETURN ! debug + ENDIF + + !...aerodynamically rough or smooth surface + ! "In the classic study by Nikuradse (1933) the transition from + ! smooth to rough was examined in pipe flow. He introduced a + ! roughness Reynolds number Rr = U* Z0 / Nu and found the flow to + ! be smooth for Rr < 0.13 and rough for Rr > 2.5 with a transition + ! regime in between." (E.B. Kraus and J.A. Businger, Atmosphere-Ocean + ! Interaction, second edition, P.144-145, 1994). + ! Similar statements can be found in the books: Evaporation into the + ! atmosphere, by Wilfried Brutsaert ,P.59,89, 1982; or Seinfeld & + ! Pandis, P.858, 1998. + ! Here we assume a sudden transition point Rr = 1 from smooth to + ! rough, following L. Merlivat (1978, The dependence of bulk + ! evaporation coefficients on air-water interfacial conditions as + ! determined by the isotopic method, J. Geophys. Res., Oceans & + ! Atmos., 83, C6, 2977-2980). Also refer to Brutsaert's book, P.125. + ! We used to use the criterion "REYNO > 10" for aerodynamically rough + ! surface and now change to "REYNO > 1". (hyl, 10/15/99) + ! D. J. Jacob change the criterion for aerodynamically rough + ! surface to REYNO > 0.1 + IF ( REYNO >= 0.1e+0_fp ) THEN !rough surface + ! Add option for non-local PBL + !TODO: we only use non-local option + !IF (.NOT. LNLPBL) THEN + + !...aerodynamically rough surface. + !* + ! IF (CORR1.LE.0.0e+0_fp .AND. Z0OBK .LT. -1.e+0_fp)THEN + !*... unstable condition; set RA to zero. + !* (first implemented in V. 3.2) + ! RA = 0.e+0_fp + !*... error trap: prevent CORR1 or Z0OBK from being + !*... zero or close to zero (ckeller, 3/15/16) + ! ELSEIF ( ABS(CORR1)<=SMALL .OR. ABS(Z0OBK)<=SMALL ) THEN + ! RA = 0.e+0_fp + ! ELSEIF (CORR1.LE.0.0e+0_fp .AND. Z0OBK .GE. -1.e+0_fp) THEN + !*... unstable conditions; + !*... compute Ra as described above + ! DUMMY1 = (1.e+0_fp - 9e+0_fp*CORR1)**0.5e+0_fp + ! DUMMY2 = (1.e+0_fp - 9e+0_fp*Z0OBK)**0.5e+0_fp + ! DUMMY3 = ABS((DUMMY1 - 1.e+0_fp)/(DUMMY1 + 1.e+0_fp)) + ! DUMMY4 = ABS((DUMMY2 - 1.e+0_fp)/(DUMMY2 + 1.e+0_fp)) + ! RA = 0.74e+0_fp* (1.e+0_fp/CKUSTR) * LOG(DUMMY3/DUMMY4) + + ! ELSEIF((CORR1.GT.0.0e+0_fp).AND.(.NOT.LRGERA)) THEN + !*... moderately stable conditions (z/zMO <1); + !*... compute Ra as described above + ! RA = (1e+0_fp/CKUSTR) * (.74e+0_fp*LOG(CORR1/Z0OBK) + & + ! 4.7e+0_fp*(CORR1-Z0OBK)) + ! ELSEIF(LRGERA) THEN + !*... very stable conditions + ! RA = 1.e+04_fp + ! ENDIF + !* check that RA is positive; if RA is negative (as occasionally + !* happened in version 3.1) send a warning message. + + !ELSE !not using non-local PBL + + IF (CORR1.LT.0.0e+0_fp) THEN + !*... unstable conditions; compute Ra as described + !*... above. + !coef_a=1.e+0_fp + !coef_b=15.e+0_fp + DUMMY1 = (1.e+0_fp - 15.e+0_fp*CORR1)**0.5e+0_fp + DUMMY2 = (1.e+0_fp - 15.e+0_fp*Z0OBK)**0.5e+0_fp + DUMMY3 = ABS((DUMMY1 - 1.e+0_fp)/(DUMMY1 + 1.e+0_fp)) + DUMMY4 = ABS((DUMMY2 - 1.e+0_fp)/(DUMMY2 + 1.e+0_fp)) + RA = 1.e+0_fp * (1.e+0_fp/CKUSTR) * LOG(DUMMY3/DUMMY4) + + ELSEIF((CORR1.GE.0.0e+0_fp).AND.(CORR1.LE.1.0e+0_fp)) THEN + !coef_a=1.e+0_fp + !coef_b=5.e+0_fp + RA = (1.e+0_fp/CKUSTR) * (1.e+0_fp*LOG(CORR1/Z0OBK) + & + 5.e+0_fp*(CORR1-Z0OBK)) + + ELSE ! CORR1 .GT. 1.0D0 + !coef_a=5e+0_fp + !coef_b=1.e+0_fp + RA = (1.e+0_fp/CKUSTR) * (5.e+0_fp*LOG(CORR1/Z0OBK) + & + 1.e+0_fp*(CORR1-Z0OBK)) + ENDIF + + !* check that RA is positive and maximize at 1.E4 s m-1 + RA = MIN(RA,1.e+4_fp) + ! If RA is < 0, set RA = 0 + IF (RA .LT. 0.e+0_fp) RA = 0.0e+0_fp + + !END IF !PBL or non-local PBL options + + !get Rb for a gas species; arosol Rb is set to zero + !** DAIR is the thermal diffusivity of air; value 0.2*1.E-4 m2 s-1 cited on p. 16,476 of + !** Jacob et al. [1992] + DAIR = 0.2e0_fp*1.e-4_fp + IF (IS_GAS) THEN + RB = (2.e+0_fp/CKUSTR)* (DAIR/DIFFG(TEMPK,PRESSU,XMW)) & + **0.667e+0_fp + END IF + + ELSE !smooth surface + !** suppress drydep over smooth surfaces by setting Ra to + !** a large value (1e4). This prevents negative dry deposition + !** velocities when u* is very small. Rb is not important in that case since + !** the total resistentce is Ra + Rb. So we set Rb to zero. + RA = 1.e+4_fp + + END IF + + end subroutine Wesely_Ra_Rb + + +end module CCPr_drydep_Common_Mod diff --git a/src/process/drydep/ccpr_scheme_wesely_mod.F90 b/src/process/drydep/ccpr_scheme_wesely_mod.F90 new file mode 100644 index 00000000..25a781b3 --- /dev/null +++ b/src/process/drydep/ccpr_scheme_wesely_mod.F90 @@ -0,0 +1,335 @@ +!> +!! \file +!! \brief CCPr Scheme for dry deposition +!! +!! +!! Reference: +!! (1) Wesely, M. L. (1989). Parameterization of surface resistances to gaseous dry +!! deposition in regional-scale numerical models. Atmospheric Environment. +!! (2) Most of the codes are adopted from GEOS-Chem drydep_mod.F90 module. +!! https://github.com/geoschem/geos-chem +!! +!! \author Wei Li +!! \date 02/2025 +!!!> +module CCPr_Scheme_Wesely_Mod + + implicit none + + private + + public :: CCPr_Scheme_Wesely + +contains + + !> + !! \brief Computes the dry deposition velocity using the Wesely scheme + !! + !!References: Wesely, M. L. (1989). + !! + !! \param RADIAT Solar radiation [W/m2] + !! \param TEMP Surface Temperature [K] + !! \param SUNCOS Cosine of solar zenith angle at middle of current chem timestep + !! \param F0 React. factor for oxidation depends on species + !! \param HSTAR Henry's law constant depends on species + !! \param XMW Molecular weight [kg/mol] + !! \param USTAR Friction velocity [m/s] + !! \param OBK Monin-Obhukov length [m] + !! \param CFRAC Surface cloud fraction + !! \param THIK height of first model layer [m] + !! \param ZO Roughness length [m] + !! \param PRESSU Surface pressure [Pa] + !! \param SPC Species name + !! \param XLAI Leaf area index (Note: change to fraction LAI of each land type) + !! \param ILAND Land type ID in current grid box (mapped to deposition surface types + !! \param IUSE Fraction of gridbox area occupied by each land type + !! \param SALINITY Salinity of the ocean + !! \param TSKIN Skin temperature + !! \param IODIDE Iodide concentration + !! \param XLON Longitude + !! \param YLAT Latitude + !! \param LUC name of land use category (one of OLSON, NOAH and IGBP for now) + !! \param CO2_EFFECT Flag for CO2 effect on Rs + !! \param CO2_LEVEL CO2 level + !! \param CO2_REF Reference CO2 level + !! \param IS_SNOW Flag for snow surface + !! \param IS_ICE Flag for ice surface + !! \param IS_LAND Flag for land surface + !! \param DD_DvzAerSnow Fixed VD for some aerosols over snow and ice [cm/s] + !! \param DD_DvzMinVal_SNOW Minimum VD for some sulfate species over snow and ice [cm/s] + !! \param DD_DvzMinVal_LAND Minimum VD for some sulfate species over land [cm/s] + !! \param VD output of dry deposition velocity [m/s] + !! \param DDFreq output of dry deposition frequency [1/s] + !! \param RC Success or failure? + !! + !! \ingroup catchem_drydep_process + !!!> + subroutine CCPr_Scheme_Wesely( RADIAT, TEMP, SUNCOS, F0, HSTAR, XMW, & + USTAR, OBK, CFRAC, THIK, ZO, PRESSU, SPC, XLAI, ILAND, IUSE, & + SALINITY, TSKIN, IODIDE, XLON, YLAT, LUC, CO2_EFFECT, & + CO2_LEVEL, CO2_REF, IS_SNOW, IS_ICE, IS_LAND, & + DD_DvzAerSnow, DD_DvzMinVal_SNOW, DD_DvzMinVal_LAND, VD, DDFreq, RC) + ! Uses + !USE Constants, Only : PI_180 !pull in a constant from the CONSTANTS MODULE + use precision_mod, only : fp !pull in a precision from the PRECISION MODULE + Use Error_Mod, Only : CC_SUCCESS ! Error Check Success + USE CCPr_Drydep_Common_Mod + + IMPLICIT NONE + ! Parameters + !----------- + real(fp), intent(in) :: RADIAT !< Solar radiation [W/m2] + real(fp), intent(in) :: TEMP !< Temperature [K] + real(fp), intent(in) :: SUNCOS !< Cosine of solar zenith angle at middle of current chem timestep + real(fp), intent(inout) :: F0 !< React. factor for oxidation depends on species + real(fp), intent(in) :: HSTAR !< Henry's law constant depends on species + real(fp), intent(in) :: XMW !< Molecular weight [kg/mol] + real(fp), intent(in) :: USTAR !< Friction velocity [m/s] + real(fp), intent(in) :: OBK !< Monin-Obhukov length [m] + real(fp), intent(in) :: CFRAC !< Surface cloud fraction [unitless] + real(fp), intent(in) :: THIK !< height of first model layer [m] + real(fp), intent(in) :: ZO !< Roughness length [m] + !real(fp), intent(in) :: RHB !< Relative humidity at surface [uniteless] + real(fp), intent(in) :: PRESSU !< Surface pressure [Pa] + !real(fp), intent(in) :: W10 !< Wind speed at 10m [m/s] + !integer, intent(in) :: N_SPC !< Species ID (TODO: may be changed to species name) + character(len=20), intent(in) :: SPC !< Species name + real(fp), dimension(:), intent(in) :: XLAI !< Leaf area index (Note: change to fraction LAI of each land type) + integer, dimension(:), intent(in) :: ILAND !< Land type ID in current grid box (mapped to deposition surface types + real(fp), dimension(:), intent(in) :: IUSE !< Fraction (per mille) of gridbox area occupied by each land type (TODO!!) + !some inputs are for O3 over water and Hg over Amazon forest (not sure if we should include them for now) + real(fp), intent(in) :: SALINITY !< Salinity of the ocean + real(fp), intent(in) :: TSKIN !< Skin temperature + real(fp), intent(in) :: IODIDE !< Iodide concentration + real(fp), intent(in) :: XLON !< Longitude + real(fp), intent(in) :: YLAT !< Latitude + character(len=20), intent(in) :: LUC !< name of land use category (one of OLSON, NOAH and IGBP for now) + ! CO2 effect on Rs + logical, intent(in) :: CO2_EFFECT !< Flag for CO2 effect on Rs + real(fp), intent(in) :: CO2_LEVEL !< CO2 level + real(fp), intent(in) :: CO2_REF !< Reference CO2 level + logical, intent(in) :: IS_SNOW, IS_ICE, IS_LAND !< Flags for snow, ice or land + !set range of dry deposition velocities + real(fp), intent(in) :: DD_DvzAerSnow !< Fixed VD for some aerosols over snow and ice [cm/s] + real(fp), intent(in) :: DD_DvzMinVal_SNOW !< Minimum VD for some sulfate species over snow and ice [cm/s] + real(fp), intent(in) :: DD_DvzMinVal_LAND !< Minimum VD for some sulfate species over land [cm/s] + !output + real(fp), intent(out) :: VD !< dry deposition velocity [m/s] + real(fp), intent(out) :: DDFreq !< dry deposition frequency [1/s] + integer, intent(out) :: RC !< Success or failure? + + ! Local Variables + !---------------- + real(fp) :: XLAI_IN, C1X, RA, RB, RSURFC, VK, DVZ + integer :: II !< Index of the drydep land type + integer :: ILDT !< index of the land types in the grid box + integer :: LDT !loop index of land types + !string + character(len=255) :: thisLoc + character(len=512) :: ErrMsg + + !-------------------------------------------- + ! main function + !-------------------------------------------- + + ! Assume success + RC = CC_SUCCESS + ErrMsg = '' + ThisLoc = ' -> at CCPr_scheme_Wesely (in process/drydep/CCPr_Scheme_Wesely_Mod.F90)' + + ! Add option for non-local PBL mixing scheme: THIK must be the first box height. + ! TODO: we only use non-local mixing here + !IF (.NOT. LNLPBL) THIK = MAX( ZH, THIK ) + + ! Zero variables that aren't zeroed below + VD = 0.0_fp + DDFreq = 0.0_fp + DVZ = 0.0_fp + RSURFC = 0.0_fp + RA = 0.0_fp + RB = 0.0_fp + C1X = 0.0_fp + VK = 0.0_fp + XLAI_IN = 0.0_fp + + ! Better test for depositing species: We need both HSTAR and XMW + ! to be nonzero, OR the value of AIROSOL to be true. This should + ! avoid any further floating point invalid issues caused by putting + ! a zero value in a denominator. + IF ( ( HSTAR > 0e+0_fp .and. XMW > 0e+0_fp ) ) THEN + DO LDT =1 , SIZE(IUSE) + ! If the land type is not represented in grid + ! box, then skip to the next land type + IF ( IUSE(LDT) <= 0 ) CYCLE + + ILDT = ILAND(LDT) + IF ( LUC == 'OLSON' ) THEN + ! Olson land type index + 1 + ILDT = ILDT + 1 + ! Dry deposition land type index + II = IDEP_IOLSON(ILDT) + ELSE IF ( LUC == 'NOAH' ) THEN + ! it is possible that water is given as 0 not 17 in GFS CCPP + IF (ILDT == 0) ILDT = 17 + II = IDEP_NOAH(ILDT) + ELSE IF ( LUC == 'IGBP' ) THEN + ! it is possible that water is given as 0 not 17 + IF (ILDT == 0) ILDT = 17 + II = IDEP_IGBP(ILDT) + ENDIF + + !LAI of the landtype in the subgrid + !XLAI_IN = XLAI * DBLE(IUSE(LDT)) !TODO: may be able to calculate online if fraction LAI is not provided + XLAI_IN = XLAI(LDT) + + !If the surface to be snow or ice;set II to 1 instead + !We do not use II index to specify directly since IS_SNOW and IS_ICE are given at each grid not subgrid as ILAND + IF( (IS_SNOW) .OR. (IS_ICE) ) II=1 + + !get bulk surface resistances (Rs) + call Wesely_Rc_Gas( RADIAT, TEMP, SUNCOS, F0, HSTAR, XMW, USTAR, CFRAC, PRESSU, & + XLAI_IN, II, SPC, SALINITY, TSKIN, IODIDE, XLON, YLAT, & + CO2_EFFECT, CO2_LEVEL, CO2_REF, RSURFC, RC) + + if (RC /= CC_SUCCESS ) then + errMsg = 'Error in getting bulk surface resistances (RSURFC)' + CALL CC_Error( errMsg, RC, thisLoc ) + RETURN + endif + + !*Set max and min values for bulk surface resistances + RSURFC = MAX(1.e+0_fp, MIN(RSURFC,9999.e+0_fp)) + !*because of high resistance values, different rule applied for ocean ozone + IF ((SPC .EQ. 'O3') .AND. (II .EQ. 11)) THEN + RSURFC = MAX(1.e+0_fp, MIN(RSURFC,999999.e+0_fp)) + ENDIF + ! Set Rc for strong acids (HNO3,HCl,HBr) to 1 s/m + ! Ref. Jaegle et al. 2018, cf. Erisman,van Pul,Ayers 1994 + IF ( HSTAR .gt. 1.e+10_fp ) RSURFC= 1.e+0_fp + + !get Ra and Rb + call Wesely_Ra_Rb(TEMP, PRESSU, XMW, USTAR, OBK, ZO, THIK, .TRUE., Ra, Rb, RC) + + !get VD (TODO: IUSE is decimal not percent or permille as in GEOS-Chem) + C1X = RSURFC + Ra + Rb + VK = VD + !VD = VK + DBLE( IUSE(LDT) ) / C1X !This seems to be useless in the original codes + + !VD = VK + DBLE( IUSE(LDT) ) / C1X + VD = VK + IUSE(LDT) / C1X + + END DO + ENDIF + + !apply spectial treatment or scaling factor to Vd + DVZ = VD *100.e+0_fp !m/s -- > cm/s + + ! Scale relative to specified species(Note:we do not use FLAG but match names instead) + !TODO: We simply hardcode the scaling factor here + + !IF ( FLAG(D) .eq. 1 ) THEN + IF ((SPC .eq. 'N2O5') .or. (SPC .eq. 'HC187') ) THEN + + ! Scale species to HNO3 (MW_g = 63.012 g/mol) + DVZ = DVZ * sqrt(63.01) / sqrt( XMW*1e3_fp ) + + !ELSE IF ( FLAG(D) .eq. 2 ) THEN + ELSE IF ((SPC .eq. 'MPAN') .or. (SPC .eq. 'PPN') .or. (SPC .eq. 'R4N2')) THEN + + ! Scale species to PAN (MW_g = 121.06 g/mol) + DVZ = DVZ * sqrt(121.06) / sqrt( XMW*1e3_fp ) + + !ELSE IF ( FLAG(D) .eq. 3 ) THEN + ELSE IF ((SPC .eq. 'MONITS') .or. (SPC .eq. 'MONITU') .or. (SPC .eq. 'HONIT')) THEN + + ! Scale species to ISOPN (MW_g = 147.15 g/mol) + DVZ = DVZ * sqrt(147.15) / sqrt(XMW*1e3_fp) + + ENDIF + + !----------------------------------------------------------- + ! Special treatment for snow and ice + !----------------------------------------------------------- + IF ( (IS_SNOW) .OR. (IS_ICE) ) THEN + + !------------------------------------- + ! %%% SURFACE IS SNOW OR ICE %%% + !------------------------------------- + IF ( DD_DvzAerSnow > 0.0_fp ) THEN + + ! For most aerosol species (basically everything + ! except sea salt and dust species), we just set + ! the deposition velocity over snow to a fixed value + !DVZ = DBLE( DD_DvzAerSnow ) + DVZ = DD_DvzAerSnow + + ELSE + + ! Otherwise, enforce a minimum drydep velocity over snow + ! (cf. the GOCART model). NOTE: In practice this will + ! only apply to the species SO2, SO4, MSA, NH3, NH4, NIT. + !DVZ = MAX( DVZ, DBLE( DD_DvzMinVal_Snow ) ) + DVZ = MAX( DVZ, DD_DvzMinVal_Snow ) + + ENDIF + + ELSE + + !------------------------------------- + ! %%% SURFACE IS NOT SNOW OR ICE %%% + !------------------------------------- + + ! Enforce a minimum drydep velocity over land (cf. the + ! GOCART model). NOTE: In practice this will only apply + ! to the species SO2, SO4, MSA, NH3, NH4, NIT. + !DVZ = MAX( DVZ, DBLE( DD_DvzMinVal_Land ) ) + DVZ = MAX( DVZ, DD_DvzMinVal_Land ) + + ENDIF + + !----------------------------------------------------------- + ! Special treatment for ACETONE + !----------------------------------------------------------- + + ! For ACET, we need to only do drydep over the land + ! and not over the oceans. + !IF ( N == id_ACET ) THEN + IF ( SPC == 'ACET' ) THEN + IF ( Is_Land ) THEN + DVZ = 0.1e+0_fp + ELSE + DVZ = 0e+0_fp + ENDIF + ENDIF + + !----------------------------------------------------------- + ! Special treatment for ALD2,MENO3,ETNO3,MOH + !----------------------------------------------------------- + + ! we need to only do drydep over the land + ! and not over the oceans. + !IF ( N == id_ALD2 ) THEN + IF ( (SPC == 'ALD2') .or. (SPC == 'MENO3') .or. (SPC == 'ETNO3') .or. (SPC == 'MOH') ) THEN + IF ( .not. Is_Land ) THEN + DVZ = 0e+0_fp + ENDIF + ENDIF + + !----------------------------------------------------------- + ! Compute drydep velocity and frequency + !----------------------------------------------------------- + + ! Dry deposition velocities [m/s] + VD = DVZ / 100.e+0_fp + + ! Dry deposition frequency [1/s] + DDFreq = VD / THIK + + !test only + !write(*,*) 'Test finish for species () with Vd (): ', SPC, VD + + + end subroutine CCPr_Scheme_Wesely + + +end module CCPr_Scheme_Wesely_Mod diff --git a/src/process/drydep/ccpr_scheme_zhang_aerosol_mod.F90 b/src/process/drydep/ccpr_scheme_zhang_aerosol_mod.F90 new file mode 100644 index 00000000..bf5ff066 --- /dev/null +++ b/src/process/drydep/ccpr_scheme_zhang_aerosol_mod.F90 @@ -0,0 +1,277 @@ +!> +!! \file +!! \brief CCPr Scheme for dry deposition of aeroosl species from Zhang et al., (2001) with +!! Emerson's updates. The Ra and Rb are still from Wesely (1989) for now. +!! +!! +!! Reference: +!! (1) Wesely, M. L. (1989). Parameterization of surface resistances to gaseous dry +!! deposition in regional-scale numerical models. Atmospheric Environment. +!! (2) Zhang, L., Gong, S., Padro, J., & Barrie, L. (2001). A size-segregated particle +!! dry deposition scheme for an atmospheric aerosol module. Atmospheric environment. +!! (3) Emerson, E. W., et al. (2020). Revisiting particle dry deposition and its role +!! in radiative effect estimates. PNAS, 117(42), 26076-26082. +!! (4) Most of the codes are adopted from GEOS-Chem drydep_mod.F90 module. +!! https://github.com/geoschem/geos-chem +!! +!! \author Wei Li +!! \date 02/2025 +!!!> +module CCPr_Scheme_Zhang_aerosol_Mod + + implicit none + + private + + public :: CCPr_Scheme_Zhang_Aero + +contains + + !> + !! \brief Computes the dry deposition velocity using the Wesely scheme + !! + !!References: Wesely, M. L. (1989). + !! + !! \param TEMP Surface Temperature [K] + !! \param HSTAR Henry's law constant depends on species + !! \param XMW Molecular weight [kg/mol] + !! \param A_RADI Aerosol radius [m] + !! \param A_DEN Aerosol density [kg/m3] + !! \param USTAR Friction velocity [m/s] + !! \param OBK Monin-Obhukov length [m] + !! \param THIK height of first model layer [m] + !! \param ZO Roughness length [m] + !! \param RHB Relative humidity at surface [uniteless] + !! \param PRESSU Surface pressure [Pa] + !! \param W10 Wind speed at 10m [m/s] + !! \param SPC Species name + !! \param ILAND Land type ID in current grid box (mapped to deposition surface types + !! \param IUSE Fraction of gridbox area occupied by each land type + !! \param SeaSalt_Lower_Bin Lower bin boundary of sea salt radius [um] + !! \param SeaSalt_UPPER_Bin Upper bin boundary of sea salt radius [um] + !! \param LUC name of land use category (one of OLSON, NOAH and IGBP for now) + !! \param IS_DUST Flag for dust species + !! \param IS_SEASALT Flag for sea salt species + !! \param IS_SNOW Flag for snow surface + !! \param IS_ICE Flag for ice surface + !! \param DD_DvzAerSnow Fixed VD for some aerosols over snow and ice [cm/s] + !! \param DD_DvzMinVal_SNOW Minimum VD for some sulfate species over snow and ice [cm/s] + !! \param DD_DvzMinVal_LAND Minimum VD for some sulfate species over land [cm/s] + !! \param VD output of dry deposition velocity [m/s] + !! \param DDFreq output of dry deposition frequency [1/s] + !! \param RC Success or failure? + !! + !! \ingroup catchem_drydep_process + !!!> + subroutine CCPr_Scheme_Zhang_Aero( TEMP, HSTAR, XMW, A_RADI, A_DEN, & + USTAR, OBK, THIK, ZO, RHB, PRESSU, W10, SPC, ILAND, IUSE, & + SeaSalt_Lower_Bin, SeaSalt_UPPER_Bin, LUC, IS_DUST, IS_SEASALT, IS_SNOW, IS_ICE, & + DD_DvzAerSnow, DD_DvzMinVal_SNOW, DD_DvzMinVal_LAND, VD, DDFreq, RC) + ! Uses + !USE Constants, Only : PI_180 !pull in a constant from the CONSTANTS MODULE + use precision_mod, only : fp !pull in a precision from the PRECISION MODULE + Use Error_Mod, Only : CC_SUCCESS ! Error Check Success + USE CCPr_Drydep_Common_Mod + + IMPLICIT NONE + ! Parameters + !----------- + !real(fp), intent(in) :: RADIAT !< Solar radiation [W/m2] + real(fp), intent(in) :: TEMP !< Temperature [K] + !real(fp), intent(in) :: SUNCOS !< Cosine of solar zenith angle at middle of current chem timestep + !real(fp), intent(inout) :: F0 !< React. factor for oxidation depends on species + real(fp), intent(in) :: HSTAR !< Henry's law constant depends on species + real(fp), intent(in) :: XMW !< Molecular weight [kg/mol] + real(fp), intent(in) :: A_RADI !< Aerosol radius [m] + real(fp), intent(in) :: A_DEN !< Aerosol density [kg/m3] + real(fp), intent(in) :: USTAR !< Friction velocity [m/s] + real(fp), intent(in) :: OBK !< Monin-Obhukov length [m] + !real(fp), intent(in) :: CFRAC !< Surface cloud fraction [unitless] + !real(fp), intent(in) :: ZH !< PBL height [m] + real(fp), intent(in) :: THIK !< height of first model layer [m] + real(fp), intent(in) :: ZO !< Roughness length [m] + real(fp), intent(in) :: RHB !< Relative humidity at surface [uniteless] + real(fp), intent(in) :: PRESSU !< Surface pressure [Pa] + real(fp), intent(in) :: W10 !< Wind speed at 10m [m/s] + !integer, intent(in) :: N_SPC !< Species ID (TODO: may be changed to species name) + character(len=20), intent(in) :: SPC !< Species name + !real(fp), dimension(:), intent(in) :: XLAI !< Leaf area index (Note: change to fraction LAI of each land type) + integer, dimension(:), intent(in) :: ILAND !< Land type ID in current grid box (mapped to deposition surface types + real(fp), dimension(:), intent(in) :: IUSE !< Fraction (per mille) of gridbox area occupied by each land type (TODO!!) + real(fp), dimension(:), intent(in) :: SeaSalt_Lower_Bin !< Lower bin boundary of sea salt radius [um] + real(fp), dimension(:), intent(in) :: SeaSalt_UPPER_Bin !< Upper bin boundary of sea salt radius [um] + !some inputs are for O3 over water and Hg over Amazon forest (not sure if we should include them for now) + !real(fp), intent(in) :: SALINITY !< Salinity of the ocean + !real(fp), intent(in) :: TSKIN !< Skin temperature + !real(fp), intent(in) :: IODIDE !< Iodide concentration + !real(fp), intent(in) :: XLON !< Longitude + !real(fp), intent(in) :: YLAT !< Latitude + character(len=20), intent(in) :: LUC !< name of land use category (one of OLSON, NOAH and IGBP for now) + ! CO2 effect on Rs + !logical, intent(in) :: CO2_EFFECT !< Flag for CO2 effect on Rs + !real(fp), intent(in) :: CO2_LEVEL !< CO2 level + !real(fp), intent(in) :: CO2_REF !< Reference CO2 level + logical, intent(in) :: IS_DUST, IS_SEASALT + logical, intent(in) :: IS_SNOW, IS_ICE !< Flags for snow, ice + !set range of dry deposition velocities + real(fp), intent(in) :: DD_DvzAerSnow !< Fixed VD for some aerosols over snow and ice [cm/s] + real(fp), intent(in) :: DD_DvzMinVal_SNOW !< Minimum VD for some sulfate species over snow and ice [cm/s] + real(fp), intent(in) :: DD_DvzMinVal_LAND !< Minimum VD for some sulfate species over land [cm/s] + !output + real(fp), intent(out) :: VD !< dry deposition velocity [m/s] + real(fp), intent(out) :: DDFreq !< dry deposition frequency [1/s] + integer, intent(out) :: RC !< Success or failure? + + ! Local Variables + !---------------- + real(fp) :: C1X, RA, RB, RSURFC, VTSoutput, VK, DVZ + integer :: II !< Index of the drydep land type + integer :: ILDT !< index of the land types in the grid box + integer :: LDT !loop index of land types + integer :: LUCINDEX !mapping above II to Zhang's 15 land types for aerosols + !string + character(len=255) :: thisLoc + character(len=512) :: ErrMsg + + !-------------------------------------------- + ! main function + !-------------------------------------------- + + ! Assume success + RC = CC_SUCCESS + ErrMsg = '' + ThisLoc = ' -> at CCPr_scheme_Zhang_Aero (in process/drydep/CCPr_Scheme_Zhang_aerosol_Mod.F90)' + + ! Add option for non-local PBL mixing scheme: THIK must be the first box height. + ! TODO: we only use non-local mixing here + !IF (.NOT. LNLPBL) THIK = MAX( ZH, THIK ) + + ! Zero variables that aren't zeroed below + VD = 0.0_fp + DDFreq = 0.0_fp + DVZ = 0.0_fp + RSURFC = 0.0_fp + RA = 0.0_fp + RB = 0.0_fp + C1X = 0.0_fp + VK = 0.0_fp + VTSoutput = 0.0_fp + + ! Better test for depositing species: We need both HSTAR and XMW + ! to be nonzero, OR the value of AIROSOL to be true. This should + ! avoid any further floating point invalid issues caused by putting + ! a zero value in a denominator. + DO LDT =1 , SIZE(IUSE) + ! If the land type is not represented in grid + ! box, then skip to the next land type + IF ( IUSE(LDT) <= 0 ) CYCLE + + ILDT = ILAND(LDT) + IF ( LUC == 'OLSON' ) THEN + ! Olson land type index + 1 + ILDT = ILDT + 1 + ! Dry deposition land type index + II = IDEP_IOLSON(ILDT) + LUCINDEX = LUCINDEX_GC(II) + ELSE IF ( LUC == 'NOAH' ) THEN + ! it is possible that water is given as 0 not 17 in GFS CCPP + IF (ILDT == 0) ILDT = 17 + II = IDEP_NOAH(ILDT) + !Note: we use ILDT, instead of II, to get LUCINDEX here + LUCINDEX = LUCINDEX_NOAH(ILDT) + ELSE IF ( LUC == 'IGBP' ) THEN + ! it is possible that water is given as 0 not 17 + IF (ILDT == 0) ILDT = 17 + II = IDEP_IGBP(ILDT) + LUCINDEX = LUCINDEX_IGBP(ILDT) + ENDIF + + !get bulk surface resistances (Rs) + !Note to change pressure unit from Pa to kPa + RSURFC = AERO_SFCRSII ( SPC, IS_DUST, IS_SEASALT, LUCINDEX, A_RADI, A_DEN, PRESSU*1e-3_fp, & + TEMP, USTAR, RHB, W10, SeaSalt_Lower_Bin, SeaSalt_UPPER_Bin,VTSoutput, RC) + + if (RC /= CC_SUCCESS ) then + errMsg = 'Error in getting bulk surface resistances (RSURFC)' + CALL CC_Error( errMsg, RC, thisLoc ) + RETURN + endif + + !*Set max and min values for bulk surface resistances + RSURFC = MAX(1.e+0_fp, MIN(RSURFC,9999.e+0_fp)) + ! Set Rc for strong acids (HNO3,HCl,HBr) to 1 s/m + ! Ref. Jaegle et al. 2018, cf. Erisman,van Pul,Ayers 1994 + IF ( HSTAR .gt. 1.e+10_fp ) RSURFC= 1.e+0_fp + + !get Ra and Rb + call Wesely_Ra_Rb(TEMP, PRESSU, XMW, USTAR, OBK, ZO, THIK, .FALSE., Ra, Rb, RC) + + !get VD (TODO: IUSE is decimal not percent or permille as in GEOS-Chem) + C1X = RSURFC + Ra + Rb + VK = VD + !VD = VK + DBLE( IUSE(LDT) ) / C1X + DBLE( IUSE(LDT) ) * VTSoutput + VD = VK + IUSE(LDT) / C1X + IUSE(LDT) * VTSoutput + END DO + + + !apply spectial treatment or scaling factor to Vd + DVZ = VD *100.e+0_fp !m/s -- > cm/s + + !----------------------------------------------------------- + ! Special treatment for snow and ice + !----------------------------------------------------------- + IF ( (IS_SNOW) .OR. (IS_ICE) ) THEN + + !------------------------------------- + ! %%% SURFACE IS SNOW OR ICE %%% + !------------------------------------- + IF ( DD_DvzAerSnow > 0.0_fp ) THEN + + ! For most aerosol species (basically everything + ! except sea salt and dust species), we just set + ! the deposition velocity over snow to a fixed value + !DVZ = DBLE( DD_DvzAerSnow ) + DVZ = DD_DvzAerSnow + + ELSE + + ! Otherwise, enforce a minimum drydep velocity over snow + ! (cf. the GOCART model). NOTE: In practice this will + ! only apply to the species SO2, SO4, MSA, NH3, NH4, NIT. + !DVZ = MAX( DVZ, DBLE( DD_DvzMinVal_Snow ) ) + DVZ = MAX( DVZ, DD_DvzMinVal_Snow ) + + ENDIF + + ELSE + + !------------------------------------- + ! %%% SURFACE IS NOT SNOW OR ICE %%% + !------------------------------------- + + ! Enforce a minimum drydep velocity over land (cf. the + ! GOCART model). NOTE: In practice this will only apply + ! to the species SO2, SO4, MSA, NH3, NH4, NIT. + !DVZ = MAX( DVZ, DBLE( DD_DvzMinVal_Land ) ) + DVZ = MAX( DVZ, DD_DvzMinVal_Land ) + + ENDIF + + !----------------------------------------------------------- + ! Compute drydep velocity and frequency + !----------------------------------------------------------- + + ! Dry deposition velocities [m/s] + VD = DVZ / 100.e+0_fp + + ! Dry deposition frequency [1/s] + DDFreq = VD / THIK + + !test only + !write(*,*) 'Test finish for species () with Vd (): ', SPC, VD + + + end subroutine CCPr_Scheme_Zhang_Aero + + +end module CCPr_Scheme_Zhang_aerosol_Mod diff --git a/tests/CATChem_config.yml b/tests/CATChem_config.yml index a8e4c6ee..ed90b75b 100644 --- a/tests/CATChem_config.yml +++ b/tests/CATChem_config.yml @@ -45,3 +45,8 @@ process: activate: true scheme_opt: 1 resuspension: false + bvoc: + activate: true + scheme_opt: 1 + co2_inhib: true + co2_conc_ppm: 390.0 diff --git a/tests/CMakeLists.txt b/tests/CMakeLists.txt index 487163ec..1ff6f2eb 100644 --- a/tests/CMakeLists.txt +++ b/tests/CMakeLists.txt @@ -87,6 +87,22 @@ add_test( WORKING_DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR} ) +add_executable(test_bvoc test_bvoc.F90) +target_link_libraries(test_bvoc PRIVATE CATChem_core) +target_link_libraries(test_bvoc PRIVATE CATChem) +target_link_libraries(test_bvoc PRIVATE CATChem_process_bvoc) +target_link_libraries(test_bvoc PRIVATE testing) +set_target_properties( + test_bvoc + PROPERTIES Fortran_MODULE_DIRECTORY ${CMAKE_BINARY_DIR}/include +) + +add_test( + NAME test_ccpr_bvoc + COMMAND test_bvoc + WORKING_DIRECTORY ${CMAKE_CURRENT_SOURCE_DIR} +) + add_executable(test_chem test_chem.f90) target_link_libraries(test_chem PRIVATE CATChem) target_link_libraries(test_chem PRIVATE testing) diff --git a/tests/Configs/Default/CATChem_config.yml b/tests/Configs/Default/CATChem_config.yml index ca532a07..2933893f 100644 --- a/tests/Configs/Default/CATChem_config.yml +++ b/tests/Configs/Default/CATChem_config.yml @@ -45,5 +45,15 @@ process: dust_beta: 1.0 drydep: activate: true - scheme_opt: 1 + aero_scheme_opt: 1 resuspension: false + #CO2 effect on stomatal conductance in wesely + gas_scheme_opt: 1 + co2_effect: true + co2_level: 600.0 + co2_reference: 380.0 + bvoc: + activate: true + scheme_opt: 1 + co2_inhib: true + co2_conc_ppm: 390.0 diff --git a/tests/Configs/Default/CATChem_emission.yml b/tests/Configs/Default/CATChem_emission.yml index aee12410..7de71809 100644 --- a/tests/Configs/Default/CATChem_emission.yml +++ b/tests/Configs/Default/CATChem_emission.yml @@ -22,3 +22,88 @@ dust: DU10: long_name: "Dust Species Coarse Mode" map: ["dust1", "dust2"] +BVOC: + ISOP: + long_name: "Isoprene" + scale: [1.0] + map: [ISOP] + APIN: + long_name: "a-Pinene" + scale: [1.0] + map: [APIN] + BPIN: + long_name: "b-Pinene" + scale: [1.0] + map: [BPIN] + LIMO: + long_name: "Limonene" + scale: [1.0] + map: [LIMO] + SABI: + long_name: "Sabinene" + scale: [1.0] + map: [SABI] + MYRC: + long_name: "Myrcene" + scale: [1.0] + map: [MYRC] + CARE: + long_name: "3-Carene" + scale: [1.0] + map: [CARE] + OCIM: + long_name: "Ocimene" + scale: [1.0] + map: [OCIM] + OMON: + long_name: "Other Monoterpenes" + scale: [1.0] + map: [OMON] + ALD2: + long_name: "Acetaldehyde" + scale: [1.0] + map: [ALD2] + MOH: + long_name: "Methanol" + scale: [1.0] + map: [MOH] + EOH: + long_name: "Ethanol" + scale: [1.0] + map: [EOH] + MBOX: + long_name: "Methyl Butenol" + scale: [1.0] + map: [MBOX] + FAXX: + long_name: "Formic Acid" + scale: [1.0] + map: [FAXX] + AAXX: + long_name: "Acetic Acid" + scale: [1.0] + map: [AAXX] + ACET: + long_name: "Acetone" + scale: [1.0] + map: [ACET] + PRPE: + long_name: "C3 alkenes" + scale: [1.0] + map: [PRPE] + C2H4: + long_name: "Ethene" + scale: [1.0] + map: [C2H4] + FARN: + long_name: "a-Farnesene" + scale: [1.0] + map: [FARN] + BCAR: + long_name: "b-Caryophyllene" + scale: [1.0] + map: [BCAR] + OSQT: + long_name: "Sesquiterpene" + scale: [1.0] + map: [OSQT] diff --git a/tests/Configs/Default/CATChem_species.yml b/tests/Configs/Default/CATChem_species.yml index 77172c76..cdb2621e 100644 --- a/tests/Configs/Default/CATChem_species.yml +++ b/tests/Configs/Default/CATChem_species.yml @@ -25,3 +25,407 @@ dust2: is_dust: true is_aerosol: true is_drydep: true +#add more species for Wesely dry deposition test +#viscosity is dummy value for gases to read in properly +#upper_ and lower_radius are dummy values for aerosols to read in properly +O3: + name: O3 + description: Ozone + is_gas: true + is_drydep: true + dd_f0: 1.0 + dd_hstar: 1.0e-2 + mw_g: 48.00 + viscosity: 0.0 +NO2: + name: NO2 + description: Nitrogen dioxide + is_gas: true + is_drydep: true + dd_f0: 0.1 + dd_hstar: 1.0e-2 + mw_g: 46.01 + viscosity: 0.0 +NH3: + name: NH3 + description: Ammonia + is_gas: true + is_drydep: true + dd_f0: 0.0 + dd_hstar: 2.0e+4 + mw_g: 17.04 + dd_DvzAerSnow: 0.03 + dd_DvzMinVal_snow: 0.2 + dd_DvzMinVal_land: 0.3 + viscosity: 0.0 +SO2: + name: SO2 + description: Sulfur dioxide + is_gas: true + is_drydep: true + dd_f0: 0.0 + dd_hstar: 1.0e+5 + mw_g: 64.04 + dd_DvzAerSnow: 0.03 + dd_DvzMinVal_snow: 0.2 + dd_DvzMinVal_land: 0.3 + viscosity: 0.0 +CH2O: + name: CH2O + description: Formaldehyde + is_gas: true + is_drydep: true + dd_f0: 0.0 + dd_hstar: 3.0e+3 + mw_g: 30.03 + viscosity: 0.0 +N2O5: + name: N2O5 + description: Dinitrogen pentoxide + is_gas: true + is_drydep: true + dd_f0: 0.0 + dd_hstar: 1.0e+14 + mw_g: 108.02 + viscosity: 0.0 +HNO3: + name: HNO3 + description: Nitric acid + is_gas: true + is_drydep: true + dd_f0: 0.0 + dd_hstar: 1.0e+14 + mw_g: 63.01 + viscosity: 0.0 +NIT: + name: NIT + description: Inorganic nitrate + is_aerosol: true + is_drydep: true + dd_f0: 0.0 + dd_hstar: 0.0 + mw_g: 62.01 + radius: 8.7e-8 + density: 1500.0 + dd_DvzAerSnow: 0.03 + dd_DvzMinVal_snow: 0.01 + dd_DvzMinVal_land: 0.01 + lower_radius: 0.1 + upper_radius: 1.0 +SO4: + name: SO4 + description: Sulfate + is_aerosol: true + is_drydep: true + dd_f0: 0.0 + dd_hstar: 0.0 + mw_g: 96.06 + radius: 8.7e-8 + density: 1500.0 + dd_DvzAerSnow: 0.03 + dd_DvzMinVal_snow: 0.01 + dd_DvzMinVal_land: 0.01 + lower_radius: 0.1 + upper_radius: 1.0 +NH4: + name: NH4 + description: Ammonium + is_aerosol: true + is_drydep: true + dd_f0: 0.0 + dd_hstar: 0.0 + mw_g: 18.05 + radius: 8.7e-8 + density: 1500.0 + dd_DvzAerSnow: 0.03 + dd_DvzMinVal_snow: 0.01 + dd_DvzMinVal_land: 0.01 + lower_radius: 0.1 + upper_radius: 1.0 +BCPI: + name: BCPI + description: Hydrophilic black carbon aerosol + is_aerosol: true + is_drydep: true + dd_f0: 0.0 + dd_hstar: 0.0 + mw_g: 12.01 + radius: 8.7e-8 + density: 1800.0 + dd_DvzAerSnow: 0.03 + lower_radius: 0.1 + upper_radius: 1.0 +BCPO: + name: BCPO + description: Hydrophobic black carbon aerosol + is_aerosol: true + is_drydep: true + dd_f0: 0.0 + dd_hstar: 0.0 + mw_g: 12.01 + radius: 8.7e-8 + density: 1800.0 + dd_DvzAerSnow: 0.03 + lower_radius: 0.1 + upper_radius: 1.0 +SALA: + name: SALA + description: Fine (0.01-0.05 microns) sea salt aerosol + is_aerosol: true + is_seasalt: true + is_drydep: true + dd_f0: 0.0 + dd_hstar: 0.0 + mw_g: 31.40 + radius: 1.14945e-7 + density: 2200.0 + lower_radius: 0.01 + upper_radius: 0.5 +SALC: + name: SALC + description: Coarse (0.5-8.0 microns) sea salt aerosol + is_aerosol: true + is_seasalt: true + is_drydep: true + dd_f0: 0.0 + dd_hstar: 0.0 + mw_g: 31.40 + radius: 0.74025e-6 + density: 2200.0 + lower_radius: 0.5 + upper_radius: 8.0 +SO4S: + name: SO4S + description: Sulfate aerosol on surface of seasalt aerosol + is_aerosol: true + is_seasalt: true + is_drydep: true + dd_f0: 0.0 + dd_hstar: 0.0 + mw_g: 31.40 + radius: 0.74025e-6 + density: 2200.0 + lower_radius: 0.5 + upper_radius: 8.0 +NITS: + name: NITS + description: Inorganic nitrate aerosol on surface of seasalt aerosol + is_aerosol: true + is_seasalt: true + is_drydep: true + dd_f0: 0.0 + dd_hstar: 0.0 + mw_g: 31.40 + radius: 0.74025e-6 + density: 2200.0 + lower_radius: 0.5 + upper_radius: 8.0 +BRSALC: + name: BRSALC + description: Coarse sea salt bromine + is_aerosol: true + is_seasalt: true + is_drydep: true + dd_f0: 0.0 + dd_hstar: 0.0 + mw_g: 79.90 + radius: 0.74025e-6 + density: 2200.0 + lower_radius: 0.5 + upper_radius: 8.0 +ISALC: + name: ISALC + description: Coarse sea salt iodine + is_aerosol: true + is_seasalt: true + is_drydep: true + dd_f0: 0.0 + dd_hstar: 0.0 + mw_g: 126.90 + radius: 0.74025e-6 + density: 2200.0 + lower_radius: 0.5 + upper_radius: 8.0 +BRSALA: + name: BRSALA + description: Fine sea salt bromine + is_aerosol: true + is_seasalt: true + is_drydep: true + dd_f0: 0.0 + dd_hstar: 0.0 + mw_g: 79.90 + radius: 1.14945e-7 + density: 2200.0 + lower_radius: 0.01 + upper_radius: 0.5 +ISALA: + name: ISALA + description: Fine sea salt iodine + is_aerosol: true + is_seasalt: true + is_drydep: true + dd_f0: 0.0 + dd_hstar: 0.0 + mw_g: 126.90 + radius: 1.14945e-7 + density: 2200.0 + lower_radius: 0.01 + upper_radius: 0.5 +#here we go with GEOS-Chem dust bins +DST1: + name: DST1 + description: Dust aerosol, Reff = 0.7 microns + is_aerosol: true + is_dust: true + is_drydep: true + dd_f0: 0.0 + dd_hstar: 0.0 + mw_g: 29.00 + radius: 3.334475e-7 + density: 2500.0 + lower_radius: 0.1 + upper_radius: 1.0 +DST2: + name: DST2 + description: Dust aerosol, Reff = 1.4 microns + is_aerosol: true + is_dust: true + is_drydep: true + dd_f0: 0.0 + dd_hstar: 0.0 + mw_g: 29.00 + radius: 1.24535e-6 + density: 2650.0 + lower_radius: 0.1 + upper_radius: 1.0 +DST3: + name: DST3 + description: Dust aerosol, Reff = 2.4 microns + is_aerosol: true + is_dust: true + is_drydep: true + dd_f0: 0.0 + dd_hstar: 0.0 + mw_g: 29.00 + radius: 2.082e-6 + density: 2650.0 + lower_radius: 0.1 + upper_radius: 1.0 +DST4: + name: DST4 + description: Dust aerosol, Reff = 4.5 microns + is_aerosol: true + is_dust: true + is_drydep: true + dd_f0: 0.0 + dd_hstar: 0.0 + mw_g: 29.00 + radius: 3.3385e-6 + density: 2650.0 + lower_radius: 0.1 + upper_radius: 1.0 +SO4D1: + name: SO4D1 + description: Sulfate on dust, Reff = 0.7 microns + is_aerosol: true + is_dust: true + is_drydep: true + dd_f0: 0.0 + dd_hstar: 0.0 + mw_g: 29.0 + radius: 3.334475e-7 + density: 2500.0 + lower_radius: 0.1 + upper_radius: 1.0 +SO4D2: + name: SO4D2 + description: Sulfate on dust, Reff = 1.4 microns + is_aerosol: true + is_dust: true + is_drydep: true + dd_f0: 0.0 + dd_hstar: 0.0 + mw_g: 29.0 + radius: 1.24535e-6 + density: 2650.0 + lower_radius: 0.1 + upper_radius: 1.0 +SO4D3: + name: SO4D3 + description: Sulfate on dust, Reff = 2.4 microns + is_aerosol: true + is_dust: true + is_drydep: true + dd_f0: 0.0 + dd_hstar: 0.0 + mw_g: 29.0 + radius: 2.082e-6 + density: 2650.0 + lower_radius: 0.1 + upper_radius: 1.0 +SO4D4: + name: SO4D4 + description: Sulfate on dust, Reff = 4.5 microns + is_aerosol: true + is_dust: true + is_drydep: true + dd_f0: 0.0 + dd_hstar: 0.0 + mw_g: 29.0 + radius: 3.3385e-6 + density: 2650.0 + lower_radius: 0.1 + upper_radius: 1.0 +NITD1: + name: NITD1 + description: Nitrate on dust, Reff = 0.7 microns + is_aerosol: true + is_dust: true + is_drydep: true + dd_f0: 0.0 + dd_hstar: 0.0 + mw_g: 29.0 + radius: 3.334475e-7 + density: 2500.0 + lower_radius: 0.1 + upper_radius: 1.0 +NITD2: + name: NITD2 + description: Nitrate on dust, Reff = 1.4 microns + is_aerosol: true + is_dust: true + is_drydep: true + dd_f0: 0.0 + dd_hstar: 0.0 + mw_g: 29.0 + radius: 1.24535e-6 + density: 2650.0 + lower_radius: 0.1 + upper_radius: 1.0 +NITD3: + name: NITD3 + description: Nitrate on dust, Reff = 2.4 microns + is_aerosol: true + is_dust: true + is_drydep: true + dd_f0: 0.0 + dd_hstar: 0.0 + mw_g: 29.0 + radius: 2.082e-6 + density: 2650.0 + lower_radius: 0.1 + upper_radius: 1.0 +NITD4: + name: NITD4 + description: Nitrate on dust, Reff = 4.5 microns + is_aerosol: true + is_dust: true + is_drydep: true + dd_f0: 0.0 + dd_hstar: 0.0 + mw_g: 29.0 + radius: 3.3385e-6 + density: 2650.0 + lower_radius: 0.1 + upper_radius: 1.0 diff --git a/tests/test_bvoc.F90 b/tests/test_bvoc.F90 new file mode 100644 index 00000000..099384ff --- /dev/null +++ b/tests/test_bvoc.F90 @@ -0,0 +1,173 @@ +program test_bvoc + use CATChem, fp => cc_rk + use testing_mod, only: assert + use state_mod + use ccpr_bvoc_common_mod, only : BvocStateType + !use EmisState_Mod, only: Emis_Allocate + + implicit none + + + type(BvocStateType) :: BvocState + + ! Integers + INTEGER:: rc ! Success or failure + + character(len=:), allocatable :: title + + integer :: c ! Loop counter for emission Cats + integer :: s ! Loop counter for emitted species + + ! Error handling + CHARACTER(LEN=512) :: errMsg + CHARACTER(LEN=255) :: thisLoc + CHARACTER(LEN=255), PARAMETER :: configFile ='Configs/Default/CATChem_config.yml' + + thisLoc = 'test_bvoc -> at read CATChem_Config.yml' + errMsg = '' + rc = CC_SUCCESS + + write(*,*) ' CCCCC A TTTTTTT CCCCC H' + write(*,*) ' C A A T C H CCCC EEEE M M' + write(*,*) ' C AAAAA T C HHHHH C E E M M M M' + write(*,*) ' C A A T C H H C E EE M M M' + write(*,*) ' CCCCC A A T CCCCC H H CCCC EEEEE M M' + write(*,*) '' + write(*,*) '' + + !---------------------------- + ! Test 1 + !---------------------------- + + ! Read input file and initialize grid + call cc_read_config(Config, GridState, EmisState, ChemState, rc,configFile) + if (rc /= CC_success) then + errMsg = 'Error reading configuration file: ' // TRIM( configFile ) + call cc_emit_error(errMsg, rc, thisLoc) + stop 1 + endif + title = 'BVOC Test 1 | Read Config' + write(*,*) 'title = ', title + write(*,*) 'Config%bvoc_activate = ', Config%bvoc_activate + write(*,*) 'Config%bvoc_scheme = ', Config%bvoc_scheme + write(*,*) 'Config%megan_co2_inhib = ', Config%megan_co2_inhib + write(*,*) 'Config%megan_co2_conc_ppm = ', Config%megan_co2_conc_ppm + write(*,*) 'EmisState%nCats = ', EmisState%nCats + !write(*,*) 'EmisState%Cats = ', EmisState%Cats !cannot write allocatable variables here; need to put in the subroutin at the bottom + + !call Emis_Allocate(GridState, EmisState, RC) !Not sure why cannot call it even if I made it public and used EmisStateMod in this module + if (EmisState%nCats > 0) then + do c = 1, EmisState%nCats + do s = 1, EmisState%Cats(c)%nSpecies + ALLOCATE(EmisState%Cats(c)%Species(s)%Flux(GridState%number_of_levels), STAT=RC) + if (RC /= CC_SUCCESS) then + ErrMsg = 'Error allocating "EmisState%Cats%Species%Flux"!' + call cc_emit_error(ErrMsg, RC, ThisLoc) + stop 1 !!Note here is not 'return' + endif + end do + end do + end if + + !---------------------------- + ! Test 2 + !---------------------------- + + ! Meteorological State (get from 20190620 18:00:00 HEMCO log out) + MetState%TSTEP= 3600 + MetState%LAI= 3.9094312191009521 + allocate(MetState%PFT_16(16)) + MetState%PFT_16= (/0.00, 0.11120668053627014, 0.00, 0.00, 0.00, 0.00, 0.00, 0.35108909010887146, & + 0.00, 0.00, 0.00, 0.00, 0.00,0.18369837105274200,6.9862455129623413E-002,0.26875913143157959/) + MetState%PMISOLAI= 3.90559316 ! needs to multiply PFTSUM + MetState%Q_DIR_2= 368.02691650390625 + MetState%Q_DIFF_2= 55.688854217529297 + MetState%PARDR_LASTXDAYS= 69.8014755 + MetState%PARDF_LASTXDAYS= 37.4157791 + MetState%TS= 300.42892456054688 + MetState%T_LASTXDAYS= 294.497833 + MetState%T_LAST24H= 294.919861 + MetState%GWETROOT= 0.76981580257415771 + MetState%SUNCOS= 0.96700188446067026 + MetState%LAT= 38.00 + MetState%DOY= 171 + MetState%LocalHour= 12.00 + MetState%D_BTW_M= 1.00 + !These are read from file. Keep them here for now + !MetState%AEF_ISOP= 1.8055753025901623E-009 + !MetState%AEF_MBOX= 4.9856540616165277E-013 + !MetState%AEF_BPIN= 1.3127712426530056E-011 + !MetState%AEF_CARE= 3.6563258621377127E-012 + !MetState%AEF_LIMO= 6.3985420662872528E-012 + !MetState%AEF_OCIM= 3.0705341449874024E-011 + !MetState%AEF_SABI= 1.0054971341792413E-011 + + ! Allocate DiagState + call cc_allocate_diagstate(Config, DiagState, ChemState, RC) + if (rc /= CC_SUCCESS) then + errMsg = 'Error in cc_allocate_diagstate' + stop 1 + endif + + title = "BVOC Test 2 | Test each species" + Config%bvoc_activate = .TRUE. + + !call cc_bvoc_init(Config, ChemState, EmisState, BvocState, RC) + call cc_bvoc_init(Config, EmisState, BvocState, RC) + if (rc /= CC_SUCCESS) then + errMsg = 'Error in cc_bvoc_init' + call cc_emit_error(errMsg, rc, thisLoc) + stop 1 + end if + + !call cc_bvoc_run(MetState, EmisState, DiagState, BvocState, ChemState, RC ) + call cc_bvoc_run(MetState, EmisState, DiagState, BvocState, RC ) + if (rc /= CC_SUCCESS) then + errMsg = 'Error in cc_bvoc_run' + call cc_emit_error(errMsg, rc, thisLoc) + stop 1 + end if + + call print_info(Config, BvocState, MetState, DiagState, title) + call assert(BvocState%TotalEmission > 1.0e-9_fp, "Test BVOC species") + !add check to each species + do s = 1, BvocState%nBvocSpecies + call assert(BvocState%EmissionPerSpecies(s) > 1.0e-12_fp, & + "Test lower emission limit for species " // TRIM(BvocState%BvocSpeciesName(s))) + call assert(BvocState%EmissionPerSpecies(s) < 1.0e-9_fp, & + "Test upper emission limit for species " // TRIM(BvocState%BvocSpeciesName(s))) + end do + + +contains + + subroutine print_info(Config_, BvocState_, MetState_, DiagState_, title_) + type(ConfigType), intent(in) :: Config_ + type(MetStateType), intent(in) :: MetState_ + type(BvocStateType), intent(in) :: BvocState_ + type(DiagStatetype), INTENT(in) :: DiagState_ + character(len=*), intent(in) :: title_ + + write(*,*) '=======================================' + write(*,*) title_ + write(*,*) '=======================================' + write(*,*) '*************' + write(*,*) 'Configuration ' + write(*,*) '*************' + write(*,*) 'Config%bvoc_activate = ', Config_%bvoc_activate + write(*,*) 'BvocState%activate = ', BvocState_%activate + write(*,*) 'BvocState%CatIndex = ', BvocState_%CatIndex + write(*,*) 'BvocState%CO2Inhib = ', BvocState_%CO2Inhib + write(*,*) 'BvocState%CO2conc = ', BvocState_%CO2conc + write(*,*) 'MetState%LAI =', MetState_%LAI + write(*,*) 'MetState%DOY =', MetState_%DOY + !write(*,*) 'MetState%AEF_ISOP =', MetState_%AEF_ISOP + write(*,*) 'MetState%PFT_16 =', MetState_%PFT_16 + write(*,*) 'BvocState%BvocSpeciesName=', BvocState_%BvocSpeciesName + write(*,*) 'BvocState%EmissionPerSpecies=', BvocState_%EmissionPerSpecies + write(*,*) 'BvocState%TotalEmission = ', BvocState_%TotalEmission + write(*,*) 'DiagState%PARDR_LASTXDAYS = ', DiagState_%PARDR_LASTXDAYS + + end subroutine print_info + +end program test_bvoc diff --git a/tests/test_drydep.f90 b/tests/test_drydep.f90 index 35bb979b..c37001c1 100644 --- a/tests/test_drydep.f90 +++ b/tests/test_drydep.f90 @@ -50,22 +50,15 @@ program test_drydep title = 'drydep Test 1 | Read Config' - !DryDepState%SchemeOpt = 1 + !DryDepState%AeroSchemeOpt = 1 DryDepState%Activate = .false. - call print_info(Config, DryDepState, MetState, title) + call print_info(Config, DryDepState, MetState, ChemState, title) write (*,*) '-- ' write (*,*) 'Completed ', title write (*,*) '--' - !---------------------------- - ! Test 2 - !---------------------------- - ! Set number of drydep species - ChemState%nSpeciesAerodrydep = 2 - DryDepState%Activate = .true. - - ! Meteorological State + ! Meteorological State to run the tests MetState%LWI = 1.0_fp MetState%USTAR = 0.1_fp MetState%PBLH = 1000.0_fp @@ -88,9 +81,43 @@ program test_drydep MetState%ZMID(i) = (MetState%NLEVS*100 - I*100) ! m end do - DryDepState%SchemeOpt = 1 + !used for Wesely & Zhang drydep scheme (need to be put here otherwise it cannot run without allocation of some variables) + MetState%SWGDN = 500.0_fp + MetState%TS = 301.0_fp + MetState%SUNCOSmid= 0.97_fp + MetState%USTAR = 0.05_fp + MetState%OBK = 100.0_fp + MetState%CLDFRC = 0.1 + allocate(MetState%BXHEIGHT(MetState%NLEVS)) + MetState%BXHEIGHT = 40.0_fp + MetState%Z0 = 10_fp + allocate(MetState%RH(MetState%NLEVS)) + MetState%RH = 0.4661 !unitless (low values[<=0.466 in this test] will lead to the error of DEN for seasalt species) + MetState%PS = 1000.0_fp ! hPa + MetState%FRLAI = (/ 3.0, 3.0, 1.0, 0.0/) !TODO: whether LAI is separated to each land type? + MetState%ILAND = (/ 5, 6, 18, 11 /) + MetState%FRLANDUSE = (/ 0.4, 0.4, 0.1, 0.1 /) + MetState%SALINITY=25 ! greater than 20 (in ppt; part per thousand) is considered as ocean + MetState%TSKIN = 305.0_fp + MetState%IODIDE = 100_fp !in [nM; nanoMolar] + MetState%LON = -92.0_fp + MetState%LAT = 38.0_fp + MetState%LUCNAME = 'OLSON' + !MetState%LNLPBL = .true. + MetState%IsSnow = .false. + MetState%IsIce = .false. + MetState%IsLand = .true. + + !---------------------------- + ! Test 2 + !---------------------------- + title = "DryDep Test 2 | Test GOCART DryDep defaults" + + !ChemState%nSpeciesDrydep = 2 + !DryDepState%Activate = .true. + !DryDepState%AeroSchemeOpt = 1 ! Turn off resuspension - DryDepState%Resuspension = .FALSE. + !DryDepState%Resuspension = .FALSE. ! Allocate DiagState call cc_allocate_diagstate(Config, DiagState, ChemState, RC) @@ -99,8 +126,6 @@ program test_drydep stop 1 endif - title = "DryDep Test 2 | Test GOCART DryDep defaults" - call cc_drydep_init(Config, DryDepState, ChemState, rc) if (rc /= CC_SUCCESS) then errMsg = 'Error in cc_drydep_init' @@ -116,7 +141,7 @@ program test_drydep stop 1 end if - call print_info(Config, DryDepState, MetState, title) + call print_info(Config, DryDepState, MetState, ChemState, title) call assert(DiagState%drydep_frequency(1) > 0.0_fp, "Test GOCART DryDep Scheme (no resuspension)") @@ -124,7 +149,7 @@ program test_drydep ! Test 3 !---------------------------- title = "drydep Test 3 | resuspension is .TRUE. " - ChemState%nSpeciesAerodrydep = 1 + !ChemState%nSpeciesDrydep = 1 ! Turn on resuspension DryDepState%Resuspension = .TRUE. DryDepState%particleradius = 0.000001 ! [m] @@ -138,17 +163,65 @@ program test_drydep end if ! Please revisit statements below - confirm only 1 valid value is being returned - call print_info(Config, DryDepState, MetState, title) + call print_info(Config, DryDepState, MetState, ChemState, title) call assert(DiagState%drydep_frequency(1) > 0.0_fp, "Test 2 GOCART drydep Scheme (resuspension activated)") + !---------------------------- + ! Test 4 + !---------------------------- + title = "drydep Test 4 | Wesely & Zhang Scheme" + + !clean up the test above for a different scheme test (Test 4) + call cc_drydep_finalize( DryDepState, rc) + if (rc /= CC_SUCCESS) then + errMsg = 'Error in cc_drydep_finalize' + call cc_emit_error(errMsg, rc, thisLoc) + stop 1 + end if + + !deallocate the diagstate arrays + if (allocated(DiagState%drydep_frequency)) deallocate(DiagState%drydep_frequency) + if (allocated(DiagState%drydep_vel)) deallocate(DiagState%drydep_vel) + + !ChemState%nSpeciesDrydep = 34 + Config%drydep_aero_scheme = 2 + Config%drydep_gas_scheme = 1 + + ! Allocate DiagState + call cc_allocate_diagstate(Config, DiagState, ChemState, RC) + if (rc /= CC_SUCCESS) then + errMsg = 'Error in cc_allocate_diagstate' + stop 1 + endif + + call cc_drydep_init(Config, DryDepState, ChemState, rc) + if (rc /= CC_SUCCESS) then + errMsg = 'Error in cc_drydep_init' + call cc_emit_error(errMsg, rc, thisLoc) + stop 1 + end if + + call cc_drydep_run(MetState, DiagState, DryDepState, ChemState, rc) + if (rc /= CC_SUCCESS) then + errMsg = 'Error in cc_drydep_run' + call cc_emit_error(errMsg, rc, thisLoc) + stop 1 + end if + + ! Please revisit statements below - confirm only 1 valid value is being returned + call print_info(Config, DryDepState, MetState, ChemState, title) + call assert(DiagState%drydep_frequency(1) > 0.0_fp, "Test 4 Wesely drydep Scheme") + + contains - subroutine print_info(Config_, DryDepState_, MetState_, title_) + subroutine print_info(Config_, DryDepState_, MetState_, ChemState_, title_) type(ConfigType), intent(in) :: Config_ type(MetStateType), intent(in) :: MetState_ type(DryDepStateType), intent(in) :: DryDepState_ + type(ChemStateType), intent(in) :: ChemState_ character(len=*), intent(in) :: title_ write(*,*) '=======================================' @@ -158,13 +231,15 @@ subroutine print_info(Config_, DryDepState_, MetState_, title_) write(*,*) 'Configuration ' write(*,*) '*************' write(*,*) 'Config%drydep_activate = ', Config_%drydep_activate - write(*,*) 'Config%drydep_scheme = ', Config_%drydep_scheme + write(*,*) 'Config%drydep_aero_scheme = ', Config_%drydep_aero_scheme + write(*,*) 'Config%drydep_gas_scheme = ', Config_%drydep_gas_scheme write(*,*) 'Config%drydep_resuspension = ', Config_%drydep_resuspension if (DryDepState_%Activate) then write(*,*) 'DryDepState%Activate = ', DryDepState_%Activate - write(*,*) 'DryDepState%SchemeOpt = ', DryDepState_%SchemeOpt + write(*,*) 'DryDepState%AeroSchemeOpt = ', DryDepState_%AeroSchemeOpt + write(*,*) 'DryDepState%GasSchemeOpt = ', DryDepState_%GasSchemeOpt write(*,*) 'DryDepState%Resuspension = ', DryDepState_%Resuspension if (DryDepState_%Resuspension) then @@ -173,6 +248,10 @@ subroutine print_info(Config_, DryDepState_, MetState_, title_) end if write(*,*) 'MetState%AIRDEN =', MetState_%AIRDEN + + write(*,*) 'ChemState%nSpeciesDrydep = ', ChemState_%nSpeciesDrydep + write(*,*) 'ChemState%chemSpecies%name =', ChemState_%chemSpecies(ChemState%DryDepIndex(:))%short_name + write(*,*) 'DryDepState_%drydep_vel =', DryDepState_%drydep_vel write(*,*) 'DryDepState%drydepf = ', DryDepState_%drydep_frequency end if